Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 498:554883a95de0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
discovered gameboy->vga color map.
author Robert McIntyre <rlm@mit.edu>
date Mon, 11 Jun 2012 10:07:01 -0500
parents a6d060a64246
children 8b8053ccb33c
comparison
equal deleted inserted replaced
497:690811e54b51 498:554883a95de0
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 [[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])
133 kernel-address 0xC000 133 kernel-address 0xC000
134 kernel 134 kernel
135 [0xF3 ;; disable interrupts 135 [0xF3 ;; disable interrupts
136 (clear-music-registers) 136 (clear-music-registers)
137 (frame-metronome) 137 (frame-metronome)
138 (set-palettes obj-palette-select obj-palette-data palettes) 138 (set-palettes obj-palette-select obj-palette-data palettes)
139 (set-palettes bg-palette-select bg-palette-data palettes) 139 (set-palettes bg-palette-select bg-palette-data palettes)
140 (infinite-loop)]] 140 (infinite-loop)]]
141 (-> (set-memory-range (second (music-base)) 141 (-> (set-memory-range state
142 kernel-address (flatten kernel)) 142 kernel-address (flatten kernel))
143 (PC! kernel-address)))) 143 (PC! kernel-address))))
144 144 ([[r g b]]
145 (display-one-color @current-state [r g b])))
145 146
146 (require 'cortex.sense) 147 (require 'cortex.sense)
147 (import java.awt.image.BufferedImage) 148 (import java.awt.image.BufferedImage)
148 149
149 (defn show-screenshot [] 150 (defn show-screenshot []
150 (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB) 151 (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB)
151 pix (vec (pixels)) 152 pix (vec (pixels))
152 view (cortex.sense/view-image)] 153 view (cortex.sense/view-image)]
153 (dorun (for [x (range 160) y (range 144)] 154 (dorun (for [x (range 160) y (range 144)]
154 (.setRGB im x y 155 (.setRGB im x y (pix (+ x (* 160 y))))))
155 ;0
156 (pix (+ x (* 160 y)))
157 )))
158 (view im))) 156 (view im)))
159 157
160 158 (defn-memo gb-rgb->vga-rgb [[r g b]]
161 159 (let [vga-rgb
162 (defn write-palette-color [palette-num r g b] 160 (first (pixels
163 (let [[byte-1 byte-2] (gb-rgb->bits r g b)] 161 (run-moves
162 (display-one-color
163 (tick @current-state)
164 [r g b])
165 [[][]])))]
166 [(bit-shift-right (bit-and vga-rgb 0xFF0000) 16)
167 (bit-shift-right (bit-and vga-rgb 0xFF00) 8)
168 (bit-and vga-rgb 0xFF)]))
164 169
170 (defn generate-gb-color-map []
171 (set-state! (mid-game))
172 (let [gb-colors
173 (for [r (range 32)
174 g (range 32)
175 b (range 32)]
176 [r g b])]
177 (zipmap gb-colors
178 (map gb-rgb->vga-rgb
179 gb-colors))))
165 180
166 )) 181 (import java.io.FileWriter)
167 182
183 (def gb-color-map-file
184 (File. user-home "proj/vba-clojure/gb-color-map"))
168 185
186 (defn write-gb-color-map! []
187 (binding [*out*(FileWriter. gb-color-map-file)]
188 (let [out-str
189 (.replace
190 (str
191 (into (sorted-map) (generate-gb-color-map)))
192 "," ",\n")]
193 (println out-str))))
194
195 (defn-memo gb-color-map []
196 (read-string (slurp gb-color-map-file)))