view clojure/com/aurellem/run/adv_choreo.clj @ 582:393b49a83394

tracked down error to set=HL-from-row-and-column
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 09:43:19 -0500
parents 5f09601abe8c
children 21e4ab461506
line wrap: on
line source
1 ;;;; "Advanced Choreography" -- this is the final video for this project.
3 (ns com.aurellem.run.adv-choreo
4 (:use (com.aurellem.gb saves gb-driver util constants
5 items vbm characters money
6 rlm-assembly))
7 (:use (com.aurellem.run util music title save-corruption
8 bootstrap-0 bootstrap-1 image
9 ram-display final-cut basic-choreo))
10 (:require clojure.string)
11 (:import java.awt.image.BufferedImage)
12 (:import (javax.imageio ImageWriteParam IIOImage ImageIO))
13 (:import [com.aurellem.gb.gb_driver SaveState])
14 (:import java.io.File))
18 ;; Use the gameboy's screen to display the new programming
19 ;; instead of a side window. This will make it look much
20 ;; cooler and create a terminal-like effect as the game is
21 ;; being reprogramed. To do this, use a fixed data entry
22 ;; region in ram, and run a program that translates this
23 ;; region into the screen. Every time this data entry region
24 ;; is full, run a program that copies the data to the
25 ;; appropriate region in memory. This will cost ~15 seconds
26 ;; at the beginning to set up, and then should have minimal
27 ;; overhead (~5%) for the rest of the data transfer, but
28 ;; will have a good psychological effect for the viewer
29 ;; since he can see that something is actually happening in
30 ;; the game.
33 ;; Symbol size and type.
35 ;; use fonts from zophar's domain:
36 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html
38 ;; Green font on black background for matrix look.
41 (defn program-data [base-address]
42 (let [image-program
43 (display-image-kernel
44 base-address
46 ;;pinkie-pie-mark
47 test-image-color
49 )
52 music-base-address (+ (count image-program) base-address)
54 initial-music-data
55 (midi-bytes pony-csv 0 0 0 0)
57 data-lengths
58 (map (comp count :data)
59 [(:kernel initial-music-data)
60 (:voice-1 initial-music-data)
61 (:voice-2 initial-music-data)]);; noise not needed
62 addresses
63 (map (partial + music-base-address) (reductions + 0 data-lengths))
65 final-music-data
66 (apply (partial midi-bytes pony-csv) addresses)
68 music-program
69 (concat
70 (:data (:kernel final-music-data))
71 (:data (:voice-1 final-music-data))
72 (:data (:voice-2 final-music-data))
73 (:data (:noise final-music-data)))]
75 (concat
76 image-program ;; image program falls through to music program
78 (infinite-loop)
79 ;;music-program
81 )))
86 (def glyphs
87 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
88 (mapv #(ImageIO/read
89 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
90 ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
92 (defn glyph-init-program
93 [start-address]
94 (let [zero-glyph (image->gb-image (glyphs 0))
96 ;; write same pallet information to all pallettes
97 A (flatten
98 [(write-byte LCD-control-register 0x00);; disable LCD protection
99 (set-palettes bg-palette-select bg-palette-data
100 (repeat 8 (first (:palettes zero-glyph))))
101 (select-LCD-bank 0)
102 (write-byte SCX-register 0)
103 (write-byte SCY-register 0)])
104 B (flatten
105 [(write-data
106 (+ start-address (count A))
107 character-data-address
108 (flatten
109 (map (comp gb-tile->bytes first :tiles image->gb-image)
110 glyphs)))
113 (write-byte
114 LCD-control-register
115 (Integer/parseInt
116 (str
117 "1" ;; LCDC on/off
118 "0" ;; Window code area
119 "0" ;; Windowing on?
120 "1" ;; BG tile base (1 = 0x8000)
121 "0" ;; BG-1 or BG-2 ?
122 "0" ;; OBJ-block composition
123 "0" ;; OBJ-on flag
124 "1") ;; no-effect
125 2))])]
126 (concat A B )))
130 (defn glyph-display-program
131 [start-address]
132 (let [data-start (+ 2 start-address)
133 load-data
134 (flatten
135 [;; data region
136 0x18
137 4
138 0 0 0 0;; current row and column
139 ;; save all registers
140 0xC5 0xD5 0xE5 0xF5
142 ;; load data from data region into registers
144 0xF5 ;; push A, which contains current glyph
146 0x21
147 (reverse (disect-bytes-2 data-start))
148 ;; load row and column into DE
149 0x2A 0x57 ;; row -> D
150 0x2A 0x5F ;; column -> E
153 ])
156 display-glyph
157 (let [init*
158 (flatten
159 [(repeat 100 0)
160 ;; Reset HL to initial value
162 ;; clear screen if we are at 0,0
163 0x57 0xB3 ;; D->A, OR E A ==> (= D E 0)
164 0x20 ;; skip clear-screen if D and E are not both zero
165 :clear-screen-length])
167 clear-screen
168 (flatten
169 [;; save all registers
170 0xC5 0xD5 0xE5 0xF5
172 (select-LCD-bank 0)
173 ;; write 0x00 to memory locations
174 ;; 0x9800 to 0x9A34
175 0x21
176 0x00 0x98 ;; load 0x9800 into HL
179 0x16 3 ;; 3 -> D
180 0x1E 190 ;; 188 -> E
182 0x3E 0 ;; 0-> A
184 ;; begin of do-while loop
185 0x22 ;; load 0 to 0x9800
186 0x1D ;; dec E
187 0x20
188 (->signed-8-bit -4)
189 0x15 ;; dec D
190 0x1E 190 ;; 188 -> E
191 0x20
192 (->signed-8-bit -8)
193 ;; end of do-while-loop
195 ;; restore all registers
196 0xF1 0xE1 0xD1 0xC1])
198 ;; RLM: for TESTING ONLY!!!
199 clear-screen (repeat 10 0)
200 increment-row-column
201 [;; D contains row and E contains column
203 ;; every time column (E) reaches 20, set
204 ;; column to 0 and increment row
205 0x1C ;; inc E
206 0x3E 20 0xBB ;; compare E to 20
207 0x20
208 3
209 0x14
210 0x1E 0
213 0x3E 18
214 0xBA
215 0x20
216 2
217 0x16 0
219 ;; 0x00 ;;0x1C ;; inc E
220 ;; 0x3E 20 0xBB ;; compare E to 20
221 ;; 0x20 ;; if E is 20
222 ;; 3
223 ;; 0x1E 0 ;; set E to zero
224 ;; 0x00; 0x14 ;; (inc D) -> D
226 ;; ;; every time row (D) reaches 18, set row to 0
227 ;; 0x3E 18 0xBA ;; compare D to 18
228 ;; 0x20 ;; if D is 18
229 ;; 2
230 ;; 0x16 0
231 ;; set D to zero
232 ]
234 set-HL-from-row-and-column
235 (flatten
236 [;; formula for memory offset is:
237 ;; (+ 0x9800 (* 32 row) column) ==
238 ;; (+ 0x97E0 (* 32 (+ 1 row)) column)
239 0xD5 ;; push DE
241 ;; RLM: this should be 0x9800, investigate
242 0x21 0x00 0x98 ;; load HL with something
244 0x06 0
245 0x4B ;; columns (E) -> BC
246 0x09 ;; HL += columns
249 0xAF ;; 0 -> A
251 0x06 0
252 0x0E 32 ;; load 32 into BC
254 0xBA ;; CP A D
255 0x20
256 4
257 ;;(+ 32 3)
258 0x09 ;; HL += 32
259 ;;(repeat 32 0x23)
260 0x3C
261 0x18
262 ;;(->signed-8-bit (+ -6 -32))
263 (->signed-8-bit -7)
264 ;; 0x14 ;; inc D to handle case where D == 0
265 ;; ;; D will never be > 20, so this will never overflow.
267 ;; ;; do
268 ;; 0x09 ;; HL += 32
269 ;; 0x15 ;; dec D
270 ;; ;; while D != 0
271 ;; 0x20
272 ;; (->signed-8-bit -4)
274 0xD1 ;; pop DE
275 ])
277 render-glyph
278 (flatten
279 [;; Render each nybble of A as a character
280 ;; there are two characters to a glyph.
281 0x21
282 (reverse (disect-bytes-2 data-start))
283 ;; load row and column into DE
284 0x2A 0x57 ;; row -> D
285 0x2A 0x5F ;; column -> E
288 set-HL-from-row-and-column
290 0xF1 ;; pop A, now A is equal to key input
291 0x3E 0xFF ;; RLM: TESTING set A = 0xFF
292 0xF5 ;; save A
294 0xE6 0xF0 ;; clear second nybble
295 0xCB 0x37 ;; swap nybbles
296 0x77 ;; store A in video RAM as a character (pun)
297 increment-row-column
300 set-HL-from-row-and-column
302 0xF1 ;; restore A
303 0xE6 0x0F ;; select second nybble
304 0x77 ;; store second nybble as character
305 increment-row-column
306 ])
309 init (replace
310 {:clear-screen-length (count clear-screen)} init*)
311 ]
313 (concat init clear-screen render-glyph))
315 cleanup
316 ;; restore all registers
317 (flatten
318 [;; Reset HL to initial data-start value
319 0x44 0x4D ;;HL -> BC
321 0x21
322 (reverse (disect-bytes-2 data-start))
323 ;;0x23
324 ;; write variables
325 0x7A 0x22 ;; D -> rows -> to RAM
326 0x7B 0x22 ;; E -> columns
328 0x78 0x22 ;; RLM: testing store HL
329 0x79 0x22
332 ])
334 stack-cleanup
335 [0xF1 0xE1 0xD1 0xC1]
336 ]
337 (concat load-data
338 display-glyph
339 cleanup stack-cleanup)))
341 (def main-program-base-address 0xC000)
343 (defn glyph-bootstrap-program
344 [start-address delay-count total-glyph-count]
345 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
346 header (concat (frame-metronome) (read-user-input))
348 glyph-display (glyph-display-program
349 (+ (count init)
350 (count header)
351 start-address))
352 ;;(- (count (program-data 0)) 100))
354 state-machine-start-address
355 (+ start-address (count init) (count header) (count glyph-display))
356 state-machine
357 (bootstrap-state-machine state-machine-start-address)
359 return-to-header
360 (flatten
361 [0xC3
362 (reverse (disect-bytes-2
363 (+ (count init) start-address)))])]
364 (concat init header glyph-display state-machine return-to-header)))
368 (defn-memo begin-glyph-bootstrap
369 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
370 ([script]
371 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
372 main-glyph-start (+ relocated-bootstrap-start
373 (count glyph-init))
374 glyph-program (glyph-bootstrap-program
375 main-glyph-start 0 0)]
376 (->> script
377 (do-nothing 2)
378 ;; begin glyph program
379 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
381 (write-RAM
382 relocated-bootstrap-start
383 (concat glyph-init glyph-program))
384 (transfer-control relocated-bootstrap-start)
385 (do-nothing 1)
387 ))))
389 (defn write-all-program-data
390 ([] (write-all-program-data (begin-glyph-bootstrap)))
391 ([script]
392 (let [base-address main-program-base-address]
393 (->> script
394 (write-RAM base-address (program-data base-address))))))
396 (defn activate-program
397 ([] (activate-program (write-all-program-data)))
398 ([script]
399 (->> script
400 (transfer-control main-program-base-address)
401 ;;(do-nothing 1800)
402 (do-nothing 50)
403 )))
406 ;; possible screen writing programs
408 ;; (program needs to stop executing at some point)
409 ;; maybe have total length counter or something?
411 ;; automatic counter that reads from program-start and clears the
412 ;; screen every 360 (* 18 20) gliphs
414 ;; advantages -- very simple and low bandwidth
415 ;; disadvantages -- hard to align counter
417 ;; implementation -- refactor main-bootstrap-program to provide a
418 ;; state-machine code-section which can be recombined into another
419 ;; program.