view clojure/com/aurellem/run/music.clj @ 520:fe2b9a1fe919

reduced colors in pinkie pie mark to exactly 4.
author Robert McIntyre <rlm@mit.edu>
date Sat, 23 Jun 2012 17:22:32 -0500
parents a6d060a64246
children 2de44c6184ee
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 ;; one noise
396 (- (count (music-step nil nil true)))
397 -2 ;; this jump instruction
398 -2 ;; activate frame 1
399 -2 ;; activate frame 2
400 -2 ;; activate frame 3
401 ))]))
403 (defn frequency-code->frequency
404 [code]
405 (assert (<= 0 code 2047))
406 (/ 131072 (- 2048 code)))
408 (defn clamp [x low high]
409 (cond (> x high) high
410 (< x low) low
411 true x))
413 (defn frequency->frequency-code
414 [frequency]
415 (clamp
416 (Math/round
417 (float
418 (/ (- (* 2048 frequency) 131072) frequency)))
419 0x00 2048))
421 (defn note-codes [frequency volume duration]
422 (assert (<= 0 volume 0xF))
423 (if (<= duration 0xFF)
424 (let [frequency-code
425 (frequency->frequency-code frequency)
426 volume&high-frequency
427 (+ (bit-shift-left volume 4)
428 (bit-shift-right frequency-code 8))
429 low-frequency
430 (bit-and 0xFF frequency-code)]
431 [note-code
432 volume&high-frequency
433 low-frequency
434 duration])
435 (vec
436 (flatten
437 [(note-codes frequency volume 0xFF)
438 (note-codes frequency volume (- duration 0xFF))]))))
441 (defn midi-code->frequency
442 [midi-code]
443 (* 8.1757989156
444 (Math/pow 2 (* (float (/ 12)) midi-code))))
446 ;; division == clock-pulses / quarter-note
447 ;; tempo == microseconds / quarter-note
449 ;; have: clock-pulses
450 ;; want: seconds
453 (defn silent-note [length]
454 {:frequency 1
455 :duration length
456 :volume 0})
458 (defn commands
459 "return all events where #(= (:command %) command)"
460 [command s]
461 (filter #(= command (:command %)) s))
463 (defn track-info [#^File midi-file]
464 (let [events (parse-midi midi-file)
465 track-titles (commands :Title_t events)
466 track-info
467 (map #(read-string (read-string (:args %))) track-titles)
468 track-map
469 (zipmap track-info track-titles)]
470 track-map))
472 (defn target-tracks
473 "return the track-numbers in the form [voice-0 voice-1 noise]"
474 [#^File midi-file]
475 (let [track-data (track-info midi-file)
476 track-order
477 (zipmap (map :out (keys track-data))
478 (vals track-data))
479 channel-nums (map (comp :channel track-order) (range 3))]
480 channel-nums))
482 (defn midi-track->abstract-mini-midi
483 [#^File midi-file track-num]
484 (let [midi-events (parse-midi midi-file)
486 note-on-events (commands :Note_on_c midi-events)
487 note-off-events (commands :Note_off_c midi-events)
489 select-channel
490 (fn [n s]
491 (sort-by :time (filter #(= n (:channel %)) s)))
493 channel-on (select-channel track-num note-on-events)
495 channel-off (select-channel track-num note-off-events)
498 tempo (:args (first (commands :Tempo midi-events)))
499 division
500 (:division (:args (first (commands :Header midi-events))))
502 notes
503 (map
504 (fn [note-on note-off]
505 {:frequency (midi-code->frequency (:note (:args note-on)))
506 :midi-code (:note (:args note-on))
507 :duration
508 (/ (* (/ tempo division)
509 (- (:time note-off) (:time note-on)))
510 1e6) ;; convert clock-pulses into seconds
511 :volume (int (/ (:velocity (:args note-on)) 10))
512 :time-stamp (/ (* (/ tempo division)
513 (:time note-on)) 1e6)})
514 channel-on channel-off)
516 silences
517 (map (fn [note-1 note-2]
518 (let [note-1-space (- (:time-stamp note-2)
519 (:time-stamp note-1))
520 note-1-length (:duration note-1)]
521 (silent-note (- note-1-space note-1-length))))
522 ;; to handle silence at the beginning.
523 (concat [(assoc (silent-note 0)
524 :time-stamp 0)] notes)
525 notes)
527 notes-with-silence
528 (concat
529 (filter (comp not zero? :duration)
530 (interleave silences notes))
531 [(silent-note 3)])]
532 notes-with-silence))
534 (defn midi-track->mini-midi-voice [#^File midi-file track-num]
535 (let [abstract-mini-midi
536 (midi-track->abstract-mini-midi midi-file track-num)]
537 (map
538 (fn [note-event]
539 (note-codes (:frequency note-event)
540 (:volume note-event)
541 (int (* (:duration note-event) 0x100))))
542 abstract-mini-midi)))
544 (def midi-code->gb-noise-code
545 {nil 0xFF
546 35 90
547 38 20
548 39 0
549 })
551 (defn noise-codes [code volume duration]
552 (assert (<= 0 volume 0xF))
553 (if (<= duration 0xFF)
554 [(midi-code->gb-noise-code code code)
555 (bit-shift-left volume 4)
556 duration]
557 (vec
558 (flatten
559 [(noise-codes code volume 0xFF)
560 (noise-codes code volume (- duration 0xFF))]))))
562 (defn midi-track->mini-midi-noise [#^File midi-file track-num]
563 (let [abstract-mini-midi
564 (midi-track->abstract-mini-midi midi-file track-num)]
565 (map
566 (fn [noise-event]
567 (noise-codes (:midi-code noise-event)
568 (:volume noise-event)
569 (int (* (:duration noise-event) 0x100))))
570 abstract-mini-midi)))
573 (defn midi->mini-midi [#^File midi-file]
574 (let [targets (target-tracks midi-file)
575 duty-info (keys (track-info midi-file))]
577 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
578 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
579 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))
580 :duty (zipmap (map :out duty-info)
581 (map #(get % :duty 0) duty-info))}))
583 (defn play-midi [#^File midi-file]
584 (let [voice-1-target 0xA000
585 voice-2-target 0xB000
586 noise-target 0xA900
587 program-target 0xC000
588 mini-midi (midi->mini-midi midi-file)
589 long-silence (flatten (note-codes 20 0 20001))
590 long-noise-silence
591 (interleave (range 500) (repeat 0x00) (repeat 255))
593 voice-1 (flatten (:voice-1 mini-midi))
594 wave-duty-1 ((:duty mini-midi) 0 0)
596 voice-2 (flatten (:voice-2 mini-midi))
597 wave-duty-2 ((:duty mini-midi) 1 0)
599 noise (flatten (:noise mini-midi))
600 ]
602 (-> (second (music-base))
603 (set-memory-range voice-1-target long-silence)
604 (set-memory-range voice-2-target long-silence)
605 (set-memory-range noise-target long-noise-silence)
606 (set-memory-range voice-1-target voice-1)
607 (set-memory-range voice-2-target voice-2)
608 (set-memory-range noise-target noise)
609 (set-memory-range
610 program-target
611 (music-kernel wave-duty-1 wave-duty-2))
612 (PC! program-target))))
614 (defn test-noise []
615 (let [noise-pattern
616 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
617 (interleave (range 10) (repeat 0x00) (repeat 255)))]
619 (-> (second (music-base))
620 (set-memory-range 0xA900 (flatten noise-pattern))
621 (set-memory-range 0xC000 (music-kernel 0 0))
622 (PC! 0xC000))))
624 (defn test-play-noise [noise-code]
625 (Thread/sleep 300)
626 (println "playing noise:" noise-code)
627 (run-moves
628 (let [noise-pattern
629 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
630 (-> (second (music-base))
631 (set-memory-range 0xA900 (flatten noise-pattern))
632 (set-memory-range 0xC000 (music-kernel 0 0))
633 (PC! 0xC000)))
634 (repeat 20 [])))
636 (defn test-all-noises []
637 (dorun (map test-play-noise (range 0x100))))
639 (def C4 (partial note-codes 261.63))
640 (def D4 (partial note-codes 293.66))
641 (def E4 (partial note-codes 329.63))
642 (def F4 (partial note-codes 349.23))
643 (def G4 (partial note-codes 392))
644 (def A4 (partial note-codes 440))
645 (def B4 (partial note-codes 493.88))
646 (def C5 (partial note-codes 523.3))
648 (def scale
649 (flatten
650 [(C4 0xF 0x40)
651 (D4 0xF 0x40)
652 (E4 0xF 0x40)
653 (F4 0xF 0x40)
654 (G4 0xF 0x40)
655 (A4 0xF 0x40)
656 (B4 0xF 0x40)
657 (C5 0xF 0x40)]))
659 (defn play-music [music-bytes]
660 (let [program-target 0xC000
661 music-target 0xA000]
662 (-> (set-memory-range (second (music-base))
663 program-target (music-kernel))
664 (set-memory-range music-target music-bytes)
665 (PC! program-target))))
667 (defn run-program
668 ([program]
669 (let [target 0xC000]
670 (-> (set-memory-range (second (music-base))
671 target program)
672 (PC! target)))))
674 (defn test-timer []
675 (flatten
676 [0x3E
677 0x01
678 0xE0
679 0x06 ;; set TMA to 0
681 0x3E
682 (Integer/parseInt "00000100" 2)
683 0xE0
684 0x07 ;; set TAC to 16384 Hz and activate timer
686 (repeat
687 500
688 [0xF0
689 0x05])]))
691 (defn play-pony []
692 (println "playing" (.getName pony-csv))
693 (run-moves (play-midi pony-csv) (repeat 1800 [])))
695 (defn play-regret []
696 (println "playing" (.getName regret-csv))
697 (run-moves (play-midi regret-csv) (repeat 3380 [])))
699 (defn play-mother []
700 (println "playing" (.getName mother-csv))
701 (run-moves (play-midi mother-csv) (repeat 2200 [])))
703 (defn demo [] (play-mother) (play-regret) (play-pony))