Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 437:20a9d5faf47c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
now I can play two voices at once!
author Robert McIntyre <rlm@mit.edu>
date Wed, 25 Apr 2012 13:09:06 -0500
parents 3171cbe077f3
children 067ea3f0d951
comparison
equal deleted inserted replaced
436:3171cbe077f3 437:20a9d5faf47c
224 ;; 0x18 ;; set frequency-low-bits 224 ;; 0x18 ;; set frequency-low-bits
225 225
226 ;; 0x2A ;; load duration 226 ;; 0x2A ;; load duration
227 ;; ]) 227 ;; ])
228 228
229 (def storage-start 0xC999)
230
231 (defn music-step [sound-base-address] 229 (defn music-step [sound-base-address]
232 ;; C == current-ticks 230 ;; C == current-ticks
233 ;; A == desired-ticks 231 ;; A == desired-ticks
234 232
235 (flatten 233 (flatten
291 0x07 ;; set TAC to 65536 Hz and activate timer 289 0x07 ;; set TAC to 65536 Hz and activate timer
292 290
293 ;; initialize frame 1 291 ;; initialize frame 1
294 0x21 292 0x21
295 0x00 293 0x00
296 0xD0 ;; set HL to 0xD000 == music-start 1 294 0xA0 ;; set HL to 0xA000 == music-start 1
297 0x0E 295 0x0E
298 0x00 ;; 0->C 296 0x00 ;; 0->C
299 0x06 297 0x06
300 0x00 ;; 0->B 298 0x00 ;; 0->B
301 299
306 0xE5 ;; push HL 304 0xE5 ;; push HL
307 305
308 ;; initialize frame 2 306 ;; initialize frame 2
309 0x21 307 0x21
310 0x00 308 0x00
311 0xC0 ;; set HL to 0xC000 == music-start 2 309 0xB0 ;; set HL to 0xB000 == music-start 2
312 310
313 0xF5 ;; push AF 311 0xF5 ;; push AF
314 0xC5 ;; push CB 312 0xC5 ;; push CB
315 0xE5 ;; push HL 313 0xE5 ;; push HL
316 314
317 315
318 316 ;; main music loop
319 ;; init-2 (0->A,B,C), 0xC000 -> HL 317
320 318 0xE8 ;; SP + 6; activate frame 1
321 ;; push to stack
322
323 0xE8 ;; SP + 8
324 6 319 6
325 ;; pop from stack
326 (music-step music-1) 320 (music-step music-1)
327 ;; save to stack 321 ;;(repeat (count (music-step music-1)) 0x00)
328 322
329 323 0xE8 ;; SP - 6; activate frame 2
330 ;; SP + 5 324 (->signed-8-bit -6)
331 ;; pop from stack 325 ;;(repeat (count (music-step music-2)) 0x00)
332 ;;(music-step music-2) 326 (music-step music-2)
333 ;; save to stack 327
334 328
335 0x18 329 0x18
336 (->signed-8-bit (+ (- (count (music-step 0))) 330 (->signed-8-bit (+
337 -2))])) 331 ;; two music-steps
332 (- (* 2 (count (music-step 0))))
333 -2 ;; this jump instruction
334 -2 ;; activate frame 1
335 -2 ;; activate frame 2
336 ))]))
338 337
339 (defn frequency-code->frequency 338 (defn frequency-code->frequency
340 [code] 339 [code]
341 (assert (<= 0 code 2047)) 340 (assert (<= 0 code 2047))
342 (/ 131072 (- 2048 code))) 341 (/ 131072 (- 2048 code)))
469 (B4 0xF 0x40) 468 (B4 0xF 0x40)
470 (C5 0xF 0x40)])) 469 (C5 0xF 0x40)]))
471 470
472 (defn play-music [music-bytes] 471 (defn play-music [music-bytes]
473 (let [program-target 0xC000 472 (let [program-target 0xC000
474 music-target 0xD000] 473 music-target 0xA000]
475 (-> (set-memory-range (second (music-base)) 474 (-> (set-memory-range (second (music-base))
476 program-target (music-kernel)) 475 program-target (music-kernel))
477 (set-memory-range music-target music-bytes) 476 (set-memory-range music-target music-bytes)
478 (PC! program-target)))) 477 (PC! program-target))))
479 478
480 479
481 (defn test-note [music-bytes] 480 ;; (defn test-note [music-bytes]
482 (-> (set-memory-range (second (music-base)) 481 ;; (-> (set-memory-range (second (music-base))
483 0xC000 (concat (clear-music-registers) 482 ;; 0xC000 (concat (clear-music-registers)
484 (play-note) 483 ;; (play-note)
485 (infinite-loop))) 484 ;; (infinite-loop)))
486 (set-memory-range 0xD000 music-bytes) 485 ;; (set-memory-range 0xD000 music-bytes)
487 (PC! 0xC000) 486 ;; (PC! 0xC000)
488 (HL! 0xD000) 487 ;; (HL! 0xD000)
489 )) 488 ;; ))
490 489
491 490
492 (defn run-program 491 (defn run-program
493 ([program] 492 ([program]
494 (let [target 0xC000] 493 (let [target 0xC000]