# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1340408302 18000
# Node ID 7ba07a6adb0c806ae78065541c4a1bdf9519a8ce
# Parent  964957680c1180ffc406de37c74cff37afd395f9
going to correct premium stupdity.

diff -r 964957680c11 -r 7ba07a6adb0c clojure/com/aurellem/run/image.clj
--- a/clojure/com/aurellem/run/image.clj	Fri Jun 22 15:03:41 2012 -0500
+++ b/clojure/com/aurellem/run/image.clj	Fri Jun 22 18:38:22 2012 -0500
@@ -32,17 +32,6 @@
 ;; screen.
 
 
-
-
-
-
-
-
-
-
-
-
-
 (def image-program-target 0xB000)
 
 (def display-width 160)
@@ -333,10 +322,6 @@
    []
    (sort-by (comp - count) objs)))
 
-(defn absorb-combine-4 [objs]
-
-  )
-
 (defn palettes [^BufferedImage image]
   (let [palettes (map tile->palette (gb-tiles image))
         unique-palettes (absorb-contract (set palettes))]
@@ -393,8 +378,6 @@
            (palette-index
             (tile-pallete tile image-palettes))])))}))
 
-
-
 (defn wait-until-v-blank
   "Modified version of frame-metronome. waits untill LY == 144,
    indicating start of v-blank period."
@@ -412,7 +395,6 @@
           (+ -4 (- (count timing-loop))))]]
     (concat timing-loop continue-if-144)))
 
-
 (def bg-character-data 0x9000)
 
 (defn gb-tile->bytes
@@ -442,7 +424,6 @@
       (map row->bits
            (partition 8 tile))))))
 
-
 (defn write-data
   "Efficient assembly to write a sequence of values to
    memory, starting at a target address."
@@ -450,7 +431,6 @@
   (let [len (count data)
         program-length 21] ;; change this if program length
         ;; below changes!
-        
     (flatten
        [0x21 ;; load data address start into HL
         (reverse (disect-bytes-2 (+ base-address program-length)))
@@ -482,6 +462,75 @@
           (+ len base-address program-length)))
         data])))
 
+(defn write-image
+  "Assume the image data is 160x144 pixels specified as 360 blocks."
+  [base-address target-address image-data]
+  
+  (let [len (count image-data)
+        gen-program
+        (fn [program-length]
+          (flatten 
+           [0x21 ;; load data address start into HL
+            (reverse
+             (disect-bytes-2 (+ base-address program-length)))
+
+            0x01 ;; load target address into BC
+            (reverse (disect-bytes-2 target-address))
+
+            0x1E ;; total-rows (18) -> E
+            1
+
+            0x16 ;; total columns (20) -> D
+            20
+            
+            ;; wite one block (8x8 pixels) to screen.
+            0x3E
+            16   ;; load 16 into A
+
+            0xF5 ;; push A
+            
+            ;; data x-fer loop start
+            0x2A ;; (HL) -> A; HL++;
+            0x02 ;; A -> (BC);
+            0x03 ;; INC BC;
+
+
+            0xF1 ;; pop A
+            
+            0x3D ;; dec A
+            0x20 ;; 
+            (->signed-8-bit -8) ;; continue writing block
+
+            0x15 ;; dec D 
+            0x20
+            (->signed-8-bit -13) ;; continue writing row
+
+            ;; row is complete, advance to next row
+            ;; HL += 192
+
+            0xC5 ;; push BC
+
+            0x06 ;; 0 -> B
+            0
+
+            0x0E
+            0  ;; 192 -> C
+
+            0x09 ;; HL + BC -> HL 
+
+            0xC1 ;; pop BC
+            
+            0x1D ;; dec E
+            0x20
+            (->signed-8-bit -23) ;; contunue writing picture
+
+            0xC3
+            (reverse
+             (disect-bytes-2
+              (+ len base-address program-length)))]))]
+    (flatten (concat
+              (gen-program (count (gen-program 0)))
+              image-data))))
 
 (defn test-write-data []
   (let [test-data (concat (range 256)
@@ -524,30 +573,30 @@
   (assert (or (= n 0) (= n 1)))
   (write-byte LCD-bank-select-address n))
 
+(defn write-image* [_ _ _] [])
+
 (defn display-image-kernel [base-address ^BufferedImage image]
   (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.
+           ;; [ ] We're only using background palettes; just set the
+           ;; minimum required bg palettes for this image, starting
+           ;; with palette #0.
 
            (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)
-
            ;; [X] set SCX and SCY to 0
            (write-byte SCX-register 0)
            (write-byte SCY-register 0)
-
            ]
         A (flatten A)
 
@@ -562,7 +611,7 @@
 
         
         C [;; [ ] write image to the screen in terms of tiles
-           (write-data
+           (write-image
             (+ base-address (+ (count A) (count B)))
             BG-1-address
             (map first (:data gb-image)))]
@@ -571,7 +620,7 @@
 
         D [;; [ ] specifiy pallets for each character
            (select-LCD-bank 1)
-           (write-data
+           (write-image
             (+ base-address (+ (count A) (count B) (count C)))
             BG-1-address
             (map second (:data gb-image)))
@@ -595,14 +644,12 @@
               "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))))
@@ -610,6 +657,3 @@
          kernel-address
          (display-image-kernel kernel-address image))
         (PC! kernel-address))))
-      
-
-