1.1 --- a/clojure/com/aurellem/run/image.clj	Wed Jun 20 22:49:31 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/image.clj	Fri Jun 22 15:03:41 2012 -0500
     1.3 @@ -90,7 +90,7 @@
     1.4  
     1.5  (def max-palettes 8)
     1.6  
     1.7 -(defn write-data [target data]
     1.8 +(defn write-byte [target data]
     1.9      (flatten
    1.10       [0x3E ;; load literal to A
    1.11        data
    1.12 @@ -114,14 +114,27 @@
    1.13                "00" ;; color num
    1.14                "0"  ;; H/L
    1.15                ) 2)]
    1.16 -    (write-data palette-select-address palette-write-data)))
    1.17 +    (write-byte palette-select-address palette-write-data)))
    1.18          
    1.19  (defn set-palettes [palette-select palette-data palettes]
    1.20    (assert (<= (count palettes)) max-palettes)
    1.21    (flatten 
    1.22     [(begin-sequential-palette-write 0 palette-select)
    1.23 -    (map (partial write-data palette-data)
    1.24 -         (flatten (map gb-rgb->bits palettes)))]))
    1.25 +
    1.26 +    0x21 ;; target address to HL
    1.27 +    (reverse (disect-bytes-2 palette-data))
    1.28 +    
    1.29 +    
    1.30 +    (for [palette palettes]
    1.31 +      (map (fn [byte]
    1.32 +             [0x3E ;; literal to A
    1.33 +              byte
    1.34 +              0x77]) ;; A -> (HL)
    1.35 +           
    1.36 +           (flatten
    1.37 +            (map #(gb-rgb->bits (get palette % [0 0 0]))
    1.38 +                 (range 4)))))]))
    1.39 +      
    1.40  
    1.41  (defn display-one-color
    1.42    "Displayes a single color onto the gameboy screen. Input rgb in
    1.43 @@ -129,14 +142,16 @@
    1.44    ([state [r g b]]
    1.45       ;; construct a kernel that displays a single color
    1.46       (let
    1.47 -         [palettes (repeat 8 [r g b])
    1.48 +         [palettes (repeat 8 [[r g b] [r g b] [r g b] [r g b]])
    1.49            kernel-address 0xC000
    1.50            kernel
    1.51            [0xF3 ;; disable interrupts
    1.52             (clear-music-registers)
    1.53             (frame-metronome)
    1.54 -           (set-palettes obj-palette-select obj-palette-data palettes)
    1.55 -           (set-palettes bg-palette-select bg-palette-data palettes)
    1.56 +           ;;(set-palettes
    1.57 +           ;; obj-palette-select obj-palette-data palettes)
    1.58 +           (set-palettes
    1.59 +            bg-palette-select bg-palette-data palettes)
    1.60             (infinite-loop)]]
    1.61         (-> (set-memory-range state
    1.62                               kernel-address (flatten kernel))
    1.63 @@ -493,42 +508,108 @@
    1.64                      (+ target-address
    1.65                         (count test-data))))))))
    1.66  
    1.67 +(def LCD-bank-select-address 0xFF4F)
    1.68 +
    1.69 +(def BG-1-address 0x9800)
    1.70 +(def BG-2-address 0x9C00)
    1.71 +(def character-data-address 0x8000)
    1.72 +
    1.73 +(def LCD-control-register 0xFF40)
    1.74 +(def STAT-register        0xFF41)
    1.75 +
    1.76 +(def SCX-register 0xFF42)
    1.77 +(def SCY-register 0xFF43)
    1.78 +
    1.79 +(defn select-LCD-bank [n]
    1.80 +  (assert (or (= n 0) (= n 1)))
    1.81 +  (write-byte LCD-bank-select-address n))
    1.82 +
    1.83  (defn display-image-kernel [base-address ^BufferedImage image]
    1.84 -  (let [gb-image (image->gb-image image)]
    1.85 -  
    1.86 -    [(clear-music-registers)
    1.87 +  (let [gb-image (image->gb-image image)
    1.88 +        
    1.89 +        A [(clear-music-registers)
    1.90 +           
    1.91 +           ;; [X] disable LCD protection circuit.
    1.92 +           (write-byte LCD-control-register 0x00)
    1.93 +           ;; now we can write to all video RAM anytime with
    1.94 +           ;; impunity.
    1.95 +           
    1.96 +           ;; we're only using background palettes; just set the
    1.97 +           ;; minimum required bg palettes for this image,
    1.98 +           ;; starting with palette #0.
    1.99  
   1.100 -     ;; [ ] disable LCD protection circuit.
   1.101 -     
   1.102 -     ;; now we can write to all video RAM anytime with
   1.103 -     ;; impunity.
   1.104 +           (set-palettes bg-palette-select bg-palette-data
   1.105 +                         (:palettes gb-image))
   1.106  
   1.107 +           ;; [X] switch to bank 0 to set BG character data.
   1.108 +           (select-LCD-bank 0)
   1.109  
   1.110 -     
   1.111 -     ;; we're only using background palettes; just set the
   1.112 -     ;; minimum required bg palettes for this image,
   1.113 -     ;; starting with palette #0.
   1.114 +           ;; [X] set SCX and SCY to 0
   1.115 +           (write-byte SCX-register 0)
   1.116 +           (write-byte SCY-register 0)
   1.117  
   1.118 -     (set-palettes bg-palette-select bg-palette-data
   1.119 -                   (:palettes gb-image))
   1.120 +           ]
   1.121 +        A (flatten A)
   1.122  
   1.123 -     ;; [ ] switch to bank 0 to set BG character data.
   1.124 -     
   1.125 -     
   1.126 -     ;; [ ] write minimum amount of tiles to BG character
   1.127 -     ;; section
   1.128 -     
   1.129 +        B [;; [X] write minimum amount of tiles to BG character
   1.130 +           ;; section
   1.131 +           (write-data
   1.132 +            (+ base-address (count A))
   1.133 +            character-data-address
   1.134 +            (flatten
   1.135 +             (map gb-tile->bytes (:tiles gb-image))))]
   1.136 +        B (flatten B)
   1.137  
   1.138 -     ;; [ ] disable the display of OBJ tiles.
   1.139 -     
   1.140 +        
   1.141 +        C [;; [ ] write image to the screen in terms of tiles
   1.142 +           (write-data
   1.143 +            (+ base-address (+ (count A) (count B)))
   1.144 +            BG-1-address
   1.145 +            (map first (:data gb-image)))]
   1.146  
   1.147 -     ;; [ ] reactivate the LCD display
   1.148 -     
   1.149 +        C (flatten C)
   1.150  
   1.151 -     (infinite-loop)]
   1.152 +        D [;; [ ] specifiy pallets for each character
   1.153 +           (select-LCD-bank 1)
   1.154 +           (write-data
   1.155 +            (+ base-address (+ (count A) (count B) (count C)))
   1.156 +            BG-1-address
   1.157 +            (map second (:data gb-image)))
   1.158  
   1.159 -     
   1.160 -  ))
   1.161  
   1.162 +           ;; [X] reactivate the LCD display
   1.163 +           ;; we're using only BG images, located at
   1.164 +           ;; BG-1 (0x9800), with background character data
   1.165 +           ;; stored starting at 0x8000
   1.166  
   1.167 +           (write-byte
   1.168 +            LCD-control-register
   1.169 +            (Integer/parseInt
   1.170 +             (str
   1.171 +              "1"  ;; LCDC on/off
   1.172 +              "0"  ;; Window code area
   1.173 +              "0"  ;; Windowing on?
   1.174 +              "1"  ;; BG tile base (1 = 0x8000)
   1.175 +              "0"  ;; BG-1 or BG-2 ?
   1.176 +              "0"  ;; OBJ-block composition
   1.177 +              "0"  ;; OBJ-on flag 
   1.178 +              "1") ;; no-effect 
   1.179 +             2))
   1.180 +           
   1.181  
   1.182 +           (infinite-loop)]
   1.183 +        D (flatten D)]
   1.184 +
   1.185 +    (concat A B C D)))
   1.186 +
   1.187 +
   1.188 +(defn display-image [#^BufferedImage image]
   1.189 +  (let [kernel-address 0xB000]
   1.190 +    (-> (tick (tick (tick (mid-game))))
   1.191 +        (set-memory-range
   1.192 +         kernel-address
   1.193 +         (display-image-kernel kernel-address image))
   1.194 +        (PC! kernel-address))))
   1.195 +      
   1.196 +
   1.197 +