Mercurial > vba-clojure
view clojure/com/aurellem/run/music.clj @ 520:fe2b9a1fe919
reduced colors in pinkie pie mark to exactly 4.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 23 Jun 2012 17:22:32 -0500 |
parents | a6d060a64246 |
children | 2de44c6184ee |
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 pony12 (File. user-home "/proj/vba-clojure/music/pony-title.mid"))14 (def pony-csv15 (File. user-home "proj/vba-clojure/music/pony-title.csv"))17 (def sync-test18 (File. user-home "proj/vba-clojure/music/sync-test.mid"))20 (def drum-test21 (File. user-home "proj/vba-clojure/music/drum-test.mid"))23 (def regret24 (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.mid"))26 (def regret-csv27 (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.csv"))29 (def mother30 (File. user-home "proj/vba-clojure/music/mother.mid"))32 (def mother-csv33 (File. user-home "proj/vba-clojure/music/mother.csv"))36 (defn raw-midi-text [#^File midi-file]37 (let [extention (apply str (take-last 3 (.getCanonicalPath38 midi-file)))]39 (cond (= "mid" extention)40 (:out41 (clojure.java.shell/sh42 "midicsv"43 (.getCanonicalPath midi-file)44 "-"))45 (= "csv" extention)46 (slurp midi-file))))48 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")50 (defmulti parse-command :command)52 (defn discard-args [command] (dissoc command :args))54 (defmethod parse-command :Start_track55 [command] (discard-args command))57 (defmethod parse-command :End_track58 [command] (discard-args command))60 (defmethod parse-command :default61 [command] command)63 (defn parse-number-list64 [number-list-str]65 (map #(Integer/parseInt %)66 (clojure.string/split number-list-str #", ")))68 (defmethod parse-command :Tempo69 [command]70 (update-in command [:args] #(Integer/parseInt %)))72 (defn parse-midi-note-list73 [midi-note-list-str]74 (let [[channel note velocity]75 (parse-number-list midi-note-list-str)]76 {:channel channel :note note :velocity velocity}))78 (defmethod parse-command :Note_on_c79 [command]80 (update-in command [:args] parse-midi-note-list))82 (defmethod parse-command :Note_off_c83 [command]84 (update-in command [:args] parse-midi-note-list))86 (defmethod parse-command :Header87 [command]88 (let [args (:args command)89 [format num-tracks division] (parse-number-list args)]90 (assoc command :args91 {:format format92 :num-tracks num-tracks93 :division division})))95 (defmethod parse-command :Program_c96 [command]97 (let [args (:args command)98 [channel program-num] (parse-number-list args)]99 (assoc command :args100 {:channel channel101 :program-num program-num})))103 (defn parse-midi [#^File midi-file]104 (map105 (comp parse-command106 (fn [line]107 (let [[[_ channel time command args]]108 (re-seq command-line line)]109 {:channel (Integer/parseInt channel)110 :time (Integer/parseInt time)111 :command (keyword command)112 :args (apply str (drop 2 args))})))113 (drop-last114 (clojure.string/split-lines115 (raw-midi-text midi-file)))))117 (def music-base new-kernel)119 (defn store [n address]120 (flatten121 [0xF5122 0xE5124 0x3E125 n127 0x21128 (reverse (disect-bytes-2 address))130 0x77132 0xE1133 0xF1]))135 (defn infinite-loop []136 [0x18 0xFE])138 (def divider-register 0xFF04)140 (defrecord Bit-Note [frequency volume duration duty])142 (defn clear-music-registers []143 (flatten144 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep145 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty146 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume147 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low148 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high150 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000151 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000152 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low153 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high155 (store (Integer/parseInt "00000000" 2) 0xFF1A)156 (store (Integer/parseInt "00000000" 2) 0xFF1B)157 (store (Integer/parseInt "00000000" 2) 0xFF1C)158 (store (Integer/parseInt "00000000" 2) 0xFF1D)159 (store (Integer/parseInt "00000000" 2) 0xFF1E)161 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length162 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume163 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency164 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control165 ]))168 ;; mini-midi syntax170 ;; codes171 ;; note-code == 0x00172 ;; change-duty-code = 0x01173 ;; silence-code = 0x02175 ;; silence format176 ;; 2 bytes177 ;; [silence-code (0x02)]178 ;; [duration-8-bits]180 ;; note data format181 ;; 4 bytes182 ;; [note-code (0x00)]183 ;; [volume-4-bits 0 frequency-high-3-bits]184 ;; [frequengy-low-8-bits]185 ;; [duration-8-bits]187 ;; change-duty-format188 ;; 2 bytes189 ;; [change-duty-code (0x01)]190 ;; [new-duty]192 (def note-code 0x00)193 (def change-duty-code 0x01)194 (def silence-code 0x02)196 (defn do-message197 "Read the message which starts at the current value of HL and do198 what it says. Duration is left in A, and HL is advanced199 appropraitely."200 ([] (do-message 0x16 1))201 ([sound-base-address wave-duty]202 (assert (<= 0 wave-duty 3))203 (let [switch204 [0x2A ;; load message code into A, increment HL206 ;; switch on message207 0xFE208 note-code210 0x20211 :note-length]213 play-note214 [0x3E ;; set wave-duty215 (bit-shift-left wave-duty 6)216 0xE0217 sound-base-address218 0x2A ;; load volume/frequency-high info219 0xF5 ;; push A220 0xE6221 (Integer/parseInt "11110000" 2) ;; volume mask222 0xE0223 (inc sound-base-address) ;;0x17 ;; set volume224 0xF1 ;; pop A225 0xE6226 (Integer/parseInt "00000111" 2) ;; frequency-high mask227 0xE0228 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high230 0x2A ;; load frequency low-bits231 0xE0232 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits233 0x2A]] ;; load duration234 (replace235 {:note-length (count play-note)}236 (concat switch play-note)))))238 (defn play-noise239 "read [noise-code, volume, duration] and play the noise. Duration is left in240 A, and HL is advanced appropraitely."241 ([]242 [0x2A ;; load noise-code into A243 0xE0244 0x22 ;; write noise-code246 0x2A ;; load volume247 0xE0248 0x21 ;; write volume250 0x2A] ;; load duration into A251 ))254 ;; (defn play-note255 ;; "Play the note referenced by HL in the appropiate channel.256 ;; Leaves desired-duration in A."258 ;; [0x2A ;; load volume/frequency-high info259 ;; 0xF5 ;; push A260 ;; 0xE6261 ;; (Integer/parseInt "11110000" 2) ;; volume mask262 ;; 0xE0263 ;; 0x17 ;; set volume264 ;; 0xF1 ;; pop A265 ;; 0xE6266 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask267 ;; 0xE0268 ;; 0x19 ;; set frequency-high270 ;; 0x2A ;; load frequency low-bits271 ;; 0xE0272 ;; 0x18 ;; set frequency-low-bits274 ;; 0x2A ;; load duration275 ;; ])277 (defn music-step [sound-base-address wave-duty noise?]278 ;; C == current-ticks279 ;; A == desired-ticks281 (flatten282 [;; restore variables from stack283 0xE1 ;; pop HL284 0xC1 ;; pop CB285 0xF1 ;; pop AF288 0xF5 ;; push A289 0xF0290 0x05 ;; load current ticks from 0xF005291 0xB8 ;;292 0x30 ;; increment C only if last result caused carry293 0x01294 0x0C296 0x47 ;; update sub-ticks (A->B)298 0xF1 ;; pop AF, now A contains desired-ticks300 0xB9 ;; compare with current ticks302 ;; if desired-ticks = current ticks303 ;; go to next note ; set current set ticks to 0.305 (if noise?306 [0x20307 (+ 2 (count (play-noise)))308 (play-noise)]310 [0x20311 (+ (count (do-message 0 0)) 2)312 (do-message sound-base-address wave-duty)])314 0x0E315 0x00 ;; 0->C (current-ticks)317 ;; save variables to stack318 0xF5 ;; push AF319 0xC5 ;; push CB320 0xE5 ;; push HL323 ]))325 (def music-1 0x11)326 (def music-2 0x16)328 (defn music-kernel [wave-duty-1 wave-duty-2]329 (flatten330 [;; global initilization section331 (clear-music-registers)333 0x3E334 0x01335 0xE0336 0x06 ;; set TMA to 0338 0x3E339 (Integer/parseInt "00000110" 2)340 0xE0341 0x07 ;; set TAC to 65536 Hz and activate timer343 ;; initialize frame 1344 0x21345 0x00346 0xA0 ;; set HL to 0xA000 == music-start 1347 0x0E348 0x00 ;; 0->C349 0x06350 0x00 ;; 0->B352 0xAF ;; 0->A354 0xF5 ;; push AF355 0xC5 ;; push CB356 0xE5 ;; push HL358 ;; initialize frame 2359 0x21360 0x00361 0xB0 ;; set HL to 0xB000 == music-start 2363 0xF5 ;; push AF364 0xC5 ;; push CB365 0xE5 ;; push HL368 ;; initialize frame 3 (noise)369 0x21370 0x00371 0xA9 ;; 0xA9OO -> HL373 0xF5 ;; push AF374 0xC5 ;; push CB375 0xE5 ;; push HL377 ;; main music loop379 0xE8 ;; SP + 12; activate frame 1380 12381 (music-step music-1 wave-duty-1 false)383 0xE8 ;; SP - 6; activate frame 2384 (->signed-8-bit -6)385 (music-step music-2 wave-duty-2 false)387 0xE8 ;; SP - 6; activate frame 3388 (->signed-8-bit -6)389 (music-step nil nil true)391 0x18392 (->signed-8-bit (+393 ;; two music-steps394 (- (* 2 (count (music-step 0 0 false))))395 ;; one noise396 (- (count (music-step nil nil true)))397 -2 ;; this jump instruction398 -2 ;; activate frame 1399 -2 ;; activate frame 2400 -2 ;; activate frame 3401 ))]))403 (defn frequency-code->frequency404 [code]405 (assert (<= 0 code 2047))406 (/ 131072 (- 2048 code)))408 (defn clamp [x low high]409 (cond (> x high) high410 (< x low) low411 true x))413 (defn frequency->frequency-code414 [frequency]415 (clamp416 (Math/round417 (float418 (/ (- (* 2048 frequency) 131072) frequency)))419 0x00 2048))421 (defn note-codes [frequency volume duration]422 (assert (<= 0 volume 0xF))423 (if (<= duration 0xFF)424 (let [frequency-code425 (frequency->frequency-code frequency)426 volume&high-frequency427 (+ (bit-shift-left volume 4)428 (bit-shift-right frequency-code 8))429 low-frequency430 (bit-and 0xFF frequency-code)]431 [note-code432 volume&high-frequency433 low-frequency434 duration])435 (vec436 (flatten437 [(note-codes frequency volume 0xFF)438 (note-codes frequency volume (- duration 0xFF))]))))441 (defn midi-code->frequency442 [midi-code]443 (* 8.1757989156444 (Math/pow 2 (* (float (/ 12)) midi-code))))446 ;; division == clock-pulses / quarter-note447 ;; tempo == microseconds / quarter-note449 ;; have: clock-pulses450 ;; want: seconds453 (defn silent-note [length]454 {:frequency 1455 :duration length456 :volume 0})458 (defn commands459 "return all events where #(= (:command %) command)"460 [command s]461 (filter #(= command (:command %)) s))463 (defn track-info [#^File midi-file]464 (let [events (parse-midi midi-file)465 track-titles (commands :Title_t events)466 track-info467 (map #(read-string (read-string (:args %))) track-titles)468 track-map469 (zipmap track-info track-titles)]470 track-map))472 (defn target-tracks473 "return the track-numbers in the form [voice-0 voice-1 noise]"474 [#^File midi-file]475 (let [track-data (track-info midi-file)476 track-order477 (zipmap (map :out (keys track-data))478 (vals track-data))479 channel-nums (map (comp :channel track-order) (range 3))]480 channel-nums))482 (defn midi-track->abstract-mini-midi483 [#^File midi-file track-num]484 (let [midi-events (parse-midi midi-file)486 note-on-events (commands :Note_on_c midi-events)487 note-off-events (commands :Note_off_c midi-events)489 select-channel490 (fn [n s]491 (sort-by :time (filter #(= n (:channel %)) s)))493 channel-on (select-channel track-num note-on-events)495 channel-off (select-channel track-num note-off-events)498 tempo (:args (first (commands :Tempo midi-events)))499 division500 (:division (:args (first (commands :Header midi-events))))502 notes503 (map504 (fn [note-on note-off]505 {:frequency (midi-code->frequency (:note (:args note-on)))506 :midi-code (:note (:args note-on))507 :duration508 (/ (* (/ tempo division)509 (- (:time note-off) (:time note-on)))510 1e6) ;; convert clock-pulses into seconds511 :volume (int (/ (:velocity (:args note-on)) 10))512 :time-stamp (/ (* (/ tempo division)513 (:time note-on)) 1e6)})514 channel-on channel-off)516 silences517 (map (fn [note-1 note-2]518 (let [note-1-space (- (:time-stamp note-2)519 (:time-stamp note-1))520 note-1-length (:duration note-1)]521 (silent-note (- note-1-space note-1-length))))522 ;; to handle silence at the beginning.523 (concat [(assoc (silent-note 0)524 :time-stamp 0)] notes)525 notes)527 notes-with-silence528 (concat529 (filter (comp not zero? :duration)530 (interleave silences notes))531 [(silent-note 3)])]532 notes-with-silence))534 (defn midi-track->mini-midi-voice [#^File midi-file track-num]535 (let [abstract-mini-midi536 (midi-track->abstract-mini-midi midi-file track-num)]537 (map538 (fn [note-event]539 (note-codes (:frequency note-event)540 (:volume note-event)541 (int (* (:duration note-event) 0x100))))542 abstract-mini-midi)))544 (def midi-code->gb-noise-code545 {nil 0xFF546 35 90547 38 20548 39 0549 })551 (defn noise-codes [code volume duration]552 (assert (<= 0 volume 0xF))553 (if (<= duration 0xFF)554 [(midi-code->gb-noise-code code code)555 (bit-shift-left volume 4)556 duration]557 (vec558 (flatten559 [(noise-codes code volume 0xFF)560 (noise-codes code volume (- duration 0xFF))]))))562 (defn midi-track->mini-midi-noise [#^File midi-file track-num]563 (let [abstract-mini-midi564 (midi-track->abstract-mini-midi midi-file track-num)]565 (map566 (fn [noise-event]567 (noise-codes (:midi-code noise-event)568 (:volume noise-event)569 (int (* (:duration noise-event) 0x100))))570 abstract-mini-midi)))573 (defn midi->mini-midi [#^File midi-file]574 (let [targets (target-tracks midi-file)575 duty-info (keys (track-info midi-file))]577 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))578 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))579 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))580 :duty (zipmap (map :out duty-info)581 (map #(get % :duty 0) duty-info))}))583 (defn play-midi [#^File midi-file]584 (let [voice-1-target 0xA000585 voice-2-target 0xB000586 noise-target 0xA900587 program-target 0xC000588 mini-midi (midi->mini-midi midi-file)589 long-silence (flatten (note-codes 20 0 20001))590 long-noise-silence591 (interleave (range 500) (repeat 0x00) (repeat 255))593 voice-1 (flatten (:voice-1 mini-midi))594 wave-duty-1 ((:duty mini-midi) 0 0)596 voice-2 (flatten (:voice-2 mini-midi))597 wave-duty-2 ((:duty mini-midi) 1 0)599 noise (flatten (:noise mini-midi))600 ]602 (-> (second (music-base))603 (set-memory-range voice-1-target long-silence)604 (set-memory-range voice-2-target long-silence)605 (set-memory-range noise-target long-noise-silence)606 (set-memory-range voice-1-target voice-1)607 (set-memory-range voice-2-target voice-2)608 (set-memory-range noise-target noise)609 (set-memory-range610 program-target611 (music-kernel wave-duty-1 wave-duty-2))612 (PC! program-target))))614 (defn test-noise []615 (let [noise-pattern616 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))617 (interleave (range 10) (repeat 0x00) (repeat 255)))]619 (-> (second (music-base))620 (set-memory-range 0xA900 (flatten noise-pattern))621 (set-memory-range 0xC000 (music-kernel 0 0))622 (PC! 0xC000))))624 (defn test-play-noise [noise-code]625 (Thread/sleep 300)626 (println "playing noise:" noise-code)627 (run-moves628 (let [noise-pattern629 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]630 (-> (second (music-base))631 (set-memory-range 0xA900 (flatten noise-pattern))632 (set-memory-range 0xC000 (music-kernel 0 0))633 (PC! 0xC000)))634 (repeat 20 [])))636 (defn test-all-noises []637 (dorun (map test-play-noise (range 0x100))))639 (def C4 (partial note-codes 261.63))640 (def D4 (partial note-codes 293.66))641 (def E4 (partial note-codes 329.63))642 (def F4 (partial note-codes 349.23))643 (def G4 (partial note-codes 392))644 (def A4 (partial note-codes 440))645 (def B4 (partial note-codes 493.88))646 (def C5 (partial note-codes 523.3))648 (def scale649 (flatten650 [(C4 0xF 0x40)651 (D4 0xF 0x40)652 (E4 0xF 0x40)653 (F4 0xF 0x40)654 (G4 0xF 0x40)655 (A4 0xF 0x40)656 (B4 0xF 0x40)657 (C5 0xF 0x40)]))659 (defn play-music [music-bytes]660 (let [program-target 0xC000661 music-target 0xA000]662 (-> (set-memory-range (second (music-base))663 program-target (music-kernel))664 (set-memory-range music-target music-bytes)665 (PC! program-target))))667 (defn run-program668 ([program]669 (let [target 0xC000]670 (-> (set-memory-range (second (music-base))671 target program)672 (PC! target)))))674 (defn test-timer []675 (flatten676 [0x3E677 0x01678 0xE0679 0x06 ;; set TMA to 0681 0x3E682 (Integer/parseInt "00000100" 2)683 0xE0684 0x07 ;; set TAC to 16384 Hz and activate timer686 (repeat687 500688 [0xF0689 0x05])]))691 (defn play-pony []692 (println "playing" (.getName pony-csv))693 (run-moves (play-midi pony-csv) (repeat 1800 [])))695 (defn play-regret []696 (println "playing" (.getName regret-csv))697 (run-moves (play-midi regret-csv) (repeat 3380 [])))699 (defn play-mother []700 (println "playing" (.getName mother-csv))701 (run-moves (play-midi mother-csv) (repeat 2200 [])))703 (defn demo [] (play-mother) (play-regret) (play-pony))