view clojure/com/aurellem/run/music.clj @ 438:067ea3f0d951

can now play midi files with two tracks.
author Robert McIntyre <rlm@mit.edu>
date Wed, 25 Apr 2012 13:46:31 -0500
parents 20a9d5faf47c
children bf87b87a4ad7
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 (defn raw-midi-text [#^File midi-file]
15 (:out
16 (clojure.java.shell/sh
17 "midicsv"
18 (.getCanonicalPath midi-file)
19 "-")))
21 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
23 (defmulti parse-command :command)
25 (defn discard-args [command] (dissoc command :args))
27 (defmethod parse-command :Start_track
28 [command] (discard-args command))
30 (defmethod parse-command :End_track
31 [command] (discard-args command))
33 (defmethod parse-command :default
34 [command] command)
36 (defn parse-number-list
37 [number-list-str]
38 (map #(Integer/parseInt %)
39 (clojure.string/split number-list-str #", ")))
41 (defmethod parse-command :Tempo
42 [command]
43 (update-in command [:args] #(Integer/parseInt %)))
45 (defn parse-midi-note-list
46 [midi-note-list-str]
47 (let [[channel note velocity]
48 (parse-number-list midi-note-list-str)]
49 {:channel channel :note note :velocity velocity}))
51 (defmethod parse-command :Note_on_c
52 [command]
53 (update-in command [:args] parse-midi-note-list))
55 (defmethod parse-command :Note_off_c
56 [command]
57 (update-in command [:args] parse-midi-note-list))
59 (defmethod parse-command :Header
60 [command]
61 (let [args (:args command)
62 [format num-tracks division] (parse-number-list args)]
63 (assoc command :args
64 {:format format
65 :num-tracks num-tracks
66 :division division})))
68 (defmethod parse-command :Program_c
69 [command]
70 (let [args (:args command)
71 [channel program-num] (parse-number-list args)]
72 (assoc command :args
73 {:channel channel
74 :program-num program-num})))
76 (defn parse-midi [#^File midi-file]
77 (map
78 (comp parse-command
79 (fn [line]
80 (let [[[_ channel time command args]]
81 (re-seq command-line line)]
82 {:channel (Integer/parseInt channel)
83 :time (Integer/parseInt time)
84 :command (keyword command)
85 :args (apply str (drop 2 args))})))
86 (drop-last
87 (clojure.string/split-lines
88 (raw-midi-text midi-file)))))
90 (def music-base new-kernel)
92 (defn store [n address]
93 (flatten
94 [0xF5
95 0xE5
97 0x3E
98 n
100 0x21
101 (reverse (disect-bytes-2 address))
103 0x77
105 0xE1
106 0xF1]))
108 (defn infinite-loop []
109 [0x18 0xFE])
111 (def divider-register 0xFF04)
113 (defrecord Bit-Note [frequency volume duration duty])
115 (defn clear-music-registers []
116 (flatten
117 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
118 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
119 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
120 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
121 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
123 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
124 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
125 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
126 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
128 (store (Integer/parseInt "00000000" 2) 0xFF1A)
129 (store (Integer/parseInt "00000000" 2) 0xFF1B)
130 (store (Integer/parseInt "00000000" 2) 0xFF1C)
131 (store (Integer/parseInt "00000000" 2) 0xFF1D)
132 (store (Integer/parseInt "00000000" 2) 0xFF1E)
134 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
135 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
136 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
137 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
138 ]))
141 ;; mini-midi syntax
143 ;; codes
144 ;; note-code == 0x00
145 ;; change-duty-code = 0x01
146 ;; silence-code = 0x02
148 ;; silence format
149 ;; 2 bytes
150 ;; [silence-code (0x02)]
151 ;; [duration-8-bits]
153 ;; note data format
154 ;; 4 bytes
155 ;; [note-code (0x00)]
156 ;; [volume-4-bits 0 frequency-high-3-bits]
157 ;; [frequengy-low-8-bits]
158 ;; [duration-8-bits]
160 ;; change-duty-format
161 ;; 2 bytes
162 ;; [change-duty-code (0x01)]
163 ;; [new-duty]
165 (def note-code 0x00)
166 (def change-duty-code 0x01)
167 (def silence-code 0x02)
169 (defn do-message
170 "Read the message which starts at the current value of HL and do
171 what it says. Duration is left in A, and HL is advanced
172 appropraitely."
173 ([] (do-message 0x16))
174 ([sound-base-address]
175 (let [switch
176 [0x2A ;; load message code into A, increment HL
178 ;; switch on message
179 0xFE
180 note-code
182 0x20
183 :note-length]
185 play-note
186 [0x2A ;; load volume/frequency-high info
187 0xF5 ;; push A
188 0xE6
189 (Integer/parseInt "11110000" 2) ;; volume mask
190 0xE0
191 (inc sound-base-address) ;;0x17 ;; set volume
192 0xF1 ;; pop A
193 0xE6
194 (Integer/parseInt "00000111" 2) ;; frequency-high mask
195 0xE0
196 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
198 0x2A ;; load frequency low-bits
199 0xE0
200 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
201 0x2A]] ;; load duration
202 (replace
203 {:note-length (count play-note)}
204 (concat switch play-note)))))
206 ;; (defn play-note
207 ;; "Play the note referenced by HL in the appropiate channel.
208 ;; Leaves desired-duration in A."
210 ;; [0x2A ;; load volume/frequency-high info
211 ;; 0xF5 ;; push A
212 ;; 0xE6
213 ;; (Integer/parseInt "11110000" 2) ;; volume mask
214 ;; 0xE0
215 ;; 0x17 ;; set volume
216 ;; 0xF1 ;; pop A
217 ;; 0xE6
218 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
219 ;; 0xE0
220 ;; 0x19 ;; set frequency-high
222 ;; 0x2A ;; load frequency low-bits
223 ;; 0xE0
224 ;; 0x18 ;; set frequency-low-bits
226 ;; 0x2A ;; load duration
227 ;; ])
229 (defn music-step [sound-base-address]
230 ;; C == current-ticks
231 ;; A == desired-ticks
233 (flatten
234 [;; restore variables from stack
235 0xE1 ;; pop HL
236 0xC1 ;; pop CB
237 0xF1 ;; pop AF
240 0xF5 ;; push A
241 0xF0
242 0x05 ;; load current ticks from 0xF005
243 0xB8 ;;
244 0x30 ;; increment C only if last result caused carry
245 0x01
246 0x0C
248 0x47 ;; update sub-ticks (A->B)
250 0xF1 ;; pop AF, now A contains desired-ticks
252 0xB9 ;; compare with current ticks
254 ;; if desired-ticks = current ticks
255 ;; go to next note ; set current set ticks to 0.
257 0x20
258 (+ (count (do-message 0)) 2)
260 (do-message sound-base-address)
262 0x0E
263 0x00 ;; 0->C (current-ticks)
265 ;; save variables to stack
266 0xF5 ;; push AF
267 0xC5 ;; push CB
268 0xE5 ;; push HL
271 ]))
273 (def music-1 0x11)
274 (def music-2 0x16)
276 (defn music-kernel []
277 (flatten
278 [;; global initilization section
279 (clear-music-registers)
281 0x3E
282 0x01
283 0xE0
284 0x06 ;; set TMA to 0
286 0x3E
287 (Integer/parseInt "00000110" 2)
288 0xE0
289 0x07 ;; set TAC to 65536 Hz and activate timer
291 ;; initialize frame 1
292 0x21
293 0x00
294 0xA0 ;; set HL to 0xA000 == music-start 1
295 0x0E
296 0x00 ;; 0->C
297 0x06
298 0x00 ;; 0->B
300 0xAF ;; 0->A
302 0xF5 ;; push AF
303 0xC5 ;; push CB
304 0xE5 ;; push HL
306 ;; initialize frame 2
307 0x21
308 0x00
309 0xB0 ;; set HL to 0xB000 == music-start 2
311 0xF5 ;; push AF
312 0xC5 ;; push CB
313 0xE5 ;; push HL
316 ;; main music loop
318 0xE8 ;; SP + 6; activate frame 1
319 6
320 (music-step music-1)
321 ;;(repeat (count (music-step music-1)) 0x00)
323 0xE8 ;; SP - 6; activate frame 2
324 (->signed-8-bit -6)
325 ;;(repeat (count (music-step music-2)) 0x00)
326 (music-step music-2)
329 0x18
330 (->signed-8-bit (+
331 ;; two music-steps
332 (- (* 2 (count (music-step 0))))
333 -2 ;; this jump instruction
334 -2 ;; activate frame 1
335 -2 ;; activate frame 2
336 ))]))
338 (defn frequency-code->frequency
339 [code]
340 (assert (<= 0 code 2047))
341 (/ 131072 (- 2048 code)))
343 (defn clamp [x low high]
344 (cond (> x high) high
345 (< x low) low
346 true x))
348 (defn frequency->frequency-code
349 [frequency]
350 (clamp
351 (Math/round
352 (float
353 (/ (- (* 2048 frequency) 131072) frequency)))
354 0x00 2048))
356 (defn note-codes [frequency volume duration]
357 (assert (<= 0 volume 0xF))
358 (if (<= duration 0xFF)
359 (let [frequency-code
360 (frequency->frequency-code frequency)
361 volume&high-frequency
362 (+ (bit-shift-left volume 4)
363 (bit-shift-right frequency-code 8))
364 low-frequency
365 (bit-and 0xFF frequency-code)]
366 [note-code
367 volume&high-frequency
368 low-frequency
369 duration])
370 (vec
371 (flatten
372 [(note-codes frequency volume 0xFF)
373 (note-codes frequency volume (- duration 0xFF))]))))
376 (defn midi-code->frequency
377 [midi-code]
378 (* 8.1757989156
379 (Math/pow 2 (* (float (/ 12)) midi-code))))
381 ;; division == clock-pulses / quarter-note
382 ;; tempo == microseconds / quarter-note
384 ;; have: clock-pulses
385 ;; want: seconds
388 (defn silence [length]
389 {:frequency 1
390 :duration length
391 :volume 0})
393 (defn commands
394 "return all events where #(= (:command %) command)"
395 [command s]
396 (filter #(= command (:command %)) s))
398 (defn midi-track->mini-midi [#^File midi-file track-num]
399 (let [midi-events (parse-midi midi-file)
401 note-on-events (commands :Note_on_c midi-events)
402 note-off-events (commands :Note_off_c midi-events)
404 select-channel
405 (fn [n s]
406 (sort-by :time (filter #(= n (:channel (:args %))) s)))
408 channel-on (select-channel track-num note-on-events)
410 channel-off (select-channel track-num note-off-events)
413 tempo (:args (first (commands :Tempo midi-events)))
414 division
415 (:division (:args (first (commands :Header midi-events))))
417 notes
418 (map
419 (fn [note-on note-off]
420 {:frequency (midi-code->frequency (:note (:args note-on)))
421 :duration
422 (/ (* (/ tempo division)
423 (- (:time note-off) (:time note-on)))
424 1e6) ;; convert clock-pulses into seconds
425 :volume (int (/ (:velocity (:args note-on)) 10))
426 :time-stamp (/ (* (/ tempo division)
427 (:time note-on)) 1e6)})
428 channel-on channel-off)
430 silences
431 (map (fn [note-1 note-2]
432 (let [note-1-space (- (:time-stamp note-2)
433 (:time-stamp note-1))
434 note-1-length (:duration note-1)]
435 (silence (- note-1-space note-1-length))))
436 ;; to handle silence at the beginning.
437 (concat [(assoc (silence 0)
438 :time-stamp 0)] notes)
439 notes)
441 notes-with-silence
442 (filter (comp not zero? :duration)
443 (interleave silences notes))]
444 (map
445 (fn [note-event]
446 (note-codes (:frequency note-event)
447 (:volume note-event)
448 (int (* (:duration note-event) 0x100))))
449 notes-with-silence)))
451 (defn midi->mini-midi [#^File midi-file]
452 {:track-1 (flatten (midi-track->mini-midi midi-file 1))
453 :track-2 (flatten (midi-track->mini-midi midi-file 2))})
455 (defn play-midi [#^File midi-file]
456 (let [track-1-target 0xA000
457 track-2-target 0xB000
458 program-target 0xC000
459 mini-midi (midi->mini-midi midi-file)
460 long-silence (flatten (note-codes 20 0 9001))]
462 (-> (second (music-base))
463 (set-memory-range track-1-target long-silence)
464 (set-memory-range track-2-target long-silence)
465 (set-memory-range track-1-target (:track-1 mini-midi))
466 (set-memory-range track-2-target (:track-2 mini-midi))
467 (set-memory-range program-target (music-kernel))
468 (PC! program-target))))
473 (def C4 (partial note-codes 261.63))
474 (def D4 (partial note-codes 293.66))
475 (def E4 (partial note-codes 329.63))
476 (def F4 (partial note-codes 349.23))
477 (def G4 (partial note-codes 392))
478 (def A4 (partial note-codes 440))
479 (def B4 (partial note-codes 493.88))
480 (def C5 (partial note-codes 523.3))
482 (def scale
483 (flatten
484 [(C4 0xF 0x40)
485 (D4 0xF 0x40)
486 (E4 0xF 0x40)
487 (F4 0xF 0x40)
488 (G4 0xF 0x40)
489 (A4 0xF 0x40)
490 (B4 0xF 0x40)
491 (C5 0xF 0x40)]))
493 (defn play-music [music-bytes]
494 (let [program-target 0xC000
495 music-target 0xA000]
496 (-> (set-memory-range (second (music-base))
497 program-target (music-kernel))
498 (set-memory-range music-target music-bytes)
499 (PC! program-target))))
503 ;; (defn test-note [music-bytes]
504 ;; (-> (set-memory-range (second (music-base))
505 ;; 0xC000 (concat (clear-music-registers)
506 ;; (play-note)
507 ;; (infinite-loop)))
508 ;; (set-memory-range 0xD000 music-bytes)
509 ;; (PC! 0xC000)
510 ;; (HL! 0xD000)
511 ;; ))
514 (defn run-program
515 ([program]
516 (let [target 0xC000]
517 (-> (set-memory-range (second (music-base))
518 target program)
519 (PC! target)))))
521 (defn test-timer []
522 (flatten
523 [0x3E
524 0x01
525 0xE0
526 0x06 ;; set TMA to 0
528 0x3E
529 (Integer/parseInt "00000100" 2)
530 0xE0
531 0x07 ;; set TAC to 16384 Hz and activate timer
533 (repeat
534 500
535 [0xF0
536 0x05])]))