Mercurial > vba-clojure

annotate clojure/com/aurellem/run/adv_choreo.clj @ 558:6f8b15c2fb48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
trying to track down major problem with storing variables in RAM.
author Robert McIntyre <rlm@mit.edu>
date Fri, 31 Aug 2012 04:22:08 -0500
parents cd54ac4a8701
children 91e99cc36bda
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@558 129 ;; handle-delay*
rlm@558 130 ;; (flatten
rlm@558 131 ;; [0xA7 ;; test if delay is zero
rlm@558 132 ;; ;; if delay is not 0, decrement and skip to cleanup
rlm@558 133 ;; 0x28 ;; JR Z, skip this section if A==0
rlm@558 134 ;; 4
rlm@558 135 ;; 0x3D ;; dec A
rlm@558 136 ;; 0x77 ;; (dec delay) -> delay
rlm@558 137 ;; 0x18
rlm@558 138 ;; :to-cleanup])
rlm@558 139
rlm@558 140 ;; handle-glyph-count*
rlm@558 141 ;; (flatten
rlm@558 142 ;; [;; if glyph-count is 0, go directly to stack-cleanup
rlm@558 143
rlm@558 144 ;; ;;0x79 0xB0 ;; check if BC == 0
rlm@558 145 ;; 0 0
rlm@558 146 ;; 0x20 ;; JR NZ, skip if BC !=0
rlm@558 147 ;; 2
rlm@558 148 ;; 0 0
rlm@558 149 ;; ;;0x18
rlm@558 150 ;; ;;:to-stack-cleanup
rlm@558 151 ;; ])
rlm@558 152 ;; handle-glyph-count* [0 0 0 0]
rlm@558 153
rlm@558 154
rlm@558 155 ;; handle-delay
rlm@558 156 ;; (replace {:to-cleanup
rlm@558 157 ;; (+ (count display-glyph) (count handle-glyph-count*))}
rlm@558 158 ;; handle-delay*)
rlm@558 159
rlm@558 160 ;; handle-glyph-count
rlm@558 161 ;; (replace {:to-stack-cleanup
rlm@558 162 ;; (+ (count display-glyph) (count cleanup))}
rlm@558 163 ;; handle-glyph-count*)
rlm@558 164
rlm@558 165
rlm@553 166 (defn glyph-display-program
rlm@553 167 [start-address
rlm@556 168 monitor-address
rlm@553 169 delay-count
rlm@553 170 total-glyph-count]
rlm@556 171 (let [data-start (+ 2 start-address)
rlm@556 172 monitor-address-high (+ 0 data-start)
rlm@556 173 monitor-address-low (+ 1 data-start)
rlm@554 174
rlm@556 175 glyph-count-high (+ 2 data-start)
rlm@556 176 glyph-count-low (+ 3 data-start)
rlm@554 177
rlm@557 178 delay-address (+ 4 data-start)
rlm@556 179
rlm@557 180 load-data
rlm@557 181 (flatten
rlm@557 182 [;; data region
rlm@557 183
rlm@557 184 0x18
rlm@557 185 5
rlm@557 186 (disect-bytes-2 monitor-address)
rlm@557 187 (disect-bytes-2 total-glyph-count)
rlm@557 188 delay-count
rlm@557 189
rlm@557 190 ;; save all registers
rlm@557 191 0xC5 0xD5 0xE5 0xF5
rlm@557 192
rlm@557 193 ;; load data from data region into registers
rlm@557 194 0x21
rlm@558 195 (reverse (disect-bytes-2 data-start))
rlm@557 196
rlm@557 197 0x2A 0x47 ;; monitor-address-high -> B
rlm@557 198 0x2A 0x4F ;; monitor-address-low -> C
rlm@557 199
rlm@557 200 0x2A 0x57 ;; glyph-count-high -> D
rlm@557 201 0x2A 0x5F ;; glyph-count-low -> E
rlm@557 202
rlm@558 203 0x7E ;; delay -> A
rlm@557 204 ])
rlm@557 205
rlm@558 206 display-glyph [0 0 0]
rlm@557 207 cleanup
rlm@557 208 ;; restore all registers
rlm@558 209
rlm@558 210 (flatten
rlm@558 211 [;; HL points to delay currently,
rlm@558 212 ;; decrement HL and then restore everything
rlm@558 213
rlm@558 214 0x03 ;; (inc monitor-address) -> monitor-address
rlm@558 215 0x1B ;; (dec glyph-count) -> glyph-count
rlm@558 216
rlm@558 217 ;; Reset HL to initial value
rlm@558 218 0x21
rlm@558 219 (reverse (disect-bytes-2 data-start))
rlm@558 220
rlm@558 221 0x78 0x22 ;; B -> monitor-address-high
rlm@558 222 0x79 0x22 ;; C -> monitor-address-low
rlm@558 223
rlm@558 224 ;;0x7A 0x22 ;; D -> glyph-count-high
rlm@558 225 ;;0x7B 0x22 ;; E -> glyph-count-low
rlm@558 226 ])
rlm@558 227
rlm@558 228 stack-cleanup
rlm@557 229 [0xF1 0xE1 0xD1 0xC1]
rlm@557 230
rlm@558 231 ]
rlm@558 232 (concat load-data
rlm@558 233 ;;handle-delay handle-glyph-count
rlm@558 234 display-glyph
rlm@558 235 cleanup stack-cleanup)))
rlm@557 236
rlm@554 237
rlm@556 238
rlm@556 239 (def main-program-base-address 0xC000)
rlm@553 240
rlm@553 241 (defn glyph-bootstrap-program
rlm@553 242 [start-address delay-count total-glyph-count]
rlm@553 243 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@554 244 header (concat (frame-metronome) (read-user-input))
rlm@553 245
rlm@553 246 glyph-display (glyph-display-program
rlm@553 247 (+ (count init) (count header)
rlm@553 248 start-address)
rlm@556 249 main-program-base-address 100
rlm@558 250 200)
rlm@558 251 ;;(- (count (program-data 0)) 100))
rlm@553 252
rlm@553 253 state-machine-start-address
rlm@553 254 (+ start-address (count init) (count header) (count glyph-display))
rlm@553 255 state-machine
rlm@553 256 (bootstrap-state-machine state-machine-start-address)
rlm@553 257
rlm@553 258 return-to-header
rlm@553 259 (flatten
rlm@553 260 [0x18
rlm@553 261 (->signed-8-bit
rlm@553 262 (- (count init)
rlm@553 263 2 ;; this command length
rlm@553 264 3 ;; I have no idea why we need a 3 here
rlm@553 265 ;; need to investigate.
rlm@553 266 (count glyph-display)
rlm@553 267 (count header)
rlm@553 268 (count state-machine)))])]
rlm@553 269
rlm@553 270 (concat init glyph-display header state-machine return-to-header)))
rlm@553 271
rlm@556 272
rlm@551 273
rlm@558 274 (defn-memo begin-glyph-bootstrap
rlm@554 275 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
rlm@554 276 ([script]
rlm@554 277 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
rlm@554 278 main-glyph-start (+ relocated-bootstrap-start
rlm@554 279 (count glyph-init))
rlm@554 280 glyph-program (glyph-bootstrap-program
rlm@554 281 main-glyph-start 0 0)]
rlm@554 282 (->> script
rlm@554 283 (do-nothing 2)
rlm@554 284 ;; begin glyph program
rlm@554 285 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@554 286
rlm@554 287 (write-RAM
rlm@554 288 relocated-bootstrap-start
rlm@554 289 (concat glyph-init glyph-program))
rlm@554 290 (transfer-control relocated-bootstrap-start)
rlm@555 291 (do-nothing 1)
rlm@553 292
rlm@554 293 ))))
rlm@553 294
rlm@551 295 (defn write-all-program-data
rlm@554 296 ([] (write-all-program-data (begin-glyph-bootstrap)))
rlm@551 297 ([script]
rlm@551 298 (let [base-address main-program-base-address]
rlm@551 299 (->> script
rlm@551 300 (write-RAM base-address (program-data base-address))))))
rlm@551 301
rlm@551 302 (defn activate-program
rlm@551 303 ([] (activate-program (write-all-program-data)))
rlm@551 304 ([script]
rlm@551 305 (->> script
rlm@551 306 (transfer-control main-program-base-address)
rlm@554 307 ;;(do-nothing 1800)
rlm@554 308 (do-nothing 50)
rlm@554 309 )))
rlm@552 310
rlm@552 311
rlm@552 312 ;; possible screen writing programs
rlm@552 313
rlm@552 314 ;; (program needs to stop executing at some point)
rlm@552 315 ;; maybe have total length counter or something?
rlm@552 316
rlm@552 317 ;; automatic counter that reads from program-start and clears the
rlm@552 318 ;; screen every 360 (* 18 20) gliphs
rlm@552 319
rlm@552 320 ;; advantages -- very simple and low bandwidth
rlm@552 321 ;; disadvantages -- hard to align counter
rlm@552 322
rlm@552 323 ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552 324 ;; state-machine code-section which can be recombined into another
rlm@552 325 ;; program.