Mercurial > vba-clojure

annotate clojure/com/aurellem/run/adv_choreo.clj @ 589:d9d86f6018e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
cleanup.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 10:15:04 -0500
parents 6e9368c371d5
children ba185915c24f
rev   line source
rlm@550 1 ;;;; "Advanced Choreography" -- this is the final video for this project.
rlm@550 2
rlm@550 3 (ns com.aurellem.run.adv-choreo
rlm@550 4 (:use (com.aurellem.gb saves gb-driver util constants
rlm@550 5 items vbm characters money
rlm@550 6 rlm-assembly))
rlm@550 7 (:use (com.aurellem.run util music title save-corruption
rlm@550 8 bootstrap-0 bootstrap-1 image
rlm@550 9 ram-display final-cut basic-choreo))
rlm@550 10 (:require clojure.string)
rlm@553 11 (:import java.awt.image.BufferedImage)
rlm@553 12 (:import (javax.imageio ImageWriteParam IIOImage ImageIO))
rlm@550 13 (:import [com.aurellem.gb.gb_driver SaveState])
rlm@550 14 (:import java.io.File))
rlm@550 15
rlm@550 16
rlm@550 17
rlm@550 18 ;; Use the gameboy's screen to display the new programming
rlm@550 19 ;; instead of a side window. This will make it look much
rlm@550 20 ;; cooler and create a terminal-like effect as the game is
rlm@550 21 ;; being reprogramed. To do this, use a fixed data entry
rlm@550 22 ;; region in ram, and run a program that translates this
rlm@550 23 ;; region into the screen. Every time this data entry region
rlm@550 24 ;; is full, run a program that copies the data to the
rlm@550 25 ;; appropriate region in memory. This will cost ~15 seconds
rlm@550 26 ;; at the beginning to set up, and then should have minimal
rlm@550 27 ;; overhead (~5%) for the rest of the data transfer, but
rlm@550 28 ;; will have a good psychological effect for the viewer
rlm@550 29 ;; since he can see that something is actually happening in
rlm@550 30 ;; the game.
rlm@550 31
rlm@550 32
rlm@551 33 ;; Symbol size and type.
rlm@551 34
rlm@551 35 ;; use fonts from zophar's domain:
rlm@551 36 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html
rlm@551 37
rlm@551 38 ;; Green font on black background for matrix look.
rlm@551 39
rlm@551 40
rlm@551 41 (defn program-data [base-address]
rlm@551 42 (let [image-program
rlm@551 43 (display-image-kernel
rlm@551 44 base-address
rlm@554 45
rlm@589 46 pinkie-pie-mark
rlm@589 47 ;;test-image-color
rlm@554 48 )
rlm@554 49
rlm@551 50
rlm@551 51 music-base-address (+ (count image-program) base-address)
rlm@551 52
rlm@551 53 initial-music-data
rlm@551 54 (midi-bytes pony-csv 0 0 0 0)
rlm@551 55
rlm@551 56 data-lengths
rlm@551 57 (map (comp count :data)
rlm@551 58 [(:kernel initial-music-data)
rlm@551 59 (:voice-1 initial-music-data)
rlm@551 60 (:voice-2 initial-music-data)]);; noise not needed
rlm@551 61 addresses
rlm@551 62 (map (partial + music-base-address) (reductions + 0 data-lengths))
rlm@551 63
rlm@551 64 final-music-data
rlm@551 65 (apply (partial midi-bytes pony-csv) addresses)
rlm@551 66
rlm@551 67 music-program
rlm@551 68 (concat
rlm@551 69 (:data (:kernel final-music-data))
rlm@551 70 (:data (:voice-1 final-music-data))
rlm@551 71 (:data (:voice-2 final-music-data))
rlm@551 72 (:data (:noise final-music-data)))]
rlm@551 73
rlm@551 74 (concat
rlm@551 75 image-program ;; image program falls through to music program
rlm@589 76 music-program)))
rlm@553 77
rlm@553 78 (def glyphs
rlm@553 79 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
rlm@553 80 (mapv #(ImageIO/read
rlm@553 81 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
rlm@588 82 ["0" "1" "2" "3" "4" "5" "6" "7" "8"
rlm@588 83 "9" "A" "B" "C" "D" "E" "F" "_"]))
rlm@588 84
rlm@553 85
rlm@554 86 (defn glyph-init-program
rlm@553 87 [start-address]
rlm@553 88 (let [zero-glyph (image->gb-image (glyphs 0))
rlm@553 89
rlm@553 90 ;; write same pallet information to all pallettes
rlm@553 91 A (flatten
rlm@554 92 [(write-byte LCD-control-register 0x00);; disable LCD protection
rlm@553 93 (set-palettes bg-palette-select bg-palette-data
rlm@553 94 (repeat 8 (first (:palettes zero-glyph))))
rlm@553 95 (select-LCD-bank 0)
rlm@553 96 (write-byte SCX-register 0)
rlm@553 97 (write-byte SCY-register 0)])
rlm@553 98 B (flatten
rlm@553 99 [(write-data
rlm@553 100 (+ start-address (count A))
rlm@553 101 character-data-address
rlm@553 102 (flatten
rlm@553 103 (map (comp gb-tile->bytes first :tiles image->gb-image)
rlm@554 104 glyphs)))
rlm@553 105
rlm@554 106
rlm@554 107 (write-byte
rlm@554 108 LCD-control-register
rlm@554 109 (Integer/parseInt
rlm@554 110 (str
rlm@554 111 "1" ;; LCDC on/off
rlm@554 112 "0" ;; Window code area
rlm@554 113 "0" ;; Windowing on?
rlm@554 114 "1" ;; BG tile base (1 = 0x8000)
rlm@554 115 "0" ;; BG-1 or BG-2 ?
rlm@554 116 "0" ;; OBJ-block composition
rlm@554 117 "0" ;; OBJ-on flag
rlm@554 118 "1") ;; no-effect
rlm@554 119 2))])]
rlm@554 120 (concat A B )))
rlm@553 121
rlm@558 122
rlm@560 123
rlm@553 124 (defn glyph-display-program
rlm@577 125 [start-address]
rlm@556 126 (let [data-start (+ 2 start-address)
rlm@557 127 load-data
rlm@557 128 (flatten
rlm@557 129 [;; data region
rlm@557 130 0x18
rlm@584 131 2
rlm@584 132 0 0;; current row and column
rlm@557 133 ;; save all registers
rlm@557 134 0xC5 0xD5 0xE5 0xF5
rlm@557 135
rlm@557 136 ;; load data from data region into registers
rlm@562 137
rlm@577 138 0xF5 ;; push A, which contains current glyph
rlm@577 139
rlm@577 140 0x21
rlm@558 141 (reverse (disect-bytes-2 data-start))
rlm@577 142 ;; load row and column into DE
rlm@577 143 0x2A 0x57 ;; row -> D
rlm@577 144 0x2A 0x5F ;; column -> E
rlm@557 145 ])
rlm@557 146
rlm@560 147
rlm@562 148 display-glyph
rlm@568 149 (let [init*
rlm@563 150 (flatten
rlm@577 151 [(repeat 100 0)
rlm@565 152 ;; Reset HL to initial value
rlm@567 153
rlm@568 154 ;; clear screen if we are at 0,0
rlm@585 155 0x7A 0xB3 ;; D->A, OR E A ==> (= D E 0)
rlm@571 156 0x20 ;; skip clear-screen if D and E are not both zero
rlm@572 157 :clear-screen-length])
rlm@562 158
rlm@563 159 clear-screen
rlm@568 160 (flatten
rlm@569 161 [;; save all registers
rlm@569 162 0xC5 0xD5 0xE5 0xF5
rlm@569 163
rlm@570 164 (select-LCD-bank 0)
rlm@570 165 ;; write 0x00 to memory locations
rlm@570 166 ;; 0x9800 to 0x9A34
rlm@570 167 0x21
rlm@570 168 0x00 0x98 ;; load 0x9800 into HL
rlm@570 169
rlm@570 170 0x16 3 ;; 3 -> D
rlm@570 171 0x1E 190 ;; 188 -> E
rlm@570 172
rlm@584 173 ;; Empty space Character ID
rlm@584 174 0x3E 16 ;; 0-> A
rlm@570 175
rlm@570 176 ;; begin of do-while loop
rlm@584 177 0x22 ;; load A to 0x9800
rlm@570 178 0x1D ;; dec E
rlm@570 179 0x20
rlm@570 180 (->signed-8-bit -4)
rlm@570 181 0x15 ;; dec D
rlm@570 182 0x1E 190 ;; 188 -> E
rlm@570 183 0x20
rlm@570 184 (->signed-8-bit -8)
rlm@570 185 ;; end of do-while-loop
rlm@572 186
rlm@569 187 ;; restore all registers
rlm@572 188 0xF1 0xE1 0xD1 0xC1])
rlm@572 189
rlm@584 190
rlm@573 191 increment-row-column
rlm@573 192 [;; D contains row and E contains column
rlm@573 193
rlm@573 194 ;; every time column (E) reaches 20, set
rlm@573 195 ;; column to 0 and increment row
rlm@573 196 0x1C ;; inc E
rlm@573 197 0x3E 20 0xBB ;; compare E to 20
rlm@578 198 0x20
rlm@579 199 3
rlm@587 200 0x14 ;; increment row
rlm@587 201 0x1E 0 ;; set column to 0
rlm@578 202
rlm@579 203
rlm@587 204 ;; if row==18, set row to 0
rlm@579 205 0x3E 18
rlm@579 206 0xBA
rlm@579 207 0x20
rlm@579 208 2
rlm@587 209 0x16 0]
rlm@573 210
rlm@573 211 set-HL-from-row-and-column
rlm@581 212 (flatten
rlm@573 213 [;; formula for memory offset is:
rlm@577 214 ;; (+ 0x9800 (* 32 row) column) ==
rlm@587 215 0x21 0x00 0x98 ;; load HL with 0x9800
rlm@577 216
rlm@584 217 0x06 0
rlm@584 218 0x4B ;; columns (E) -> BC
rlm@584 219 0x09 ;; HL += columns
rlm@573 220
rlm@579 221
rlm@579 222 0xAF ;; 0 -> A
rlm@579 223
rlm@579 224 0x06 0
rlm@579 225 0x0E 32 ;; load 32 into BC
rlm@579 226
rlm@581 227 0xBA ;; CP A D
rlm@583 228 0x28 ;; skip this next section if A == D
rlm@579 229 4
rlm@579 230 0x09 ;; HL += 32
rlm@579 231 0x3C
rlm@579 232 0x18
rlm@587 233
rlm@588 234 (->signed-8-bit -7)])
rlm@573 235
rlm@572 236 render-glyph
rlm@572 237 (flatten
rlm@577 238 [;; Render each nybble of A as a character
rlm@577 239 ;; there are two characters to a glyph.
rlm@584 240
rlm@577 241 set-HL-from-row-and-column
rlm@581 242
rlm@575 243 0xF1 ;; pop A, now A is equal to key input
rlm@575 244 0xF5 ;; save A
rlm@575 245
rlm@575 246 0xE6 0xF0 ;; clear second nybble
rlm@575 247 0xCB 0x37 ;; swap nybbles
rlm@579 248 0x77 ;; store A in video RAM as a character (pun)
rlm@577 249 increment-row-column
rlm@581 250
rlm@581 251
rlm@577 252 set-HL-from-row-and-column
rlm@581 253
rlm@575 254 0xF1 ;; restore A
rlm@575 255 0xE6 0x0F ;; select second nybble
rlm@579 256 0x77 ;; store second nybble as character
rlm@588 257 increment-row-column])
rlm@563 258
rlm@572 259
rlm@568 260 init (replace
rlm@568 261 {:clear-screen-length (count clear-screen)} init*)
rlm@568 262 ]
rlm@568 263
rlm@572 264 (concat init clear-screen render-glyph))
rlm@563 265
rlm@557 266 cleanup
rlm@557 267 ;; restore all registers
rlm@562 268 (flatten
rlm@582 269 [;; Reset HL to initial data-start value
rlm@558 270 0x21
rlm@558 271 (reverse (disect-bytes-2 data-start))
rlm@579 272 ;;0x23
rlm@582 273 ;; write variables
rlm@579 274 0x7A 0x22 ;; D -> rows -> to RAM
rlm@569 275 0x7B 0x22 ;; E -> columns
rlm@558 276 ])
rlm@558 277
rlm@558 278 stack-cleanup
rlm@557 279 [0xF1 0xE1 0xD1 0xC1]
rlm@576 280 ]
rlm@558 281 (concat load-data
rlm@558 282 display-glyph
rlm@558 283 cleanup stack-cleanup)))
rlm@556 284
rlm@556 285 (def main-program-base-address 0xC000)
rlm@553 286
rlm@553 287 (defn glyph-bootstrap-program
rlm@553 288 [start-address delay-count total-glyph-count]
rlm@553 289 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@554 290 header (concat (frame-metronome) (read-user-input))
rlm@553 291
rlm@553 292 glyph-display (glyph-display-program
rlm@559 293 (+ (count init)
rlm@562 294 (count header)
rlm@577 295 start-address))
rlm@553 296
rlm@553 297 state-machine-start-address
rlm@553 298 (+ start-address (count init) (count header) (count glyph-display))
rlm@553 299 state-machine
rlm@553 300 (bootstrap-state-machine state-machine-start-address)
rlm@553 301
rlm@553 302 return-to-header
rlm@553 303 (flatten
rlm@564 304 [0xC3
rlm@564 305 (reverse (disect-bytes-2
rlm@564 306 (+ (count init) start-address)))])]
rlm@562 307 (concat init header glyph-display state-machine return-to-header)))
rlm@553 308
rlm@558 309 (defn-memo begin-glyph-bootstrap
rlm@554 310 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
rlm@554 311 ([script]
rlm@554 312 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
rlm@554 313 main-glyph-start (+ relocated-bootstrap-start
rlm@554 314 (count glyph-init))
rlm@554 315 glyph-program (glyph-bootstrap-program
rlm@554 316 main-glyph-start 0 0)]
rlm@554 317 (->> script
rlm@554 318 (do-nothing 2)
rlm@554 319 ;; begin glyph program
rlm@554 320 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@554 321
rlm@554 322 (write-RAM
rlm@554 323 relocated-bootstrap-start
rlm@554 324 (concat glyph-init glyph-program))
rlm@554 325 (transfer-control relocated-bootstrap-start)
rlm@589 326 (do-nothing 1)))))
rlm@553 327
rlm@551 328 (defn write-all-program-data
rlm@554 329 ([] (write-all-program-data (begin-glyph-bootstrap)))
rlm@551 330 ([script]
rlm@551 331 (let [base-address main-program-base-address]
rlm@551 332 (->> script
rlm@551 333 (write-RAM base-address (program-data base-address))))))
rlm@551 334
rlm@551 335 (defn activate-program
rlm@551 336 ([] (activate-program (write-all-program-data)))
rlm@551 337 ([script]
rlm@551 338 (->> script
rlm@551 339 (transfer-control main-program-base-address)
rlm@589 340 (do-nothing 1800))))
rlm@552 341
rlm@552 342
rlm@552 343 ;; possible screen writing programs
rlm@552 344
rlm@552 345 ;; (program needs to stop executing at some point)
rlm@552 346 ;; maybe have total length counter or something?
rlm@552 347
rlm@552 348 ;; automatic counter that reads from program-start and clears the
rlm@552 349 ;; screen every 360 (* 18 20) gliphs
rlm@552 350
rlm@552 351 ;; advantages -- very simple and low bandwidth
rlm@552 352 ;; disadvantages -- hard to align counter
rlm@552 353
rlm@552 354 ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552 355 ;; state-machine code-section which can be recombined into another
rlm@552 356 ;; program.