Mercurial > vba-clojure

comparison clojure/com/aurellem/run/adv_choreo.clj @ 554:37daf1acb212

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
progress.
author Robert McIntyre <rlm@mit.edu>
date Fri, 31 Aug 2012 00:51:17 -0500
parents 0901694725f0
children 2d9bf762a073
comparison
equal deleted inserted replaced
553:0901694725f0 554:37daf1acb212
40 40
41 (defn program-data [base-address] 41 (defn program-data [base-address]
42 (let [image-program 42 (let [image-program
43 (display-image-kernel 43 (display-image-kernel
44 base-address 44 base-address
45 pinkie-pie-mark) 45
46 ;;pinkie-pie-mark
47 test-image-color
48
49 )
50
46 51
47 music-base-address (+ (count image-program) base-address) 52 music-base-address (+ (count image-program) base-address)
48 53
49 initial-music-data 54 initial-music-data
50 (midi-bytes pony-csv 0 0 0 0) 55 (midi-bytes pony-csv 0 0 0 0)
67 (:data (:voice-2 final-music-data)) 72 (:data (:voice-2 final-music-data))
68 (:data (:noise final-music-data)))] 73 (:data (:noise final-music-data)))]
69 74
70 (concat 75 (concat
71 image-program ;; image program falls through to music program 76 image-program ;; image program falls through to music program
72 music-program))) 77
78 (infinite-loop)
79 ;;music-program
80
81 )))
73 82
74 83
75 84
76 85
77 (def glyphs 86 (def glyphs
78 "The sixteen 8x8 glyphs which make up the \"terminal\" font." 87 "The sixteen 8x8 glyphs which make up the \"terminal\" font."
79 (mapv #(ImageIO/read 88 (mapv #(ImageIO/read
80 (File. user-home (str "proj/vba-clojure/font/" % ".png"))) 89 (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"])) 90 ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
82 91
83 (defn glyphs-init-program 92 (defn glyph-init-program
84 [start-address] 93 [start-address]
85 (let [zero-glyph (image->gb-image (glyphs 0)) 94 (let [zero-glyph (image->gb-image (glyphs 0))
86 95
87 ;; write same pallet information to all pallettes 96 ;; write same pallet information to all pallettes
88 A (flatten 97 A (flatten
89 [(write-byte LCD-control-register 0x00) 98 [(write-byte LCD-control-register 0x00);; disable LCD protection
90 (set-palettes bg-palette-select bg-palette-data 99 (set-palettes bg-palette-select bg-palette-data
91 (repeat 8 (first (:palettes zero-glyph)))) 100 (repeat 8 (first (:palettes zero-glyph))))
92 (select-LCD-bank 0) 101 (select-LCD-bank 0)
93 (write-byte SCX-register 0) 102 (write-byte SCX-register 0)
94 (write-byte SCY-register 0)]) 103 (write-byte SCY-register 0)])
96 [(write-data 105 [(write-data
97 (+ start-address (count A)) 106 (+ start-address (count A))
98 character-data-address 107 character-data-address
99 (flatten 108 (flatten
100 (map (comp gb-tile->bytes first :tiles image->gb-image) 109 (map (comp gb-tile->bytes first :tiles image->gb-image)
101 glyphs)))])] 110 glyphs)))
102 (concat A B))) 111
103 112
113 (write-byte
114 LCD-control-register
115 (Integer/parseInt
116 (str
117 "1" ;; LCDC on/off
118 "0" ;; Window code area
119 "0" ;; Windowing on?
120 "1" ;; BG tile base (1 = 0x8000)
121 "0" ;; BG-1 or BG-2 ?
122 "0" ;; OBJ-block composition
123 "0" ;; OBJ-on flag
124 "1") ;; no-effect
125 2))])]
126 (concat A B )))
104 127
105 (defn glyph-display-program 128 (defn glyph-display-program
106 [start-address 129 [start-address
107 delay-count 130 delay-count
108 total-glyph-count] 131 total-glyph-count]
109 (glyphs-init-program start-address) ;; ONLY for testing! 132 [0xC5
110 ) 133 0xD5
134 0xE5
135 0xF5
136
137
138
139 0xF1
140 0xE1
141 0xD1
142 0xC1
143
144 ])
111 145
112 146
113 (defn glyph-bootstrap-program 147 (defn glyph-bootstrap-program
114 [start-address delay-count total-glyph-count] 148 [start-address delay-count total-glyph-count]
115 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B 149 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
116 header (concat (frame-metronome) (read-user-input)) 150 header (concat (frame-metronome) (read-user-input))
117 151
118 glyph-display (glyph-display-program 152 glyph-display (glyph-display-program
119 (+ (count init) (count header) 153 (+ (count init) (count header)
120 start-address) 154 start-address)
121 0 0) ;; ONLY FOR TESTING 155 0 0) ;; ONLY FOR TESTING
137 (count header) 171 (count header)
138 (count state-machine)))])] 172 (count state-machine)))])]
139 173
140 (concat init glyph-display header state-machine return-to-header))) 174 (concat init glyph-display header state-machine return-to-header)))
141 175
142
143
144
145 (def main-program-base-address 0xC000) 176 (def main-program-base-address 0xC000)
146 177
147
148
149 ;; RLM want to transfer control here --- this is where I left off.
150 (defn begin-glyph-bootstrap 178 (defn begin-glyph-bootstrap
151 ([] (begin-glyph-bootstrap (relocate-main-bootstrap))) 179 ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
152 ([script] 180 ([script]
153 (let [glyph-program (glyph-bootstrap-program 181 (let [glyph-init (glyph-init-program relocated-bootstrap-start)
154 0xDF00 0 0) 182 main-glyph-start (+ relocated-bootstrap-start
155 183 (count glyph-init))
156 184 glyph-program (glyph-bootstrap-program
185 main-glyph-start 0 0)]
186 (->> script
187 (do-nothing 2)
188 ;; begin glyph program
189 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
157 190
158 191 (write-RAM
159 192 relocated-bootstrap-start
193 (concat glyph-init glyph-program))
194 (transfer-control relocated-bootstrap-start)
195 (do-nothing 10)
196
197 ))))
198
160 (defn write-all-program-data 199 (defn write-all-program-data
161 ([] (write-all-program-data (relocate-main-bootstrap))) 200 ([] (write-all-program-data (begin-glyph-bootstrap)))
162 ([script] 201 ([script]
163 (let [base-address main-program-base-address] 202 (let [base-address main-program-base-address]
164 (->> script 203 (->> script
165 (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
166 (write-RAM base-address (program-data base-address)))))) 204 (write-RAM base-address (program-data base-address))))))
167 205
168 (defn activate-program 206 (defn activate-program
169 ([] (activate-program (write-all-program-data))) 207 ([] (activate-program (write-all-program-data)))
170 ([script] 208 ([script]
171 (->> script 209 (->> script
172 (transfer-control main-program-base-address) 210 (transfer-control main-program-base-address)
173 (do-nothing 1800)))) 211 ;;(do-nothing 1800)
212 (do-nothing 50)
213 )))
174 214
175 215
176 ;; possible screen writing programs 216 ;; possible screen writing programs
177 217
178 ;; (program needs to stop executing at some point) 218 ;; (program needs to stop executing at some point)