vba-clojure: clojure/com/aurellem/run/music.clj comparison

comparison 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

comparison

equal deleted inserted replaced

-:1bc26d1826e5
+:f6b5a1914efa
 bootstrap-0 bootstrap-1))
 (:require clojure.string)
 (:import [com.aurellem.gb.gb_driver SaveState])
 (:import java.io.File))
-(def third-kind
+(def pony
-(File. "/home/r/proj/midi/third-kind.mid"))
+(File. user-home "/proj/vba-clojure/music/pony-title.mid"))
+(def pony-csv
+(File. user-home "proj/vba-clojure/music/pony-title.csv"))
+(def sync-test
+(File. user-home "proj/vba-clojure/music/sync-test.mid"))
+(def drum-test
+(File. user-home "proj/vba-clojure/music/drum-test.mid"))
+(def regret
+(File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.mid"))
+(def regret-csv
+(File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.csv"))
+(def mother
+(File. user-home "proj/vba-clojure/music/mother.mid"))
+(def mother-csv
+(File. user-home "proj/vba-clojure/music/mother.csv"))
 (defn raw-midi-text [#^File midi-file]
-(:out
+(let [extention (apply str (take-last 3 (.getCanonicalPath
-(clojure.java.shell/sh
+midi-file)))]
-"midicsv"
+(cond (= "mid" extention)
-(.getCanonicalPath midi-file)
+(:out
-"-")))
+(clojure.java.shell/sh
+"midicsv"
+(.getCanonicalPath midi-file)
+"-"))
+(= "csv" extention)
+(slurp midi-file))))
 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
 (defmulti parse-command :command)
 (defn do-message
 "Read the message which starts at the current value of HL and do
 what it says. Duration is left in A, and HL is advanced
 appropraitely."
-([] (do-message 0x16))
+([] (do-message 0x16 1))
-([sound-base-address]
+([sound-base-address wave-duty]
+(assert (<= 0 wave-duty 3))
 (let [switch
 [0x2A ;; load message code into A, increment HL
 ;; switch on message
 0xFE
 0x20
 :note-length]
 play-note
-[0x2A   ;; load volume/frequency-high info
+[0x3E ;; set wave-duty
+(bit-shift-left wave-duty 6)
+0xE0
+sound-base-address
+0x2A   ;; load volume/frequency-high info
 0xF5   ;; push A
 0xE6
 (Integer/parseInt "11110000" 2) ;; volume mask
 0xE0
 (inc sound-base-address) ;;0x17   ;; set volume
 0x2A]]   ;; load duration
 (replace
 {:note-length (count play-note)}
 (concat switch play-note)))))
+(defn play-noise
+"read [noise-code, volume,  duration] and play the noise. Duration is left in
+A, and HL is advanced appropraitely."
+([]
+[0x2A  ;; load noise-code into A
+0xE0
+0x22  ;; write noise-code
+0x2A  ;; load volume
+0xE0
+0x21  ;; write volume
+0x2A] ;; load duration into A
+))
 ;; (defn play-note
 ;;   "Play the note referenced by HL in the appropiate channel.
 ;;    Leaves desired-duration in A."
 ;;   [0x2A   ;; load volume/frequency-high info
 ;;    0x18   ;; set frequency-low-bits
 ;;    0x2A   ;; load duration
 ;;    ])
-(defn music-step [sound-base-address]
+(defn music-step [sound-base-address wave-duty noise?]
 ;; C == current-ticks
 ;; A == desired-ticks
 (flatten
 [;; restore variables from stack
 0xB9 ;; compare with current ticks
 ;; if desired-ticks = current ticks
 ;;   go to next note ; set current set ticks to 0.
-0x20
+(if noise?
-(+ (count (do-message 0)) 2)
+[0x20
+(+ 2 (count (play-noise)))
-(do-message sound-base-address)
+(play-noise)]
+[0x20
+(+ (count (do-message 0 0)) 2)
+(do-message sound-base-address wave-duty)])
 0x0E
 0x00 ;; 0->C (current-ticks)
 ;; save variables to stack
 ]))
 (def music-1 0x11)
 (def music-2 0x16)
-(defn music-kernel []
+(defn music-kernel [wave-duty-1 wave-duty-2]
 (flatten
 [;; global initilization section
 (clear-music-registers)
 0x3E
 0xF5 ;; push AF
 0xC5 ;; push CB
 0xE5 ;; push HL
+;; initialize frame 3 (noise)
+0x21
+0x00
+0xA9 ;; 0xA9OO -> HL
+0xF5 ;; push AF
+0xC5 ;; push CB
+0xE5 ;; push HL
 ;; main music loop
-0xE8 ;; SP + 6; activate frame 1
+0xE8 ;; SP + 12; activate frame 1
-6
+12
-(music-step music-1)
+(music-step music-1 wave-duty-1 false)
-;;(repeat (count (music-step music-1)) 0x00)
 0xE8 ;; SP - 6; activate frame 2
 (->signed-8-bit -6)
-;;(repeat (count (music-step music-2)) 0x00)
+(music-step music-2 wave-duty-2 false)
-(music-step music-2)
+0xE8 ;; SP - 6;  activate frame 3
+(->signed-8-bit -6)
+(music-step nil nil true)
 0x18
 (->signed-8-bit (+
 ;; two music-steps
-(- (* 2 (count (music-step 0))))
+(- (* 2 (count (music-step 0 0 false))))
+(- (count (music-step nil nil true)))
 -2 ;; this jump instruction
 -2 ;; activate frame 1
 -2 ;; activate frame 2
+-2 ;; activate frame 3
 ))]))
 (defn frequency-code->frequency
 [code]
 (assert (<= 0 code 2047))
 (defn commands
 "return all events where #(= (:command %) command)"
 [command s]
 (filter #(= command (:command %)) s))
-(defn midi-track->mini-midi [#^File midi-file track-num]
+(defn track-info [#^File midi-file]
-(let [midi-events (parse-midi midi-file)
+(let [events (parse-midi midi-file)
+track-titles (commands :Title_t events)
+track-info
+(map #(read-string (read-string (:args %))) track-titles)
+track-map
+(zipmap track-info track-titles)]
+track-map))
+(defn target-tracks
+"return the track-numbers in the form [voice-0 voice-1 noise]"
+[#^File midi-file]
+(let [track-data (track-info midi-file)
+track-order
+(zipmap (map :out (keys track-data))
+(vals track-data))
+channel-nums (map (comp :channel track-order) (range 3))]
+channel-nums))
+(defn midi-track->abstract-mini-midi
+[#^File midi-file track-num]
+(let [midi-events (parse-midi midi-file)
 note-on-events  (commands :Note_on_c  midi-events)
 note-off-events (commands :Note_off_c midi-events)
 select-channel
 (fn [n s]
-(sort-by :time (filter #(= n (:channel (:args %))) s)))
+(sort-by :time (filter #(= n (:channel %)) s)))
 channel-on (select-channel track-num note-on-events)
 channel-off (select-channel track-num note-off-events)
 notes
 (map
 (fn [note-on note-off]
 {:frequency (midi-code->frequency (:note (:args note-on)))
+:midi-code (:note (:args note-on))
 :duration
 (/ (* (/ tempo division)
 (- (:time note-off) (:time note-on)))
 1e6) ;; convert clock-pulses into seconds
 :volume (int (/ (:velocity (:args note-on)) 10))
 (concat [(assoc (silence 0)
 :time-stamp 0)] notes)
 notes)
 notes-with-silence
-(filter (comp not zero? :duration)
+(concat
-(interleave silences notes))]
+(filter (comp not zero? :duration)
+(interleave silences notes))
+[(silence 3)])]
+notes-with-silence))
+(defn midi-track->mini-midi-voice [#^File midi-file track-num]
+(let [abstract-mini-midi
+(midi-track->abstract-mini-midi midi-file track-num)]
+(map
+(fn [note-event]
+(note-codes (:frequency note-event)
+(:volume note-event)
+(int (* (:duration note-event) 0x100))))
+abstract-mini-midi)))
+(def midi-code->gb-noise-code
+{nil 0xFF
+35 87
+38 20
+39 0
+})
+(defn noise-codes [code volume duration]
+(assert (<= 0 volume 0xF))
+(if (<= duration 0xFF)
+[(midi-code->gb-noise-code code code)
+(bit-shift-left volume 4)
+duration]
+(vec
+(flatten
+[(noise-codes code volume 0xFF)
+(noise-codes code volume (- duration 0xFF))]))))
+(defn midi-track->mini-midi-noise [#^File midi-file track-num]
+(let [abstract-mini-midi
+(midi-track->abstract-mini-midi midi-file track-num)]
 (map
-(fn [note-event]
+(fn [noise-event]
-(note-codes (:frequency note-event)
+(noise-codes (:midi-code noise-event)
-(:volume note-event)
+(:volume noise-event)
-(int (* (:duration note-event) 0x100))))
+(int (* (:duration noise-event) 0x100))))
-notes-with-silence)))
+abstract-mini-midi)))
 (defn midi->mini-midi [#^File midi-file]
-{:track-1 (flatten (midi-track->mini-midi midi-file 1))
+(let [targets (target-tracks midi-file)
-:track-2 (flatten (midi-track->mini-midi midi-file 2))})
+duty-info (keys (track-info midi-file))]
+{:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
+:voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
+:noise   (midi-track->mini-midi-noise midi-file (nth targets 2))
+:duty    (zipmap (map :out duty-info)
+(map #(get % :duty 0) duty-info))}))
 (defn play-midi [#^File midi-file]
-(let [track-1-target 0xA000
+(let [voice-1-target 0xA000
-track-2-target 0xB000
+voice-2-target 0xB000
+noise-target   0xA900
 program-target 0xC000
 mini-midi (midi->mini-midi midi-file)
-long-silence (flatten (note-codes 20 0 9001))]
+long-silence (flatten (note-codes 20 0 20001))
+long-noise-silence
+(interleave (range 500) (repeat 0x00) (repeat 255))
+voice-1 (flatten (:voice-1 mini-midi))
+wave-duty-1 ((:duty mini-midi) 0 0)
+voice-2 (flatten (:voice-2 mini-midi))
+wave-duty-2 ((:duty mini-midi) 1 0)
+noise (flatten (:noise mini-midi))
+]
 (-> (second (music-base))
-(set-memory-range track-1-target long-silence)
+(set-memory-range voice-1-target long-silence)
-(set-memory-range track-2-target long-silence)
+(set-memory-range voice-2-target long-silence)
-(set-memory-range track-1-target (:track-1 mini-midi))
+(set-memory-range noise-target   long-noise-silence)
-(set-memory-range track-2-target (:track-2 mini-midi))
+(set-memory-range voice-1-target voice-1)
-(set-memory-range program-target (music-kernel))
+(set-memory-range voice-2-target voice-2)
+(set-memory-range noise-target   noise)
+(set-memory-range
+program-target
+(music-kernel wave-duty-1 wave-duty-2))
 (PC! program-target))))
+(defn test-noise []
+(let [noise-pattern
+(concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
+(interleave (range 10) (repeat 0x00) (repeat 255)))]
+(-> (second (music-base))
+(set-memory-range 0xA900 (flatten noise-pattern))
+(set-memory-range 0xC000 (music-kernel 0 0))
+(PC! 0xC000))))
+(defn test-play-noise [noise-code]
+(Thread/sleep 300)
+(println "playing noise:" noise-code)
+(run-moves
+(let [noise-pattern
+(interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
+(-> (second (music-base))
+(set-memory-range 0xA900 (flatten noise-pattern))
+(set-memory-range 0xC000 (music-kernel 0 0))
+(PC! 0xC000)))
+(repeat 20 [])))
+(defn test-all-noises []
+(dorun (map test-play-noise (range 0x100))))
 (def C4 (partial note-codes 261.63))
 (def D4 (partial note-codes 293.66))
 (def E4 (partial note-codes 329.63))
 (def F4 (partial note-codes 349.23))
 (-> (set-memory-range (second (music-base))
 program-target (music-kernel))
 (set-memory-range music-target music-bytes)
 (PC! program-target))))
-;; (defn test-note [music-bytes]
-;;   (-> (set-memory-range (second (music-base))
-;;                         0xC000 (concat (clear-music-registers)
-;;                                        (play-note)
-;;                                        (infinite-loop)))
-;;       (set-memory-range 0xD000 music-bytes)
-;;       (PC! 0xC000)
-;;       (HL! 0xD000)
-;;       ))
 (defn run-program
 ([program]
 (let [target 0xC000]
 (-> (set-memory-range (second (music-base))
 target program)
 (repeat
 500
 [0xF0
 0x05])]))
+(defn play-pony []
+(println "playing" (.getName pony-csv))
+(run-moves (play-midi pony-csv) (repeat 1800 [])))
+(defn play-regret []
+(println "playing" (.getName regret-csv))
+(run-moves (play-midi regret-csv) (repeat 3380 [])))
+(defn play-mother []
+(println "playing" (.getName mother-csv))
+(run-moves (play-midi mother-csv) (repeat 2200 [])))
+(defn demo [] (play-mother) (play-regret) (play-pony))

Mercurial > vba-clojure

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