Mercurial > vba-clojure

annotate clojure/com/aurellem/run/adv_choreo.clj @ 574:be6f46094ad0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
implemented video-memory pointer logic.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 04:05:51 -0500
parents 40f62391db9d
children 15876b1a0906
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@554 46 ;;pinkie-pie-mark
rlm@554 47 test-image-color
rlm@554 48
rlm@554 49 )
rlm@554 50
rlm@551 51
rlm@551 52 music-base-address (+ (count image-program) base-address)
rlm@551 53
rlm@551 54 initial-music-data
rlm@551 55 (midi-bytes pony-csv 0 0 0 0)
rlm@551 56
rlm@551 57 data-lengths
rlm@551 58 (map (comp count :data)
rlm@551 59 [(:kernel initial-music-data)
rlm@551 60 (:voice-1 initial-music-data)
rlm@551 61 (:voice-2 initial-music-data)]);; noise not needed
rlm@551 62 addresses
rlm@551 63 (map (partial + music-base-address) (reductions + 0 data-lengths))
rlm@551 64
rlm@551 65 final-music-data
rlm@551 66 (apply (partial midi-bytes pony-csv) addresses)
rlm@551 67
rlm@551 68 music-program
rlm@551 69 (concat
rlm@551 70 (:data (:kernel final-music-data))
rlm@551 71 (:data (:voice-1 final-music-data))
rlm@551 72 (:data (:voice-2 final-music-data))
rlm@551 73 (:data (:noise final-music-data)))]
rlm@551 74
rlm@551 75 (concat
rlm@551 76 image-program ;; image program falls through to music program
rlm@554 77
rlm@554 78 (infinite-loop)
rlm@554 79 ;;music-program
rlm@554 80
rlm@554 81 )))
rlm@551 82
rlm@551 83
rlm@551 84
rlm@553 85
rlm@553 86 (def glyphs
rlm@553 87 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
rlm@553 88 (mapv #(ImageIO/read
rlm@553 89 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
rlm@553 90 ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
rlm@553 91
rlm@554 92 (defn glyph-init-program
rlm@553 93 [start-address]
rlm@553 94 (let [zero-glyph (image->gb-image (glyphs 0))
rlm@553 95
rlm@553 96 ;; write same pallet information to all pallettes
rlm@553 97 A (flatten
rlm@554 98 [(write-byte LCD-control-register 0x00);; disable LCD protection
rlm@553 99 (set-palettes bg-palette-select bg-palette-data
rlm@553 100 (repeat 8 (first (:palettes zero-glyph))))
rlm@553 101 (select-LCD-bank 0)
rlm@553 102 (write-byte SCX-register 0)
rlm@553 103 (write-byte SCY-register 0)])
rlm@553 104 B (flatten
rlm@553 105 [(write-data
rlm@553 106 (+ start-address (count A))
rlm@553 107 character-data-address
rlm@553 108 (flatten
rlm@553 109 (map (comp gb-tile->bytes first :tiles image->gb-image)
rlm@554 110 glyphs)))
rlm@553 111
rlm@554 112
rlm@554 113 (write-byte
rlm@554 114 LCD-control-register
rlm@554 115 (Integer/parseInt
rlm@554 116 (str
rlm@554 117 "1" ;; LCDC on/off
rlm@554 118 "0" ;; Window code area
rlm@554 119 "0" ;; Windowing on?
rlm@554 120 "1" ;; BG tile base (1 = 0x8000)
rlm@554 121 "0" ;; BG-1 or BG-2 ?
rlm@554 122 "0" ;; OBJ-block composition
rlm@554 123 "0" ;; OBJ-on flag
rlm@554 124 "1") ;; no-effect
rlm@554 125 2))])]
rlm@554 126 (concat A B )))
rlm@553 127
rlm@558 128
rlm@560 129
rlm@553 130 (defn glyph-display-program
rlm@553 131 [start-address
rlm@562 132 max-glyphs]
rlm@556 133 (let [data-start (+ 2 start-address)
rlm@562 134 [max-glyphs-high max-glyphs-low]
rlm@562 135 (disect-bytes-2 max-glyphs)
rlm@557 136 load-data
rlm@557 137 (flatten
rlm@557 138 [;; data region
rlm@557 139 0x18
rlm@571 140 4
rlm@562 141 0 0 ;; current num of glyphs-rendered
rlm@571 142 0 0 ;; current row and column
rlm@557 143 ;; save all registers
rlm@557 144 0xC5 0xD5 0xE5 0xF5
rlm@557 145
rlm@557 146 ;; load data from data region into registers
rlm@562 147
rlm@562 148 0xF5 ;; push A
rlm@562 149 0x21 ;; begin data load
rlm@558 150 (reverse (disect-bytes-2 data-start))
rlm@562 151
rlm@562 152 0x2A 0x47 ;; glyphs-rendered -> BC
rlm@562 153 0x2A 0x4F
rlm@557 154
rlm@562 155 0x16 max-glyphs-high ;; load max-glyphs
rlm@562 156 0x1E max-glyphs-low ;; into DE
rlm@557 157 ])
rlm@557 158
rlm@560 159 handle-glyph-count*
rlm@560 160 (flatten
rlm@562 161 [;; if glyphs-rendered = max-glyph count, go directly
rlm@562 162 ;; to stack-cleanup
rlm@562 163
rlm@562 164 0x47 0xBA ;; compare B to D
rlm@562 165 0x20 ;; skip next section B != D
rlm@566 166 8 ;; this is equal to the number of instructions in the next
rlm@562 167 ;; indented region!
rlm@562 168
rlm@562 169 0x79 0xBB ;; compare C to E
rlm@562 170 0x20 ;; JR NZ, skip if C != E
rlm@566 171 4
rlm@562 172 0xF1 ;; pop AF for stack maintainance!
rlm@562 173 0x18
rlm@566 174 :stack-cleanup-low
rlm@566 175 :stack-cleanup-high
rlm@560 176 ])
rlm@560 177
rlm@562 178 display-glyph
rlm@562 179
rlm@568 180 (let [init*
rlm@563 181 (flatten
rlm@563 182 [0xF1 ;; pop A, now A is equal to key input
rlm@563 183 ;; BC is current number of glyphs rendered.
rlm@563 184 ;; each glyph is two characters, and the screen can hold up
rlm@563 185 ;; to 360 characters. Thus, if the current glyphs is a
rlm@563 186 ;; multiple of 180, the screen must be refreshed.
rlm@562 187
rlm@563 188 ;; DE contains max-glyphs and HL will be overwritten next
rlm@563 189 ;; section, so both are free to use here.
rlm@565 190 (repeat 100 0)
rlm@565 191 ;; Reset HL to initial value
rlm@565 192 0x21
rlm@565 193 (reverse (disect-bytes-2 data-start))
rlm@567 194 ;; load row and column into DE
rlm@567 195 0x23 0x23 ;; HL += 2
rlm@567 196 0x2A 0x57 ;; row -> D
rlm@567 197 0x2A 0x5F ;; column -> E
rlm@567 198
rlm@568 199 ;; clear screen if we are at 0,0
rlm@568 200 0x57 0xB3 ;; D->A, OR E A ==> (= D E 0)
rlm@571 201 0x20 ;; skip clear-screen if D and E are not both zero
rlm@572 202 :clear-screen-length])
rlm@562 203
rlm@563 204 clear-screen
rlm@568 205 (flatten
rlm@569 206 [;; save all registers
rlm@569 207 0xC5 0xD5 0xE5 0xF5
rlm@569 208
rlm@570 209 (select-LCD-bank 0)
rlm@570 210 ;; write 0x00 to memory locations
rlm@570 211 ;; 0x9800 to 0x9A34
rlm@570 212 0x21
rlm@570 213 0x00 0x98 ;; load 0x9800 into HL
rlm@570 214
rlm@570 215
rlm@570 216 0x16 3 ;; 3 -> D
rlm@570 217 0x1E 190 ;; 188 -> E
rlm@570 218
rlm@570 219 0x3E 0 ;; 0-> A
rlm@570 220
rlm@570 221 ;; begin of do-while loop
rlm@570 222 0x22 ;; load 0 to 0x9800
rlm@570 223 0x1D ;; dec E
rlm@570 224 0x20
rlm@570 225 (->signed-8-bit -4)
rlm@570 226 0x15 ;; dec D
rlm@570 227 0x1E 190 ;; 188 -> E
rlm@570 228 0x20
rlm@570 229 (->signed-8-bit -8)
rlm@570 230 ;; end of do-while-loop
rlm@572 231
rlm@569 232 ;; restore all registers
rlm@572 233 0xF1 0xE1 0xD1 0xC1])
rlm@572 234
rlm@573 235 increment-row-column
rlm@573 236 [;; D contains row and E contains column
rlm@573 237
rlm@573 238 ;; every time column (E) reaches 20, set
rlm@573 239 ;; column to 0 and increment row
rlm@573 240 0x1C ;; inc E
rlm@573 241 0x3E 20 0xBB ;; compare E to 20
rlm@573 242 0x20 ;; if E is 20
rlm@573 243 3
rlm@573 244 0x1E 0 ;; set E to zero
rlm@573 245 0x14 ;; (inc D) -> D
rlm@573 246
rlm@573 247 ;; every time row (D) reaches 18, set row to 0
rlm@573 248 0x3E 18 0xBA ;; compare D to 18
rlm@573 249 0x20 ;; if D is 18
rlm@573 250 2
rlm@573 251 0x16 0] ;; set D to zero
rlm@573 252
rlm@573 253 set-HL-from-row-and-column
rlm@573 254 [;; formula for memory offset is:
rlm@573 255 ;; (+ 0x9800 (* 32 row) column)
rlm@574 256 0xD5 0xC5 ;; push D E B C
rlm@573 257
rlm@574 258 0x21 0x00 0x98 ;; load HL with 0x9800
rlm@573 259
rlm@574 260 0x01 32 00 ;; load 32 into BC
rlm@574 261
rlm@574 262 ;; do
rlm@574 263 0x09 ;; HL += 32
rlm@574 264 0x15 ;; dec D
rlm@574 265 ;; while D != 0
rlm@574 266 0x20
rlm@574 267 (->signed-8-bit -4)
rlm@574 268
rlm@574 269 0x4B ;; E->C
rlm@574 270 0x15 ;; add columns (E) to HL
rlm@574 271
rlm@574 272 0xC1 0xD1 ;; pop C B E D
rlm@573 273 ]
rlm@573 274
rlm@573 275
rlm@573 276
rlm@573 277
rlm@572 278 render-glyph
rlm@572 279 (flatten
rlm@573 280 [set-HL-from-row-and-column
rlm@573 281 increment-row-column
rlm@573 282 ;; Render each nybble of A as a character
rlm@573 283 ;; there are two characters to a glyph.
rlm@569 284 ])
rlm@563 285
rlm@572 286
rlm@568 287 init (replace
rlm@568 288 {:clear-screen-length (count clear-screen)} init*)
rlm@568 289 ]
rlm@568 290
rlm@572 291 (concat init clear-screen render-glyph))
rlm@563 292
rlm@557 293 cleanup
rlm@557 294 ;; restore all registers
rlm@562 295 (flatten
rlm@562 296 [0x03 ;; (inc glyphs-rednered) -> glyphs-rendered
rlm@558 297
rlm@558 298 ;; Reset HL to initial value
rlm@558 299 0x21
rlm@558 300 (reverse (disect-bytes-2 data-start))
rlm@573 301 0x78 0x22 ;; BC -> glyphs-rendered to RAM
rlm@569 302 0x79 0x22 ;;
rlm@558 303
rlm@573 304 0x7A 0x22 ;; D -> rows -> to RAM
rlm@569 305 0x7B 0x22 ;; E -> columns
rlm@558 306 ])
rlm@558 307
rlm@558 308 stack-cleanup
rlm@557 309 [0xF1 0xE1 0xD1 0xC1]
rlm@566 310
rlm@566 311 [stack-cleanup-high
rlm@566 312 stack-cleanup-low]
rlm@566 313 (disect-bytes-2 (+ start-address (count load-data)
rlm@566 314 (count handle-glyph-count*)
rlm@566 315 (count cleanup)
rlm@566 316 (count display-glyph)))
rlm@566 317
rlm@560 318 handle-glyph-count
rlm@566 319 (replace {:stack-cleanup-high stack-cleanup-high
rlm@566 320 :stack-cleanup-low stack-cleanup-low}
rlm@561 321 handle-glyph-count*)]
rlm@565 322 (println (+ (count display-glyph) (count cleanup)))
rlm@558 323 (concat load-data
rlm@562 324 handle-glyph-count
rlm@558 325 display-glyph
rlm@558 326 cleanup stack-cleanup)))
rlm@556 327
rlm@556 328 (def main-program-base-address 0xC000)
rlm@553 329
rlm@553 330 (defn glyph-bootstrap-program
rlm@553 331 [start-address delay-count total-glyph-count]
rlm@553 332 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@554 333 header (concat (frame-metronome) (read-user-input))
rlm@553 334
rlm@553 335 glyph-display (glyph-display-program
rlm@559 336 (+ (count init)
rlm@562 337 (count header)
rlm@553 338 start-address)
rlm@562 339 2000)
rlm@558 340 ;;(- (count (program-data 0)) 100))
rlm@553 341
rlm@553 342 state-machine-start-address
rlm@553 343 (+ start-address (count init) (count header) (count glyph-display))
rlm@553 344 state-machine
rlm@553 345 (bootstrap-state-machine state-machine-start-address)
rlm@553 346
rlm@553 347 return-to-header
rlm@553 348 (flatten
rlm@564 349 [0xC3
rlm@564 350 (reverse (disect-bytes-2
rlm@564 351 (+ (count init) start-address)))])]
rlm@562 352 (concat init header glyph-display state-machine return-to-header)))
rlm@553 353
rlm@556 354
rlm@551 355
rlm@558 356 (defn-memo begin-glyph-bootstrap
rlm@554 357 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
rlm@554 358 ([script]
rlm@554 359 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
rlm@554 360 main-glyph-start (+ relocated-bootstrap-start
rlm@554 361 (count glyph-init))
rlm@554 362 glyph-program (glyph-bootstrap-program
rlm@554 363 main-glyph-start 0 0)]
rlm@554 364 (->> script
rlm@554 365 (do-nothing 2)
rlm@554 366 ;; begin glyph program
rlm@554 367 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@554 368
rlm@554 369 (write-RAM
rlm@554 370 relocated-bootstrap-start
rlm@554 371 (concat glyph-init glyph-program))
rlm@554 372 (transfer-control relocated-bootstrap-start)
rlm@555 373 (do-nothing 1)
rlm@553 374
rlm@554 375 ))))
rlm@553 376
rlm@551 377 (defn write-all-program-data
rlm@554 378 ([] (write-all-program-data (begin-glyph-bootstrap)))
rlm@551 379 ([script]
rlm@551 380 (let [base-address main-program-base-address]
rlm@551 381 (->> script
rlm@551 382 (write-RAM base-address (program-data base-address))))))
rlm@551 383
rlm@551 384 (defn activate-program
rlm@551 385 ([] (activate-program (write-all-program-data)))
rlm@551 386 ([script]
rlm@551 387 (->> script
rlm@551 388 (transfer-control main-program-base-address)
rlm@554 389 ;;(do-nothing 1800)
rlm@554 390 (do-nothing 50)
rlm@554 391 )))
rlm@552 392
rlm@552 393
rlm@552 394 ;; possible screen writing programs
rlm@552 395
rlm@552 396 ;; (program needs to stop executing at some point)
rlm@552 397 ;; maybe have total length counter or something?
rlm@552 398
rlm@552 399 ;; automatic counter that reads from program-start and clears the
rlm@552 400 ;; screen every 360 (* 18 20) gliphs
rlm@552 401
rlm@552 402 ;; advantages -- very simple and low bandwidth
rlm@552 403 ;; disadvantages -- hard to align counter
rlm@552 404
rlm@552 405 ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552 406 ;; state-machine code-section which can be recombined into another
rlm@552 407 ;; program.