Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 427:fbccf46cf34d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sucessfully played third-kind.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 08:26:23 -0500
parents c03f28aa98d9
children 476f7da175a4
comparison
equal deleted inserted replaced
426:c03f28aa98d9 427:fbccf46cf34d
6 bootstrap-0 bootstrap-1)) 6 bootstrap-0 bootstrap-1))
7 (:require clojure.string) 7 (:require clojure.string)
8 (:import [com.aurellem.gb.gb_driver SaveState]) 8 (:import [com.aurellem.gb.gb_driver SaveState])
9 (:import java.io.File)) 9 (:import java.io.File))
10 10
11 11 (def third-kind
12 (File. "/home/r/proj/midi/third-kind.mid"))
13
14 (defn raw-midi-text [#^File midi-file]
15 (:out
16 (clojure.java.shell/sh
17 "midicsv"
18 (.getCanonicalPath midi-file)
19 "-")))
20
21 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
22
23 (defmulti parse-command :command)
24
25 (defn discard-args [command] (dissoc command :args))
26
27 (defmethod parse-command :Start_track
28 [command] (discard-args command))
29
30 (defmethod parse-command :End_track
31 [command] (discard-args command))
32
33 (defmethod parse-command :default
34 [command] command)
35
36 (defn parse-number-list
37 [number-list-str]
38 (map #(Integer/parseInt %)
39 (clojure.string/split number-list-str #", ")))
40
41 (defmethod parse-command :Tempo
42 [command]
43 (update-in command [:args] #(Integer/parseInt %)))
44
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}))
50
51 (defmethod parse-command :Note_on_c
52 [command]
53 (update-in command [:args] parse-midi-note-list))
54
55 (defmethod parse-command :Note_off_c
56 [command]
57 (update-in command [:args] parse-midi-note-list))
58
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})))
67
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})))
75
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)))))
89
12 (def music-base new-kernel) 90 (def music-base new-kernel)
13
14
15
16 91
17 (defn store [n address] 92 (defn store [n address]
18 (flatten 93 (flatten
19 [0xF5 94 [0xF5
20 0xE5 95 0xE5
31 0xF1])) 106 0xF1]))
32 107
33 (defn infinite-loop [] 108 (defn infinite-loop []
34 [0x18 0xFE]) 109 [0x18 0xFE])
35 110
36
37
38 (def divider-register 0xFF04) 111 (def divider-register 0xFF04)
39
40 112
41 (defrecord Bit-Note [frequency volume duration duty]) 113 (defrecord Bit-Note [frequency volume duration duty])
42 114
43 (defn clear-music-registers [] 115 (defn clear-music-registers []
44 (flatten 116 (flatten
90 ;; [new-duty] 162 ;; [new-duty]
91 163
92 (def note-code 0x00) 164 (def note-code 0x00)
93 (def change-duty-code 0x01) 165 (def change-duty-code 0x01)
94 (def silence-code 0x02) 166 (def silence-code 0x02)
95
96 167
97 (defn do-message 168 (defn do-message
98 "Read the message which starts at the current value of HL and do 169 "Read the message which starts at the current value of HL and do
99 what it says. Duration is left in A, and HL is advanced 170 what it says. Duration is left in A, and HL is advanced
100 appropraitely." 171 appropraitely."
248 [note-code 319 [note-code
249 volume&high-frequency 320 volume&high-frequency
250 low-frequency 321 low-frequency
251 duration])) 322 duration]))
252 323
324 (defn midi-code->frequency
325 [midi-code]
326 (* 8.1757989156
327 (Math/pow 2 (* (float (/ 12)) midi-code))))
328
329 ;; division == clock-pulses / quarter-note
330 ;; tempo == microseconds / quarter-note
331
332 ;; have: clock-pulses
333 ;; want: seconds
334
335
336
337
338 (defn midi->mini-midi [#^File midi-file]
339 (let [midi-events (parse-midi midi-file)
340
341 note-on-events
342 (filter #(= :Note_on_c (:command %)) midi-events)
343 note-off-events
344 (filter #(= :Note_off_c (:command %)) midi-events)
345
346 channel-1-on
347 (sort-by :time
348 (filter #(= 1 (:channel (:args %)))
349 note-on-events))
350 channel-1-off
351 (sort-by :time
352 (filter #(= 1 (:channel (:args %)))
353 note-off-events))
354
355
356 tempo (:args (first (filter #(= :Tempo (:command %)) midi-events)))
357 division (:division
358 (:args (first (filter #(= :Header (:command %)) midi-events))))
359 ]
360
361 (map
362 (fn [note-event]
363 (note-codes (:frequency note-event)
364 (:volume note-event)
365 (int (* (:duration note-event) 0x100))))
366
367 (map
368 (fn [note-on note-off]
369 {:frequency (midi-code->frequency (:note (:args note-on)))
370 :duration
371 (/ (* (/ tempo division)
372 (- (:time note-off) (:time note-on)))
373 1e6) ;; convert clock-pulses into seconds
374 :volume (int (/ (:velocity (:args note-on)) 10))
375 :time-stamp (/ (* (/ tempo division)
376 (:time note-on)) 1e6)})
377 channel-1-on channel-1-off))))
378
379
380
381
382
383
384
253 (def C4 (partial note-codes 261.63)) 385 (def C4 (partial note-codes 261.63))
254 (def D4 (partial note-codes 293.66)) 386 (def D4 (partial note-codes 293.66))
255 (def E4 (partial note-codes 329.63)) 387 (def E4 (partial note-codes 329.63))
256 (def F4 (partial note-codes 349.23)) 388 (def F4 (partial note-codes 349.23))
257 (def G4 (partial note-codes 392)) 389 (def G4 (partial note-codes 392))
312 (repeat 444 (repeat
313 500 445 500
314 [0xF0 446 [0xF0
315 0x05])])) 447 0x05])]))
316 448
317 (def third-kind 449
318 (File. "/home/r/proj/midi/third-kind.mid"))
319
320 (defn raw-midi-text [#^File midi-file]
321 (:out
322 (clojure.java.shell/sh
323 "midicsv"
324 (.getCanonicalPath midi-file)
325 "-")))
326
327 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
328
329 (defmulti parse-command :command)
330
331 (defn discard-args [command] (dissoc command :args))
332
333 (defmethod parse-command :Start_track
334 [command] (discard-args command))
335
336 (defmethod parse-command :End_track
337 [command] (discard-args command))
338
339 (defmethod parse-command :default
340 [command] command)
341
342 (defn parse-number-list
343 [number-list-str]
344 (map #(Integer/parseInt %)
345 (clojure.string/split number-list-str #", ")))
346
347 (defmethod parse-command :Tempo
348 [command]
349 (update-in command [:args] #(Integer/parseInt %)))
350
351 (defn parse-midi-note-list
352 [midi-note-list-str]
353 (let [[channel note velocity]
354 (parse-number-list midi-note-list-str)]
355 {:channel channel :note note :velocity velocity}))
356
357
358 (defmethod parse-command :Note_on_c
359 [command]
360 (update-in command [:args] parse-midi-note-list))
361
362 (defmethod parse-command :Note_off_c
363 [command]
364 (update-in command [:args] parse-midi-note-list))
365
366 (defmethod parse-command :Header
367 [command]
368 (let [args (:args command)
369 [format num-tracks division] (parse-number-list args)]
370 (assoc command :args
371 {:format format
372 :num-tracks num-tracks
373 :division division})))
374
375 (defmethod parse-command :Program_c
376 [command]
377 (let [args (:args command)
378 [channel program-num] (parse-number-list args)]
379 (assoc command :args
380 {:channel channel
381 :program-num program-num})))
382
383
384 (defn parse-midi [#^File midi-file]
385 (map
386 (comp parse-command
387 (fn [line]
388 (let [[[_ channel time command args]]
389 (re-seq command-line line)]
390 ;;(println (re-seq command-parse-1 line))
391 {:channel (Integer/parseInt channel)
392 :time (Integer/parseInt time)
393 :command (keyword command)
394 :args (apply str (drop 2 args))})))
395 (drop-last
396 (clojure.string/split-lines
397 (raw-midi-text midi-file)))))
398