1.1 --- a/clojure/com/aurellem/run/music.clj	Wed May 02 13:07:36 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/music.clj	Sun May 06 20:52:31 2012 -0500
     1.3 @@ -8,15 +8,42 @@
     1.4    (:import [com.aurellem.gb.gb_driver SaveState])
     1.5    (:import java.io.File))
     1.6  
     1.7 -(def third-kind
     1.8 -  (File. "/home/r/proj/midi/third-kind.mid"))
     1.9 +(def pony
    1.10 +  (File. user-home "/proj/vba-clojure/music/pony-title.mid"))
    1.11 +
    1.12 +(def pony-csv 
    1.13 +  (File. user-home "proj/vba-clojure/music/pony-title.csv"))
    1.14 +  
    1.15 +(def sync-test
    1.16 +  (File. user-home "proj/vba-clojure/music/sync-test.mid"))
    1.17 +
    1.18 +(def drum-test
    1.19 +  (File. user-home "proj/vba-clojure/music/drum-test.mid"))
    1.20 +
    1.21 +(def regret
    1.22 +  (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.mid"))
    1.23 +
    1.24 +(def regret-csv
    1.25 +  (File. user-home "proj/vba-clojure/music/ship-of-regret-and-sleep.csv"))
    1.26 +
    1.27 +(def mother
    1.28 +  (File. user-home "proj/vba-clojure/music/mother.mid"))
    1.29 +
    1.30 +(def mother-csv
    1.31 +  (File. user-home "proj/vba-clojure/music/mother.csv"))
    1.32 +
    1.33  
    1.34  (defn raw-midi-text [#^File midi-file]
    1.35 -  (:out 
    1.36 -   (clojure.java.shell/sh
    1.37 -    "midicsv"
    1.38 -    (.getCanonicalPath midi-file)
    1.39 -    "-")))
    1.40 +  (let [extention (apply str (take-last 3 (.getCanonicalPath
    1.41 +                                           midi-file)))]
    1.42 +    (cond (= "mid" extention)
    1.43 +          (:out 
    1.44 +           (clojure.java.shell/sh
    1.45 +            "midicsv"
    1.46 +            (.getCanonicalPath midi-file)
    1.47 +            "-"))
    1.48 +          (= "csv" extention)
    1.49 +             (slurp midi-file))))
    1.50  
    1.51  (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
    1.52  
    1.53 @@ -170,8 +197,9 @@
    1.54    "Read the message which starts at the current value of HL and do
    1.55     what it says. Duration is left in A, and HL is advanced
    1.56     appropraitely."
    1.57 -  ([] (do-message 0x16))
    1.58 -  ([sound-base-address]
    1.59 +  ([] (do-message 0x16 1))
    1.60 +  ([sound-base-address wave-duty]
    1.61 +     (assert (<= 0 wave-duty 3))
    1.62       (let [switch
    1.63             [0x2A ;; load message code into A, increment HL
    1.64              
    1.65 @@ -183,7 +211,11 @@
    1.66              :note-length]
    1.67  
    1.68             play-note
    1.69 -           [0x2A   ;; load volume/frequency-high info
    1.70 +           [0x3E ;; set wave-duty
    1.71 +            (bit-shift-left wave-duty 6)
    1.72 +            0xE0
    1.73 +            sound-base-address
    1.74 +            0x2A   ;; load volume/frequency-high info
    1.75              0xF5   ;; push A
    1.76              0xE6
    1.77              (Integer/parseInt "11110000" 2) ;; volume mask
    1.78 @@ -203,6 +235,22 @@
    1.79          {:note-length (count play-note)}
    1.80          (concat switch play-note)))))
    1.81  
    1.82 +(defn play-noise
    1.83 +  "read [noise-code, volume,  duration] and play the noise. Duration is left in
    1.84 +   A, and HL is advanced appropraitely."
    1.85 +  ([]
    1.86 +     [0x2A  ;; load noise-code into A
    1.87 +      0xE0
    1.88 +      0x22  ;; write noise-code
    1.89 +
    1.90 +      0x2A  ;; load volume
    1.91 +      0xE0
    1.92 +      0x21  ;; write volume
    1.93 +      
    1.94 +      0x2A] ;; load duration into A
    1.95 +     ))
    1.96 +
    1.97 +
    1.98  ;; (defn play-note
    1.99  ;;   "Play the note referenced by HL in the appropiate channel.
   1.100  ;;    Leaves desired-duration in A."
   1.101 @@ -226,7 +274,7 @@
   1.102  ;;    0x2A   ;; load duration
   1.103  ;;    ]) 
   1.104  
   1.105 -(defn music-step [sound-base-address]
   1.106 +(defn music-step [sound-base-address wave-duty noise?]
   1.107    ;; C == current-ticks
   1.108    ;; A == desired-ticks
   1.109    
   1.110 @@ -254,10 +302,14 @@
   1.111      ;; if desired-ticks = current ticks
   1.112      ;;   go to next note ; set current set ticks to 0.
   1.113  
   1.114 -    0x20
   1.115 -    (+ (count (do-message 0)) 2)
   1.116 -
   1.117 -    (do-message sound-base-address)
   1.118 +    (if noise?
   1.119 +      [0x20
   1.120 +       (+ 2 (count (play-noise)))
   1.121 +       (play-noise)]
   1.122 +    
   1.123 +      [0x20
   1.124 +       (+ (count (do-message 0 0)) 2)
   1.125 +       (do-message sound-base-address wave-duty)])
   1.126      
   1.127      0x0E
   1.128      0x00 ;; 0->C (current-ticks)
   1.129 @@ -273,7 +325,7 @@
   1.130  (def music-1 0x11)
   1.131  (def music-2 0x16)
   1.132  
   1.133 -(defn music-kernel []
   1.134 +(defn music-kernel [wave-duty-1 wave-duty-2]
   1.135    (flatten
   1.136     [;; global initilization section
   1.137      (clear-music-registers)
   1.138 @@ -313,26 +365,38 @@
   1.139      0xE5 ;; push HL
   1.140  
   1.141  
   1.142 +    ;; initialize frame 3 (noise)
   1.143 +    0x21
   1.144 +    0x00
   1.145 +    0xA9 ;; 0xA9OO -> HL
   1.146 +
   1.147 +    0xF5 ;; push AF
   1.148 +    0xC5 ;; push CB
   1.149 +    0xE5 ;; push HL
   1.150 +
   1.151      ;; main music loop
   1.152  
   1.153 -    0xE8 ;; SP + 6; activate frame 1
   1.154 -    6
   1.155 -    (music-step music-1)
   1.156 -    ;;(repeat (count (music-step music-1)) 0x00)
   1.157 +    0xE8 ;; SP + 12; activate frame 1
   1.158 +    12
   1.159 +    (music-step music-1 wave-duty-1 false)
   1.160      
   1.161      0xE8 ;; SP - 6; activate frame 2
   1.162      (->signed-8-bit -6)
   1.163 -    ;;(repeat (count (music-step music-2)) 0x00)
   1.164 -    (music-step music-2)
   1.165 -    
   1.166 +    (music-step music-2 wave-duty-2 false)
   1.167 +
   1.168 +    0xE8 ;; SP - 6;  activate frame 3
   1.169 +    (->signed-8-bit -6)
   1.170 +    (music-step nil nil true)
   1.171  
   1.172      0x18
   1.173      (->signed-8-bit (+
   1.174                       ;; two music-steps
   1.175 -                     (- (* 2 (count (music-step 0))))
   1.176 +                     (- (* 2 (count (music-step 0 0 false))))
   1.177 +                     (- (count (music-step nil nil true)))
   1.178                       -2 ;; this jump instruction
   1.179                       -2 ;; activate frame 1
   1.180                       -2 ;; activate frame 2
   1.181 +                     -2 ;; activate frame 3
   1.182                       ))]))
   1.183  
   1.184  (defn frequency-code->frequency
   1.185 @@ -395,15 +459,35 @@
   1.186    [command s]
   1.187    (filter #(= command (:command %)) s))
   1.188  
   1.189 -(defn midi-track->mini-midi [#^File midi-file track-num]
   1.190 -  (let [midi-events (parse-midi midi-file)
   1.191 +(defn track-info [#^File midi-file]
   1.192 +  (let [events (parse-midi midi-file)
   1.193 +        track-titles (commands :Title_t events)
   1.194 +        track-info
   1.195 +        (map #(read-string (read-string (:args %))) track-titles)
   1.196 +        track-map
   1.197 +        (zipmap track-info track-titles)]
   1.198 +    track-map))
   1.199 +
   1.200 +(defn target-tracks
   1.201 +  "return the track-numbers in the form [voice-0 voice-1 noise]"
   1.202 +  [#^File midi-file]
   1.203 +  (let [track-data (track-info midi-file)
   1.204 +        track-order
   1.205 +        (zipmap (map :out (keys track-data))
   1.206 +                (vals track-data))
   1.207 +        channel-nums (map (comp :channel track-order) (range 3))]
   1.208 +    channel-nums))
   1.209 +
   1.210 +(defn midi-track->abstract-mini-midi
   1.211 +  [#^File midi-file track-num]
   1.212 +    (let [midi-events (parse-midi midi-file)
   1.213  
   1.214          note-on-events  (commands :Note_on_c  midi-events)
   1.215          note-off-events (commands :Note_off_c midi-events)
   1.216  
   1.217          select-channel
   1.218          (fn [n s]
   1.219 -          (sort-by :time (filter #(= n (:channel (:args %))) s)))
   1.220 +          (sort-by :time (filter #(= n (:channel %)) s)))
   1.221  
   1.222          channel-on (select-channel track-num note-on-events)
   1.223          
   1.224 @@ -418,6 +502,7 @@
   1.225          (map
   1.226           (fn [note-on note-off]
   1.227             {:frequency (midi-code->frequency (:note (:args note-on)))
   1.228 +            :midi-code (:note (:args note-on))
   1.229              :duration
   1.230              (/ (* (/ tempo division)
   1.231                    (- (:time note-off) (:time note-on)))
   1.232 @@ -439,36 +524,116 @@
   1.233               notes)
   1.234          
   1.235          notes-with-silence
   1.236 -        (filter (comp not zero? :duration)
   1.237 -                (interleave silences notes))]
   1.238 +        (concat
   1.239 +         (filter (comp not zero? :duration)
   1.240 +                 (interleave silences notes))
   1.241 +         [(silence 3)])]
   1.242 +    notes-with-silence))
   1.243 +      
   1.244 +(defn midi-track->mini-midi-voice [#^File midi-file track-num]
   1.245 +  (let [abstract-mini-midi
   1.246 +        (midi-track->abstract-mini-midi midi-file track-num)]
   1.247 +     (map
   1.248 +      (fn [note-event]
   1.249 +        (note-codes (:frequency note-event)
   1.250 +                    (:volume note-event)
   1.251 +                    (int (* (:duration note-event) 0x100))))
   1.252 +      abstract-mini-midi)))
   1.253 +
   1.254 +(def midi-code->gb-noise-code
   1.255 +  {nil 0xFF
   1.256 +   35 87
   1.257 +   38 20
   1.258 +   39 0
   1.259 +   })
   1.260 +
   1.261 +(defn noise-codes [code volume duration]
   1.262 +  (assert (<= 0 volume 0xF))
   1.263 +  (if (<= duration 0xFF)
   1.264 +    [(midi-code->gb-noise-code code code)
   1.265 +     (bit-shift-left volume 4)
   1.266 +     duration]
   1.267 +    (vec
   1.268 +     (flatten 
   1.269 +      [(noise-codes code volume 0xFF)
   1.270 +       (noise-codes code volume (- duration 0xFF))]))))
   1.271 +
   1.272 +(defn midi-track->mini-midi-noise [#^File midi-file track-num]
   1.273 +  (let [abstract-mini-midi
   1.274 +        (midi-track->abstract-mini-midi midi-file track-num)]
   1.275      (map
   1.276 -     (fn [note-event]
   1.277 -       (note-codes (:frequency note-event)
   1.278 -                   (:volume note-event)
   1.279 -                   (int (* (:duration note-event) 0x100))))
   1.280 -     notes-with-silence)))
   1.281 +     (fn [noise-event]
   1.282 +       (noise-codes (:midi-code noise-event)
   1.283 +                    (:volume noise-event)
   1.284 +                    (int (* (:duration noise-event) 0x100))))
   1.285 +     abstract-mini-midi)))
   1.286 +
   1.287  
   1.288  (defn midi->mini-midi [#^File midi-file]
   1.289 -  {:track-1 (flatten (midi-track->mini-midi midi-file 1))
   1.290 -   :track-2 (flatten (midi-track->mini-midi midi-file 2))})
   1.291 +  (let [targets (target-tracks midi-file)
   1.292 +        duty-info (keys (track-info midi-file))]
   1.293 +    
   1.294 +    {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
   1.295 +     :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
   1.296 +     :noise   (midi-track->mini-midi-noise midi-file (nth targets 2))
   1.297 +     :duty    (zipmap (map :out duty-info)
   1.298 +                      (map #(get % :duty 0) duty-info))}))
   1.299  
   1.300  (defn play-midi [#^File midi-file]
   1.301 -  (let [track-1-target 0xA000
   1.302 -        track-2-target 0xB000
   1.303 +  (let [voice-1-target 0xA000
   1.304 +        voice-2-target 0xB000
   1.305 +        noise-target   0xA900
   1.306          program-target 0xC000
   1.307          mini-midi (midi->mini-midi midi-file)
   1.308 -        long-silence (flatten (note-codes 20 0 9001))]
   1.309 +        long-silence (flatten (note-codes 20 0 20001))
   1.310 +        long-noise-silence
   1.311 +        (interleave (range 500) (repeat 0x00) (repeat 255))
   1.312 +        
   1.313 +        voice-1 (flatten (:voice-1 mini-midi))
   1.314 +        wave-duty-1 ((:duty mini-midi) 0 0)
   1.315 +
   1.316 +        voice-2 (flatten (:voice-2 mini-midi))
   1.317 +        wave-duty-2 ((:duty mini-midi) 1 0)
   1.318 +
   1.319 +        noise (flatten (:noise mini-midi))
   1.320 +        ]
   1.321      
   1.322      (-> (second (music-base))
   1.323 -        (set-memory-range track-1-target long-silence)
   1.324 -        (set-memory-range track-2-target long-silence)
   1.325 -        (set-memory-range track-1-target (:track-1 mini-midi))
   1.326 -        (set-memory-range track-2-target (:track-2 mini-midi))
   1.327 -        (set-memory-range program-target (music-kernel))
   1.328 +        (set-memory-range voice-1-target long-silence)
   1.329 +        (set-memory-range voice-2-target long-silence)
   1.330 +        (set-memory-range noise-target   long-noise-silence)
   1.331 +        (set-memory-range voice-1-target voice-1)
   1.332 +        (set-memory-range voice-2-target voice-2)
   1.333 +        (set-memory-range noise-target   noise)
   1.334 +        (set-memory-range
   1.335 +         program-target
   1.336 +         (music-kernel wave-duty-1 wave-duty-2))
   1.337          (PC! program-target))))
   1.338  
   1.339 +(defn test-noise []
   1.340 +  (let [noise-pattern
   1.341 +        (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
   1.342 +                (interleave (range 10) (repeat 0x00) (repeat 255)))]
   1.343 +                
   1.344 +    (-> (second (music-base))
   1.345 +        (set-memory-range 0xA900 (flatten noise-pattern))
   1.346 +        (set-memory-range 0xC000 (music-kernel 0 0))
   1.347 +        (PC! 0xC000))))
   1.348  
   1.349 -  
   1.350 +(defn test-play-noise [noise-code]
   1.351 +  (Thread/sleep 300)
   1.352 +  (println "playing noise:" noise-code)
   1.353 +  (run-moves
   1.354 +   (let [noise-pattern
   1.355 +         (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
   1.356 +     (-> (second (music-base))
   1.357 +         (set-memory-range 0xA900 (flatten noise-pattern))
   1.358 +         (set-memory-range 0xC000 (music-kernel 0 0))
   1.359 +         (PC! 0xC000)))
   1.360 +   (repeat 20 [])))
   1.361 +
   1.362 +(defn test-all-noises []
   1.363 +  (dorun (map test-play-noise (range 0x100))))
   1.364  
   1.365  (def C4 (partial note-codes 261.63))
   1.366  (def D4 (partial note-codes 293.66))
   1.367 @@ -498,19 +663,6 @@
   1.368          (set-memory-range music-target music-bytes)
   1.369          (PC! program-target))))
   1.370  
   1.371 -
   1.372 -
   1.373 -;; (defn test-note [music-bytes]
   1.374 -;;   (-> (set-memory-range (second (music-base))
   1.375 -;;                         0xC000 (concat (clear-music-registers)
   1.376 -;;                                        (play-note)
   1.377 -;;                                        (infinite-loop)))
   1.378 -;;       (set-memory-range 0xD000 music-bytes)
   1.379 -;;       (PC! 0xC000)
   1.380 -;;       (HL! 0xD000)
   1.381 -;;       ))
   1.382 -
   1.383 -
   1.384  (defn run-program
   1.385    ([program]
   1.386       (let [target 0xC000]
   1.387 @@ -535,4 +687,19 @@
   1.388       [0xF0
   1.389        0x05])]))
   1.390  
   1.391 +(defn play-pony []
   1.392 +  (println "playing" (.getName pony-csv))
   1.393 +  (run-moves (play-midi pony-csv) (repeat 1800 [])))
   1.394  
   1.395 +(defn play-regret []
   1.396 +  (println "playing" (.getName regret-csv))
   1.397 +  (run-moves (play-midi regret-csv) (repeat 3380 [])))
   1.398 +
   1.399 +(defn play-mother []
   1.400 +  (println "playing" (.getName mother-csv))
   1.401 +  (run-moves (play-midi mother-csv) (repeat 2200 [])))
   1.402 +
   1.403 +(defn demo [] (play-mother) (play-regret) (play-pony))
   1.404 +
   1.405 +
   1.406 +  
   1.407 \ No newline at end of file