Mercurial > vba-clojure

comparison 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
comparison
equal deleted inserted replaced
552:9068685e7d96 553:0901694725f0
6 rlm-assembly)) 6 rlm-assembly))
7 (:use (com.aurellem.run util music title save-corruption 7 (:use (com.aurellem.run util music title save-corruption
8 bootstrap-0 bootstrap-1 image 8 bootstrap-0 bootstrap-1 image
9 ram-display final-cut basic-choreo)) 9 ram-display final-cut basic-choreo))
10 (:require clojure.string) 10 (:require clojure.string)
11 (:import java.awt.image.BufferedImage)
12 (:import (javax.imageio ImageWriteParam IIOImage ImageIO))
11 (:import [com.aurellem.gb.gb_driver SaveState]) 13 (:import [com.aurellem.gb.gb_driver SaveState])
12 (:import java.io.File)) 14 (:import java.io.File))
13 15
14 16
15 17
32 34
33 ;; use fonts from zophar's domain: 35 ;; use fonts from zophar's domain:
34 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html 36 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html
35 37
36 ;; Green font on black background for matrix look. 38 ;; Green font on black background for matrix look.
37
38
39
40 ;; [ ] get single long ram write.
41
42
43 39
44 40
45 (defn program-data [base-address] 41 (defn program-data [base-address]
46 (let [image-program 42 (let [image-program
47 (display-image-kernel 43 (display-image-kernel
75 image-program ;; image program falls through to music program 71 image-program ;; image program falls through to music program
76 music-program))) 72 music-program)))
77 73
78 74
79 75
76
77 (def glyphs
78 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
79 (mapv #(ImageIO/read
80 (File. user-home (str "proj/vba-clojure/font/" % ".png")))
81 ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
82
83 (defn glyphs-init-program
84 [start-address]
85 (let [zero-glyph (image->gb-image (glyphs 0))
86
87 ;; write same pallet information to all pallettes
88 A (flatten
89 [(write-byte LCD-control-register 0x00)
90 (set-palettes bg-palette-select bg-palette-data
91 (repeat 8 (first (:palettes zero-glyph))))
92 (select-LCD-bank 0)
93 (write-byte SCX-register 0)
94 (write-byte SCY-register 0)])
95 B (flatten
96 [(write-data
97 (+ start-address (count A))
98 character-data-address
99 (flatten
100 (map (comp gb-tile->bytes first :tiles image->gb-image)
101 glyphs)))])]
102 (concat A B)))
103
104
105 (defn glyph-display-program
106 [start-address
107 delay-count
108 total-glyph-count]
109 (glyphs-init-program start-address) ;; ONLY for testing!
110 )
111
112
113 (defn glyph-bootstrap-program
114 [start-address delay-count total-glyph-count]
115 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
116 header (concat (frame-metronome) (read-user-input))
117
118 glyph-display (glyph-display-program
119 (+ (count init) (count header)
120 start-address)
121 0 0) ;; ONLY FOR TESTING
122
123 state-machine-start-address
124 (+ start-address (count init) (count header) (count glyph-display))
125 state-machine
126 (bootstrap-state-machine state-machine-start-address)
127
128 return-to-header
129 (flatten
130 [0x18
131 (->signed-8-bit
132 (- (count init)
133 2 ;; this command length
134 3 ;; I have no idea why we need a 3 here
135 ;; need to investigate.
136 (count glyph-display)
137 (count header)
138 (count state-machine)))])]
139
140 (concat init glyph-display header state-machine return-to-header)))
141
142
143
144
80 (def main-program-base-address 0xC000) 145 (def main-program-base-address 0xC000)
81 146
147
148
149 ;; RLM want to transfer control here --- this is where I left off.
150 (defn begin-glyph-bootstrap
151 ([] (begin-glyph-bootstrap (relocate-main-bootstrap)))
152 ([script]
153 (let [glyph-program (glyph-bootstrap-program
154 0xDF00 0 0)
155
156
157
158
159
82 (defn write-all-program-data 160 (defn write-all-program-data
83 ([] (write-all-program-data (silence-noise))) 161 ([] (write-all-program-data (relocate-main-bootstrap)))
84 ([script] 162 ([script]
85 (let [base-address main-program-base-address] 163 (let [base-address main-program-base-address]
86 (->> script 164 (->> script
165 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
87 (write-RAM base-address (program-data base-address)))))) 166 (write-RAM base-address (program-data base-address))))))
88 167
89 (defn activate-program 168 (defn activate-program
90 ([] (activate-program (write-all-program-data))) 169 ([] (activate-program (write-all-program-data)))
91 ([script] 170 ([script]