Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 511:964957680c11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
got an image to display, but it doesn't tile correctly.
author Robert McIntyre <rlm@mit.edu>
date Fri, 22 Jun 2012 15:03:41 -0500
parents b9814e3114e4
children 7ba07a6adb0c
comparison
equal deleted inserted replaced
510:b9814e3114e4 511:964957680c11
88 (def obj-palette-select 0xFF6A) 88 (def obj-palette-select 0xFF6A)
89 (def obj-palette-data 0xFF6B) 89 (def obj-palette-data 0xFF6B)
90 90
91 (def max-palettes 8) 91 (def max-palettes 8)
92 92
93 (defn write-data [target data] 93 (defn write-byte [target data]
94 (flatten 94 (flatten
95 [0x3E ;; load literal to A 95 [0x3E ;; load literal to A
96 data 96 data
97 0xEA ;; load A into target 97 0xEA ;; load A into target
98 (reverse (disect-bytes-2 target))])) 98 (reverse (disect-bytes-2 target))]))
112 (Integer/parseInt 112 (Integer/parseInt
113 (Integer/toBinaryString palette-num) 10)) 113 (Integer/toBinaryString palette-num) 10))
114 "00" ;; color num 114 "00" ;; color num
115 "0" ;; H/L 115 "0" ;; H/L
116 ) 2)] 116 ) 2)]
117 (write-data palette-select-address palette-write-data))) 117 (write-byte palette-select-address palette-write-data)))
118 118
119 (defn set-palettes [palette-select palette-data palettes] 119 (defn set-palettes [palette-select palette-data palettes]
120 (assert (<= (count palettes)) max-palettes) 120 (assert (<= (count palettes)) max-palettes)
121 (flatten 121 (flatten
122 [(begin-sequential-palette-write 0 palette-select) 122 [(begin-sequential-palette-write 0 palette-select)
123 (map (partial write-data palette-data) 123
124 (flatten (map gb-rgb->bits palettes)))])) 124 0x21 ;; target address to HL
125 (reverse (disect-bytes-2 palette-data))
126
127
128 (for [palette palettes]
129 (map (fn [byte]
130 [0x3E ;; literal to A
131 byte
132 0x77]) ;; A -> (HL)
133
134 (flatten
135 (map #(gb-rgb->bits (get palette % [0 0 0]))
136 (range 4)))))]))
137
125 138
126 (defn display-one-color 139 (defn display-one-color
127 "Displayes a single color onto the gameboy screen. Input rgb in 140 "Displayes a single color onto the gameboy screen. Input rgb in
128 gameboy rgb." 141 gameboy rgb."
129 ([state [r g b]] 142 ([state [r g b]]
130 ;; construct a kernel that displays a single color 143 ;; construct a kernel that displays a single color
131 (let 144 (let
132 [palettes (repeat 8 [r g b]) 145 [palettes (repeat 8 [[r g b] [r g b] [r g b] [r g b]])
133 kernel-address 0xC000 146 kernel-address 0xC000
134 kernel 147 kernel
135 [0xF3 ;; disable interrupts 148 [0xF3 ;; disable interrupts
136 (clear-music-registers) 149 (clear-music-registers)
137 (frame-metronome) 150 (frame-metronome)
138 (set-palettes obj-palette-select obj-palette-data palettes) 151 ;;(set-palettes
139 (set-palettes bg-palette-select bg-palette-data palettes) 152 ;; obj-palette-select obj-palette-data palettes)
153 (set-palettes
154 bg-palette-select bg-palette-data palettes)
140 (infinite-loop)]] 155 (infinite-loop)]]
141 (-> (set-memory-range state 156 (-> (set-memory-range state
142 kernel-address (flatten kernel)) 157 kernel-address (flatten kernel))
143 (PC! kernel-address)))) 158 (PC! kernel-address))))
144 ([[r g b]] 159 ([[r g b]]
491 vec 506 vec
492 (subvec target-address 507 (subvec target-address
493 (+ target-address 508 (+ target-address
494 (count test-data)))))))) 509 (count test-data))))))))
495 510
511 (def LCD-bank-select-address 0xFF4F)
512
513 (def BG-1-address 0x9800)
514 (def BG-2-address 0x9C00)
515 (def character-data-address 0x8000)
516
517 (def LCD-control-register 0xFF40)
518 (def STAT-register 0xFF41)
519
520 (def SCX-register 0xFF42)
521 (def SCY-register 0xFF43)
522
523 (defn select-LCD-bank [n]
524 (assert (or (= n 0) (= n 1)))
525 (write-byte LCD-bank-select-address n))
526
496 (defn display-image-kernel [base-address ^BufferedImage image] 527 (defn display-image-kernel [base-address ^BufferedImage image]
497 (let [gb-image (image->gb-image image)] 528 (let [gb-image (image->gb-image image)
498 529
499 [(clear-music-registers) 530 A [(clear-music-registers)
500 531
501 ;; [ ] disable LCD protection circuit. 532 ;; [X] disable LCD protection circuit.
502 533 (write-byte LCD-control-register 0x00)
503 ;; now we can write to all video RAM anytime with 534 ;; now we can write to all video RAM anytime with
504 ;; impunity. 535 ;; impunity.
505 536
506 537 ;; we're only using background palettes; just set the
507 538 ;; minimum required bg palettes for this image,
508 ;; we're only using background palettes; just set the 539 ;; starting with palette #0.
509 ;; minimum required bg palettes for this image, 540
510 ;; starting with palette #0. 541 (set-palettes bg-palette-select bg-palette-data
511 542 (:palettes gb-image))
512 (set-palettes bg-palette-select bg-palette-data 543
513 (:palettes gb-image)) 544 ;; [X] switch to bank 0 to set BG character data.
514 545 (select-LCD-bank 0)
515 ;; [ ] switch to bank 0 to set BG character data. 546
516 547 ;; [X] set SCX and SCY to 0
517 548 (write-byte SCX-register 0)
518 ;; [ ] write minimum amount of tiles to BG character 549 (write-byte SCY-register 0)
519 ;; section 550
520 551 ]
521 552 A (flatten A)
522 ;; [ ] disable the display of OBJ tiles. 553
523 554 B [;; [X] write minimum amount of tiles to BG character
524 555 ;; section
525 ;; [ ] reactivate the LCD display 556 (write-data
526 557 (+ base-address (count A))
527 558 character-data-address
528 (infinite-loop)] 559 (flatten
529 560 (map gb-tile->bytes (:tiles gb-image))))]
530 561 B (flatten B)
531 )) 562
532 563
533 564 C [;; [ ] write image to the screen in terms of tiles
534 565 (write-data
566 (+ base-address (+ (count A) (count B)))
567 BG-1-address
568 (map first (:data gb-image)))]
569
570 C (flatten C)
571
572 D [;; [ ] specifiy pallets for each character
573 (select-LCD-bank 1)
574 (write-data
575 (+ base-address (+ (count A) (count B) (count C)))
576 BG-1-address
577 (map second (:data gb-image)))
578
579
580 ;; [X] reactivate the LCD display
581 ;; we're using only BG images, located at
582 ;; BG-1 (0x9800), with background character data
583 ;; stored starting at 0x8000
584
585 (write-byte
586 LCD-control-register
587 (Integer/parseInt
588 (str
589 "1" ;; LCDC on/off
590 "0" ;; Window code area
591 "0" ;; Windowing on?
592 "1" ;; BG tile base (1 = 0x8000)
593 "0" ;; BG-1 or BG-2 ?
594 "0" ;; OBJ-block composition
595 "0" ;; OBJ-on flag
596 "1") ;; no-effect
597 2))
598
599
600 (infinite-loop)]
601 D (flatten D)]
602
603 (concat A B C D)))
604
605
606 (defn display-image [#^BufferedImage image]
607 (let [kernel-address 0xB000]
608 (-> (tick (tick (tick (mid-game))))
609 (set-memory-range
610 kernel-address
611 (display-image-kernel kernel-address image))
612 (PC! kernel-address))))
613
614
615