1.1 --- a/clojure/com/aurellem/run/image.clj	Fri Jun 22 15:03:41 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/image.clj	Fri Jun 22 18:38:22 2012 -0500
     1.3 @@ -32,17 +32,6 @@
     1.4  ;; screen.
     1.5  
     1.6  
     1.7 -
     1.8 -
     1.9 -
    1.10 -
    1.11 -
    1.12 -
    1.13 -
    1.14 -
    1.15 -
    1.16 -
    1.17 -
    1.18  (def image-program-target 0xB000)
    1.19  
    1.20  (def display-width 160)
    1.21 @@ -333,10 +322,6 @@
    1.22     []
    1.23     (sort-by (comp - count) objs)))
    1.24  
    1.25 -(defn absorb-combine-4 [objs]
    1.26 -
    1.27 -  )
    1.28 -
    1.29  (defn palettes [^BufferedImage image]
    1.30    (let [palettes (map tile->palette (gb-tiles image))
    1.31          unique-palettes (absorb-contract (set palettes))]
    1.32 @@ -393,8 +378,6 @@
    1.33             (palette-index
    1.34              (tile-pallete tile image-palettes))])))}))
    1.35  
    1.36 -
    1.37 -
    1.38  (defn wait-until-v-blank
    1.39    "Modified version of frame-metronome. waits untill LY == 144,
    1.40     indicating start of v-blank period."
    1.41 @@ -412,7 +395,6 @@
    1.42            (+ -4 (- (count timing-loop))))]]
    1.43      (concat timing-loop continue-if-144)))
    1.44  
    1.45 -
    1.46  (def bg-character-data 0x9000)
    1.47  
    1.48  (defn gb-tile->bytes
    1.49 @@ -442,7 +424,6 @@
    1.50        (map row->bits
    1.51             (partition 8 tile))))))
    1.52  
    1.53 -
    1.54  (defn write-data
    1.55    "Efficient assembly to write a sequence of values to
    1.56     memory, starting at a target address."
    1.57 @@ -450,7 +431,6 @@
    1.58    (let [len (count data)
    1.59          program-length 21] ;; change this if program length
    1.60          ;; below changes!
    1.61 -        
    1.62      (flatten
    1.63         [0x21 ;; load data address start into HL
    1.64          (reverse (disect-bytes-2 (+ base-address program-length)))
    1.65 @@ -482,6 +462,75 @@
    1.66            (+ len base-address program-length)))
    1.67          data])))
    1.68  
    1.69 +(defn write-image
    1.70 +  "Assume the image data is 160x144 pixels specified as 360 blocks."
    1.71 +  [base-address target-address image-data]
    1.72 +  
    1.73 +  (let [len (count image-data)
    1.74 +        gen-program
    1.75 +        (fn [program-length]
    1.76 +          (flatten 
    1.77 +           [0x21 ;; load data address start into HL
    1.78 +            (reverse
    1.79 +             (disect-bytes-2 (+ base-address program-length)))
    1.80 +
    1.81 +            0x01 ;; load target address into BC
    1.82 +            (reverse (disect-bytes-2 target-address))
    1.83 +
    1.84 +            0x1E ;; total-rows (18) -> E
    1.85 +            1
    1.86 +
    1.87 +            0x16 ;; total columns (20) -> D
    1.88 +            20
    1.89 +            
    1.90 +            ;; wite one block (8x8 pixels) to screen.
    1.91 +            0x3E
    1.92 +            16   ;; load 16 into A
    1.93 +
    1.94 +            0xF5 ;; push A
    1.95 +            
    1.96 +            ;; data x-fer loop start
    1.97 +            0x2A ;; (HL) -> A; HL++;
    1.98 +            0x02 ;; A -> (BC);
    1.99 +            0x03 ;; INC BC;
   1.100 +
   1.101 +
   1.102 +            0xF1 ;; pop A
   1.103 +            
   1.104 +            0x3D ;; dec A
   1.105 +            0x20 ;; 
   1.106 +            (->signed-8-bit -8) ;; continue writing block
   1.107 +
   1.108 +            0x15 ;; dec D 
   1.109 +            0x20
   1.110 +            (->signed-8-bit -13) ;; continue writing row
   1.111 +
   1.112 +            ;; row is complete, advance to next row
   1.113 +            ;; HL += 192
   1.114 +
   1.115 +            0xC5 ;; push BC
   1.116 +
   1.117 +            0x06 ;; 0 -> B
   1.118 +            0
   1.119 +
   1.120 +            0x0E
   1.121 +            0  ;; 192 -> C
   1.122 +
   1.123 +            0x09 ;; HL + BC -> HL 
   1.124 +
   1.125 +            0xC1 ;; pop BC
   1.126 +            
   1.127 +            0x1D ;; dec E
   1.128 +            0x20
   1.129 +            (->signed-8-bit -23) ;; contunue writing picture
   1.130 +
   1.131 +            0xC3
   1.132 +            (reverse
   1.133 +             (disect-bytes-2
   1.134 +              (+ len base-address program-length)))]))]
   1.135 +    (flatten (concat
   1.136 +              (gen-program (count (gen-program 0)))
   1.137 +              image-data))))
   1.138  
   1.139  (defn test-write-data []
   1.140    (let [test-data (concat (range 256)
   1.141 @@ -524,30 +573,30 @@
   1.142    (assert (or (= n 0) (= n 1)))
   1.143    (write-byte LCD-bank-select-address n))
   1.144  
   1.145 +(defn write-image* [_ _ _] [])
   1.146 +
   1.147  (defn display-image-kernel [base-address ^BufferedImage image]
   1.148    (let [gb-image (image->gb-image image)
   1.149          
   1.150          A [(clear-music-registers)
   1.151 -           
   1.152 +
   1.153             ;; [X] disable LCD protection circuit.
   1.154             (write-byte LCD-control-register 0x00)
   1.155             ;; now we can write to all video RAM anytime with
   1.156             ;; impunity.
   1.157             
   1.158 -           ;; we're only using background palettes; just set the
   1.159 -           ;; minimum required bg palettes for this image,
   1.160 -           ;; starting with palette #0.
   1.161 +           ;; [ ] We're only using background palettes; just set the
   1.162 +           ;; minimum required bg palettes for this image, starting
   1.163 +           ;; with palette #0.
   1.164  
   1.165             (set-palettes bg-palette-select bg-palette-data
   1.166                           (:palettes gb-image))
   1.167  
   1.168             ;; [X] switch to bank 0 to set BG character data.
   1.169             (select-LCD-bank 0)
   1.170 -
   1.171             ;; [X] set SCX and SCY to 0
   1.172             (write-byte SCX-register 0)
   1.173             (write-byte SCY-register 0)
   1.174 -
   1.175             ]
   1.176          A (flatten A)
   1.177  
   1.178 @@ -562,7 +611,7 @@
   1.179  
   1.180          
   1.181          C [;; [ ] write image to the screen in terms of tiles
   1.182 -           (write-data
   1.183 +           (write-image
   1.184              (+ base-address (+ (count A) (count B)))
   1.185              BG-1-address
   1.186              (map first (:data gb-image)))]
   1.187 @@ -571,7 +620,7 @@
   1.188  
   1.189          D [;; [ ] specifiy pallets for each character
   1.190             (select-LCD-bank 1)
   1.191 -           (write-data
   1.192 +           (write-image
   1.193              (+ base-address (+ (count A) (count B) (count C)))
   1.194              BG-1-address
   1.195              (map second (:data gb-image)))
   1.196 @@ -595,14 +644,12 @@
   1.197                "0"  ;; OBJ-on flag 
   1.198                "1") ;; no-effect 
   1.199               2))
   1.200 -           
   1.201  
   1.202             (infinite-loop)]
   1.203          D (flatten D)]
   1.204  
   1.205      (concat A B C D)))
   1.206  
   1.207 -
   1.208  (defn display-image [#^BufferedImage image]
   1.209    (let [kernel-address 0xB000]
   1.210      (-> (tick (tick (tick (mid-game))))
   1.211 @@ -610,6 +657,3 @@
   1.212           kernel-address
   1.213           (display-image-kernel kernel-address image))
   1.214          (PC! kernel-address))))
   1.215 -      
   1.216 -
   1.217 -