view clojure/com/aurellem/run/adv_choreo.clj @ 561:c57398047795

saving progress.
author Robert McIntyre <rlm@mit.edu>
date Fri, 31 Aug 2012 08:50:32 -0500
parents 3194a4f438ca
children 114f58b5b6d0
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 monitor-address
133 delay-count
134 total-glyph-count]
135 (let [data-start (+ 2 start-address)
136 load-data
137 (flatten
138 [;; data region
140 0x18
141 5
142 (disect-bytes-2 monitor-address)
143 (disect-bytes-2 total-glyph-count)
144 delay-count
146 ;; save all registers
147 0xC5 0xD5 0xE5 0xF5
149 ;; load data from data region into registers
150 0x21
151 (reverse (disect-bytes-2 data-start))
153 0x2A 0x47 ;; monitor-address-high -> B
154 0x2A 0x4F ;; monitor-address-low -> C
156 0x2A 0x57 ;; glyph-count-high -> D
157 0x2A 0x5F ;; glyph-count-low -> E
159 0x7E ;; delay -> A
160 ])
162 handle-delay*
163 (flatten
164 [0xA7 ;; test if delay is zero
165 ;; if delay is not 0, decrement and skip to cleanup
166 0x28 ;; JR Z, skip this section if A==0
167 4
168 0x3D ;; dec A
169 0x77 ;; (dec delay) -> delay
170 0x18
171 :to-cleanup])
173 handle-glyph-count*
174 (flatten
175 [;; if glyph-count is 0, go directly to stack-cleanup
176 0x79 0xB0 ;; check if BC == 0
177 0x20 ;; JR NZ, skip if BC !=0
178 2
179 0x18
180 :to-stack-cleanup
181 ])
183 display-glyph [0 0 0]
184 cleanup
185 ;; restore all registers
187 (flatten
188 [0x03 ;; (inc monitor-address) -> monitor-address
189 0x1B ;; (dec glyph-count) -> glyph-count
191 ;; Reset HL to initial value
192 0x21
193 (reverse (disect-bytes-2 data-start))
195 0x78 0x22 ;; B -> monitor-address-high
196 0x79 0x22 ;; C -> monitor-address-low
198 0x7A 0x22 ;; D -> glyph-count-high
199 0x7B 0x22 ;; E -> glyph-count-low
200 ])
202 stack-cleanup
203 [0xF1 0xE1 0xD1 0xC1]
205 handle-delay
206 (replace {:to-cleanup
207 (+ (count display-glyph) (count handle-glyph-count*))}
208 handle-delay*)
210 handle-glyph-count
211 (replace {:to-stack-cleanup
212 (+ (count display-glyph) (count cleanup))}
213 handle-glyph-count*)]
214 (concat load-data
215 handle-delay handle-glyph-count
216 display-glyph
217 cleanup stack-cleanup)))
219 (def main-program-base-address 0xC000)
221 (defn glyph-bootstrap-program
222 [start-address delay-count total-glyph-count]
223 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
224 header (concat (frame-metronome) (read-user-input))
226 glyph-display (glyph-display-program
227 (+ (count init)
228 ;;(count header)
229 start-address)
230 main-program-base-address 100
231 200)
232 ;;(- (count (program-data 0)) 100))
234 state-machine-start-address
235 (+ start-address (count init) (count header) (count glyph-display))
236 state-machine
237 (bootstrap-state-machine state-machine-start-address)
239 return-to-header
240 (flatten
241 [0x18
242 (->signed-8-bit
243 (- (count init)
244 2 ;; this command length
245 3 ;; I have no idea why we need a 3 here
246 ;; need to investigate.
247 (count glyph-display)
248 (count header)
249 (count state-machine)))])]
251 (concat init glyph-display header state-machine return-to-header)))
255 (defn-memo begin-glyph-bootstrap
256 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
257 ([script]
258 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
259 main-glyph-start (+ relocated-bootstrap-start
260 (count glyph-init))
261 glyph-program (glyph-bootstrap-program
262 main-glyph-start 0 0)]
263 (->> script
264 (do-nothing 2)
265 ;; begin glyph program
266 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
268 (write-RAM
269 relocated-bootstrap-start
270 (concat glyph-init glyph-program))
271 (transfer-control relocated-bootstrap-start)
272 (do-nothing 1)
274 ))))
276 (defn write-all-program-data
277 ([] (write-all-program-data (begin-glyph-bootstrap)))
278 ([script]
279 (let [base-address main-program-base-address]
280 (->> script
281 (write-RAM base-address (program-data base-address))))))
283 (defn activate-program
284 ([] (activate-program (write-all-program-data)))
285 ([script]
286 (->> script
287 (transfer-control main-program-base-address)
288 ;;(do-nothing 1800)
289 (do-nothing 50)
290 )))
293 ;; possible screen writing programs
295 ;; (program needs to stop executing at some point)
296 ;; maybe have total length counter or something?
298 ;; automatic counter that reads from program-start and clears the
299 ;; screen every 360 (* 18 20) gliphs
301 ;; advantages -- very simple and low bandwidth
302 ;; disadvantages -- hard to align counter
304 ;; implementation -- refactor main-bootstrap-program to provide a
305 ;; state-machine code-section which can be recombined into another
306 ;; program.