rlm@417: (ns com.aurellem.run.music
rlm@417:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@417:                          items vbm characters money
rlm@417:                          rlm-assembly))
rlm@417:   (:use (com.aurellem.run util title save-corruption
rlm@417:                           bootstrap-0 bootstrap-1))
rlm@426:   (:require clojure.string)
rlm@426:   (:import [com.aurellem.gb.gb_driver SaveState])
rlm@426:   (:import java.io.File))
rlm@417: 
rlm@455: (def pony
rlm@481:   (File. user-home "/proj/vba-clojure/music/pony-title.mid"))
rlm@455: 
rlm@480: (def pony-csv 
rlm@481:   (File. user-home "proj/vba-clojure/music/pony-title.csv"))
rlm@480:   
rlm@455: (def sync-test
rlm@481:   (File. user-home "proj/vba-clojure/music/sync-test.mid"))
rlm@455: 
rlm@468: (def drum-test
rlm@481:   (File. user-home "proj/vba-clojure/music/drum-test.mid"))
rlm@468: 
rlm@477: (def regret
rlm@481:   (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.mid"))
rlm@454: 
rlm@480: (def regret-csv
rlm@481:   (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.csv"))
rlm@480: 
rlm@480: (def mother
rlm@481:   (File. user-home "proj/vba-clojure/music/mother.mid"))
rlm@480: 
rlm@480: (def mother-csv
rlm@481:   (File. user-home "proj/vba-clojure/music/mother.csv"))
rlm@480: 
rlm@480: 
rlm@427: (defn raw-midi-text [#^File midi-file]
rlm@480:   (let [extention (apply str (take-last 3 (.getCanonicalPath
rlm@480:                                            midi-file)))]
rlm@480:     (cond (= "mid" extention)
rlm@480:           (:out 
rlm@480:            (clojure.java.shell/sh
rlm@480:             "midicsv"
rlm@480:             (.getCanonicalPath midi-file)
rlm@480:             "-"))
rlm@480:           (= "csv" extention)
rlm@480:              (slurp midi-file))))
rlm@427: 
rlm@427: (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
rlm@427: 
rlm@427: (defmulti parse-command :command)
rlm@427: 
rlm@427: (defn discard-args [command] (dissoc command :args))
rlm@427: 
rlm@427: (defmethod parse-command :Start_track
rlm@427:   [command] (discard-args command))
rlm@427: 
rlm@427: (defmethod parse-command :End_track
rlm@427:   [command] (discard-args command))
rlm@427: 
rlm@427: (defmethod parse-command :default
rlm@427:   [command] command)
rlm@427: 
rlm@427: (defn parse-number-list
rlm@427:   [number-list-str]
rlm@427:   (map #(Integer/parseInt %)
rlm@427:        (clojure.string/split number-list-str #", ")))
rlm@427: 
rlm@427: (defmethod parse-command :Tempo
rlm@427:   [command]
rlm@427:   (update-in command [:args] #(Integer/parseInt %)))
rlm@427: 
rlm@427: (defn parse-midi-note-list
rlm@427:   [midi-note-list-str]
rlm@427:   (let [[channel note velocity]
rlm@427:         (parse-number-list midi-note-list-str)]
rlm@427:     {:channel channel :note note :velocity velocity}))
rlm@427: 
rlm@427: (defmethod parse-command :Note_on_c
rlm@427:   [command]
rlm@427:   (update-in command [:args] parse-midi-note-list))
rlm@427: 
rlm@427: (defmethod parse-command :Note_off_c
rlm@427:   [command]
rlm@427:   (update-in command [:args] parse-midi-note-list))
rlm@427: 
rlm@427: (defmethod parse-command :Header
rlm@427:   [command]
rlm@427:   (let [args (:args command)
rlm@427:         [format num-tracks division] (parse-number-list args)]
rlm@427:     (assoc command :args
rlm@427:            {:format format
rlm@427:             :num-tracks num-tracks
rlm@427:             :division division})))
rlm@427:         
rlm@427: (defmethod parse-command :Program_c
rlm@427:   [command]
rlm@427:   (let [args (:args command)
rlm@427:         [channel program-num] (parse-number-list args)]
rlm@427:     (assoc command :args
rlm@427:            {:channel channel
rlm@427:             :program-num program-num})))
rlm@427: 
rlm@427: (defn parse-midi [#^File midi-file]
rlm@427:   (map
rlm@427:    (comp parse-command
rlm@427:          (fn [line]
rlm@427:            (let [[[_ channel time command args]]
rlm@427:                  (re-seq command-line line)]
rlm@427:              {:channel (Integer/parseInt channel)
rlm@427:               :time (Integer/parseInt time)
rlm@427:               :command (keyword command)
rlm@427:               :args (apply str (drop 2 args))})))
rlm@427:    (drop-last
rlm@427:     (clojure.string/split-lines
rlm@427:      (raw-midi-text midi-file)))))
rlm@427:   
rlm@417: (def music-base new-kernel)
rlm@417: 
rlm@417: (defn store [n address]
rlm@417:   (flatten
rlm@417:    [0xF5
rlm@417:     0xE5
rlm@417:     
rlm@417:     0x3E
rlm@417:     n
rlm@417:     
rlm@417:     0x21
rlm@417:     (reverse (disect-bytes-2 address))
rlm@417: 
rlm@417:     0x77
rlm@417:     
rlm@417:     0xE1
rlm@417:     0xF1]))
rlm@417: 
rlm@417: (defn infinite-loop []
rlm@417:   [0x18 0xFE])
rlm@417: 
rlm@417: (def divider-register 0xFF04)
rlm@417: 
rlm@417: (defrecord Bit-Note [frequency volume duration duty])
rlm@417: 
rlm@417: (defn clear-music-registers []
rlm@417:   (flatten
rlm@433:    [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
rlm@417: 
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417: 
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417: 
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
rlm@433:     (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
rlm@433:     ]))
rlm@417: 
rlm@424: 
rlm@424: ;; mini-midi syntax
rlm@424: 
rlm@424: ;; codes
rlm@424: ;; note-code == 0x00
rlm@424: ;; change-duty-code = 0x01
rlm@424: ;; silence-code = 0x02
rlm@424: 
rlm@424: ;; silence format
rlm@424: ;;  2 bytes
rlm@424: ;;  [silence-code (0x02)]
rlm@424: ;;  [duration-8-bits]
rlm@424: 
rlm@424: ;; note data format
rlm@424: ;;  4 bytes
rlm@424: ;;  [note-code (0x00)]
rlm@424: ;;  [volume-4-bits 0 frequency-high-3-bits]
rlm@424: ;;  [frequengy-low-8-bits]
rlm@424: ;;  [duration-8-bits]
rlm@424: 
rlm@424: ;; change-duty-format
rlm@424: ;;  2 bytes
rlm@424: ;;  [change-duty-code (0x01)]
rlm@424: ;;  [new-duty]
rlm@424: 
rlm@425: (def note-code 0x00)
rlm@425: (def change-duty-code 0x01)
rlm@425: (def silence-code 0x02)
rlm@425: 
rlm@424: (defn do-message
rlm@424:   "Read the message which starts at the current value of HL and do
rlm@424:    what it says. Duration is left in A, and HL is advanced
rlm@424:    appropraitely."
rlm@461:   ([] (do-message 0x16 1))
rlm@461:   ([sound-base-address wave-duty]
rlm@461:      (assert (<= 0 wave-duty 3))
rlm@433:      (let [switch
rlm@433:            [0x2A ;; load message code into A, increment HL
rlm@433:             
rlm@433:             ;; switch on message
rlm@433:             0xFE
rlm@433:             note-code
rlm@433:             
rlm@433:             0x20
rlm@433:             :note-length]
rlm@424: 
rlm@433:            play-note
rlm@461:            [0x3E ;; set wave-duty
rlm@461:             (bit-shift-left wave-duty 6)
rlm@461:             0xE0
rlm@461:             sound-base-address
rlm@461:             0x2A   ;; load volume/frequency-high info
rlm@433:             0xF5   ;; push A
rlm@433:             0xE6
rlm@433:             (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433:             0xE0
rlm@433:             (inc sound-base-address) ;;0x17   ;; set volume
rlm@433:             0xF1   ;; pop A
rlm@433:             0xE6
rlm@433:             (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433:             0xE0   
rlm@433:             (+ 3 sound-base-address) ;;0x19   ;; set frequency-high
rlm@433:             
rlm@433:             0x2A   ;; load frequency low-bits
rlm@433:             0xE0
rlm@433:             (+ 2 sound-base-address) ;;0x18   ;; set frequency-low-bits
rlm@433:             0x2A]]   ;; load duration
rlm@433:        (replace
rlm@433:         {:note-length (count play-note)}
rlm@433:         (concat switch play-note)))))
rlm@424: 
rlm@466: (defn play-noise
rlm@467:   "read [noise-code, volume,  duration] and play the noise. Duration is left in
rlm@466:    A, and HL is advanced appropraitely."
rlm@466:   ([]
rlm@466:      [0x2A  ;; load noise-code into A
rlm@466:       0xE0
rlm@466:       0x22  ;; write noise-code
rlm@467: 
rlm@467:       0x2A  ;; load volume
rlm@467:       0xE0
rlm@467:       0x21  ;; write volume
rlm@467:       
rlm@466:       0x2A] ;; load duration into A
rlm@466:      ))
rlm@466: 
rlm@466: 
rlm@433: ;; (defn play-note
rlm@433: ;;   "Play the note referenced by HL in the appropiate channel.
rlm@433: ;;    Leaves desired-duration in A."
rlm@433: 
rlm@433: ;;   [0x2A   ;; load volume/frequency-high info
rlm@433: ;;    0xF5   ;; push A
rlm@433: ;;    0xE6
rlm@433: ;;    (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433: ;;    0xE0
rlm@433: ;;    0x17   ;; set volume
rlm@433: ;;    0xF1   ;; pop A
rlm@433: ;;    0xE6
rlm@433: ;;    (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433: ;;    0xE0   
rlm@433: ;;    0x19   ;; set frequency-high
rlm@417:    
rlm@433: ;;    0x2A   ;; load frequency low-bits
rlm@433: ;;    0xE0
rlm@433: ;;    0x18   ;; set frequency-low-bits
rlm@417: 
rlm@433: ;;    0x2A   ;; load duration
rlm@433: ;;    ]) 
rlm@417: 
rlm@466: (defn music-step [sound-base-address wave-duty noise?]
rlm@432:   ;; C == current-ticks
rlm@432:   ;; A == desired-ticks
rlm@435:   
rlm@435:   (flatten
rlm@435:    [;; restore variables from stack
rlm@435:     0xE1 ;; pop HL
rlm@435:     0xC1 ;; pop CB
rlm@435:     0xF1 ;; pop AF
rlm@432: 
rlm@435: 
rlm@435:     0xF5 ;; push A
rlm@417:     0xF0
rlm@432:     0x05 ;; load current ticks from 0xF005
rlm@431:     0xB8 ;; 
rlm@417:     0x30 ;; increment C only if last result caused carry
rlm@417:     0x01
rlm@418:     0x0C
rlm@417: 
rlm@417:     0x47 ;; update sub-ticks (A->B)
rlm@417: 
rlm@417:     0xF1 ;; pop AF, now A contains desired-ticks
rlm@417: 
rlm@417:     0xB9 ;; compare with current ticks
rlm@417: 
rlm@417:     ;; if desired-ticks = current ticks
rlm@417:     ;;   go to next note ; set current set ticks to 0.
rlm@417: 
rlm@466:     (if noise?
rlm@466:       [0x20
rlm@466:        (+ 2 (count (play-noise)))
rlm@466:        (play-noise)]
rlm@466:     
rlm@466:       [0x20
rlm@466:        (+ (count (do-message 0 0)) 2)
rlm@466:        (do-message sound-base-address wave-duty)])
rlm@417:     
rlm@417:     0x0E
rlm@435:     0x00 ;; 0->C (current-ticks)
rlm@417: 
rlm@435:     ;; save variables to stack
rlm@435:     0xF5 ;; push AF
rlm@435:     0xC5 ;; push CB
rlm@435:     0xE5 ;; push HL
rlm@435:     
rlm@435: 
rlm@435:     ]))
rlm@435:     
rlm@435: (def music-1 0x11)
rlm@434: (def music-2 0x16)
rlm@434: 
rlm@537: (defn music-kernel
rlm@537:   [voice-1-address
rlm@537:    voice-2-address
rlm@537:    noise-address
rlm@537:    voice-1-wave-duty
rlm@537:    voice-2-wave-duty]
rlm@417:   (flatten
rlm@432:    [;; global initilization section
rlm@432:     (clear-music-registers)
rlm@432:     
rlm@417:     0x3E
rlm@418:     0x01
rlm@417:     0xE0
rlm@417:     0x06 ;; set TMA to 0
rlm@417:     
rlm@417:     0x3E
rlm@423:     (Integer/parseInt "00000110" 2)
rlm@417:     0xE0
rlm@423:     0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417: 
rlm@435:     ;; initialize frame 1 
rlm@432:     0x21
rlm@537:     (reverse (disect-bytes-2 voice-1-address))
rlm@537:     ;; set HL to voice-1-address
rlm@432:     0x0E
rlm@432:     0x00 ;; 0->C
rlm@432:     0x06
rlm@432:     0x00 ;; 0->B
rlm@435: 
rlm@433:     0xAF ;; 0->A
rlm@432: 
rlm@435:     0xF5 ;; push AF
rlm@435:     0xC5 ;; push CB
rlm@435:     0xE5 ;; push HL
rlm@432: 
rlm@435:     ;; initialize frame 2
rlm@436:     0x21
rlm@537:     (reverse (disect-bytes-2 voice-2-address))
rlm@537:     ;; set HL to voice-2-address
rlm@436: 
rlm@436:     0xF5 ;; push AF
rlm@436:     0xC5 ;; push CB
rlm@436:     0xE5 ;; push HL
rlm@436: 
rlm@436: 
rlm@466:     ;; initialize frame 3 (noise)
rlm@466:     0x21
rlm@537:     (reverse (disect-bytes-2 noise-address))
rlm@537:     ;; set HL to noise-address
rlm@466: 
rlm@466:     0xF5 ;; push AF
rlm@466:     0xC5 ;; push CB
rlm@466:     0xE5 ;; push HL
rlm@466: 
rlm@437:     ;; main music loop
rlm@437: 
rlm@466:     0xE8 ;; SP + 12; activate frame 1
rlm@466:     12
rlm@537:     (music-step music-1 voice-1-wave-duty false)
rlm@435:     
rlm@437:     0xE8 ;; SP - 6; activate frame 2
rlm@437:     (->signed-8-bit -6)
rlm@537:     (music-step music-2 voice-1-wave-duty false)
rlm@466: 
rlm@466:     0xE8 ;; SP - 6;  activate frame 3
rlm@466:     (->signed-8-bit -6)
rlm@466:     (music-step nil nil true)
rlm@424: 
rlm@417:     0x18
rlm@437:     (->signed-8-bit (+
rlm@437:                      ;; two music-steps
rlm@466:                      (- (* 2 (count (music-step 0 0 false))))
rlm@482:                      ;; one noise
rlm@466:                      (- (count (music-step nil nil true)))
rlm@437:                      -2 ;; this jump instruction
rlm@437:                      -2 ;; activate frame 1
rlm@437:                      -2 ;; activate frame 2
rlm@466:                      -2 ;; activate frame 3
rlm@437:                      ))]))
rlm@417: 
rlm@424: (defn frequency-code->frequency
rlm@424:   [code]
rlm@424:   (assert (<= 0 code 2047))
rlm@424:   (/ 131072 (- 2048 code)))
rlm@424: 
rlm@424: (defn clamp [x low high]
rlm@424:   (cond  (> x high) high
rlm@424:          (< x low)  low
rlm@424:          true x))
rlm@424: 
rlm@424: (defn frequency->frequency-code
rlm@424:   [frequency]
rlm@424:   (clamp
rlm@424:    (Math/round
rlm@424:     (float
rlm@424:      (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424:    0x00 2048))
rlm@424:     
rlm@424: (defn note-codes [frequency volume duration]
rlm@424:   (assert (<= 0 volume 0xF))
rlm@430:   (if (<= duration 0xFF)
rlm@430:     (let [frequency-code
rlm@430:           (frequency->frequency-code frequency)
rlm@430:           volume&high-frequency
rlm@430:           (+ (bit-shift-left volume 4)
rlm@430:              (bit-shift-right frequency-code 8))
rlm@430:           low-frequency
rlm@430:           (bit-and 0xFF frequency-code)]
rlm@430:       [note-code
rlm@430:        volume&high-frequency
rlm@430:        low-frequency
rlm@430:        duration])
rlm@430:     (vec
rlm@430:      (flatten 
rlm@430:       [(note-codes frequency volume 0xFF)
rlm@430:        (note-codes frequency volume (- duration 0xFF))]))))
rlm@430:   
rlm@424: 
rlm@427: (defn midi-code->frequency
rlm@427:   [midi-code]
rlm@427:   (* 8.1757989156
rlm@427:      (Math/pow 2 (* (float (/ 12)) midi-code))))
rlm@427: 
rlm@427: ;; division == clock-pulses / quarter-note
rlm@427: ;; tempo    == microseconds / quarter-note
rlm@427: 
rlm@427: ;; have: clock-pulses
rlm@427: ;; want: seconds
rlm@427: 
rlm@427: 
rlm@496: (defn silent-note [length]
rlm@428:   {:frequency 1
rlm@428:    :duration length
rlm@428:    :volume 0})
rlm@427: 
rlm@466: (defn commands
rlm@466:   "return all events where #(= (:command %) command)"
rlm@466:   [command s]
rlm@466:   (filter #(= command (:command %)) s))
rlm@466: 
rlm@462: (defn track-info [#^File midi-file]
rlm@462:   (let [events (parse-midi midi-file)
rlm@462:         track-titles (commands :Title_t events)
rlm@462:         track-info
rlm@462:         (map #(read-string (read-string (:args %))) track-titles)
rlm@462:         track-map
rlm@462:         (zipmap track-info track-titles)]
rlm@462:     track-map))
rlm@462: 
rlm@462: (defn target-tracks
rlm@462:   "return the track-numbers in the form [voice-0 voice-1 noise]"
rlm@462:   [#^File midi-file]
rlm@462:   (let [track-data (track-info midi-file)
rlm@462:         track-order
rlm@462:         (zipmap (map :out (keys track-data))
rlm@462:                 (vals track-data))
rlm@462:         channel-nums (map (comp :channel track-order) (range 3))]
rlm@462:     channel-nums))
rlm@438: 
rlm@467: (defn midi-track->abstract-mini-midi
rlm@467:   [#^File midi-file track-num]
rlm@467:     (let [midi-events (parse-midi midi-file)
rlm@427: 
rlm@438:         note-on-events  (commands :Note_on_c  midi-events)
rlm@438:         note-off-events (commands :Note_off_c midi-events)
rlm@427: 
rlm@438:         select-channel
rlm@438:         (fn [n s]
rlm@462:           (sort-by :time (filter #(= n (:channel %)) s)))
rlm@438: 
rlm@438:         channel-on (select-channel track-num note-on-events)
rlm@427:         
rlm@438:         channel-off (select-channel track-num note-off-events)
rlm@427:         
rlm@438:         
rlm@438:         tempo (:args (first (commands :Tempo midi-events)))
rlm@438:         division
rlm@438:         (:division (:args (first (commands :Header midi-events))))
rlm@428: 
rlm@428:         notes
rlm@428:         (map
rlm@428:          (fn [note-on note-off]
rlm@428:            {:frequency (midi-code->frequency (:note (:args note-on)))
rlm@467:             :midi-code (:note (:args note-on))
rlm@428:             :duration
rlm@428:             (/ (* (/ tempo division)
rlm@428:                   (- (:time note-off) (:time note-on)))
rlm@428:                1e6) ;; convert clock-pulses into seconds
rlm@428:             :volume (int (/ (:velocity (:args note-on)) 10))
rlm@428:             :time-stamp (/ (* (/ tempo division)
rlm@428:                               (:time note-on)) 1e6)})
rlm@438:          channel-on channel-off)
rlm@428: 
rlm@428:         silences
rlm@428:         (map (fn [note-1 note-2]
rlm@428:                (let [note-1-space (- (:time-stamp note-2)
rlm@428:                                      (:time-stamp note-1))
rlm@428:                      note-1-length (:duration note-1)]
rlm@496:                  (silent-note (- note-1-space note-1-length))))
rlm@428:              ;; to handle silence at the beginning.
rlm@496:              (concat [(assoc (silent-note 0)
rlm@428:                         :time-stamp 0)] notes)
rlm@428:              notes)
rlm@428:         
rlm@428:         notes-with-silence
rlm@456:         (concat
rlm@456:          (filter (comp not zero? :duration)
rlm@456:                  (interleave silences notes))
rlm@496:          [(silent-note 3)])]
rlm@467:     notes-with-silence))
rlm@467:       
rlm@467: (defn midi-track->mini-midi-voice [#^File midi-file track-num]
rlm@467:   (let [abstract-mini-midi
rlm@467:         (midi-track->abstract-mini-midi midi-file track-num)]
rlm@456:      (map
rlm@456:       (fn [note-event]
rlm@456:         (note-codes (:frequency note-event)
rlm@456:                     (:volume note-event)
rlm@456:                     (int (* (:duration note-event) 0x100))))
rlm@467:       abstract-mini-midi)))
rlm@467: 
rlm@468: (def midi-code->gb-noise-code
rlm@468:   {nil 0xFF
rlm@482:    35 90
rlm@468:    38 20
rlm@468:    39 0
rlm@468:    })
rlm@468: 
rlm@467: (defn noise-codes [code volume duration]
rlm@467:   (assert (<= 0 volume 0xF))
rlm@467:   (if (<= duration 0xFF)
rlm@468:     [(midi-code->gb-noise-code code code)
rlm@467:      (bit-shift-left volume 4)
rlm@467:      duration]
rlm@467:     (vec
rlm@467:      (flatten 
rlm@467:       [(noise-codes code volume 0xFF)
rlm@467:        (noise-codes code volume (- duration 0xFF))]))))
rlm@467: 
rlm@467: (defn midi-track->mini-midi-noise [#^File midi-file track-num]
rlm@467:   (let [abstract-mini-midi
rlm@467:         (midi-track->abstract-mini-midi midi-file track-num)]
rlm@467:     (map
rlm@467:      (fn [noise-event]
rlm@467:        (noise-codes (:midi-code noise-event)
rlm@467:                     (:volume noise-event)
rlm@467:                     (int (* (:duration noise-event) 0x100))))
rlm@467:      abstract-mini-midi)))
rlm@467: 
rlm@467: 
rlm@438: (defn midi->mini-midi [#^File midi-file]
rlm@462:   (let [targets (target-tracks midi-file)
rlm@463:         duty-info (keys (track-info midi-file))]
rlm@463:     
rlm@467:     {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
rlm@467:      :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
rlm@467:      :noise   (midi-track->mini-midi-noise midi-file (nth targets 2))
rlm@463:      :duty    (zipmap (map :out duty-info)
rlm@464:                       (map #(get % :duty 0) duty-info))}))
rlm@438: 
rlm@541: (defn midi-bytes
rlm@551:   ([^File midi-file program-target
rlm@551:     voice-1-target voice-2-target noise-target]
rlm@541:      (let [mini-midi (midi->mini-midi midi-file)
rlm@541:            long-silence (flatten (note-codes 20 0 3000))
rlm@541:            long-noise-silence 
rlm@541:            (interleave (range 20) (repeat 0x00) (repeat 255))
rlm@541:            voice-1 (flatten (:voice-1 mini-midi))
rlm@541:            wave-duty-1 ((:duty mini-midi) 0 0)
rlm@463: 
rlm@541:            voice-2 (flatten (:voice-2 mini-midi))
rlm@541:            wave-duty-2 ((:duty mini-midi) 1 0)
rlm@466: 
rlm@541:            noise (flatten (:noise mini-midi))
rlm@541:            kernel (music-kernel
rlm@541:                    voice-1-target
rlm@541:                    voice-2-target
rlm@541:                    noise-target
rlm@541:                    wave-duty-1 wave-duty-2)]
rlm@541:        
rlm@541:        {:voice-1 {:address voice-1-target
rlm@541:                   :data  (concat voice-1 long-silence)}
rlm@541:         :voice-2 {:address voice-2-target
rlm@541:                   :data (concat voice-2 long-silence)}
rlm@541:         :noise   {:address noise-target
rlm@541:                   :data (concat noise long-noise-silence)}
rlm@541:         :kernel  {:address program-target
rlm@541:                   :data kernel}}))
rlm@541:   ([^File midi-file]
rlm@551:      (midi-bytes midi-file 0xC000 0xC400 0xC800 0xCC00)))
rlm@535: 
rlm@535: (defn play-midi [^File midi-file]
rlm@535:   (let [bytes (midi-bytes midi-file)]
rlm@438:     (-> (second (music-base))
rlm@461:         (set-memory-range
rlm@535:          (:address (:voice-1 bytes)) (:data (:voice-1 bytes)))
rlm@535:         (set-memory-range
rlm@535:          (:address (:voice-2 bytes)) (:data (:voice-2 bytes)))
rlm@535:         (set-memory-range
rlm@535:          (:address (:noise   bytes)) (:data (:noise   bytes)))
rlm@535:         (set-memory-range
rlm@535:          (:address (:kernel  bytes)) (:data (:kernel bytes)))
rlm@535:         (PC! (:address (:kernel bytes))))))
rlm@438: 
rlm@467: (defn test-noise []
rlm@467:   (let [noise-pattern
rlm@467:         (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
rlm@467:                 (interleave (range 10) (repeat 0x00) (repeat 255)))]
rlm@467:                 
rlm@467:     (-> (second (music-base))
rlm@467:         (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467:         (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467:         (PC! 0xC000))))
rlm@467: 
rlm@467: (defn test-play-noise [noise-code]
rlm@468:   (Thread/sleep 300)
rlm@468:   (println "playing noise:" noise-code)
rlm@467:   (run-moves
rlm@467:    (let [noise-pattern
rlm@467:          (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
rlm@467:      (-> (second (music-base))
rlm@467:          (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467:          (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467:          (PC! 0xC000)))
rlm@468:    (repeat 20 [])))
rlm@467: 
rlm@467: (defn test-all-noises []
rlm@467:   (dorun (map test-play-noise (range 0x100))))
rlm@467: 
rlm@424: (def C4 (partial note-codes 261.63))
rlm@424: (def D4 (partial note-codes 293.66))
rlm@424: (def E4 (partial note-codes 329.63))
rlm@424: (def F4 (partial note-codes 349.23))
rlm@424: (def G4 (partial note-codes 392))
rlm@424: (def A4 (partial note-codes 440))
rlm@424: (def B4 (partial note-codes 493.88))
rlm@424: (def C5 (partial note-codes 523.3))
rlm@424: 
rlm@430: (def scale
rlm@430:   (flatten
rlm@430:    [(C4 0xF 0x40)
rlm@430:     (D4 0xF 0x40)
rlm@430:     (E4 0xF 0x40)
rlm@430:     (F4 0xF 0x40)
rlm@430:     (G4 0xF 0x40)
rlm@430:     (A4 0xF 0x40)
rlm@430:     (B4 0xF 0x40)
rlm@430:     (C5 0xF 0x40)]))
rlm@424:                  
rlm@418: (defn play-music [music-bytes]
rlm@417:   (let [program-target 0xC000
rlm@437:         music-target 0xA000]
rlm@417:     (-> (set-memory-range (second (music-base))
rlm@417:                           program-target (music-kernel))
rlm@417:         (set-memory-range music-target music-bytes)
rlm@417:         (PC! program-target))))
rlm@417: 
rlm@417: (defn run-program
rlm@418:   ([program]
rlm@417:      (let [target 0xC000]
rlm@417:        (-> (set-memory-range (second (music-base))
rlm@417:                              target program)
rlm@417:            (PC! target)))))
rlm@417: 
rlm@424: (defn test-timer []
rlm@424:   (flatten
rlm@424:    [0x3E
rlm@424:     0x01
rlm@424:     0xE0
rlm@424:     0x06 ;; set TMA to 0
rlm@424:     
rlm@424:     0x3E
rlm@424:     (Integer/parseInt "00000100" 2)
rlm@424:     0xE0
rlm@424:     0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424:     
rlm@424:     (repeat
rlm@424:      500
rlm@424:      [0xF0
rlm@424:       0x05])]))
rlm@426: 
rlm@480: (defn play-pony []
rlm@481:   (println "playing" (.getName pony-csv))
rlm@480:   (run-moves (play-midi pony-csv) (repeat 1800 [])))
rlm@426: 
rlm@480: (defn play-regret []
rlm@481:   (println "playing" (.getName regret-csv))
rlm@480:   (run-moves (play-midi regret-csv) (repeat 3380 [])))
rlm@480: 
rlm@480: (defn play-mother []
rlm@481:   (println "playing" (.getName mother-csv))
rlm@480:   (run-moves (play-midi mother-csv) (repeat 2200 [])))
rlm@480: 
rlm@480: (defn demo [] (play-mother) (play-regret) (play-pony))
rlm@480: 
rlm@480: 
rlm@480: