Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 466:b31cd6651375

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on noise.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 04:13:13 -0500
parents 34bf4b64d9d1
children ac0ed5c1a1c4
comparison
equal deleted inserted replaced
465:34bf4b64d9d1 466:b31cd6651375
213 0x2A]] ;; load duration 213 0x2A]] ;; load duration
214 (replace 214 (replace
215 {:note-length (count play-note)} 215 {:note-length (count play-note)}
216 (concat switch play-note))))) 216 (concat switch play-note)))))
217 217
218 (defn play-noise
219 "read [noise-code, duration] and play the noise. Duration is left in
220 A, and HL is advanced appropraitely."
221 ([]
222 [0x2A ;; load noise-code into A
223 0xE0
224 0x22 ;; write noise-code
225 0x2A] ;; load duration into A
226 ))
227
228
218 ;; (defn play-note 229 ;; (defn play-note
219 ;; "Play the note referenced by HL in the appropiate channel. 230 ;; "Play the note referenced by HL in the appropiate channel.
220 ;; Leaves desired-duration in A." 231 ;; Leaves desired-duration in A."
221 232
222 ;; [0x2A ;; load volume/frequency-high info 233 ;; [0x2A ;; load volume/frequency-high info
236 ;; 0x18 ;; set frequency-low-bits 247 ;; 0x18 ;; set frequency-low-bits
237 248
238 ;; 0x2A ;; load duration 249 ;; 0x2A ;; load duration
239 ;; ]) 250 ;; ])
240 251
241 (defn music-step [sound-base-address wave-duty] 252 (defn music-step [sound-base-address wave-duty noise?]
242 ;; C == current-ticks 253 ;; C == current-ticks
243 ;; A == desired-ticks 254 ;; A == desired-ticks
244 255
245 (flatten 256 (flatten
246 [;; restore variables from stack 257 [;; restore variables from stack
264 0xB9 ;; compare with current ticks 275 0xB9 ;; compare with current ticks
265 276
266 ;; if desired-ticks = current ticks 277 ;; if desired-ticks = current ticks
267 ;; go to next note ; set current set ticks to 0. 278 ;; go to next note ; set current set ticks to 0.
268 279
269 0x20 280 (if noise?
270 (+ (count (do-message 0 0)) 2) 281 [0x20
271 282 (+ 2 (count (play-noise)))
272 (do-message sound-base-address wave-duty) 283 (play-noise)]
284
285 [0x20
286 (+ (count (do-message 0 0)) 2)
287 (do-message sound-base-address wave-duty)])
273 288
274 0x0E 289 0x0E
275 0x00 ;; 0->C (current-ticks) 290 0x00 ;; 0->C (current-ticks)
276 291
277 ;; save variables to stack 292 ;; save variables to stack
323 0xF5 ;; push AF 338 0xF5 ;; push AF
324 0xC5 ;; push CB 339 0xC5 ;; push CB
325 0xE5 ;; push HL 340 0xE5 ;; push HL
326 341
327 342
343 ;; initialize frame 3 (noise)
344 0x21
345 0x00
346 0xA9 ;; 0xA9OO -> HL
347
348 0xF5 ;; push AF
349 0xC5 ;; push CB
350 0xE5 ;; push HL
351
328 ;; main music loop 352 ;; main music loop
329 353
330 0xE8 ;; SP + 6; activate frame 1 354 0xE8 ;; SP + 12; activate frame 1
331 6 355 12
332 (music-step music-1 wave-duty-1) 356 (music-step music-1 wave-duty-1 false)
333 ;;(repeat (count (music-step music-1)) 0x00)
334 357
335 0xE8 ;; SP - 6; activate frame 2 358 0xE8 ;; SP - 6; activate frame 2
336 (->signed-8-bit -6) 359 (->signed-8-bit -6)
337 ;;(repeat (count (music-step music-2)) 0x00) 360 (music-step music-2 wave-duty-2 false)
338 (music-step music-2 wave-duty-2) 361
339 362 0xE8 ;; SP - 6; activate frame 3
363 (->signed-8-bit -6)
364 (music-step nil nil true)
340 365
341 0x18 366 0x18
342 (->signed-8-bit (+ 367 (->signed-8-bit (+
343 ;; two music-steps 368 ;; two music-steps
344 (- (* 2 (count (music-step 0 0)))) 369 (- (* 2 (count (music-step 0 0 false))))
370 (- (count (music-step nil nil true)))
345 -2 ;; this jump instruction 371 -2 ;; this jump instruction
346 -2 ;; activate frame 1 372 -2 ;; activate frame 1
347 -2 ;; activate frame 2 373 -2 ;; activate frame 2
374 -2 ;; activate frame 3
348 ))])) 375 ))]))
349 376
350 (defn frequency-code->frequency 377 (defn frequency-code->frequency
351 [code] 378 [code]
352 (assert (<= 0 code 2047)) 379 (assert (<= 0 code 2047))
400 (defn silence [length] 427 (defn silence [length]
401 {:frequency 1 428 {:frequency 1
402 :duration length 429 :duration length
403 :volume 0}) 430 :volume 0})
404 431
432 (defn commands
433 "return all events where #(= (:command %) command)"
434 [command s]
435 (filter #(= command (:command %)) s))
436
405 (defn track-info [#^File midi-file] 437 (defn track-info [#^File midi-file]
406 (let [events (parse-midi midi-file) 438 (let [events (parse-midi midi-file)
407 track-titles (commands :Title_t events) 439 track-titles (commands :Title_t events)
408 track-info 440 track-info
409 (map #(read-string (read-string (:args %))) track-titles) 441 (map #(read-string (read-string (:args %))) track-titles)
418 track-order 450 track-order
419 (zipmap (map :out (keys track-data)) 451 (zipmap (map :out (keys track-data))
420 (vals track-data)) 452 (vals track-data))
421 channel-nums (map (comp :channel track-order) (range 3))] 453 channel-nums (map (comp :channel track-order) (range 3))]
422 channel-nums)) 454 channel-nums))
423
424 (defn commands
425 "return all events where #(= (:command %) command)"
426 [command s]
427 (filter #(= command (:command %)) s))
428 455
429 (defn midi-track->mini-midi [#^File midi-file track-num] 456 (defn midi-track->mini-midi [#^File midi-file track-num]
430 (let [midi-events (parse-midi midi-file) 457 (let [midi-events (parse-midi midi-file)
431 458
432 note-on-events (commands :Note_on_c midi-events) 459 note-on-events (commands :Note_on_c midi-events)
506 voice-1 (flatten (:voice-1 mini-midi)) 533 voice-1 (flatten (:voice-1 mini-midi))
507 wave-duty-1 ((:duty mini-midi) 0 0) 534 wave-duty-1 ((:duty mini-midi) 0 0)
508 535
509 voice-2 (flatten (:voice-2 mini-midi)) 536 voice-2 (flatten (:voice-2 mini-midi))
510 wave-duty-2 ((:duty mini-midi) 1 0) 537 wave-duty-2 ((:duty mini-midi) 1 0)
538
539 noise (flatten (:noise mini-midi))
511 ] 540 ]
512 541
513 (-> (second (music-base)) 542 (-> (second (music-base))
514 (set-memory-range track-1-target long-silence) 543 (set-memory-range track-1-target long-silence)
515 (set-memory-range track-2-target long-silence) 544 (set-memory-range track-2-target long-silence)