view clojure/com/aurellem/run/music.clj @ 484:f6b5a1914efa

merge.
author Robert McIntyre <rlm@mit.edu>
date Sun, 06 May 2012 20:52:31 -0500
parents 221b3fea9221
children 346b91ae503a
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 pony
12 (File. user-home "/proj/vba-clojure/music/pony-title.mid"))
14 (def pony-csv
15 (File. user-home "proj/vba-clojure/music/pony-title.csv"))
17 (def sync-test
18 (File. user-home "proj/vba-clojure/music/sync-test.mid"))
20 (def drum-test
21 (File. user-home "proj/vba-clojure/music/drum-test.mid"))
23 (def regret
24 (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.mid"))
26 (def regret-csv
27 (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.csv"))
29 (def mother
30 (File. user-home "proj/vba-clojure/music/mother.mid"))
32 (def mother-csv
33 (File. user-home "proj/vba-clojure/music/mother.csv"))
36 (defn raw-midi-text [#^File midi-file]
37 (let [extention (apply str (take-last 3 (.getCanonicalPath
38 midi-file)))]
39 (cond (= "mid" extention)
40 (:out
41 (clojure.java.shell/sh
42 "midicsv"
43 (.getCanonicalPath midi-file)
44 "-"))
45 (= "csv" extention)
46 (slurp midi-file))))
48 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
50 (defmulti parse-command :command)
52 (defn discard-args [command] (dissoc command :args))
54 (defmethod parse-command :Start_track
55 [command] (discard-args command))
57 (defmethod parse-command :End_track
58 [command] (discard-args command))
60 (defmethod parse-command :default
61 [command] command)
63 (defn parse-number-list
64 [number-list-str]
65 (map #(Integer/parseInt %)
66 (clojure.string/split number-list-str #", ")))
68 (defmethod parse-command :Tempo
69 [command]
70 (update-in command [:args] #(Integer/parseInt %)))
72 (defn parse-midi-note-list
73 [midi-note-list-str]
74 (let [[channel note velocity]
75 (parse-number-list midi-note-list-str)]
76 {:channel channel :note note :velocity velocity}))
78 (defmethod parse-command :Note_on_c
79 [command]
80 (update-in command [:args] parse-midi-note-list))
82 (defmethod parse-command :Note_off_c
83 [command]
84 (update-in command [:args] parse-midi-note-list))
86 (defmethod parse-command :Header
87 [command]
88 (let [args (:args command)
89 [format num-tracks division] (parse-number-list args)]
90 (assoc command :args
91 {:format format
92 :num-tracks num-tracks
93 :division division})))
95 (defmethod parse-command :Program_c
96 [command]
97 (let [args (:args command)
98 [channel program-num] (parse-number-list args)]
99 (assoc command :args
100 {:channel channel
101 :program-num program-num})))
103 (defn parse-midi [#^File midi-file]
104 (map
105 (comp parse-command
106 (fn [line]
107 (let [[[_ channel time command args]]
108 (re-seq command-line line)]
109 {:channel (Integer/parseInt channel)
110 :time (Integer/parseInt time)
111 :command (keyword command)
112 :args (apply str (drop 2 args))})))
113 (drop-last
114 (clojure.string/split-lines
115 (raw-midi-text midi-file)))))
117 (def music-base new-kernel)
119 (defn store [n address]
120 (flatten
121 [0xF5
122 0xE5
124 0x3E
125 n
127 0x21
128 (reverse (disect-bytes-2 address))
130 0x77
132 0xE1
133 0xF1]))
135 (defn infinite-loop []
136 [0x18 0xFE])
138 (def divider-register 0xFF04)
140 (defrecord Bit-Note [frequency volume duration duty])
142 (defn clear-music-registers []
143 (flatten
144 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
145 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
146 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
147 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
148 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
150 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
151 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
152 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
153 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
155 (store (Integer/parseInt "00000000" 2) 0xFF1A)
156 (store (Integer/parseInt "00000000" 2) 0xFF1B)
157 (store (Integer/parseInt "00000000" 2) 0xFF1C)
158 (store (Integer/parseInt "00000000" 2) 0xFF1D)
159 (store (Integer/parseInt "00000000" 2) 0xFF1E)
161 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
162 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
163 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
164 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
165 ]))
168 ;; mini-midi syntax
170 ;; codes
171 ;; note-code == 0x00
172 ;; change-duty-code = 0x01
173 ;; silence-code = 0x02
175 ;; silence format
176 ;; 2 bytes
177 ;; [silence-code (0x02)]
178 ;; [duration-8-bits]
180 ;; note data format
181 ;; 4 bytes
182 ;; [note-code (0x00)]
183 ;; [volume-4-bits 0 frequency-high-3-bits]
184 ;; [frequengy-low-8-bits]
185 ;; [duration-8-bits]
187 ;; change-duty-format
188 ;; 2 bytes
189 ;; [change-duty-code (0x01)]
190 ;; [new-duty]
192 (def note-code 0x00)
193 (def change-duty-code 0x01)
194 (def silence-code 0x02)
196 (defn do-message
197 "Read the message which starts at the current value of HL and do
198 what it says. Duration is left in A, and HL is advanced
199 appropraitely."
200 ([] (do-message 0x16 1))
201 ([sound-base-address wave-duty]
202 (assert (<= 0 wave-duty 3))
203 (let [switch
204 [0x2A ;; load message code into A, increment HL
206 ;; switch on message
207 0xFE
208 note-code
210 0x20
211 :note-length]
213 play-note
214 [0x3E ;; set wave-duty
215 (bit-shift-left wave-duty 6)
216 0xE0
217 sound-base-address
218 0x2A ;; load volume/frequency-high info
219 0xF5 ;; push A
220 0xE6
221 (Integer/parseInt "11110000" 2) ;; volume mask
222 0xE0
223 (inc sound-base-address) ;;0x17 ;; set volume
224 0xF1 ;; pop A
225 0xE6
226 (Integer/parseInt "00000111" 2) ;; frequency-high mask
227 0xE0
228 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
230 0x2A ;; load frequency low-bits
231 0xE0
232 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
233 0x2A]] ;; load duration
234 (replace
235 {:note-length (count play-note)}
236 (concat switch play-note)))))
238 (defn play-noise
239 "read [noise-code, volume, duration] and play the noise. Duration is left in
240 A, and HL is advanced appropraitely."
241 ([]
242 [0x2A ;; load noise-code into A
243 0xE0
244 0x22 ;; write noise-code
246 0x2A ;; load volume
247 0xE0
248 0x21 ;; write volume
250 0x2A] ;; load duration into A
251 ))
254 ;; (defn play-note
255 ;; "Play the note referenced by HL in the appropiate channel.
256 ;; Leaves desired-duration in A."
258 ;; [0x2A ;; load volume/frequency-high info
259 ;; 0xF5 ;; push A
260 ;; 0xE6
261 ;; (Integer/parseInt "11110000" 2) ;; volume mask
262 ;; 0xE0
263 ;; 0x17 ;; set volume
264 ;; 0xF1 ;; pop A
265 ;; 0xE6
266 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
267 ;; 0xE0
268 ;; 0x19 ;; set frequency-high
270 ;; 0x2A ;; load frequency low-bits
271 ;; 0xE0
272 ;; 0x18 ;; set frequency-low-bits
274 ;; 0x2A ;; load duration
275 ;; ])
277 (defn music-step [sound-base-address wave-duty noise?]
278 ;; C == current-ticks
279 ;; A == desired-ticks
281 (flatten
282 [;; restore variables from stack
283 0xE1 ;; pop HL
284 0xC1 ;; pop CB
285 0xF1 ;; pop AF
288 0xF5 ;; push A
289 0xF0
290 0x05 ;; load current ticks from 0xF005
291 0xB8 ;;
292 0x30 ;; increment C only if last result caused carry
293 0x01
294 0x0C
296 0x47 ;; update sub-ticks (A->B)
298 0xF1 ;; pop AF, now A contains desired-ticks
300 0xB9 ;; compare with current ticks
302 ;; if desired-ticks = current ticks
303 ;; go to next note ; set current set ticks to 0.
305 (if noise?
306 [0x20
307 (+ 2 (count (play-noise)))
308 (play-noise)]
310 [0x20
311 (+ (count (do-message 0 0)) 2)
312 (do-message sound-base-address wave-duty)])
314 0x0E
315 0x00 ;; 0->C (current-ticks)
317 ;; save variables to stack
318 0xF5 ;; push AF
319 0xC5 ;; push CB
320 0xE5 ;; push HL
323 ]))
325 (def music-1 0x11)
326 (def music-2 0x16)
328 (defn music-kernel [wave-duty-1 wave-duty-2]
329 (flatten
330 [;; global initilization section
331 (clear-music-registers)
333 0x3E
334 0x01
335 0xE0
336 0x06 ;; set TMA to 0
338 0x3E
339 (Integer/parseInt "00000110" 2)
340 0xE0
341 0x07 ;; set TAC to 65536 Hz and activate timer
343 ;; initialize frame 1
344 0x21
345 0x00
346 0xA0 ;; set HL to 0xA000 == music-start 1
347 0x0E
348 0x00 ;; 0->C
349 0x06
350 0x00 ;; 0->B
352 0xAF ;; 0->A
354 0xF5 ;; push AF
355 0xC5 ;; push CB
356 0xE5 ;; push HL
358 ;; initialize frame 2
359 0x21
360 0x00
361 0xB0 ;; set HL to 0xB000 == music-start 2
363 0xF5 ;; push AF
364 0xC5 ;; push CB
365 0xE5 ;; push HL
368 ;; initialize frame 3 (noise)
369 0x21
370 0x00
371 0xA9 ;; 0xA9OO -> HL
373 0xF5 ;; push AF
374 0xC5 ;; push CB
375 0xE5 ;; push HL
377 ;; main music loop
379 0xE8 ;; SP + 12; activate frame 1
380 12
381 (music-step music-1 wave-duty-1 false)
383 0xE8 ;; SP - 6; activate frame 2
384 (->signed-8-bit -6)
385 (music-step music-2 wave-duty-2 false)
387 0xE8 ;; SP - 6; activate frame 3
388 (->signed-8-bit -6)
389 (music-step nil nil true)
391 0x18
392 (->signed-8-bit (+
393 ;; two music-steps
394 (- (* 2 (count (music-step 0 0 false))))
395 (- (count (music-step nil nil true)))
396 -2 ;; this jump instruction
397 -2 ;; activate frame 1
398 -2 ;; activate frame 2
399 -2 ;; activate frame 3
400 ))]))
402 (defn frequency-code->frequency
403 [code]
404 (assert (<= 0 code 2047))
405 (/ 131072 (- 2048 code)))
407 (defn clamp [x low high]
408 (cond (> x high) high
409 (< x low) low
410 true x))
412 (defn frequency->frequency-code
413 [frequency]
414 (clamp
415 (Math/round
416 (float
417 (/ (- (* 2048 frequency) 131072) frequency)))
418 0x00 2048))
420 (defn note-codes [frequency volume duration]
421 (assert (<= 0 volume 0xF))
422 (if (<= duration 0xFF)
423 (let [frequency-code
424 (frequency->frequency-code frequency)
425 volume&high-frequency
426 (+ (bit-shift-left volume 4)
427 (bit-shift-right frequency-code 8))
428 low-frequency
429 (bit-and 0xFF frequency-code)]
430 [note-code
431 volume&high-frequency
432 low-frequency
433 duration])
434 (vec
435 (flatten
436 [(note-codes frequency volume 0xFF)
437 (note-codes frequency volume (- duration 0xFF))]))))
440 (defn midi-code->frequency
441 [midi-code]
442 (* 8.1757989156
443 (Math/pow 2 (* (float (/ 12)) midi-code))))
445 ;; division == clock-pulses / quarter-note
446 ;; tempo == microseconds / quarter-note
448 ;; have: clock-pulses
449 ;; want: seconds
452 (defn silence [length]
453 {:frequency 1
454 :duration length
455 :volume 0})
457 (defn commands
458 "return all events where #(= (:command %) command)"
459 [command s]
460 (filter #(= command (:command %)) s))
462 (defn track-info [#^File midi-file]
463 (let [events (parse-midi midi-file)
464 track-titles (commands :Title_t events)
465 track-info
466 (map #(read-string (read-string (:args %))) track-titles)
467 track-map
468 (zipmap track-info track-titles)]
469 track-map))
471 (defn target-tracks
472 "return the track-numbers in the form [voice-0 voice-1 noise]"
473 [#^File midi-file]
474 (let [track-data (track-info midi-file)
475 track-order
476 (zipmap (map :out (keys track-data))
477 (vals track-data))
478 channel-nums (map (comp :channel track-order) (range 3))]
479 channel-nums))
481 (defn midi-track->abstract-mini-midi
482 [#^File midi-file track-num]
483 (let [midi-events (parse-midi midi-file)
485 note-on-events (commands :Note_on_c midi-events)
486 note-off-events (commands :Note_off_c midi-events)
488 select-channel
489 (fn [n s]
490 (sort-by :time (filter #(= n (:channel %)) s)))
492 channel-on (select-channel track-num note-on-events)
494 channel-off (select-channel track-num note-off-events)
497 tempo (:args (first (commands :Tempo midi-events)))
498 division
499 (:division (:args (first (commands :Header midi-events))))
501 notes
502 (map
503 (fn [note-on note-off]
504 {:frequency (midi-code->frequency (:note (:args note-on)))
505 :midi-code (:note (:args note-on))
506 :duration
507 (/ (* (/ tempo division)
508 (- (:time note-off) (:time note-on)))
509 1e6) ;; convert clock-pulses into seconds
510 :volume (int (/ (:velocity (:args note-on)) 10))
511 :time-stamp (/ (* (/ tempo division)
512 (:time note-on)) 1e6)})
513 channel-on channel-off)
515 silences
516 (map (fn [note-1 note-2]
517 (let [note-1-space (- (:time-stamp note-2)
518 (:time-stamp note-1))
519 note-1-length (:duration note-1)]
520 (silence (- note-1-space note-1-length))))
521 ;; to handle silence at the beginning.
522 (concat [(assoc (silence 0)
523 :time-stamp 0)] notes)
524 notes)
526 notes-with-silence
527 (concat
528 (filter (comp not zero? :duration)
529 (interleave silences notes))
530 [(silence 3)])]
531 notes-with-silence))
533 (defn midi-track->mini-midi-voice [#^File midi-file track-num]
534 (let [abstract-mini-midi
535 (midi-track->abstract-mini-midi midi-file track-num)]
536 (map
537 (fn [note-event]
538 (note-codes (:frequency note-event)
539 (:volume note-event)
540 (int (* (:duration note-event) 0x100))))
541 abstract-mini-midi)))
543 (def midi-code->gb-noise-code
544 {nil 0xFF
545 35 87
546 38 20
547 39 0
548 })
550 (defn noise-codes [code volume duration]
551 (assert (<= 0 volume 0xF))
552 (if (<= duration 0xFF)
553 [(midi-code->gb-noise-code code code)
554 (bit-shift-left volume 4)
555 duration]
556 (vec
557 (flatten
558 [(noise-codes code volume 0xFF)
559 (noise-codes code volume (- duration 0xFF))]))))
561 (defn midi-track->mini-midi-noise [#^File midi-file track-num]
562 (let [abstract-mini-midi
563 (midi-track->abstract-mini-midi midi-file track-num)]
564 (map
565 (fn [noise-event]
566 (noise-codes (:midi-code noise-event)
567 (:volume noise-event)
568 (int (* (:duration noise-event) 0x100))))
569 abstract-mini-midi)))
572 (defn midi->mini-midi [#^File midi-file]
573 (let [targets (target-tracks midi-file)
574 duty-info (keys (track-info midi-file))]
576 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
577 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
578 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))
579 :duty (zipmap (map :out duty-info)
580 (map #(get % :duty 0) duty-info))}))
582 (defn play-midi [#^File midi-file]
583 (let [voice-1-target 0xA000
584 voice-2-target 0xB000
585 noise-target 0xA900
586 program-target 0xC000
587 mini-midi (midi->mini-midi midi-file)
588 long-silence (flatten (note-codes 20 0 20001))
589 long-noise-silence
590 (interleave (range 500) (repeat 0x00) (repeat 255))
592 voice-1 (flatten (:voice-1 mini-midi))
593 wave-duty-1 ((:duty mini-midi) 0 0)
595 voice-2 (flatten (:voice-2 mini-midi))
596 wave-duty-2 ((:duty mini-midi) 1 0)
598 noise (flatten (:noise mini-midi))
599 ]
601 (-> (second (music-base))
602 (set-memory-range voice-1-target long-silence)
603 (set-memory-range voice-2-target long-silence)
604 (set-memory-range noise-target long-noise-silence)
605 (set-memory-range voice-1-target voice-1)
606 (set-memory-range voice-2-target voice-2)
607 (set-memory-range noise-target noise)
608 (set-memory-range
609 program-target
610 (music-kernel wave-duty-1 wave-duty-2))
611 (PC! program-target))))
613 (defn test-noise []
614 (let [noise-pattern
615 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
616 (interleave (range 10) (repeat 0x00) (repeat 255)))]
618 (-> (second (music-base))
619 (set-memory-range 0xA900 (flatten noise-pattern))
620 (set-memory-range 0xC000 (music-kernel 0 0))
621 (PC! 0xC000))))
623 (defn test-play-noise [noise-code]
624 (Thread/sleep 300)
625 (println "playing noise:" noise-code)
626 (run-moves
627 (let [noise-pattern
628 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
629 (-> (second (music-base))
630 (set-memory-range 0xA900 (flatten noise-pattern))
631 (set-memory-range 0xC000 (music-kernel 0 0))
632 (PC! 0xC000)))
633 (repeat 20 [])))
635 (defn test-all-noises []
636 (dorun (map test-play-noise (range 0x100))))
638 (def C4 (partial note-codes 261.63))
639 (def D4 (partial note-codes 293.66))
640 (def E4 (partial note-codes 329.63))
641 (def F4 (partial note-codes 349.23))
642 (def G4 (partial note-codes 392))
643 (def A4 (partial note-codes 440))
644 (def B4 (partial note-codes 493.88))
645 (def C5 (partial note-codes 523.3))
647 (def scale
648 (flatten
649 [(C4 0xF 0x40)
650 (D4 0xF 0x40)
651 (E4 0xF 0x40)
652 (F4 0xF 0x40)
653 (G4 0xF 0x40)
654 (A4 0xF 0x40)
655 (B4 0xF 0x40)
656 (C5 0xF 0x40)]))
658 (defn play-music [music-bytes]
659 (let [program-target 0xC000
660 music-target 0xA000]
661 (-> (set-memory-range (second (music-base))
662 program-target (music-kernel))
663 (set-memory-range music-target music-bytes)
664 (PC! program-target))))
666 (defn run-program
667 ([program]
668 (let [target 0xC000]
669 (-> (set-memory-range (second (music-base))
670 target program)
671 (PC! target)))))
673 (defn test-timer []
674 (flatten
675 [0x3E
676 0x01
677 0xE0
678 0x06 ;; set TMA to 0
680 0x3E
681 (Integer/parseInt "00000100" 2)
682 0xE0
683 0x07 ;; set TAC to 16384 Hz and activate timer
685 (repeat
686 500
687 [0xF0
688 0x05])]))
690 (defn play-pony []
691 (println "playing" (.getName pony-csv))
692 (run-moves (play-midi pony-csv) (repeat 1800 [])))
694 (defn play-regret []
695 (println "playing" (.getName regret-csv))
696 (run-moves (play-midi regret-csv) (repeat 3380 [])))
698 (defn play-mother []
699 (println "playing" (.getName mother-csv))
700 (run-moves (play-midi mother-csv) (repeat 2200 [])))
702 (defn demo [] (play-mother) (play-regret) (play-pony))