view clojure/com/aurellem/run/music.clj @ 476:2d419f7f999c

shortened song.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 06:34:00 -0500
parents f28a3baa4c56
children ee000791ab4e
line wrap: on
line source
1 (ns com.aurellem.run.music
2 (:use (com.aurellem.gb saves gb-driver util constants
3 items vbm characters money
4 rlm-assembly))
5 (:use (com.aurellem.run util title save-corruption
6 bootstrap-0 bootstrap-1))
7 (:require clojure.string)
8 (:import [com.aurellem.gb.gb_driver SaveState])
9 (:import java.io.File))
11 (def third-kind
12 (File. "/home/r/proj/midi/third-kind.mid"))
14 (def pony
15 (File. "/home/r/proj/vba-clojure/music/pony-title.mid"))
17 (def sync-test
18 (File. "/home/r/proj/vba-clojure/music/sync-test.mid"))
20 (def drum-test
21 (File. "/home/r/proj/vba-clojure/music/drum-test.mid"))
24 (defn raw-midi-text [#^File midi-file]
25 (:out
26 (clojure.java.shell/sh
27 "midicsv"
28 (.getCanonicalPath midi-file)
29 "-")))
31 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
33 (defmulti parse-command :command)
35 (defn discard-args [command] (dissoc command :args))
37 (defmethod parse-command :Start_track
38 [command] (discard-args command))
40 (defmethod parse-command :End_track
41 [command] (discard-args command))
43 (defmethod parse-command :default
44 [command] command)
46 (defn parse-number-list
47 [number-list-str]
48 (map #(Integer/parseInt %)
49 (clojure.string/split number-list-str #", ")))
51 (defmethod parse-command :Tempo
52 [command]
53 (update-in command [:args] #(Integer/parseInt %)))
55 (defn parse-midi-note-list
56 [midi-note-list-str]
57 (let [[channel note velocity]
58 (parse-number-list midi-note-list-str)]
59 {:channel channel :note note :velocity velocity}))
61 (defmethod parse-command :Note_on_c
62 [command]
63 (update-in command [:args] parse-midi-note-list))
65 (defmethod parse-command :Note_off_c
66 [command]
67 (update-in command [:args] parse-midi-note-list))
69 (defmethod parse-command :Header
70 [command]
71 (let [args (:args command)
72 [format num-tracks division] (parse-number-list args)]
73 (assoc command :args
74 {:format format
75 :num-tracks num-tracks
76 :division division})))
78 (defmethod parse-command :Program_c
79 [command]
80 (let [args (:args command)
81 [channel program-num] (parse-number-list args)]
82 (assoc command :args
83 {:channel channel
84 :program-num program-num})))
86 (defn parse-midi [#^File midi-file]
87 (map
88 (comp parse-command
89 (fn [line]
90 (let [[[_ channel time command args]]
91 (re-seq command-line line)]
92 {:channel (Integer/parseInt channel)
93 :time (Integer/parseInt time)
94 :command (keyword command)
95 :args (apply str (drop 2 args))})))
96 (drop-last
97 (clojure.string/split-lines
98 (raw-midi-text midi-file)))))
100 (def music-base new-kernel)
102 (defn store [n address]
103 (flatten
104 [0xF5
105 0xE5
107 0x3E
108 n
110 0x21
111 (reverse (disect-bytes-2 address))
113 0x77
115 0xE1
116 0xF1]))
118 (defn infinite-loop []
119 [0x18 0xFE])
121 (def divider-register 0xFF04)
123 (defrecord Bit-Note [frequency volume duration duty])
125 (defn clear-music-registers []
126 (flatten
127 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
128 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
129 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
130 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
131 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
133 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
134 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
135 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
136 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
138 (store (Integer/parseInt "00000000" 2) 0xFF1A)
139 (store (Integer/parseInt "00000000" 2) 0xFF1B)
140 (store (Integer/parseInt "00000000" 2) 0xFF1C)
141 (store (Integer/parseInt "00000000" 2) 0xFF1D)
142 (store (Integer/parseInt "00000000" 2) 0xFF1E)
144 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
145 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
146 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
147 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
148 ]))
151 ;; mini-midi syntax
153 ;; codes
154 ;; note-code == 0x00
155 ;; change-duty-code = 0x01
156 ;; silence-code = 0x02
158 ;; silence format
159 ;; 2 bytes
160 ;; [silence-code (0x02)]
161 ;; [duration-8-bits]
163 ;; note data format
164 ;; 4 bytes
165 ;; [note-code (0x00)]
166 ;; [volume-4-bits 0 frequency-high-3-bits]
167 ;; [frequengy-low-8-bits]
168 ;; [duration-8-bits]
170 ;; change-duty-format
171 ;; 2 bytes
172 ;; [change-duty-code (0x01)]
173 ;; [new-duty]
175 (def note-code 0x00)
176 (def change-duty-code 0x01)
177 (def silence-code 0x02)
179 (defn do-message
180 "Read the message which starts at the current value of HL and do
181 what it says. Duration is left in A, and HL is advanced
182 appropraitely."
183 ([] (do-message 0x16 1))
184 ([sound-base-address wave-duty]
185 (assert (<= 0 wave-duty 3))
186 (let [switch
187 [0x2A ;; load message code into A, increment HL
189 ;; switch on message
190 0xFE
191 note-code
193 0x20
194 :note-length]
196 play-note
197 [0x3E ;; set wave-duty
198 (bit-shift-left wave-duty 6)
199 0xE0
200 sound-base-address
201 0x2A ;; load volume/frequency-high info
202 0xF5 ;; push A
203 0xE6
204 (Integer/parseInt "11110000" 2) ;; volume mask
205 0xE0
206 (inc sound-base-address) ;;0x17 ;; set volume
207 0xF1 ;; pop A
208 0xE6
209 (Integer/parseInt "00000111" 2) ;; frequency-high mask
210 0xE0
211 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
213 0x2A ;; load frequency low-bits
214 0xE0
215 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
216 0x2A]] ;; load duration
217 (replace
218 {:note-length (count play-note)}
219 (concat switch play-note)))))
221 (defn play-noise
222 "read [noise-code, volume, duration] and play the noise. Duration is left in
223 A, and HL is advanced appropraitely."
224 ([]
225 [0x2A ;; load noise-code into A
226 0xE0
227 0x22 ;; write noise-code
229 0x2A ;; load volume
230 0xE0
231 0x21 ;; write volume
233 0x2A] ;; load duration into A
234 ))
237 ;; (defn play-note
238 ;; "Play the note referenced by HL in the appropiate channel.
239 ;; Leaves desired-duration in A."
241 ;; [0x2A ;; load volume/frequency-high info
242 ;; 0xF5 ;; push A
243 ;; 0xE6
244 ;; (Integer/parseInt "11110000" 2) ;; volume mask
245 ;; 0xE0
246 ;; 0x17 ;; set volume
247 ;; 0xF1 ;; pop A
248 ;; 0xE6
249 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
250 ;; 0xE0
251 ;; 0x19 ;; set frequency-high
253 ;; 0x2A ;; load frequency low-bits
254 ;; 0xE0
255 ;; 0x18 ;; set frequency-low-bits
257 ;; 0x2A ;; load duration
258 ;; ])
260 (defn music-step [sound-base-address wave-duty noise?]
261 ;; C == current-ticks
262 ;; A == desired-ticks
264 (flatten
265 [;; restore variables from stack
266 0xE1 ;; pop HL
267 0xC1 ;; pop CB
268 0xF1 ;; pop AF
271 0xF5 ;; push A
272 0xF0
273 0x05 ;; load current ticks from 0xF005
274 0xB8 ;;
275 0x30 ;; increment C only if last result caused carry
276 0x01
277 0x0C
279 0x47 ;; update sub-ticks (A->B)
281 0xF1 ;; pop AF, now A contains desired-ticks
283 0xB9 ;; compare with current ticks
285 ;; if desired-ticks = current ticks
286 ;; go to next note ; set current set ticks to 0.
288 (if noise?
289 [0x20
290 (+ 2 (count (play-noise)))
291 (play-noise)]
293 [0x20
294 (+ (count (do-message 0 0)) 2)
295 (do-message sound-base-address wave-duty)])
297 0x0E
298 0x00 ;; 0->C (current-ticks)
300 ;; save variables to stack
301 0xF5 ;; push AF
302 0xC5 ;; push CB
303 0xE5 ;; push HL
306 ]))
308 (def music-1 0x11)
309 (def music-2 0x16)
311 (defn music-kernel [wave-duty-1 wave-duty-2]
312 (flatten
313 [;; global initilization section
314 (clear-music-registers)
316 0x3E
317 0x01
318 0xE0
319 0x06 ;; set TMA to 0
321 0x3E
322 (Integer/parseInt "00000110" 2)
323 0xE0
324 0x07 ;; set TAC to 65536 Hz and activate timer
326 ;; initialize frame 1
327 0x21
328 0x00
329 0xA0 ;; set HL to 0xA000 == music-start 1
330 0x0E
331 0x00 ;; 0->C
332 0x06
333 0x00 ;; 0->B
335 0xAF ;; 0->A
337 0xF5 ;; push AF
338 0xC5 ;; push CB
339 0xE5 ;; push HL
341 ;; initialize frame 2
342 0x21
343 0x00
344 0xB0 ;; set HL to 0xB000 == music-start 2
346 0xF5 ;; push AF
347 0xC5 ;; push CB
348 0xE5 ;; push HL
351 ;; initialize frame 3 (noise)
352 0x21
353 0x00
354 0xA9 ;; 0xA9OO -> HL
356 0xF5 ;; push AF
357 0xC5 ;; push CB
358 0xE5 ;; push HL
360 ;; main music loop
362 0xE8 ;; SP + 12; activate frame 1
363 12
364 (music-step music-1 wave-duty-1 false)
366 0xE8 ;; SP - 6; activate frame 2
367 (->signed-8-bit -6)
368 (music-step music-2 wave-duty-2 false)
370 0xE8 ;; SP - 6; activate frame 3
371 (->signed-8-bit -6)
372 (music-step nil nil true)
374 0x18
375 (->signed-8-bit (+
376 ;; two music-steps
377 (- (* 2 (count (music-step 0 0 false))))
378 (- (count (music-step nil nil true)))
379 -2 ;; this jump instruction
380 -2 ;; activate frame 1
381 -2 ;; activate frame 2
382 -2 ;; activate frame 3
383 ))]))
385 (defn frequency-code->frequency
386 [code]
387 (assert (<= 0 code 2047))
388 (/ 131072 (- 2048 code)))
390 (defn clamp [x low high]
391 (cond (> x high) high
392 (< x low) low
393 true x))
395 (defn frequency->frequency-code
396 [frequency]
397 (clamp
398 (Math/round
399 (float
400 (/ (- (* 2048 frequency) 131072) frequency)))
401 0x00 2048))
403 (defn note-codes [frequency volume duration]
404 (assert (<= 0 volume 0xF))
405 (if (<= duration 0xFF)
406 (let [frequency-code
407 (frequency->frequency-code frequency)
408 volume&high-frequency
409 (+ (bit-shift-left volume 4)
410 (bit-shift-right frequency-code 8))
411 low-frequency
412 (bit-and 0xFF frequency-code)]
413 [note-code
414 volume&high-frequency
415 low-frequency
416 duration])
417 (vec
418 (flatten
419 [(note-codes frequency volume 0xFF)
420 (note-codes frequency volume (- duration 0xFF))]))))
423 (defn midi-code->frequency
424 [midi-code]
425 (* 8.1757989156
426 (Math/pow 2 (* (float (/ 12)) midi-code))))
428 ;; division == clock-pulses / quarter-note
429 ;; tempo == microseconds / quarter-note
431 ;; have: clock-pulses
432 ;; want: seconds
435 (defn silence [length]
436 {:frequency 1
437 :duration length
438 :volume 0})
440 (defn commands
441 "return all events where #(= (:command %) command)"
442 [command s]
443 (filter #(= command (:command %)) s))
445 (defn track-info [#^File midi-file]
446 (let [events (parse-midi midi-file)
447 track-titles (commands :Title_t events)
448 track-info
449 (map #(read-string (read-string (:args %))) track-titles)
450 track-map
451 (zipmap track-info track-titles)]
452 track-map))
454 (defn target-tracks
455 "return the track-numbers in the form [voice-0 voice-1 noise]"
456 [#^File midi-file]
457 (let [track-data (track-info midi-file)
458 track-order
459 (zipmap (map :out (keys track-data))
460 (vals track-data))
461 channel-nums (map (comp :channel track-order) (range 3))]
462 channel-nums))
464 (defn midi-track->abstract-mini-midi
465 [#^File midi-file track-num]
466 (let [midi-events (parse-midi midi-file)
468 note-on-events (commands :Note_on_c midi-events)
469 note-off-events (commands :Note_off_c midi-events)
471 select-channel
472 (fn [n s]
473 (sort-by :time (filter #(= n (:channel %)) s)))
475 channel-on (select-channel track-num note-on-events)
477 channel-off (select-channel track-num note-off-events)
480 tempo (:args (first (commands :Tempo midi-events)))
481 division
482 (:division (:args (first (commands :Header midi-events))))
484 notes
485 (map
486 (fn [note-on note-off]
487 {:frequency (midi-code->frequency (:note (:args note-on)))
488 :midi-code (:note (:args note-on))
489 :duration
490 (/ (* (/ tempo division)
491 (- (:time note-off) (:time note-on)))
492 1e6) ;; convert clock-pulses into seconds
493 :volume (int (/ (:velocity (:args note-on)) 10))
494 :time-stamp (/ (* (/ tempo division)
495 (:time note-on)) 1e6)})
496 channel-on channel-off)
498 silences
499 (map (fn [note-1 note-2]
500 (let [note-1-space (- (:time-stamp note-2)
501 (:time-stamp note-1))
502 note-1-length (:duration note-1)]
503 (silence (- note-1-space note-1-length))))
504 ;; to handle silence at the beginning.
505 (concat [(assoc (silence 0)
506 :time-stamp 0)] notes)
507 notes)
509 notes-with-silence
510 (concat
511 (filter (comp not zero? :duration)
512 (interleave silences notes))
513 [(silence 3)])]
514 notes-with-silence))
516 (defn midi-track->mini-midi-voice [#^File midi-file track-num]
517 (let [abstract-mini-midi
518 (midi-track->abstract-mini-midi midi-file track-num)]
519 (map
520 (fn [note-event]
521 (note-codes (:frequency note-event)
522 (:volume note-event)
523 (int (* (:duration note-event) 0x100))))
524 abstract-mini-midi)))
526 (def midi-code->gb-noise-code
527 {nil 0xFF
528 35 87
529 38 20
530 39 0
531 })
533 (defn noise-codes [code volume duration]
534 (assert (<= 0 volume 0xF))
535 (if (<= duration 0xFF)
536 [(midi-code->gb-noise-code code code)
537 (bit-shift-left volume 4)
538 duration]
539 (vec
540 (flatten
541 [(noise-codes code volume 0xFF)
542 (noise-codes code volume (- duration 0xFF))]))))
544 (defn midi-track->mini-midi-noise [#^File midi-file track-num]
545 (let [abstract-mini-midi
546 (midi-track->abstract-mini-midi midi-file track-num)]
547 (map
548 (fn [noise-event]
549 (noise-codes (:midi-code noise-event)
550 (:volume noise-event)
551 (int (* (:duration noise-event) 0x100))))
552 abstract-mini-midi)))
555 (defn midi->mini-midi [#^File midi-file]
556 (let [targets (target-tracks midi-file)
557 duty-info (keys (track-info midi-file))]
559 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
560 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
561 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))
562 :duty (zipmap (map :out duty-info)
563 (map #(get % :duty 0) duty-info))}))
565 (defn play-midi [#^File midi-file]
566 (let [voice-1-target 0xA000
567 voice-2-target 0xB000
568 noise-target 0xA900
569 program-target 0xC000
570 mini-midi (midi->mini-midi midi-file)
571 long-silence (flatten (note-codes 20 0 20001))
572 long-noise-silence
573 (interleave (range 500) (repeat 0x00) (repeat 255))
575 voice-1 (flatten (:voice-1 mini-midi))
576 wave-duty-1 ((:duty mini-midi) 0 0)
578 voice-2 (flatten (:voice-2 mini-midi))
579 wave-duty-2 ((:duty mini-midi) 1 0)
581 noise (flatten (:noise mini-midi))
582 ]
584 (-> (second (music-base))
585 (set-memory-range voice-1-target long-silence)
586 (set-memory-range voice-2-target long-silence)
587 (set-memory-range noise-target long-noise-silence)
588 (set-memory-range voice-1-target voice-1)
589 (set-memory-range voice-2-target voice-2)
590 (set-memory-range noise-target noise)
591 (set-memory-range
592 program-target
593 (music-kernel wave-duty-1 wave-duty-2))
594 (PC! program-target))))
596 (defn test-noise []
597 (let [noise-pattern
598 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
599 (interleave (range 10) (repeat 0x00) (repeat 255)))]
601 (-> (second (music-base))
602 (set-memory-range 0xA900 (flatten noise-pattern))
603 (set-memory-range 0xC000 (music-kernel 0 0))
604 (PC! 0xC000))))
606 (defn test-play-noise [noise-code]
607 (Thread/sleep 300)
608 (println "playing noise:" noise-code)
609 (run-moves
610 (let [noise-pattern
611 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
612 (-> (second (music-base))
613 (set-memory-range 0xA900 (flatten noise-pattern))
614 (set-memory-range 0xC000 (music-kernel 0 0))
615 (PC! 0xC000)))
616 (repeat 20 [])))
618 (defn test-all-noises []
619 (dorun (map test-play-noise (range 0x100))))
621 (def C4 (partial note-codes 261.63))
622 (def D4 (partial note-codes 293.66))
623 (def E4 (partial note-codes 329.63))
624 (def F4 (partial note-codes 349.23))
625 (def G4 (partial note-codes 392))
626 (def A4 (partial note-codes 440))
627 (def B4 (partial note-codes 493.88))
628 (def C5 (partial note-codes 523.3))
630 (def scale
631 (flatten
632 [(C4 0xF 0x40)
633 (D4 0xF 0x40)
634 (E4 0xF 0x40)
635 (F4 0xF 0x40)
636 (G4 0xF 0x40)
637 (A4 0xF 0x40)
638 (B4 0xF 0x40)
639 (C5 0xF 0x40)]))
641 (defn play-music [music-bytes]
642 (let [program-target 0xC000
643 music-target 0xA000]
644 (-> (set-memory-range (second (music-base))
645 program-target (music-kernel))
646 (set-memory-range music-target music-bytes)
647 (PC! program-target))))
649 (defn run-program
650 ([program]
651 (let [target 0xC000]
652 (-> (set-memory-range (second (music-base))
653 target program)
654 (PC! target)))))
656 (defn test-timer []
657 (flatten
658 [0x3E
659 0x01
660 0xE0
661 0x06 ;; set TMA to 0
663 0x3E
664 (Integer/parseInt "00000100" 2)
665 0xE0
666 0x07 ;; set TAC to 16384 Hz and activate timer
668 (repeat
669 500
670 [0xF0
671 0x05])]))