view clojure/com/aurellem/run/adv_choreo.clj @ 604:c8cda378e1a0

fixed flaw in advanced move recording.
author Robert McIntyre <rlm@mit.edu>
date Sun, 02 Sep 2012 10:34:14 -0500
parents b3e5006e23f0
children 54644b08da1a
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
48 )
51 music-base-address (+ (count image-program) base-address)
53 initial-music-data
54 (midi-bytes pony-csv 0 0 0 0)
56 data-lengths
57 (map (comp count :data)
58 [(:kernel initial-music-data)
59 (:voice-1 initial-music-data)
60 (:voice-2 initial-music-data)]);; noise not needed
61 addresses
62 (map (partial + music-base-address) (reductions + 0 data-lengths))
64 final-music-data
65 (apply (partial midi-bytes pony-csv) addresses)
67 music-program
68 (concat
69 (:data (:kernel final-music-data))
70 (:data (:voice-1 final-music-data))
71 (:data (:voice-2 final-music-data))
72 (:data (:noise final-music-data)))]
74 (concat
75 image-program ;; image program falls through to music program
76 music-program)))
78 (def glyphs
79 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
80 (mapv #(ImageIO/read
81 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
82 ["0" "1" "2" "3" "4" "5" "6" "7" "8"
83 "9" "A" "B" "C" "D" "E" "F" "_"]))
86 (defn glyph-init-program
87 [start-address]
88 (let [zero-glyph (image->gb-image (glyphs 0))
90 ;; write same pallet information to all pallettes
91 A (flatten
92 [(write-byte LCD-control-register 0x00);; disable LCD protection
93 (set-palettes bg-palette-select bg-palette-data
94 (repeat 8 (first (:palettes zero-glyph))))
95 (select-LCD-bank 0)
96 (write-byte SCX-register 0)
97 (write-byte SCY-register 0)])
98 B (flatten
99 [(write-data
100 (+ start-address (count A))
101 character-data-address
102 (flatten
103 (map (comp gb-tile->bytes first :tiles image->gb-image)
104 glyphs)))
107 (write-byte
108 LCD-control-register
109 (Integer/parseInt
110 (str
111 "1" ;; LCDC on/off
112 "0" ;; Window code area
113 "0" ;; Windowing on?
114 "1" ;; BG tile base (1 = 0x8000)
115 "0" ;; BG-1 or BG-2 ?
116 "0" ;; OBJ-block composition
117 "0" ;; OBJ-on flag
118 "1") ;; no-effect
119 2))])]
120 (concat A B )))
124 (defn glyph-display-program
125 [start-address]
126 (let [data-start (+ 2 start-address)
127 load-data
128 (flatten
129 [;; data region
130 0x18
131 2
132 0 0;; current row and column
133 ;; save all registers
134 0xC5 0xD5 0xE5 0xF5
136 ;; load data from data region into registers
138 0xF5 ;; push A, which contains current glyph
140 0x21
141 (reverse (disect-bytes-2 data-start))
142 ;; load row and column into DE
143 0x2A 0x57 ;; row -> D
144 0x2A 0x5F ;; column -> E
145 ])
148 display-glyph
149 (let [init*
150 (flatten
151 [;; clear screen if we are at 0,0
152 0x7A 0xB3 ;; D->A, OR E A ==> (= D E 0)
153 0x20 ;; skip clear-screen if D and E are not both zero
154 :clear-screen-length])
156 clear-screen
157 (flatten
158 [;; save all registers
159 0xC5 0xD5 0xE5 0xF5
161 (select-LCD-bank 0)
162 ;; write 0x00 to memory locations
163 ;; 0x9800 to 0x9A34
164 0x21
165 0x00 0x98 ;; load 0x9800 into HL
167 0x16 3 ;; 3 -> D
168 0x1E 190 ;; 190 -> E
170 ;; Empty space Character ID
171 0x3E 16 ;; 0-> A
173 ;; begin of do-while loop
174 0x22 ;; load A to 0x9800
175 0x1D ;; dec E
176 0x20
177 (->signed-8-bit -4)
178 0x15 ;; dec D
179 0x1E 190 ;; 188 -> E
180 0x20
181 (->signed-8-bit -8)
182 ;; end of do-while-loop
184 ;; restore all registers
185 0xF1 0xE1 0xD1 0xC1])
188 increment-row-column
189 [;; D contains row and E contains column
191 ;; every time column (E) reaches 20, set
192 ;; column to 0 and increment row
193 0x1C ;; inc E
194 0x3E 20 0xBB ;; compare E to 20
195 0x20
196 3
197 0x14 ;; increment row
198 0x1E 0 ;; set column to 0
201 ;; if row==18, set row to 0
202 0x3E 18
203 0xBA
204 0x20
205 2
206 0x16 0]
208 set-HL-from-row-and-column
209 (flatten
210 [;; formula for memory offset is:
211 ;; (+ 0x9800 (* 32 row) column) ==
212 0x21 0x00 0x98 ;; load HL with 0x9800
214 0x06 0
215 0x4B ;; columns (E) -> BC
216 0x09 ;; HL += columns
219 0xAF ;; 0 -> A
221 0x06 0
222 0x0E 32 ;; load 32 into BC
224 0xBA ;; CP A D
225 0x28 ;; skip this next section if A == D
226 4
227 0x09 ;; HL += 32
228 0x3C
229 0x18
231 (->signed-8-bit -7)])
233 render-glyph
234 (flatten
235 [;; Render each nybble of A as a character
236 ;; there are two characters to a glyph.
238 set-HL-from-row-and-column
240 0xF1 ;; pop A, now A is equal to key input
241 0xF5 ;; save A
243 0xE6 0xF0 ;; clear second nybble
244 0xCB 0x37 ;; swap nybbles
245 0x77 ;; store A in video RAM as a character (pun)
246 increment-row-column
249 set-HL-from-row-and-column
251 0xF1 ;; restore A
252 0xE6 0x0F ;; select second nybble
253 0x77 ;; store second nybble as character
254 increment-row-column])
257 init (replace
258 {:clear-screen-length (count clear-screen)} init*)
259 ]
261 (concat init clear-screen render-glyph))
263 cleanup
264 ;; restore all registers
265 (flatten
266 [;; Reset HL to initial data-start value
267 0x21
268 (reverse (disect-bytes-2 data-start))
269 ;;0x23
270 ;; write variables
271 0x7A 0x22 ;; D -> rows -> to RAM
272 0x7B 0x22 ;; E -> columns
273 ])
275 stack-cleanup
276 [0xF1 0xE1 0xD1 0xC1]
277 ]
278 (concat load-data
279 display-glyph
280 cleanup stack-cleanup)))
282 (def main-program-base-address 0xC000)
284 (defn glyph-bootstrap-program
285 [start-address delay-count total-glyph-count]
286 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
287 header (concat (frame-metronome) (read-user-input))
289 glyph-display (glyph-display-program
290 (+ (count init)
291 (count header)
292 start-address))
294 state-machine-start-address
295 (+ start-address (count init) (count header) (count glyph-display))
296 state-machine
297 (bootstrap-state-machine state-machine-start-address)
299 return-to-header
300 (flatten
301 [0xC3
302 (reverse (disect-bytes-2
303 (+ (count init) start-address)))])]
304 (concat init header glyph-display state-machine return-to-header)))
306 (defn-memo begin-glyph-bootstrap
307 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
308 ([script]
309 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
310 main-glyph-start (+ relocated-bootstrap-start
311 (count glyph-init))
312 glyph-program (glyph-bootstrap-program
313 main-glyph-start 0 0)]
314 (->> script
315 (do-nothing 2)
316 ;; begin glyph program
317 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
319 (write-RAM
320 relocated-bootstrap-start
321 (concat glyph-init glyph-program))
322 (transfer-control relocated-bootstrap-start)
323 (do-nothing 1)))))
325 (defn-memo write-all-program-data
326 ([] (write-all-program-data (begin-glyph-bootstrap)))
327 ([script]
328 (let [base-address main-program-base-address]
329 (->> script
330 (write-RAM base-address (program-data base-address))))))
332 (defn-memo activate-program
333 ([] (activate-program (write-all-program-data)))
334 ([script]
335 (->> script
336 (transfer-control main-program-base-address)
337 (do-nothing 1800)
338 (play-moves [[:a]]))))
340 (def advanced-render-dir
341 (File. user-home "proj/vba-clojure/render/advanced"))
343 (defn advanced-steps [] (first (activate-program)))
345 (def gb-button-bar
346 (File. user-home "/proj/vba-clojure/images/gb-button-bar.png"))
348 (def gb-button-mark
349 (File. user-home "/proj/vba-clojure/images/gb-button-mark.png"))
351 (defn adv-write-move-image! [move target-file]
352 (let [buttons (set move)
353 key-positions
354 {:l [23 23]
355 :u [33 11]
356 :r [46 23]
357 :d [33 26]
359 :start [65 24]
360 :select [80 24]
362 :b [100 25]
363 :a [121 25]}]
364 (apply
365 clojure.java.shell/sh
366 (flatten
367 ["convert"
368 (.getCanonicalPath gb-button-bar)
369 (map
370 (fn [key]
371 (let [[x y] (key-positions key)]
372 (.getCanonicalPath gb-button-mark)
373 "-geometry" (str "+" x "+" y) "-composite"))
374 buttons)
375 (.getCanonicalPath target-file)]))))
377 (defn adv-composite-frames-command
378 [move-image screenshot target]
379 ["convert"
380 screenshot
381 move-image "-append"
382 target])
384 (defn adv-generate-composite-frames!
385 [^File rendered-dir]
386 (let [final-frames (File. rendered-dir "final")
387 _ (.mkdir final-frames)
388 move-images (file-names (File. rendered-dir "moves"))
389 screenshots (file-names (File. rendered-dir "frames"))
390 targets (map #(.getCanonicalPath
391 (File. final-frames (format "%07d.png" %)))
392 (range (count screenshots)))]
393 (dorun
394 (map
395 (comp
396 (partial apply clojure.java.shell/sh)
397 flatten
398 (partial apply adv-composite-frames-command)
399 (fn [a b d] (println d) [a b d]))
400 move-images screenshots targets))))
402 (defn write-advanced-script!
403 [] (write-script! (activate-program) "advanced"))
405 (defn advanced-script []
406 (read-script "advanced"))
408 (defn advanced-step-1! []
409 (render-files!
410 advanced-render-dir
411 adv-write-move-image!
412 false
413 (root) (first (advanced-script))))
415 (defn advanced-step-2! []
416 (adv-generate-composite-frames!
417 advanced-render-dir))
419 (defn advanced-step-3! [] (final-cut! advanced-render-dir))
424 ;; possible screen writing programs
426 ;; (program needs to stop executing at some point)
427 ;; maybe have total length counter or something?
429 ;; automatic counter that reads from program-start and clears the
430 ;; screen every 360 (* 18 20) gliphs
432 ;; advantages -- very simple and low bandwidth
433 ;; disadvantages -- hard to align counter
435 ;; implementation -- refactor main-bootstrap-program to provide a
436 ;; state-machine code-section which can be recombined into another
437 ;; program.