1.1 --- a/clojure/com/aurellem/run/music.clj	Mon Apr 23 07:02:39 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/music.clj	Mon Apr 23 08:26:23 2012 -0500
     1.3 @@ -8,12 +8,87 @@
     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  
    1.10 +(defn raw-midi-text [#^File midi-file]
    1.11 +  (:out 
    1.12 +   (clojure.java.shell/sh
    1.13 +    "midicsv"
    1.14 +    (.getCanonicalPath midi-file)
    1.15 +    "-")))
    1.16 +
    1.17 +(def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
    1.18 +
    1.19 +(defmulti parse-command :command)
    1.20 +
    1.21 +(defn discard-args [command] (dissoc command :args))
    1.22 +
    1.23 +(defmethod parse-command :Start_track
    1.24 +  [command] (discard-args command))
    1.25 +
    1.26 +(defmethod parse-command :End_track
    1.27 +  [command] (discard-args command))
    1.28 +
    1.29 +(defmethod parse-command :default
    1.30 +  [command] command)
    1.31 +
    1.32 +(defn parse-number-list
    1.33 +  [number-list-str]
    1.34 +  (map #(Integer/parseInt %)
    1.35 +       (clojure.string/split number-list-str #", ")))
    1.36 +
    1.37 +(defmethod parse-command :Tempo
    1.38 +  [command]
    1.39 +  (update-in command [:args] #(Integer/parseInt %)))
    1.40 +
    1.41 +(defn parse-midi-note-list
    1.42 +  [midi-note-list-str]
    1.43 +  (let [[channel note velocity]
    1.44 +        (parse-number-list midi-note-list-str)]
    1.45 +    {:channel channel :note note :velocity velocity}))
    1.46 +
    1.47 +(defmethod parse-command :Note_on_c
    1.48 +  [command]
    1.49 +  (update-in command [:args] parse-midi-note-list))
    1.50 +
    1.51 +(defmethod parse-command :Note_off_c
    1.52 +  [command]
    1.53 +  (update-in command [:args] parse-midi-note-list))
    1.54 +
    1.55 +(defmethod parse-command :Header
    1.56 +  [command]
    1.57 +  (let [args (:args command)
    1.58 +        [format num-tracks division] (parse-number-list args)]
    1.59 +    (assoc command :args
    1.60 +           {:format format
    1.61 +            :num-tracks num-tracks
    1.62 +            :division division})))
    1.63 +        
    1.64 +(defmethod parse-command :Program_c
    1.65 +  [command]
    1.66 +  (let [args (:args command)
    1.67 +        [channel program-num] (parse-number-list args)]
    1.68 +    (assoc command :args
    1.69 +           {:channel channel
    1.70 +            :program-num program-num})))
    1.71 +
    1.72 +(defn parse-midi [#^File midi-file]
    1.73 +  (map
    1.74 +   (comp parse-command
    1.75 +         (fn [line]
    1.76 +           (let [[[_ channel time command args]]
    1.77 +                 (re-seq command-line line)]
    1.78 +             {:channel (Integer/parseInt channel)
    1.79 +              :time (Integer/parseInt time)
    1.80 +              :command (keyword command)
    1.81 +              :args (apply str (drop 2 args))})))
    1.82 +   (drop-last
    1.83 +    (clojure.string/split-lines
    1.84 +     (raw-midi-text midi-file)))))
    1.85 +  
    1.86  (def music-base new-kernel)
    1.87  
    1.88 -
    1.89 -
    1.90 -
    1.91  (defn store [n address]
    1.92    (flatten
    1.93     [0xF5
    1.94 @@ -33,11 +108,8 @@
    1.95  (defn infinite-loop []
    1.96    [0x18 0xFE])
    1.97  
    1.98 -
    1.99 -
   1.100  (def divider-register 0xFF04)
   1.101  
   1.102 -
   1.103  (defrecord Bit-Note [frequency volume duration duty])
   1.104  
   1.105  (defn clear-music-registers []
   1.106 @@ -92,7 +164,6 @@
   1.107  (def note-code 0x00)
   1.108  (def change-duty-code 0x01)
   1.109  (def silence-code 0x02)
   1.110 -  
   1.111  
   1.112  (defn do-message
   1.113    "Read the message which starts at the current value of HL and do
   1.114 @@ -250,6 +321,67 @@
   1.115       low-frequency
   1.116       duration]))
   1.117  
   1.118 +(defn midi-code->frequency
   1.119 +  [midi-code]
   1.120 +  (* 8.1757989156
   1.121 +     (Math/pow 2 (* (float (/ 12)) midi-code))))
   1.122 +
   1.123 +;; division == clock-pulses / quarter-note
   1.124 +;; tempo    == microseconds / quarter-note
   1.125 +
   1.126 +;; have: clock-pulses
   1.127 +;; want: seconds
   1.128 +
   1.129 +
   1.130 +
   1.131 +
   1.132 +(defn midi->mini-midi [#^File midi-file]
   1.133 +  (let [midi-events (parse-midi midi-file)
   1.134 +
   1.135 +        note-on-events
   1.136 +        (filter #(= :Note_on_c (:command %)) midi-events)
   1.137 +        note-off-events
   1.138 +        (filter #(= :Note_off_c (:command %)) midi-events)
   1.139 +
   1.140 +        channel-1-on
   1.141 +        (sort-by :time
   1.142 +                 (filter #(= 1 (:channel (:args %)))
   1.143 +                  note-on-events))
   1.144 +        channel-1-off
   1.145 +        (sort-by :time
   1.146 +                 (filter #(= 1 (:channel (:args %)))
   1.147 +                         note-off-events))
   1.148 +        
   1.149 +        
   1.150 +        tempo (:args (first (filter #(= :Tempo (:command %)) midi-events)))
   1.151 +        division (:division
   1.152 +                  (:args (first (filter #(= :Header (:command %)) midi-events))))
   1.153 +        ]
   1.154 +  
   1.155 +    (map
   1.156 +     (fn [note-event]
   1.157 +       (note-codes (:frequency note-event)
   1.158 +                   (:volume note-event)
   1.159 +                   (int (* (:duration note-event) 0x100))))
   1.160 +     
   1.161 +     (map
   1.162 +      (fn [note-on note-off]
   1.163 +        {:frequency (midi-code->frequency (:note (:args note-on)))
   1.164 +         :duration
   1.165 +         (/ (* (/ tempo division)
   1.166 +               (- (:time note-off) (:time note-on)))
   1.167 +            1e6) ;; convert clock-pulses into seconds
   1.168 +         :volume (int (/ (:velocity (:args note-on)) 10))
   1.169 +         :time-stamp (/ (* (/ tempo division)
   1.170 +                           (:time note-on)) 1e6)})
   1.171 +      channel-1-on channel-1-off))))
   1.172 +           
   1.173 +
   1.174 +        
   1.175 +  
   1.176 +  
   1.177 +
   1.178 +
   1.179  (def C4 (partial note-codes 261.63))
   1.180  (def D4 (partial note-codes 293.66))
   1.181  (def E4 (partial note-codes 329.63))
   1.182 @@ -314,85 +446,4 @@
   1.183       [0xF0
   1.184        0x05])]))
   1.185  
   1.186 -(def third-kind
   1.187 -  (File. "/home/r/proj/midi/third-kind.mid"))
   1.188  
   1.189 -(defn raw-midi-text [#^File midi-file]
   1.190 -  (:out 
   1.191 -   (clojure.java.shell/sh
   1.192 -    "midicsv"
   1.193 -    (.getCanonicalPath midi-file)
   1.194 -    "-")))
   1.195 -
   1.196 -(def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
   1.197 -
   1.198 -(defmulti parse-command :command)
   1.199 -
   1.200 -(defn discard-args [command] (dissoc command :args))
   1.201 -
   1.202 -(defmethod parse-command :Start_track
   1.203 -  [command] (discard-args command))
   1.204 -
   1.205 -(defmethod parse-command :End_track
   1.206 -  [command] (discard-args command))
   1.207 -
   1.208 -(defmethod parse-command :default
   1.209 -  [command] command)
   1.210 -
   1.211 -(defn parse-number-list
   1.212 -  [number-list-str]
   1.213 -  (map #(Integer/parseInt %)
   1.214 -       (clojure.string/split number-list-str #", ")))
   1.215 -
   1.216 -(defmethod parse-command :Tempo
   1.217 -  [command]
   1.218 -  (update-in command [:args] #(Integer/parseInt %)))
   1.219 -
   1.220 -(defn parse-midi-note-list
   1.221 -  [midi-note-list-str]
   1.222 -  (let [[channel note velocity]
   1.223 -        (parse-number-list midi-note-list-str)]
   1.224 -    {:channel channel :note note :velocity velocity}))
   1.225 -  
   1.226 -
   1.227 -(defmethod parse-command :Note_on_c
   1.228 -  [command]
   1.229 -  (update-in command [:args] parse-midi-note-list))
   1.230 -
   1.231 -(defmethod parse-command :Note_off_c
   1.232 -  [command]
   1.233 -  (update-in command [:args] parse-midi-note-list))
   1.234 -
   1.235 -(defmethod parse-command :Header
   1.236 -  [command]
   1.237 -  (let [args (:args command)
   1.238 -        [format num-tracks division] (parse-number-list args)]
   1.239 -    (assoc command :args
   1.240 -           {:format format
   1.241 -            :num-tracks num-tracks
   1.242 -            :division division})))
   1.243 -        
   1.244 -(defmethod parse-command :Program_c
   1.245 -  [command]
   1.246 -  (let [args (:args command)
   1.247 -        [channel program-num] (parse-number-list args)]
   1.248 -    (assoc command :args
   1.249 -           {:channel channel
   1.250 -            :program-num program-num})))
   1.251 -
   1.252 -
   1.253 -(defn parse-midi [#^File midi-file]
   1.254 -  (map
   1.255 -   (comp parse-command
   1.256 -         (fn [line]
   1.257 -           (let [[[_ channel time command args]]
   1.258 -                 (re-seq command-line line)]
   1.259 -             ;;(println (re-seq command-parse-1 line))
   1.260 -             {:channel (Integer/parseInt channel)
   1.261 -              :time (Integer/parseInt time)
   1.262 -              :command (keyword command)
   1.263 -              :args (apply str (drop 2 args))})))
   1.264 -   (drop-last
   1.265 -    (clojure.string/split-lines
   1.266 -     (raw-midi-text midi-file)))))
   1.267 -