Mercurial > vba-clojure

annotate clojure/com/aurellem/run/adv_choreo.clj @ 559:91e99cc36bda

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
problem was improper value for starting position in memory for glyph-display-program.
author Robert McIntyre <rlm@mit.edu>
date Fri, 31 Aug 2012 04:58:15 -0500
parents 6f8b15c2fb48
children 3194a4f438ca
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@557 172 load-data
rlm@557 173 (flatten
rlm@557 174 [;; data region
rlm@557 175
rlm@557 176 0x18
rlm@557 177 5
rlm@557 178 (disect-bytes-2 monitor-address)
rlm@557 179 (disect-bytes-2 total-glyph-count)
rlm@557 180 delay-count
rlm@557 181
rlm@557 182 ;; save all registers
rlm@557 183 0xC5 0xD5 0xE5 0xF5
rlm@557 184
rlm@557 185 ;; load data from data region into registers
rlm@557 186 0x21
rlm@558 187 (reverse (disect-bytes-2 data-start))
rlm@557 188
rlm@557 189 0x2A 0x47 ;; monitor-address-high -> B
rlm@557 190 0x2A 0x4F ;; monitor-address-low -> C
rlm@557 191
rlm@557 192 0x2A 0x57 ;; glyph-count-high -> D
rlm@557 193 0x2A 0x5F ;; glyph-count-low -> E
rlm@557 194
rlm@558 195 0x7E ;; delay -> A
rlm@557 196 ])
rlm@557 197
rlm@558 198 display-glyph [0 0 0]
rlm@557 199 cleanup
rlm@557 200 ;; restore all registers
rlm@558 201
rlm@558 202 (flatten
rlm@559 203 [0x03 ;; (inc monitor-address) -> monitor-address
rlm@558 204 0x1B ;; (dec glyph-count) -> glyph-count
rlm@559 205
rlm@558 206 ;; Reset HL to initial value
rlm@558 207 0x21
rlm@558 208 (reverse (disect-bytes-2 data-start))
rlm@558 209
rlm@558 210 0x78 0x22 ;; B -> monitor-address-high
rlm@558 211 0x79 0x22 ;; C -> monitor-address-low
rlm@558 212
rlm@559 213 0x7A 0x22 ;; D -> glyph-count-high
rlm@559 214 0x7B 0x22 ;; E -> glyph-count-low
rlm@558 215 ])
rlm@558 216
rlm@558 217 stack-cleanup
rlm@557 218 [0xF1 0xE1 0xD1 0xC1]
rlm@557 219
rlm@558 220 ]
rlm@558 221 (concat load-data
rlm@558 222 ;;handle-delay handle-glyph-count
rlm@558 223 display-glyph
rlm@558 224 cleanup stack-cleanup)))
rlm@557 225
rlm@554 226
rlm@556 227
rlm@556 228 (def main-program-base-address 0xC000)
rlm@553 229
rlm@553 230 (defn glyph-bootstrap-program
rlm@553 231 [start-address delay-count total-glyph-count]
rlm@553 232 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@554 233 header (concat (frame-metronome) (read-user-input))
rlm@553 234
rlm@553 235 glyph-display (glyph-display-program
rlm@559 236 (+ (count init)
rlm@559 237 ;;(count header)
rlm@553 238 start-address)
rlm@556 239 main-program-base-address 100
rlm@558 240 200)
rlm@558 241 ;;(- (count (program-data 0)) 100))
rlm@553 242
rlm@553 243 state-machine-start-address
rlm@553 244 (+ start-address (count init) (count header) (count glyph-display))
rlm@553 245 state-machine
rlm@553 246 (bootstrap-state-machine state-machine-start-address)
rlm@553 247
rlm@553 248 return-to-header
rlm@553 249 (flatten
rlm@553 250 [0x18
rlm@553 251 (->signed-8-bit
rlm@553 252 (- (count init)
rlm@553 253 2 ;; this command length
rlm@553 254 3 ;; I have no idea why we need a 3 here
rlm@553 255 ;; need to investigate.
rlm@553 256 (count glyph-display)
rlm@553 257 (count header)
rlm@553 258 (count state-machine)))])]
rlm@553 259
rlm@553 260 (concat init glyph-display header state-machine return-to-header)))
rlm@553 261
rlm@556 262
rlm@551 263
rlm@558 264 (defn-memo begin-glyph-bootstrap
rlm@554 265 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
rlm@554 266 ([script]
rlm@554 267 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
rlm@554 268 main-glyph-start (+ relocated-bootstrap-start
rlm@554 269 (count glyph-init))
rlm@554 270 glyph-program (glyph-bootstrap-program
rlm@554 271 main-glyph-start 0 0)]
rlm@554 272 (->> script
rlm@554 273 (do-nothing 2)
rlm@554 274 ;; begin glyph program
rlm@554 275 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@554 276
rlm@554 277 (write-RAM
rlm@554 278 relocated-bootstrap-start
rlm@554 279 (concat glyph-init glyph-program))
rlm@554 280 (transfer-control relocated-bootstrap-start)
rlm@555 281 (do-nothing 1)
rlm@553 282
rlm@554 283 ))))
rlm@553 284
rlm@551 285 (defn write-all-program-data
rlm@554 286 ([] (write-all-program-data (begin-glyph-bootstrap)))
rlm@551 287 ([script]
rlm@551 288 (let [base-address main-program-base-address]
rlm@551 289 (->> script
rlm@551 290 (write-RAM base-address (program-data base-address))))))
rlm@551 291
rlm@551 292 (defn activate-program
rlm@551 293 ([] (activate-program (write-all-program-data)))
rlm@551 294 ([script]
rlm@551 295 (->> script
rlm@551 296 (transfer-control main-program-base-address)
rlm@554 297 ;;(do-nothing 1800)
rlm@554 298 (do-nothing 50)
rlm@554 299 )))
rlm@552 300
rlm@552 301
rlm@552 302 ;; possible screen writing programs
rlm@552 303
rlm@552 304 ;; (program needs to stop executing at some point)
rlm@552 305 ;; maybe have total length counter or something?
rlm@552 306
rlm@552 307 ;; automatic counter that reads from program-start and clears the
rlm@552 308 ;; screen every 360 (* 18 20) gliphs
rlm@552 309
rlm@552 310 ;; advantages -- very simple and low bandwidth
rlm@552 311 ;; disadvantages -- hard to align counter
rlm@552 312
rlm@552 313 ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552 314 ;; state-machine code-section which can be recombined into another
rlm@552 315 ;; program.