vba-clojure: clojure/com/aurellem/run/image.clj comparison

comparison clojure/com/aurellem/run/image.clj @ 512:7ba07a6adb0c

going to correct premium stupdity.

author	Robert McIntyre <rlm@mit.edu>
date	Fri, 22 Jun 2012 18:38:22 -0500
parents	964957680c11
children	3dbb863eb801

comparison

equal deleted inserted replaced

-:964957680c11
+:7ba07a6adb0c
 ;; 2. split into a grid of 8x8 pixels
 ;; 3. convert all RGB colors to gb-RGB colors
 ;; 4. determine efficient color palletes for the image
 ;; 5. output efficient assembly code to draw the image to the gb
 ;; screen.
 (def image-program-target 0xB000)
 (def display-width 160)
 accepted
 (conj accepted new-element)))
 []
 (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))]
 unique-palettes))
 (let [tile-colors (set (tile->palette tile))]
 [(tile-index tile)
 (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."
 []
 (let [timing-loop
 144  ;; compare LY (in A) with 144
 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
 (->signed-8-bit
 (+ -4 (- (count timing-loop))))]]
 (concat timing-loop continue-if-144)))
 (def bg-character-data 0x9000)
 (defn gb-tile->bytes
 "Tile is a vector of 64 numbers between 0 and 3 that
 (vec
 (flatten
 (map row->bits
 (partition 8 tile))))))
 (defn write-data
 "Efficient assembly to write a sequence of values to
 memory, starting at a target address."
 [base-address target-address data]
 (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)))
 0x01 ;; load target address into BC
 (reverse
 (disect-bytes-2
 (+ 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)
 (reverse (range 256)))
 base-address 0xC000
 (defn select-LCD-bank [n]
 (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
+;; [ ] We're only using background palettes; just set the
-;; minimum required bg palettes for this image,
+;; minimum required bg palettes for this image, starting
-;; starting with palette #0.
+;; 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)
 B [;; [X] write minimum amount of tiles to BG character
 ;; section
 (map gb-tile->bytes (:tiles gb-image))))]
 B (flatten B)
 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)))]
 C (flatten C)
 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)))
 "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))))

Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 512:7ba07a6adb0c