Mercurial > vba-clojure

annotate clojure/com/aurellem/run/adv_choreo.clj @ 553:0901694725f0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress for the night.
author Robert McIntyre <rlm@mit.edu>
date Thu, 30 Aug 2012 14:11:11 -0500
parents 9068685e7d96
children 37daf1acb212
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@551 45 pinkie-pie-mark)
rlm@551 46
rlm@551 47 music-base-address (+ (count image-program) base-address)
rlm@551 48
rlm@551 49 initial-music-data
rlm@551 50 (midi-bytes pony-csv 0 0 0 0)
rlm@551 51
rlm@551 52 data-lengths
rlm@551 53 (map (comp count :data)
rlm@551 54 [(:kernel initial-music-data)
rlm@551 55 (:voice-1 initial-music-data)
rlm@551 56 (:voice-2 initial-music-data)]);; noise not needed
rlm@551 57 addresses
rlm@551 58 (map (partial + music-base-address) (reductions + 0 data-lengths))
rlm@551 59
rlm@551 60 final-music-data
rlm@551 61 (apply (partial midi-bytes pony-csv) addresses)
rlm@551 62
rlm@551 63 music-program
rlm@551 64 (concat
rlm@551 65 (:data (:kernel final-music-data))
rlm@551 66 (:data (:voice-1 final-music-data))
rlm@551 67 (:data (:voice-2 final-music-data))
rlm@551 68 (:data (:noise final-music-data)))]
rlm@551 69
rlm@551 70 (concat
rlm@551 71 image-program ;; image program falls through to music program
rlm@551 72 music-program)))
rlm@551 73
rlm@551 74
rlm@551 75
rlm@553 76
rlm@553 77 (def glyphs
rlm@553 78 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
rlm@553 79 (mapv #(ImageIO/read
rlm@553 80 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
rlm@553 81 ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
rlm@553 82
rlm@553 83 (defn glyphs-init-program
rlm@553 84 [start-address]
rlm@553 85 (let [zero-glyph (image->gb-image (glyphs 0))
rlm@553 86
rlm@553 87 ;; write same pallet information to all pallettes
rlm@553 88 A (flatten
rlm@553 89 [(write-byte LCD-control-register 0x00)
rlm@553 90 (set-palettes bg-palette-select bg-palette-data
rlm@553 91 (repeat 8 (first (:palettes zero-glyph))))
rlm@553 92 (select-LCD-bank 0)
rlm@553 93 (write-byte SCX-register 0)
rlm@553 94 (write-byte SCY-register 0)])
rlm@553 95 B (flatten
rlm@553 96 [(write-data
rlm@553 97 (+ start-address (count A))
rlm@553 98 character-data-address
rlm@553 99 (flatten
rlm@553 100 (map (comp gb-tile->bytes first :tiles image->gb-image)
rlm@553 101 glyphs)))])]
rlm@553 102 (concat A B)))
rlm@553 103
rlm@553 104
rlm@553 105 (defn glyph-display-program
rlm@553 106 [start-address
rlm@553 107 delay-count
rlm@553 108 total-glyph-count]
rlm@553 109 (glyphs-init-program start-address) ;; ONLY for testing!
rlm@553 110 )
rlm@553 111
rlm@553 112
rlm@553 113 (defn glyph-bootstrap-program
rlm@553 114 [start-address delay-count total-glyph-count]
rlm@553 115 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@553 116 header (concat (frame-metronome) (read-user-input))
rlm@553 117
rlm@553 118 glyph-display (glyph-display-program
rlm@553 119 (+ (count init) (count header)
rlm@553 120 start-address)
rlm@553 121 0 0) ;; ONLY FOR TESTING
rlm@553 122
rlm@553 123 state-machine-start-address
rlm@553 124 (+ start-address (count init) (count header) (count glyph-display))
rlm@553 125 state-machine
rlm@553 126 (bootstrap-state-machine state-machine-start-address)
rlm@553 127
rlm@553 128 return-to-header
rlm@553 129 (flatten
rlm@553 130 [0x18
rlm@553 131 (->signed-8-bit
rlm@553 132 (- (count init)
rlm@553 133 2 ;; this command length
rlm@553 134 3 ;; I have no idea why we need a 3 here
rlm@553 135 ;; need to investigate.
rlm@553 136 (count glyph-display)
rlm@553 137 (count header)
rlm@553 138 (count state-machine)))])]
rlm@553 139
rlm@553 140 (concat init glyph-display header state-machine return-to-header)))
rlm@553 141
rlm@553 142
rlm@553 143
rlm@553 144
rlm@551 145 (def main-program-base-address 0xC000)
rlm@551 146
rlm@553 147
rlm@553 148
rlm@553 149 ;; RLM want to transfer control here --- this is where I left off.
rlm@553 150 (defn begin-glyph-bootstrap
rlm@553 151 ([] (begin-glyph-bootstrap (relocate-main-bootstrap)))
rlm@553 152 ([script]
rlm@553 153 (let [glyph-program (glyph-bootstrap-program
rlm@553 154 0xDF00 0 0)
rlm@553 155
rlm@553 156
rlm@553 157
rlm@553 158
rlm@553 159
rlm@551 160 (defn write-all-program-data
rlm@553 161 ([] (write-all-program-data (relocate-main-bootstrap)))
rlm@551 162 ([script]
rlm@551 163 (let [base-address main-program-base-address]
rlm@551 164 (->> script
rlm@553 165 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@551 166 (write-RAM base-address (program-data base-address))))))
rlm@551 167
rlm@551 168 (defn activate-program
rlm@551 169 ([] (activate-program (write-all-program-data)))
rlm@551 170 ([script]
rlm@551 171 (->> script
rlm@551 172 (transfer-control main-program-base-address)
rlm@551 173 (do-nothing 1800))))
rlm@552 174
rlm@552 175
rlm@552 176 ;; possible screen writing programs
rlm@552 177
rlm@552 178 ;; (program needs to stop executing at some point)
rlm@552 179 ;; maybe have total length counter or something?
rlm@552 180
rlm@552 181 ;; automatic counter that reads from program-start and clears the
rlm@552 182 ;; screen every 360 (* 18 20) gliphs
rlm@552 183
rlm@552 184 ;; advantages -- very simple and low bandwidth
rlm@552 185 ;; disadvantages -- hard to align counter
rlm@552 186
rlm@552 187 ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552 188 ;; state-machine code-section which can be recombined into another
rlm@552 189 ;; program.