Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 505:f992a0a0480d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix compilation problem.
author Robert McIntyre <rlm@mit.edu>
date Wed, 20 Jun 2012 13:59:21 -0500
parents 81e43f0350db
children 130ba9f49db5
comparison
equal deleted inserted replaced
504:81e43f0350db 505:f992a0a0480d
124 (flatten (map gb-rgb->bits palettes)))])) 124 (flatten (map gb-rgb->bits palettes)))]))
125 125
126 (defn display-one-color 126 (defn display-one-color
127 "Displayes a single color onto the gameboy screen. input rgb in 127 "Displayes a single color onto the gameboy screen. input rgb in
128 gameboy rgb." 128 gameboy rgb."
129 <<<<<<< local
130 [[r g b]]
131 ;; construct a kernel that displays a single color
132 (let
133 [palettes (repeat 8 [r g b])
134 kernel-address 0xC000
135 kernel
136 [0xF3 ;; disable interrupts
137 (clear-music-registers)
138 (frame-metronome)
139 (set-palettes obj-palette-select obj-palette-data palettes)
140 (set-palettes bg-palette-select bg-palette-data palettes)
141 (infinite-loop)]]
142 (-> (set-memory-range (second (music-base))
143 kernel-address (flatten kernel))
144 (PC! kernel-address))))
145 =======
146 ([state [r g b]] 129 ([state [r g b]]
147 ;; construct a kernel that displays a single color 130 ;; construct a kernel that displays a single color
148 (let 131 (let
149 [palettes (repeat 8 [r g b]) 132 [palettes (repeat 8 [r g b])
150 kernel-address 0xC000 133 kernel-address 0xC000
159 kernel-address (flatten kernel)) 142 kernel-address (flatten kernel))
160 (PC! kernel-address)))) 143 (PC! kernel-address))))
161 ([[r g b]] 144 ([[r g b]]
162 (display-one-color @current-state [r g b]))) 145 (display-one-color @current-state [r g b])))
163 146
164 (require 'cortex.sense) 147 ;;(require 'cortex.sense)
165 (import java.awt.image.BufferedImage) 148 (import java.awt.image.BufferedImage)
166 149
167 (defn show-screenshot [] 150 ;; (defn show-screenshot []
168 (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB) 151 ;; (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB)
169 pix (vec (pixels)) 152 ;; pix (vec (pixels))
170 view (cortex.sense/view-image)] 153 ;; view (cortex.sense/view-image)]
171 (dorun (for [x (range 160) y (range 144)] 154 ;; (dorun (for [x (range 160) y (range 144)]
172 (.setRGB im x y (pix (+ x (* 160 y)))))) 155 ;; (.setRGB im x y (pix (+ x (* 160 y))))))
173 (view im))) 156 ;; (view im)))
174 157
175 (defn gb-rgb->vga-rgb [[r g b]] 158 (defn gb-rgb->vga-rgb [[r g b]]
176 (let [vga-rgb 159 (let [vga-rgb
177 (first (pixels 160 (first (pixels
178 (run-moves 161 (run-moves
243 (filter 226 (filter
244 (fn [[r g b]] 227 (fn [[r g b]]
245 (= (max r g b) b )) 228 (= (max r g b) b ))
246 229
247 (seq (set (vals gb-color-map))))))))) 230 (seq (set (vals gb-color-map)))))))))
248 view (cortex.sense/view-image) 231 ;;view (cortex.sense/view-image)
249 target (File. user-home "proj/vba-clojure/gb-color-map-unique.png")] 232 target (File. user-home "proj/vba-clojure/gb-color-map-unique.png")]
250 (dorun (for [x (range 68) y (range 69)] 233 (dorun (for [x (range 68) y (range 69)]
251 (let [[r g b] (get pix (+ x (* 68 y)) [0 0 0]) 234 (let [[r g b] (get pix (+ x (* 68 y)) [0 0 0])
252 rgb (+ (bit-shift-left r 16) 235 rgb (+ (bit-shift-left r 16)
253 (bit-shift-left g 8) 236 (bit-shift-left g 8)
254 b)] 237 b)]
255 (.setRGB im x y rgb)))) 238 (.setRGB im x y rgb))))
256 (view im) 239 ;;(view im)
257 (doto 240 (doto
258 (.next (ImageIO/getImageWritersByFormatName "png")) 241 (.next (ImageIO/getImageWritersByFormatName "png"))
259 (.setOutput (FileImageOutputStream. target)) 242 (.setOutput (FileImageOutputStream. target))
260 (.write (IIOImage. im nil nil)) 243 (.write (IIOImage. im nil nil))
261 (.dispose)) 244 (.dispose))
267 (vec 250 (vec
268 (for [r (range 32)] 251 (for [r (range 32)]
269 (vec 252 (vec
270 (for [b (range 32) g (range 32)] 253 (for [b (range 32) g (range 32)]
271 (gb-color-map [r g b]))))) 254 (gb-color-map [r g b])))))
272 view (cortex.sense/view-image) 255 ;;view (cortex.sense/view-image)
273 target (File. user-home "proj/vba-clojure/gb-color-map.png")] 256 target (File. user-home "proj/vba-clojure/gb-color-map.png")]
274 257
275 (dorun 258 (dorun
276 (for [s-index (range 32)] 259 (for [s-index (range 32)]
277 (dorun 260 (dorun
283 b)] 266 b)]
284 (.setRGB im 267 (.setRGB im
285 (+ 3 (* 35 (rem s-index 6)) x) 268 (+ 3 (* 35 (rem s-index 6)) x)
286 (+ 3 (* 35 (int (/ s-index 6))) y) 269 (+ 3 (* 35 (int (/ s-index 6))) y)
287 rgb)))))) 270 rgb))))))
288 (view im) 271 ;;(view im)
289 (doto 272 (doto
290 (.next (ImageIO/getImageWritersByFormatName "png")) 273 (.next (ImageIO/getImageWritersByFormatName "png"))
291 (.setOutput (FileImageOutputStream. target)) 274 (.setOutput (FileImageOutputStream. target))
292 (.write (IIOImage. im nil nil)) 275 (.write (IIOImage. im nil nil))
293 (.dispose)) 276 (.dispose))
341 [] 324 []
342 (sort-by (comp - count) objs))) 325 (sort-by (comp - count) objs)))
343 326
344 (defn absorb-combine-4 [objs] 327 (defn absorb-combine-4 [objs]
345 328
346
347
348 ) 329 )
349 330
350 (defn palettes [^BufferedImage image] 331 (defn palettes [^BufferedImage image]
351 (let [palettes (map tile->palette (gb-tiles image)) 332 (let [palettes (map tile->palette (gb-tiles image))
352 unique-palettes (absorb-contract (set palettes))] 333 unique-palettes (absorb-contract (set palettes))]
353 unique-palettes)) 334 unique-palettes))
354 335
355 336 (defn wait-until-v-blank
356 337 "Modified version of frame-metronome. waits untill LY == 144,
357 338 indicating start of v-blank period."
358 339 []
359 340 (let [timing-loop
341 [0x01 ; \
342 0x44 ; | load 0xFF44 into BC
343 0xFF ; /
344 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
345 continue-if-144
346 [0xFE
347 144 ;; compare LY (in A) with 144
348 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
349 (->signed-8-bit
350 (+ -4 (- (count timing-loop))))]]
351 (concat timing-loop continue-if-144)))
360 352
361 353
362 (defn display-image-kernel [^BufferedImage image] 354 (defn display-image-kernel [^BufferedImage image]
363 355 ;; assume image tile data is stored at 0xA000
356 ;; " " palette date is at 0xB000
357
364 358
365 359
366 ) 360 )
361
362
363