Mercurial > vba-clojure

comparison clojure/com/aurellem/run/adv_choreo.clj @ 577:df3a7eac39d7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 04:42:41 -0500
parents 376f282bcbf1
children 385799ea1e9c
comparison
equal deleted inserted replaced
576:376f282bcbf1 577:df3a7eac39d7
126 (concat A B ))) 126 (concat A B )))
127 127
128 128
129 129
130 (defn glyph-display-program 130 (defn glyph-display-program
131 [start-address 131 [start-address]
132 max-glyphs]
133 (let [data-start (+ 2 start-address) 132 (let [data-start (+ 2 start-address)
134 [max-glyphs-high max-glyphs-low]
135 (disect-bytes-2 max-glyphs)
136 load-data 133 load-data
137 (flatten 134 (flatten
138 [;; data region 135 [;; data region
139 0x18 136 0x18
140 2 137 2
142 ;; save all registers 139 ;; save all registers
143 0xC5 0xD5 0xE5 0xF5 140 0xC5 0xD5 0xE5 0xF5
144 141
145 ;; load data from data region into registers 142 ;; load data from data region into registers
146 143
147 0xF5 ;; push A 144 0xF5 ;; push A, which contains current glyph
148 0x21 ;; begin data load 145
146 0x21
149 (reverse (disect-bytes-2 data-start)) 147 (reverse (disect-bytes-2 data-start))
150 148 ;; load row and column into DE
151 0x2A 0x47 ;; glyphs-rendered -> BC 149 0x2A 0x57 ;; row -> D
152 0x2A 0x4F 150 0x2A 0x5F ;; column -> E
153 151
154 0x16 max-glyphs-high ;; load max-glyphs 152
155 0x1E max-glyphs-low ;; into DE
156 ]) 153 ])
157 154
158 155
159 display-glyph 156 display-glyph
160 (let [init* 157 (let [init*
161 (flatten 158 (flatten
162 [;; BC is current number of glyphs rendered. 159 [(repeat 100 0)
163 ;; each glyph is two characters, and the screen can hold up
164 ;; to 360 characters. Thus, if the current glyphs is a
165 ;; multiple of 180, the screen must be refreshed.
166
167 ;; DE contains max-glyphs and HL will be overwritten next
168 ;; section, so both are free to use here.
169 (repeat 100 0)
170 ;; Reset HL to initial value 160 ;; Reset HL to initial value
171 0x21
172 (reverse (disect-bytes-2 data-start))
173 ;; load row and column into DE
174 0x2A 0x57 ;; row -> D
175 0x2A 0x5F ;; column -> E
176 161
177 ;; clear screen if we are at 0,0 162 ;; clear screen if we are at 0,0
178 0x57 0xB3 ;; D->A, OR E A ==> (= D E 0) 163 0x57 0xB3 ;; D->A, OR E A ==> (= D E 0)
179 0x20 ;; skip clear-screen if D and E are not both zero 164 0x20 ;; skip clear-screen if D and E are not both zero
180 :clear-screen-length]) 165 :clear-screen-length])
208 ;; end of do-while-loop 193 ;; end of do-while-loop
209 194
210 ;; restore all registers 195 ;; restore all registers
211 0xF1 0xE1 0xD1 0xC1]) 196 0xF1 0xE1 0xD1 0xC1])
212 197
198 ;; RLM: for TESTING ONLY!!!
199 clear-screen (repeat 10 0)
213 increment-row-column 200 increment-row-column
214 [;; D contains row and E contains column 201 [;; D contains row and E contains column
215 202
216 ;; every time column (E) reaches 20, set 203 ;; every time column (E) reaches 20, set
217 ;; column to 0 and increment row 204 ;; column to 0 and increment row
228 2 215 2
229 0x16 0] ;; set D to zero 216 0x16 0] ;; set D to zero
230 217
231 set-HL-from-row-and-column 218 set-HL-from-row-and-column
232 [;; formula for memory offset is: 219 [;; formula for memory offset is:
233 ;; (+ 0x9800 (* 32 row) column) 220 ;; (+ 0x9800 (* 32 row) column) ==
221 ;; (+ 0x97E0 (* 32 (+ 1 row)) column)
234 0xD5 0xC5 ;; push D E B C 222 0xD5 0xC5 ;; push D E B C
235 223
236 0x21 0x00 0x98 ;; load HL with 0x9800 224 0x21 0xE0 0x97 ;; load HL with 0x97E0
237 225
238 0x01 32 00 ;; load 32 into BC 226 0x06 0
227 0x0E 32 ;; load 32 into BC
228
229 0x14 ;; inc D to handle case where D == 0
230 ;; D will never be > 20, so this will never overflow.
239 231
240 ;; do 232 ;; do
241 0x09 ;; HL += 32 233 0x09 ;; HL += 32
242 0x15 ;; dec D 234 0x15 ;; dec D
243 ;; while D != 0 235 ;; while D != 0
244 0x20 236 0x20
245 (->signed-8-bit -4) 237 (->signed-8-bit -4)
246 238
247 0x4B ;; E->C
248 0x15 ;; add columns (E) to HL
249
250 0xC1 0xD1 ;; pop C B E D 239 0xC1 0xD1 ;; pop C B E D
251 ] 240 ]
252 241
253 render-glyph 242 render-glyph
254 (flatten 243 (flatten
255 [set-HL-from-row-and-column 244 [;; Render each nybble of A as a character
245 ;; there are two characters to a glyph.
246
247 set-HL-from-row-and-column
256 0xF1 ;; pop A, now A is equal to key input 248 0xF1 ;; pop A, now A is equal to key input
257 0xF5 ;; save A 249 0xF5 ;; save A
258 250
259 0xE6 0xF0 ;; clear second nybble 251 0xE6 0xF0 ;; clear second nybble
260 0xCB 0x37 ;; swap nybbles 252 0xCB 0x37 ;; swap nybbles
261 0x22 ;; store A in video as a character (pun) 253 0x22 ;; store A in video RAM as a character (pun)
262 254 increment-row-column
255
256 set-HL-from-row-and-column
263 0xF1 ;; restore A 257 0xF1 ;; restore A
264 0xE6 0x0F ;; select second nybble 258 0xE6 0x0F ;; select second nybble
265 0x22 ;; store second nybble as glyph 259 0x22 ;; store second nybble as character
266
267 increment-row-column 260 increment-row-column
268 increment-row-column 261 ])
269 ;; Render each nybble of A as a character
270 ;; there are two characters to a glyph.
271 ])
272 262
273 263
274 init (replace 264 init (replace
275 {:clear-screen-length (count clear-screen)} init*) 265 {:clear-screen-length (count clear-screen)} init*)
276 ] 266 ]
302 header (concat (frame-metronome) (read-user-input)) 292 header (concat (frame-metronome) (read-user-input))
303 293
304 glyph-display (glyph-display-program 294 glyph-display (glyph-display-program
305 (+ (count init) 295 (+ (count init)
306 (count header) 296 (count header)
307 start-address) 297 start-address))
308 2000)
309 ;;(- (count (program-data 0)) 100)) 298 ;;(- (count (program-data 0)) 100))
310 299
311 state-machine-start-address 300 state-machine-start-address
312 (+ start-address (count init) (count header) (count glyph-display)) 301 (+ start-address (count init) (count header) (count glyph-display))
313 state-machine 302 state-machine