view clojure/com/aurellem/run/music.clj @ 463:3e74bf517d8f

enabled duty-selection via title information in the midi file.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 03:45:04 -0500
parents 32375de697e5
children 413c66186baa
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"))
21 (defn raw-midi-text [#^File midi-file]
22 (:out
23 (clojure.java.shell/sh
24 "midicsv"
25 (.getCanonicalPath midi-file)
26 "-")))
28 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
30 (defmulti parse-command :command)
32 (defn discard-args [command] (dissoc command :args))
34 (defmethod parse-command :Start_track
35 [command] (discard-args command))
37 (defmethod parse-command :End_track
38 [command] (discard-args command))
40 (defmethod parse-command :default
41 [command] command)
43 (defn parse-number-list
44 [number-list-str]
45 (map #(Integer/parseInt %)
46 (clojure.string/split number-list-str #", ")))
48 (defmethod parse-command :Tempo
49 [command]
50 (update-in command [:args] #(Integer/parseInt %)))
52 (defn parse-midi-note-list
53 [midi-note-list-str]
54 (let [[channel note velocity]
55 (parse-number-list midi-note-list-str)]
56 {:channel channel :note note :velocity velocity}))
58 (defmethod parse-command :Note_on_c
59 [command]
60 (update-in command [:args] parse-midi-note-list))
62 (defmethod parse-command :Note_off_c
63 [command]
64 (update-in command [:args] parse-midi-note-list))
66 (defmethod parse-command :Header
67 [command]
68 (let [args (:args command)
69 [format num-tracks division] (parse-number-list args)]
70 (assoc command :args
71 {:format format
72 :num-tracks num-tracks
73 :division division})))
75 (defmethod parse-command :Program_c
76 [command]
77 (let [args (:args command)
78 [channel program-num] (parse-number-list args)]
79 (assoc command :args
80 {:channel channel
81 :program-num program-num})))
83 (defn parse-midi [#^File midi-file]
84 (map
85 (comp parse-command
86 (fn [line]
87 (let [[[_ channel time command args]]
88 (re-seq command-line line)]
89 {:channel (Integer/parseInt channel)
90 :time (Integer/parseInt time)
91 :command (keyword command)
92 :args (apply str (drop 2 args))})))
93 (drop-last
94 (clojure.string/split-lines
95 (raw-midi-text midi-file)))))
97 (def music-base new-kernel)
99 (defn store [n address]
100 (flatten
101 [0xF5
102 0xE5
104 0x3E
105 n
107 0x21
108 (reverse (disect-bytes-2 address))
110 0x77
112 0xE1
113 0xF1]))
115 (defn infinite-loop []
116 [0x18 0xFE])
118 (def divider-register 0xFF04)
120 (defrecord Bit-Note [frequency volume duration duty])
122 (defn clear-music-registers []
123 (flatten
124 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
125 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
126 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
127 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
128 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
130 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
131 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
132 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
133 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
135 (store (Integer/parseInt "00000000" 2) 0xFF1A)
136 (store (Integer/parseInt "00000000" 2) 0xFF1B)
137 (store (Integer/parseInt "00000000" 2) 0xFF1C)
138 (store (Integer/parseInt "00000000" 2) 0xFF1D)
139 (store (Integer/parseInt "00000000" 2) 0xFF1E)
141 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
142 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
143 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
144 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
145 ]))
148 ;; mini-midi syntax
150 ;; codes
151 ;; note-code == 0x00
152 ;; change-duty-code = 0x01
153 ;; silence-code = 0x02
155 ;; silence format
156 ;; 2 bytes
157 ;; [silence-code (0x02)]
158 ;; [duration-8-bits]
160 ;; note data format
161 ;; 4 bytes
162 ;; [note-code (0x00)]
163 ;; [volume-4-bits 0 frequency-high-3-bits]
164 ;; [frequengy-low-8-bits]
165 ;; [duration-8-bits]
167 ;; change-duty-format
168 ;; 2 bytes
169 ;; [change-duty-code (0x01)]
170 ;; [new-duty]
172 (def note-code 0x00)
173 (def change-duty-code 0x01)
174 (def silence-code 0x02)
176 (defn do-message
177 "Read the message which starts at the current value of HL and do
178 what it says. Duration is left in A, and HL is advanced
179 appropraitely."
180 ([] (do-message 0x16 1))
181 ([sound-base-address wave-duty]
182 (assert (<= 0 wave-duty 3))
183 (let [switch
184 [0x2A ;; load message code into A, increment HL
186 ;; switch on message
187 0xFE
188 note-code
190 0x20
191 :note-length]
193 play-note
194 [0x3E ;; set wave-duty
195 (bit-shift-left wave-duty 6)
196 0xE0
197 sound-base-address
198 0x2A ;; load volume/frequency-high info
199 0xF5 ;; push A
200 0xE6
201 (Integer/parseInt "11110000" 2) ;; volume mask
202 0xE0
203 (inc sound-base-address) ;;0x17 ;; set volume
204 0xF1 ;; pop A
205 0xE6
206 (Integer/parseInt "00000111" 2) ;; frequency-high mask
207 0xE0
208 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
210 0x2A ;; load frequency low-bits
211 0xE0
212 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
213 0x2A]] ;; load duration
214 (replace
215 {:note-length (count play-note)}
216 (concat switch play-note)))))
218 ;; (defn play-note
219 ;; "Play the note referenced by HL in the appropiate channel.
220 ;; Leaves desired-duration in A."
222 ;; [0x2A ;; load volume/frequency-high info
223 ;; 0xF5 ;; push A
224 ;; 0xE6
225 ;; (Integer/parseInt "11110000" 2) ;; volume mask
226 ;; 0xE0
227 ;; 0x17 ;; set volume
228 ;; 0xF1 ;; pop A
229 ;; 0xE6
230 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
231 ;; 0xE0
232 ;; 0x19 ;; set frequency-high
234 ;; 0x2A ;; load frequency low-bits
235 ;; 0xE0
236 ;; 0x18 ;; set frequency-low-bits
238 ;; 0x2A ;; load duration
239 ;; ])
241 (defn music-step [sound-base-address wave-duty]
242 ;; C == current-ticks
243 ;; A == desired-ticks
245 (flatten
246 [;; restore variables from stack
247 0xE1 ;; pop HL
248 0xC1 ;; pop CB
249 0xF1 ;; pop AF
252 0xF5 ;; push A
253 0xF0
254 0x05 ;; load current ticks from 0xF005
255 0xB8 ;;
256 0x30 ;; increment C only if last result caused carry
257 0x01
258 0x0C
260 0x47 ;; update sub-ticks (A->B)
262 0xF1 ;; pop AF, now A contains desired-ticks
264 0xB9 ;; compare with current ticks
266 ;; if desired-ticks = current ticks
267 ;; go to next note ; set current set ticks to 0.
269 0x20
270 (+ (count (do-message 0 0)) 2)
272 (do-message sound-base-address wave-duty)
274 0x0E
275 0x00 ;; 0->C (current-ticks)
277 ;; save variables to stack
278 0xF5 ;; push AF
279 0xC5 ;; push CB
280 0xE5 ;; push HL
283 ]))
285 (def music-1 0x11)
286 (def music-2 0x16)
288 (defn music-kernel [wave-duty-1 wave-duty-2]
289 (flatten
290 [;; global initilization section
291 (clear-music-registers)
293 0x3E
294 0x01
295 0xE0
296 0x06 ;; set TMA to 0
298 0x3E
299 (Integer/parseInt "00000110" 2)
300 0xE0
301 0x07 ;; set TAC to 65536 Hz and activate timer
303 ;; initialize frame 1
304 0x21
305 0x00
306 0xA0 ;; set HL to 0xA000 == music-start 1
307 0x0E
308 0x00 ;; 0->C
309 0x06
310 0x00 ;; 0->B
312 0xAF ;; 0->A
314 0xF5 ;; push AF
315 0xC5 ;; push CB
316 0xE5 ;; push HL
318 ;; initialize frame 2
319 0x21
320 0x00
321 0xB0 ;; set HL to 0xB000 == music-start 2
323 0xF5 ;; push AF
324 0xC5 ;; push CB
325 0xE5 ;; push HL
328 ;; main music loop
330 0xE8 ;; SP + 6; activate frame 1
331 6
332 (music-step music-1 wave-duty-1)
333 ;;(repeat (count (music-step music-1)) 0x00)
335 0xE8 ;; SP - 6; activate frame 2
336 (->signed-8-bit -6)
337 ;;(repeat (count (music-step music-2)) 0x00)
338 (music-step music-2 wave-duty-2)
341 0x18
342 (->signed-8-bit (+
343 ;; two music-steps
344 (- (* 2 (count (music-step 0 0))))
345 -2 ;; this jump instruction
346 -2 ;; activate frame 1
347 -2 ;; activate frame 2
348 ))]))
350 (defn frequency-code->frequency
351 [code]
352 (assert (<= 0 code 2047))
353 (/ 131072 (- 2048 code)))
355 (defn clamp [x low high]
356 (cond (> x high) high
357 (< x low) low
358 true x))
360 (defn frequency->frequency-code
361 [frequency]
362 (clamp
363 (Math/round
364 (float
365 (/ (- (* 2048 frequency) 131072) frequency)))
366 0x00 2048))
368 (defn note-codes [frequency volume duration]
369 (assert (<= 0 volume 0xF))
370 (if (<= duration 0xFF)
371 (let [frequency-code
372 (frequency->frequency-code frequency)
373 volume&high-frequency
374 (+ (bit-shift-left volume 4)
375 (bit-shift-right frequency-code 8))
376 low-frequency
377 (bit-and 0xFF frequency-code)]
378 [note-code
379 volume&high-frequency
380 low-frequency
381 duration])
382 (vec
383 (flatten
384 [(note-codes frequency volume 0xFF)
385 (note-codes frequency volume (- duration 0xFF))]))))
388 (defn midi-code->frequency
389 [midi-code]
390 (* 8.1757989156
391 (Math/pow 2 (* (float (/ 12)) midi-code))))
393 ;; division == clock-pulses / quarter-note
394 ;; tempo == microseconds / quarter-note
396 ;; have: clock-pulses
397 ;; want: seconds
400 (defn silence [length]
401 {:frequency 1
402 :duration length
403 :volume 0})
405 (defn track-info [#^File midi-file]
406 (let [events (parse-midi midi-file)
407 track-titles (commands :Title_t events)
408 track-info
409 (map #(read-string (read-string (:args %))) track-titles)
410 track-map
411 (zipmap track-info track-titles)]
412 track-map))
414 (defn target-tracks
415 "return the track-numbers in the form [voice-0 voice-1 noise]"
416 [#^File midi-file]
417 (let [track-data (track-info midi-file)
418 track-order
419 (zipmap (map :out (keys track-data))
420 (vals track-data))
421 channel-nums (map (comp :channel track-order) (range 3))]
422 channel-nums))
424 (defn commands
425 "return all events where #(= (:command %) command)"
426 [command s]
427 (filter #(= command (:command %)) s))
429 (defn midi-track->mini-midi [#^File midi-file track-num]
430 (let [midi-events (parse-midi midi-file)
432 note-on-events (commands :Note_on_c midi-events)
433 note-off-events (commands :Note_off_c midi-events)
435 select-channel
436 (fn [n s]
437 (sort-by :time (filter #(= n (:channel %)) s)))
439 channel-on (select-channel track-num note-on-events)
441 channel-off (select-channel track-num note-off-events)
444 tempo (:args (first (commands :Tempo midi-events)))
445 division
446 (:division (:args (first (commands :Header midi-events))))
448 notes
449 (map
450 (fn [note-on note-off]
451 {:frequency (midi-code->frequency (:note (:args note-on)))
452 :duration
453 (/ (* (/ tempo division)
454 (- (:time note-off) (:time note-on)))
455 1e6) ;; convert clock-pulses into seconds
456 :volume (int (/ (:velocity (:args note-on)) 10))
457 :time-stamp (/ (* (/ tempo division)
458 (:time note-on)) 1e6)})
459 channel-on channel-off)
461 silences
462 (map (fn [note-1 note-2]
463 (let [note-1-space (- (:time-stamp note-2)
464 (:time-stamp note-1))
465 note-1-length (:duration note-1)]
466 (silence (- note-1-space note-1-length))))
467 ;; to handle silence at the beginning.
468 (concat [(assoc (silence 0)
469 :time-stamp 0)] notes)
470 notes)
472 notes-with-silence
473 (concat
474 (filter (comp not zero? :duration)
475 (interleave silences notes))
476 [(silence 3)])]
478 (map
479 (fn [note-event]
480 (note-codes (:frequency note-event)
481 (:volume note-event)
482 (int (* (:duration note-event) 0x100))))
483 notes-with-silence)))
485 (defn midi->mini-midi [#^File midi-file]
486 (let [targets (target-tracks midi-file)
487 get-track (fn [n]
488 (if (not (nil? n))
489 (midi-track->mini-midi midi-file n)
490 []))
491 duty-info (keys (track-info midi-file))]
493 {:voice-1 (get-track (nth targets 0))
494 :voice-2 (get-track (nth targets 1))
495 :noise (get-track (nth targets 2))
496 :duty (zipmap (map :out duty-info)
497 (map :duty duty-info))}))
499 (defn play-midi [#^File midi-file]
500 (let [track-1-target 0xA000
501 track-2-target 0xB000
502 program-target 0xC000
503 mini-midi (midi->mini-midi midi-file)
504 long-silence (flatten (note-codes 20 0 9001))
506 voice-1 (flatten (:voice-1 mini-midi))
507 wave-duty-1 ((:duty mini-midi) 0)
509 voice-2 (flatten (:voice-2 mini-midi))
510 wave-duty-2 ((:duty mini-midi) 1)
511 ]
513 (-> (second (music-base))
514 (set-memory-range track-1-target long-silence)
515 (set-memory-range track-2-target long-silence)
516 (set-memory-range track-1-target voice-1)
517 (set-memory-range track-2-target voice-2)
518 (set-memory-range
519 program-target
520 (music-kernel wave-duty-1 wave-duty-2))
521 (PC! program-target))))
523 (def C4 (partial note-codes 261.63))
524 (def D4 (partial note-codes 293.66))
525 (def E4 (partial note-codes 329.63))
526 (def F4 (partial note-codes 349.23))
527 (def G4 (partial note-codes 392))
528 (def A4 (partial note-codes 440))
529 (def B4 (partial note-codes 493.88))
530 (def C5 (partial note-codes 523.3))
532 (def scale
533 (flatten
534 [(C4 0xF 0x40)
535 (D4 0xF 0x40)
536 (E4 0xF 0x40)
537 (F4 0xF 0x40)
538 (G4 0xF 0x40)
539 (A4 0xF 0x40)
540 (B4 0xF 0x40)
541 (C5 0xF 0x40)]))
543 (defn play-music [music-bytes]
544 (let [program-target 0xC000
545 music-target 0xA000]
546 (-> (set-memory-range (second (music-base))
547 program-target (music-kernel))
548 (set-memory-range music-target music-bytes)
549 (PC! program-target))))
553 ;; (defn test-note [music-bytes]
554 ;; (-> (set-memory-range (second (music-base))
555 ;; 0xC000 (concat (clear-music-registers)
556 ;; (play-note)
557 ;; (infinite-loop)))
558 ;; (set-memory-range 0xD000 music-bytes)
559 ;; (PC! 0xC000)
560 ;; (HL! 0xD000)
561 ;; ))
564 (defn run-program
565 ([program]
566 (let [target 0xC000]
567 (-> (set-memory-range (second (music-base))
568 target program)
569 (PC! target)))))
571 (defn test-timer []
572 (flatten
573 [0x3E
574 0x01
575 0xE0
576 0x06 ;; set TMA to 0
578 0x3E
579 (Integer/parseInt "00000100" 2)
580 0xE0
581 0x07 ;; set TAC to 16384 Hz and activate timer
583 (repeat
584 500
585 [0xF0
586 0x05])]))