# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1340395421 18000
# Node ID 964957680c1180ffc406de37c74cff37afd395f9
# Parent  b9814e3114e48160bd4ea6cfaba396fa73b1c74d
got an image to display, but it doesn't tile correctly.

diff -r b9814e3114e4 -r 964957680c11 clojure/com/aurellem/run/image.clj
--- a/clojure/com/aurellem/run/image.clj	Wed Jun 20 22:49:31 2012 -0500
+++ b/clojure/com/aurellem/run/image.clj	Fri Jun 22 15:03:41 2012 -0500
@@ -90,7 +90,7 @@
 
 (def max-palettes 8)
 
-(defn write-data [target data]
+(defn write-byte [target data]
     (flatten
      [0x3E ;; load literal to A
       data
@@ -114,14 +114,27 @@
               "00" ;; color num
               "0"  ;; H/L
               ) 2)]
-    (write-data palette-select-address palette-write-data)))
+    (write-byte palette-select-address palette-write-data)))
         
 (defn set-palettes [palette-select palette-data palettes]
   (assert (<= (count palettes)) max-palettes)
   (flatten 
    [(begin-sequential-palette-write 0 palette-select)
-    (map (partial write-data palette-data)
-         (flatten (map gb-rgb->bits palettes)))]))
+
+    0x21 ;; target address to HL
+    (reverse (disect-bytes-2 palette-data))
+    
+    
+    (for [palette palettes]
+      (map (fn [byte]
+             [0x3E ;; literal to A
+              byte
+              0x77]) ;; A -> (HL)
+           
+           (flatten
+            (map #(gb-rgb->bits (get palette % [0 0 0]))
+                 (range 4)))))]))
+      
 
 (defn display-one-color
   "Displayes a single color onto the gameboy screen. Input rgb in
@@ -129,14 +142,16 @@
   ([state [r g b]]
      ;; construct a kernel that displays a single color
      (let
-         [palettes (repeat 8 [r g b])
+         [palettes (repeat 8 [[r g b] [r g b] [r g b] [r g b]])
           kernel-address 0xC000
           kernel
           [0xF3 ;; disable interrupts
            (clear-music-registers)
            (frame-metronome)
-           (set-palettes obj-palette-select obj-palette-data palettes)
-           (set-palettes bg-palette-select bg-palette-data palettes)
+           ;;(set-palettes
+           ;; obj-palette-select obj-palette-data palettes)
+           (set-palettes
+            bg-palette-select bg-palette-data palettes)
            (infinite-loop)]]
        (-> (set-memory-range state
                              kernel-address (flatten kernel))
@@ -493,42 +508,108 @@
                     (+ target-address
                        (count test-data))))))))
 
+(def LCD-bank-select-address 0xFF4F)
+
+(def BG-1-address 0x9800)
+(def BG-2-address 0x9C00)
+(def character-data-address 0x8000)
+
+(def LCD-control-register 0xFF40)
+(def STAT-register        0xFF41)
+
+(def SCX-register 0xFF42)
+(def SCY-register 0xFF43)
+
+(defn select-LCD-bank [n]
+  (assert (or (= n 0) (= n 1)))
+  (write-byte LCD-bank-select-address n))
+
 (defn display-image-kernel [base-address ^BufferedImage image]
-  (let [gb-image (image->gb-image image)]
-  
-    [(clear-music-registers)
+  (let [gb-image (image->gb-image image)
+        
+        A [(clear-music-registers)
+           
+           ;; [X] disable LCD protection circuit.
+           (write-byte LCD-control-register 0x00)
+           ;; now we can write to all video RAM anytime with
+           ;; impunity.
+           
+           ;; we're only using background palettes; just set the
+           ;; minimum required bg palettes for this image,
+           ;; starting with palette #0.
 
-     ;; [ ] disable LCD protection circuit.
-     
-     ;; now we can write to all video RAM anytime with
-     ;; impunity.
+           (set-palettes bg-palette-select bg-palette-data
+                         (:palettes gb-image))
 
+           ;; [X] switch to bank 0 to set BG character data.
+           (select-LCD-bank 0)
 
-     
-     ;; we're only using background palettes; just set the
-     ;; minimum required bg palettes for this image,
-     ;; starting with palette #0.
+           ;; [X] set SCX and SCY to 0
+           (write-byte SCX-register 0)
+           (write-byte SCY-register 0)
 
-     (set-palettes bg-palette-select bg-palette-data
-                   (:palettes gb-image))
+           ]
+        A (flatten A)
 
-     ;; [ ] switch to bank 0 to set BG character data.
-     
-     
-     ;; [ ] write minimum amount of tiles to BG character
-     ;; section
-     
+        B [;; [X] write minimum amount of tiles to BG character
+           ;; section
+           (write-data
+            (+ base-address (count A))
+            character-data-address
+            (flatten
+             (map gb-tile->bytes (:tiles gb-image))))]
+        B (flatten B)
 
-     ;; [ ] disable the display of OBJ tiles.
-     
+        
+        C [;; [ ] write image to the screen in terms of tiles
+           (write-data
+            (+ base-address (+ (count A) (count B)))
+            BG-1-address
+            (map first (:data gb-image)))]
 
-     ;; [ ] reactivate the LCD display
-     
+        C (flatten C)
 
-     (infinite-loop)]
+        D [;; [ ] specifiy pallets for each character
+           (select-LCD-bank 1)
+           (write-data
+            (+ base-address (+ (count A) (count B) (count C)))
+            BG-1-address
+            (map second (:data gb-image)))
 
-     
-  ))
 
+           ;; [X] reactivate the LCD display
+           ;; we're using only BG images, located at
+           ;; BG-1 (0x9800), with background character data
+           ;; stored starting at 0x8000
 
+           (write-byte
+            LCD-control-register
+            (Integer/parseInt
+             (str
+              "1"  ;; LCDC on/off
+              "0"  ;; Window code area
+              "0"  ;; Windowing on?
+              "1"  ;; BG tile base (1 = 0x8000)
+              "0"  ;; BG-1 or BG-2 ?
+              "0"  ;; OBJ-block composition
+              "0"  ;; OBJ-on flag 
+              "1") ;; no-effect 
+             2))
+           
 
+           (infinite-loop)]
+        D (flatten D)]
+
+    (concat A B C D)))
+
+
+(defn display-image [#^BufferedImage image]
+  (let [kernel-address 0xB000]
+    (-> (tick (tick (tick (mid-game))))
+        (set-memory-range
+         kernel-address
+         (display-image-kernel kernel-address image))
+        (PC! kernel-address))))
+      
+
+