comparison clojure/com/aurellem/run/image.clj @ 507:24b459a95b46

saving progress.
author Robert McIntyre <rlm@mit.edu>
date Wed, 20 Jun 2012 19:51:50 -0500
parents 130ba9f49db5
children e6c02264dc9c
comparison
equal deleted inserted replaced
506:130ba9f49db5 507:24b459a95b46
122 [(begin-sequential-palette-write 0 palette-select) 122 [(begin-sequential-palette-write 0 palette-select)
123 (map (partial write-data palette-data) 123 (map (partial write-data palette-data)
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 ([state [r g b]] 129 ([state [r g b]]
130 ;; construct a kernel that displays a single color 130 ;; construct a kernel that displays a single color
131 (let 131 (let
132 [palettes (repeat 8 [r g b]) 132 [palettes (repeat 8 [r g b])
274 (.setOutput (FileImageOutputStream. target)) 274 (.setOutput (FileImageOutputStream. target))
275 (.write (IIOImage. im nil nil)) 275 (.write (IIOImage. im nil nil))
276 (.dispose)) 276 (.dispose))
277 im)) 277 im))
278 278
279
280 (count
281 (filter
282 (fn [[r g b]]
283 (= (max r g b) r ))(set (vals gb-color-map))))
284
285 (def test-image 279 (def test-image
286 (ImageIO/read 280 (ImageIO/read
287 (File. user-home "/proj/vba-clojure/images/test-gb-image.png"))) 281 (File. user-home "/proj/vba-clojure/images/test-gb-image.png")))
288 282
289 (defn rgb->triplet [rgb] 283 (defn rgb->triplet [rgb]
383 [(tile-index tile) 377 [(tile-index tile)
384 (palette-index 378 (palette-index
385 (tile-pallete tile image-palettes))])))})) 379 (tile-pallete tile image-palettes))])))}))
386 380
387 381
388
389
390
391
392
393
394
395
396 )
397 382
398 (defn wait-until-v-blank 383 (defn wait-until-v-blank
399 "Modified version of frame-metronome. waits untill LY == 144, 384 "Modified version of frame-metronome. waits untill LY == 144,
400 indicating start of v-blank period." 385 indicating start of v-blank period."
401 [] 386 []
411 (->signed-8-bit 396 (->signed-8-bit
412 (+ -4 (- (count timing-loop))))]] 397 (+ -4 (- (count timing-loop))))]]
413 (concat timing-loop continue-if-144))) 398 (concat timing-loop continue-if-144)))
414 399
415 400
401 (def bg-character-data 0x9000)
402
403 (defn gb-tile->bytes
404 "Tile is a vector of 64 numbers between 0 and 3 that
405 represent a single 8x8 color tile in the GB screen.
406 It gets bit-packed into to 16 8-bit numbers in the following
407 form:
408
409 0-low 1-low ... 7-low
410 0-high 1-high ... 7-high
411 .
412 .
413 .
414 55-low ........ 63-low
415 55-high ........ 63-high"
416 [tile]
417 (let [row->bits
418 (fn [row]
419 (mapv
420 (fn [row*]
421 (Integer/parseInt (apply str row*) 2))
422 [(map #(bit-and 0x01 %) row)
423 (map #(bit-shift-right (bit-and 0x02 %) 1)
424 row)]))]
425 (vec
426 (flatten
427 (map row->bits
428 (partition 8 tile))))))
429
430
431
416 (defn display-image-kernel [^BufferedImage image] 432 (defn display-image-kernel [^BufferedImage image]
417 ;; assume image tile data is stored at 0xA000 433 (let [gb-image (image->gb-image image)]
418 ;; " " palette date is at 0xB000
419 434
420 435 [(clear-music-registers)
421 436
437 ;; [ ] disable LCD protection circuit.
438
439 ;; now we can write to all video RAM anytime with
440 ;; impunity.
441
442
443
444 ;; we're only using background palettes; just set the
445 ;; minimum required bg palettes for this image,
446 ;; starting with palette #0.
447
448 (set-palettes bg-palette-select bg-palette-data
449 (:palettes gb-image))
450
451 ;; [ ] switch to bank 0 to set BG character data.
452
453
454 ;; [ ] write minimum amount of tiles to BG character
455 ;; section
456
457
458
459 ;; [ ] disable the display of OBJ tiles.
460
461
462 ;; [ ] reactivate the LCD display
463
464
465 (infinite-loop)
466
467
422 ) 468 )
423 469
424 470
425 471