Mercurial > vba-clojure
view clojure/com/aurellem/run/music.clj @ 469:396065930208
remove useless :duty from drum track.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 04 May 2012 06:15:47 -0500 |
parents | 85d9fa354f0b |
children | f28a3baa4c56 |
line wrap: on
line source
1 (ns com.aurellem.run.music2 (:use (com.aurellem.gb saves gb-driver util constants3 items vbm characters money4 rlm-assembly))5 (:use (com.aurellem.run util title save-corruption6 bootstrap-0 bootstrap-1))7 (:require clojure.string)8 (:import [com.aurellem.gb.gb_driver SaveState])9 (:import java.io.File))11 (def third-kind12 (File. "/home/r/proj/midi/third-kind.mid"))14 (def pony15 (File. "/home/r/proj/vba-clojure/music/pony-title.mid"))17 (def sync-test18 (File. "/home/r/proj/vba-clojure/music/sync-test.mid"))20 (def drum-test21 (File. "/home/r/proj/vba-clojure/music/drum-test.mid"))24 (defn raw-midi-text [#^File midi-file]25 (:out26 (clojure.java.shell/sh27 "midicsv"28 (.getCanonicalPath midi-file)29 "-")))31 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")33 (defmulti parse-command :command)35 (defn discard-args [command] (dissoc command :args))37 (defmethod parse-command :Start_track38 [command] (discard-args command))40 (defmethod parse-command :End_track41 [command] (discard-args command))43 (defmethod parse-command :default44 [command] command)46 (defn parse-number-list47 [number-list-str]48 (map #(Integer/parseInt %)49 (clojure.string/split number-list-str #", ")))51 (defmethod parse-command :Tempo52 [command]53 (update-in command [:args] #(Integer/parseInt %)))55 (defn parse-midi-note-list56 [midi-note-list-str]57 (let [[channel note velocity]58 (parse-number-list midi-note-list-str)]59 {:channel channel :note note :velocity velocity}))61 (defmethod parse-command :Note_on_c62 [command]63 (update-in command [:args] parse-midi-note-list))65 (defmethod parse-command :Note_off_c66 [command]67 (update-in command [:args] parse-midi-note-list))69 (defmethod parse-command :Header70 [command]71 (let [args (:args command)72 [format num-tracks division] (parse-number-list args)]73 (assoc command :args74 {:format format75 :num-tracks num-tracks76 :division division})))78 (defmethod parse-command :Program_c79 [command]80 (let [args (:args command)81 [channel program-num] (parse-number-list args)]82 (assoc command :args83 {:channel channel84 :program-num program-num})))86 (defn parse-midi [#^File midi-file]87 (map88 (comp parse-command89 (fn [line]90 (let [[[_ channel time command args]]91 (re-seq command-line line)]92 {:channel (Integer/parseInt channel)93 :time (Integer/parseInt time)94 :command (keyword command)95 :args (apply str (drop 2 args))})))96 (drop-last97 (clojure.string/split-lines98 (raw-midi-text midi-file)))))100 (def music-base new-kernel)102 (defn store [n address]103 (flatten104 [0xF5105 0xE5107 0x3E108 n110 0x21111 (reverse (disect-bytes-2 address))113 0x77115 0xE1116 0xF1]))118 (defn infinite-loop []119 [0x18 0xFE])121 (def divider-register 0xFF04)123 (defrecord Bit-Note [frequency volume duration duty])125 (defn clear-music-registers []126 (flatten127 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep128 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty129 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume130 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low131 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high133 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000134 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000135 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low136 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high138 (store (Integer/parseInt "00000000" 2) 0xFF1A)139 (store (Integer/parseInt "00000000" 2) 0xFF1B)140 (store (Integer/parseInt "00000000" 2) 0xFF1C)141 (store (Integer/parseInt "00000000" 2) 0xFF1D)142 (store (Integer/parseInt "00000000" 2) 0xFF1E)144 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length145 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume146 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency147 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control148 ]))151 ;; mini-midi syntax153 ;; codes154 ;; note-code == 0x00155 ;; change-duty-code = 0x01156 ;; silence-code = 0x02158 ;; silence format159 ;; 2 bytes160 ;; [silence-code (0x02)]161 ;; [duration-8-bits]163 ;; note data format164 ;; 4 bytes165 ;; [note-code (0x00)]166 ;; [volume-4-bits 0 frequency-high-3-bits]167 ;; [frequengy-low-8-bits]168 ;; [duration-8-bits]170 ;; change-duty-format171 ;; 2 bytes172 ;; [change-duty-code (0x01)]173 ;; [new-duty]175 (def note-code 0x00)176 (def change-duty-code 0x01)177 (def silence-code 0x02)179 (defn do-message180 "Read the message which starts at the current value of HL and do181 what it says. Duration is left in A, and HL is advanced182 appropraitely."183 ([] (do-message 0x16 1))184 ([sound-base-address wave-duty]185 (assert (<= 0 wave-duty 3))186 (let [switch187 [0x2A ;; load message code into A, increment HL189 ;; switch on message190 0xFE191 note-code193 0x20194 :note-length]196 play-note197 [0x3E ;; set wave-duty198 (bit-shift-left wave-duty 6)199 0xE0200 sound-base-address201 0x2A ;; load volume/frequency-high info202 0xF5 ;; push A203 0xE6204 (Integer/parseInt "11110000" 2) ;; volume mask205 0xE0206 (inc sound-base-address) ;;0x17 ;; set volume207 0xF1 ;; pop A208 0xE6209 (Integer/parseInt "00000111" 2) ;; frequency-high mask210 0xE0211 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high213 0x2A ;; load frequency low-bits214 0xE0215 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits216 0x2A]] ;; load duration217 (replace218 {:note-length (count play-note)}219 (concat switch play-note)))))221 (defn play-noise222 "read [noise-code, volume, duration] and play the noise. Duration is left in223 A, and HL is advanced appropraitely."224 ([]225 [0x2A ;; load noise-code into A226 0xE0227 0x22 ;; write noise-code229 0x2A ;; load volume230 0xE0231 0x21 ;; write volume233 0x2A] ;; load duration into A234 ))237 ;; (defn play-note238 ;; "Play the note referenced by HL in the appropiate channel.239 ;; Leaves desired-duration in A."241 ;; [0x2A ;; load volume/frequency-high info242 ;; 0xF5 ;; push A243 ;; 0xE6244 ;; (Integer/parseInt "11110000" 2) ;; volume mask245 ;; 0xE0246 ;; 0x17 ;; set volume247 ;; 0xF1 ;; pop A248 ;; 0xE6249 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask250 ;; 0xE0251 ;; 0x19 ;; set frequency-high253 ;; 0x2A ;; load frequency low-bits254 ;; 0xE0255 ;; 0x18 ;; set frequency-low-bits257 ;; 0x2A ;; load duration258 ;; ])260 (defn music-step [sound-base-address wave-duty noise?]261 ;; C == current-ticks262 ;; A == desired-ticks264 (flatten265 [;; restore variables from stack266 0xE1 ;; pop HL267 0xC1 ;; pop CB268 0xF1 ;; pop AF271 0xF5 ;; push A272 0xF0273 0x05 ;; load current ticks from 0xF005274 0xB8 ;;275 0x30 ;; increment C only if last result caused carry276 0x01277 0x0C279 0x47 ;; update sub-ticks (A->B)281 0xF1 ;; pop AF, now A contains desired-ticks283 0xB9 ;; compare with current ticks285 ;; if desired-ticks = current ticks286 ;; go to next note ; set current set ticks to 0.288 (if noise?289 [0x20290 (+ 2 (count (play-noise)))291 (play-noise)]293 [0x20294 (+ (count (do-message 0 0)) 2)295 (do-message sound-base-address wave-duty)])297 0x0E298 0x00 ;; 0->C (current-ticks)300 ;; save variables to stack301 0xF5 ;; push AF302 0xC5 ;; push CB303 0xE5 ;; push HL306 ]))308 (def music-1 0x11)309 (def music-2 0x16)311 (defn music-kernel [wave-duty-1 wave-duty-2]312 (flatten313 [;; global initilization section314 (clear-music-registers)316 0x3E317 0x01318 0xE0319 0x06 ;; set TMA to 0321 0x3E322 (Integer/parseInt "00000110" 2)323 0xE0324 0x07 ;; set TAC to 65536 Hz and activate timer326 ;; initialize frame 1327 0x21328 0x00329 0xA0 ;; set HL to 0xA000 == music-start 1330 0x0E331 0x00 ;; 0->C332 0x06333 0x00 ;; 0->B335 0xAF ;; 0->A337 0xF5 ;; push AF338 0xC5 ;; push CB339 0xE5 ;; push HL341 ;; initialize frame 2342 0x21343 0x00344 0xB0 ;; set HL to 0xB000 == music-start 2346 0xF5 ;; push AF347 0xC5 ;; push CB348 0xE5 ;; push HL351 ;; initialize frame 3 (noise)352 0x21353 0x00354 0xA9 ;; 0xA9OO -> HL356 0xF5 ;; push AF357 0xC5 ;; push CB358 0xE5 ;; push HL360 ;; main music loop362 0xE8 ;; SP + 12; activate frame 1363 12364 (music-step music-1 wave-duty-1 false)366 0xE8 ;; SP - 6; activate frame 2367 (->signed-8-bit -6)368 (music-step music-2 wave-duty-2 false)370 0xE8 ;; SP - 6; activate frame 3371 (->signed-8-bit -6)372 (music-step nil nil true)374 0x18375 (->signed-8-bit (+376 ;; two music-steps377 (- (* 2 (count (music-step 0 0 false))))378 (- (count (music-step nil nil true)))379 -2 ;; this jump instruction380 -2 ;; activate frame 1381 -2 ;; activate frame 2382 -2 ;; activate frame 3383 ))]))385 (defn frequency-code->frequency386 [code]387 (assert (<= 0 code 2047))388 (/ 131072 (- 2048 code)))390 (defn clamp [x low high]391 (cond (> x high) high392 (< x low) low393 true x))395 (defn frequency->frequency-code396 [frequency]397 (clamp398 (Math/round399 (float400 (/ (- (* 2048 frequency) 131072) frequency)))401 0x00 2048))403 (defn note-codes [frequency volume duration]404 (assert (<= 0 volume 0xF))405 (if (<= duration 0xFF)406 (let [frequency-code407 (frequency->frequency-code frequency)408 volume&high-frequency409 (+ (bit-shift-left volume 4)410 (bit-shift-right frequency-code 8))411 low-frequency412 (bit-and 0xFF frequency-code)]413 [note-code414 volume&high-frequency415 low-frequency416 duration])417 (vec418 (flatten419 [(note-codes frequency volume 0xFF)420 (note-codes frequency volume (- duration 0xFF))]))))423 (defn midi-code->frequency424 [midi-code]425 (* 8.1757989156426 (Math/pow 2 (* (float (/ 12)) midi-code))))428 ;; division == clock-pulses / quarter-note429 ;; tempo == microseconds / quarter-note431 ;; have: clock-pulses432 ;; want: seconds435 (defn silence [length]436 {:frequency 1437 :duration length438 :volume 0})440 (defn commands441 "return all events where #(= (:command %) command)"442 [command s]443 (filter #(= command (:command %)) s))445 (defn track-info [#^File midi-file]446 (let [events (parse-midi midi-file)447 track-titles (commands :Title_t events)448 track-info449 (map #(read-string (read-string (:args %))) track-titles)450 track-map451 (zipmap track-info track-titles)]452 track-map))454 (defn target-tracks455 "return the track-numbers in the form [voice-0 voice-1 noise]"456 [#^File midi-file]457 (let [track-data (track-info midi-file)458 track-order459 (zipmap (map :out (keys track-data))460 (vals track-data))461 channel-nums (map (comp :channel track-order) (range 3))]462 channel-nums))464 (defn midi-track->abstract-mini-midi465 [#^File midi-file track-num]466 (let [midi-events (parse-midi midi-file)468 note-on-events (commands :Note_on_c midi-events)469 note-off-events (commands :Note_off_c midi-events)471 select-channel472 (fn [n s]473 (sort-by :time (filter #(= n (:channel %)) s)))475 channel-on (select-channel track-num note-on-events)477 channel-off (select-channel track-num note-off-events)480 tempo (:args (first (commands :Tempo midi-events)))481 division482 (:division (:args (first (commands :Header midi-events))))484 notes485 (map486 (fn [note-on note-off]487 {:frequency (midi-code->frequency (:note (:args note-on)))488 :midi-code (:note (:args note-on))489 :duration490 (/ (* (/ tempo division)491 (- (:time note-off) (:time note-on)))492 1e6) ;; convert clock-pulses into seconds493 :volume (int (/ (:velocity (:args note-on)) 10))494 :time-stamp (/ (* (/ tempo division)495 (:time note-on)) 1e6)})496 channel-on channel-off)498 silences499 (map (fn [note-1 note-2]500 (let [note-1-space (- (:time-stamp note-2)501 (:time-stamp note-1))502 note-1-length (:duration note-1)]503 (silence (- note-1-space note-1-length))))504 ;; to handle silence at the beginning.505 (concat [(assoc (silence 0)506 :time-stamp 0)] notes)507 notes)509 notes-with-silence510 (concat511 (filter (comp not zero? :duration)512 (interleave silences notes))513 [(silence 3)])]514 notes-with-silence))516 (defn midi-track->mini-midi-voice [#^File midi-file track-num]517 (let [abstract-mini-midi518 (midi-track->abstract-mini-midi midi-file track-num)]519 (map520 (fn [note-event]521 (note-codes (:frequency note-event)522 (:volume note-event)523 (int (* (:duration note-event) 0x100))))524 abstract-mini-midi)))526 (def midi-code->gb-noise-code527 {nil 0xFF528 35 87529 38 20530 39 0531 })534 (defn noise-codes [code volume duration]535 (assert (<= 0 volume 0xF))536 (if (<= duration 0xFF)537 [(midi-code->gb-noise-code code code)538 (bit-shift-left volume 4)539 duration]540 (vec541 (flatten542 [(noise-codes code volume 0xFF)543 (noise-codes code volume (- duration 0xFF))]))))545 (defn midi-track->mini-midi-noise [#^File midi-file track-num]546 (let [abstract-mini-midi547 (midi-track->abstract-mini-midi midi-file track-num)]548 (map549 (fn [noise-event]550 (noise-codes (:midi-code noise-event)551 (:volume noise-event)552 (int (* (:duration noise-event) 0x100))))553 abstract-mini-midi)))556 (defn midi->mini-midi [#^File midi-file]557 (let [targets (target-tracks midi-file)558 duty-info (keys (track-info midi-file))]560 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))561 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))562 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))563 :duty (zipmap (map :out duty-info)564 (map #(get % :duty 0) duty-info))}))566 (defn play-midi [#^File midi-file]567 (let [voice-1-target 0xA000568 voice-2-target 0xB000569 noise-target 0xA900570 program-target 0xC000571 mini-midi (midi->mini-midi midi-file)572 long-silence (flatten (note-codes 20 0 20001))573 long-noise-silence574 (interleave (range 500) (repeat 0x00) (repeat 255))576 voice-1 (flatten (:voice-1 mini-midi))577 wave-duty-1 ((:duty mini-midi) 0 0)579 voice-2 (flatten (:voice-2 mini-midi))580 wave-duty-2 ((:duty mini-midi) 1 0)582 noise (flatten (:noise mini-midi))583 ]585 (-> (second (music-base))586 (set-memory-range voice-1-target long-silence)587 (set-memory-range voice-2-target long-silence)588 (set-memory-range noise-target long-noise-silence)589 (set-memory-range voice-1-target voice-1)590 (set-memory-range voice-2-target voice-2)591 (set-memory-range noise-target noise)592 (set-memory-range593 program-target594 (music-kernel wave-duty-1 wave-duty-2))595 (PC! program-target))))597 (defn test-noise []598 (let [noise-pattern599 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))600 (interleave (range 10) (repeat 0x00) (repeat 255)))]602 (-> (second (music-base))603 (set-memory-range 0xA900 (flatten noise-pattern))604 (set-memory-range 0xC000 (music-kernel 0 0))605 (PC! 0xC000))))607 (defn test-play-noise [noise-code]608 (Thread/sleep 300)609 (println "playing noise:" noise-code)610 (run-moves611 (let [noise-pattern612 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]613 (-> (second (music-base))614 (set-memory-range 0xA900 (flatten noise-pattern))615 (set-memory-range 0xC000 (music-kernel 0 0))616 (PC! 0xC000)))617 (repeat 20 [])))619 (defn test-all-noises []620 (dorun (map test-play-noise (range 0x100))))622 (def C4 (partial note-codes 261.63))623 (def D4 (partial note-codes 293.66))624 (def E4 (partial note-codes 329.63))625 (def F4 (partial note-codes 349.23))626 (def G4 (partial note-codes 392))627 (def A4 (partial note-codes 440))628 (def B4 (partial note-codes 493.88))629 (def C5 (partial note-codes 523.3))631 (def scale632 (flatten633 [(C4 0xF 0x40)634 (D4 0xF 0x40)635 (E4 0xF 0x40)636 (F4 0xF 0x40)637 (G4 0xF 0x40)638 (A4 0xF 0x40)639 (B4 0xF 0x40)640 (C5 0xF 0x40)]))642 (defn play-music [music-bytes]643 (let [program-target 0xC000644 music-target 0xA000]645 (-> (set-memory-range (second (music-base))646 program-target (music-kernel))647 (set-memory-range music-target music-bytes)648 (PC! program-target))))650 (defn run-program651 ([program]652 (let [target 0xC000]653 (-> (set-memory-range (second (music-base))654 target program)655 (PC! target)))))657 (defn test-timer []658 (flatten659 [0x3E660 0x01661 0xE0662 0x06 ;; set TMA to 0664 0x3E665 (Integer/parseInt "00000100" 2)666 0xE0667 0x07 ;; set TAC to 16384 Hz and activate timer669 (repeat670 500671 [0xF0672 0x05])]))