Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 495:1d81ddd4fa41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged changes from trip to wichita.
author Robert McIntyre <rlm@mit.edu>
date Mon, 11 Jun 2012 00:55:51 -0500
parents 151c96d60921 79606f173658
children a6d060a64246
comparison
equal deleted inserted replaced
490:151c96d60921 495:1d81ddd4fa41
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
41 41
42 42
43 43
44 44
45 45
46 (def image-program-target 0xB000)
47
48 (def display-width 160)
49 (def display-height 144)
46 50
47 51
52
53 ;{:r :g :b }
54
55 (def character-data 0x8000)
56 (def character-data-end 0x97FF)
57
58
59
60
61 (def BG-data-1 0x9800)
62
63 (def BG-data-2 0x9C00)
64
65 (def OAM 0xFE00)
66
67
68
69 (def video-bank-select-register 0xFF4F)
70
71 (defn gb-rgb->bits [[r g b]]
72 (assert (<= 0 r 31))
73 (assert (<= 0 g 31))
74 (assert (<= 0 b 31))
75 [(bit-and
76 0xFF
77 (+
78 r
79 (bit-shift-left g 5)))
80 (+
81 (bit-shift-right g 3)
82 (bit-shift-left b 2))])
83
84
85 (def bg-palette-select 0xFF68)
86 (def bg-palette-data 0xFF69)
87
88 (def obj-palette-select 0xFF6A)
89 (def obj-palette-data 0xFF6B)
90
91 (def max-palettes 8)
92
93 (defn write-data [target data]
94 (flatten
95 [0x3E ;; load literal to A
96 data
97 0xEA ;; load A into target
98 (reverse (disect-bytes-2 target))]))
99
100 (defn begin-sequential-palette-write
101 [palette-num palette-select-address]
102 (assert (<= 0 palette-num max-palettes))
103 (assert
104 (or (= palette-select-address bg-palette-select)
105 (= palette-select-address obj-palette-select)))
106 (let [palette-write-data
107 (Integer/parseInt
108 (str "1" ;; auto increment
109 "0" ;; not used
110 (format
111 "%03d"
112 (Integer/parseInt
113 (Integer/toBinaryString palette-num) 10))
114 "00" ;; color num
115 "0" ;; H/L
116 ) 2)]
117 (write-data palette-select-address palette-write-data)))
118
119 (defn set-palettes [palette-select palette-data palettes]
120 (assert (<= (count palettes)) max-palettes)
121 (flatten
122 [(begin-sequential-palette-write 0 palette-select)
123 (map (partial write-data palette-data)
124 (flatten (map gb-rgb->bits palettes)))]))
125
126 (defn display-one-color
127 "Displayes a single color onto the gameboy screen. input rgb in
128 gameboy rgb."
129 [[r g b]]
130 ;; construct a kernel that displays a single color
131 (let
132 [palettes (repeat 8 [r g b])
133 kernel-address 0xC000
134 kernel
135 [0xF3 ;; disable interrupts
136 (clear-music-registers)
137 (frame-metronome)
138 (set-palettes obj-palette-select obj-palette-data palettes)
139 (set-palettes bg-palette-select bg-palette-data palettes)
140 (infinite-loop)]]
141 (-> (set-memory-range (second (music-base))
142 kernel-address (flatten kernel))
143 (PC! kernel-address))))
144
145
146
147
148 (defn write-palette-color [palette-num r g b]
149 (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
150
151
152 ))
153
154