Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 492:716752719a78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fleshing out image color calibration code.
author Robert McIntyre <rlm@mit.edu>
date Thu, 07 Jun 2012 22:52:30 -0500
parents 2304906d443b
children 783a09c84a28
comparison
equal deleted inserted replaced
491:2304906d443b 492:716752719a78
1 (ns com.aurellem.run.image 1 (ns com.aurellem.run.image
2 (:use (com.aurellem.gb saves gb-driver util constants 2 (:use (com.aurellem.gb saves gb-driver util constants
3 items vbm characters money 3 items vbm characters money
4 rlm-assembly)) 4 rlm-assembly))
5 (:use (com.aurellem.run util title save-corruption 5 (:use (com.aurellem.run util music title save-corruption
6 bootstrap-0 bootstrap-1)) 6 bootstrap-0 bootstrap-1))
7 (:require clojure.string) 7 (:require clojure.string)
8 (:import [com.aurellem.gb.gb_driver SaveState]) 8 (:import [com.aurellem.gb.gb_driver SaveState])
9 (:import java.io.File)) 9 (:import java.io.File))
10 10
111 (def BG-data-2 0x9C00) 111 (def BG-data-2 0x9C00)
112 112
113 (def OAM 0xFE00) 113 (def OAM 0xFE00)
114 114
115 115
116 (def bg-pallet-select 0xFF68)
117 (def bg-pallet-data 0xFF69)
118
119 (def obj-palette-select 0xFF6A)
120 (def obj-palette-data 0xFF6B)
121
122
123 116
124 (def video-bank-select-register 0xFF4F) 117 (def video-bank-select-register 0xFF4F)
125 118
126 119 (defn gb-rgb->bits [[r g b]]
127 120 (assert (<= 0 r 31))
128 (defn gb-rgb->bits [r g b] 121 (assert (<= 0 g 31))
129 (assert (< 0 r 32)) 122 (assert (<= 0 b 31))
130 (assert (< 0 g 32))
131 (assert (< 0 b 32))
132 [(bit-and 123 [(bit-and
133 0xFF 124 0xFF
134 (+ 125 (+
135 r 126 r
136 (bit-shift-left g 5))) 127 (bit-shift-left g 5)))
137
138 (+ 128 (+
139 (bit-shift-right g 3) 129 (bit-shift-right g 3)
140 (bit-shift-left b 2))]) 130 (bit-shift-left b 2))])
141 131
142 132
143 133 (def bg-palette-select 0xFF68)
144 134 (def bg-palette-data 0xFF69)
145 ) 135
146 136 (def obj-palette-select 0xFF6A)
137 (def obj-palette-data 0xFF6B)
138
139 (def max-palettes 8)
140
141 (defn write-data [target data]
142 (flatten
143 [0x3E ;; load literal to A
144 data
145 0xEA ;; load A into target
146 (disect-bytes-2 target)]))
147
148 (defn begin-sequential-palette-write
149 [palette-num palette-select-address]
150 (assert (<= 0 palette-num max-palettes))
151 (assert
152 (or (= palette-select-address bg-palette-select)
153 (= palette-select-address obj-palette-select)))
154 (let [palette-write-data
155 (Integer/parseInt
156 (str "1" ;; auto increment
157 "0" ;; not used
158 (format
159 "%03d"
160 (Integer/parseInt
161 (Integer/toBinaryString palette-num) 10))
162 "00" ;; color num
163 "0" ;; H/L
164 ) 2)]
165 (write-data palette-select-address palette-write-data)))
166
167 (defn set-palettes [palette-select palette-data palettes]
168 (assert (<= (count palettes)) max-palettes)
169 (flatten
170 [(begin-sequential-palette-write 0 palette-select)
171 (map (partial write-data palette-data)
172 (flatten (map gb-rgb->bits palettes)))]))
173
147 (defn display-one-color 174 (defn display-one-color
148 "Displayes a single color onto the gameboy screen. input rgb in 175 "Displayes a single color onto the gameboy screen. input rgb in
149 gameboy rgb." 176 gameboy rgb."
150 [r g b] 177 [[r g b]]
178 ;; construct a kernel that displays a single color
179 (let [palettes (repeat 8 [r g b])
180 kernel-address 0xC000
181 kernel
182 (flatten
183 [0xF3 ;; disable interrupts
184 (frame-metronome)
185 (set-palettes
186 obj-palette-select
187 obj-palette-data
188 palettes)
189 (set-palettes
190 bg-palette-select
191 bg-palette-data
192 palettes)
193 (infinite-loop)])]
194 (-> (set-memory-range (second (music-base))
195 kernel-address kernel)
196 (PC! kernel-address))))
197
198
199
151 200
152 201 (defn write-palette-color [palette-num r g b]
153 202 (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
154 203
155 204
156 ) 205 ))
206