Mercurial > vba-clojure

annotate clojure/com/aurellem/music/midi_util.clj @ 572:58a25fa15176

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
minor formatting changes.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 03:42:16 -0500
parents ea5ed834be11
children
rev   line source
ocsenave@242 1 (ns com.aurellem.music.midi-util
ocsenave@242 2 ;;(:import javax.sound.sampled)
ocsenave@242 3 (:import (javax.sound.midi MidiSystem
ocsenave@242 4 Sequence
ocsenave@242 5 Track
ocsenave@242 6 MidiEvent
ocsenave@242 7 MetaMessage
ocsenave@242 8
ocsenave@242 9 ShortMessage)
ocsenave@242 10 (com.sun.media.sound FastShortMessage)
ocsenave@242 11 (java.io File))
ocsenave@242 12
ocsenave@309 13 (:use (com.aurellem.gb saves util mem-util constants gb-driver vbm items assembly characters))
ocsenave@242 14 (:use (com.aurellem.run title))
ocsenave@242 15 (:use (com.aurellem.exp pokemon item-bridge))
ocsenave@309 16 ;; (:use (com.aurellem.world practice))
ocsenave@242 17 (:import [com.aurellem.gb.gb_driver SaveState]))
ocsenave@242 18
ocsenave@242 19
ocsenave@242 20 ;;; PURE MIDI MANIPULATION
ocsenave@242 21
ocsenave@242 22 (defn midi-load
ocsenave@242 23 "Takes a path to a MIDI file and returns a Sequence object."
ocsenave@242 24 [path]
ocsenave@242 25 ((fn [file]
ocsenave@242 26 (if (.exists file)
ocsenave@242 27 (MidiSystem/getSequence file)
ocsenave@242 28 nil))
ocsenave@242 29 (File. path)))
ocsenave@242 30
ocsenave@242 31
ocsenave@243 32
ocsenave@243 33 (defn midi-play-seq
ocsenave@243 34 "Plays the MIDI Sequence. The MIDI runs in
ocsenave@243 35 the current thread until it finishes or is cancelled."
ocsenave@243 36 [midi]
ocsenave@242 37 (if (nil? midi) nil
ocsenave@242 38 (let [song
ocsenave@242 39 (doto
ocsenave@242 40 (MidiSystem/getSequencer)
ocsenave@242 41 (.open)
ocsenave@242 42 (.setSequence midi)
ocsenave@242 43 (.start))]
ocsenave@242 44 (try
ocsenave@242 45 (loop []
ocsenave@242 46 (if (. song (isRunning))
ocsenave@242 47 (do
ocsenave@242 48 (Thread/sleep 10)
ocsenave@242 49 (recur))
ocsenave@243 50 ))
ocsenave@243 51 (finally (.close song))))))
ocsenave@242 52
ocsenave@242 53
ocsenave@306 54 (def midi-play-file
ocsenave@306 55 "Plays the MIDI file at the given location. The MIDI file runs in
ocsenave@306 56 the current thread until it finishes or is cancelled."
ocsenave@306 57 (comp midi-play-seq midi-load))
ocsenave@306 58
ocsenave@306 59
ocsenave@306 60
ocsenave@306 61
ocsenave@242 62 (defn midi-test-1 []
ocsenave@242 63 (-> (.
ocsenave@242 64 (midi-load
ocsenave@242 65 "/home/ocsenave/bk_robert/sounds/sounds/www.vgmusic.com/console/nintendo/gameboy/PkmRB-Item.mid")
ocsenave@242 66 (getTracks))
ocsenave@242 67
ocsenave@242 68 (vec)
ocsenave@243 69 (nth 1)
ocsenave@242 70
ocsenave@242 71 ((fn[trk]
ocsenave@242 72 (map #(. trk (get %))
ocsenave@242 73 (range 0 (. trk size)))))
ocsenave@242 74
ocsenave@242 75 ((fn [evts]
ocsenave@243 76 (map (juxt #(.getTick %) #(vec (.getMessage (.getMessage
ocsenave@243 77 %))) #(.getMessage %) ) evts)
ocsenave@242 78 )
ocsenave@242 79
ocsenave@242 80 )))
ocsenave@242 81
ocsenave@242 82
ocsenave@242 83
ocsenave@242 84
ocsenave@242 85
ocsenave@243 86 (defn midi-short
ocsenave@243 87 "Creates a MIDI event containing a ShortMessage."
ocsenave@243 88 [tick [status & ns]]
ocsenave@243 89 (MidiEvent.
ocsenave@243 90 (apply
ocsenave@243 91 (fn
ocsenave@243 92 ([x] (doto (ShortMessage.) (.setMessage x)))
ocsenave@243 93 ([x y] (doto (ShortMessage.) (.setMessage x y 0)))
ocsenave@243 94 ([x y z] (doto (ShortMessage.) (.setMessage x y z)))
ocsenave@243 95 ([x y z w] (doto (ShortMessage.) (.setMessage x y z w))))
ocsenave@243 96 status
ocsenave@243 97 ns)
ocsenave@243 98 tick))
ocsenave@242 99
ocsenave@243 100 (defn midi-meta
ocsenave@243 101 "Creates a MIDI event containing a MetaMessage"
ocsenave@243 102 [tick type ns]
ocsenave@243 103 (MidiEvent.
ocsenave@243 104 (doto (MetaMessage.)
ocsenave@243 105 (.setMessage type
ocsenave@243 106 (byte-array (map byte ns))
ocsenave@243 107 (count ns)))
ocsenave@243 108 tick))
ocsenave@242 109
ocsenave@243 110
ocsenave@243 111
ocsenave@243 112 (defn sign
ocsenave@243 113 "Interpret the bits of n as a signed two's-complement byte"
ocsenave@243 114 [n]
ocsenave@243 115 (if (>= n 128) (- n 256)
ocsenave@243 116 n))
ocsenave@243 117
ocsenave@243 118 (defn unsign
ocsenave@243 119 "Interpret the bits as an unsigned byte."
ocsenave@243 120 [n]
ocsenave@243 121 (if (neg? n) (+ n 256) n))
ocsenave@243 122
ocsenave@243 123
ocsenave@242 124
ocsenave@242 125
ocsenave@242 126 (defn midi-test-2 []
ocsenave@243 127 (let [sequence (Sequence. (float 30) 12)] ;; 30 fps, 10 frames per beat
ocsenave@242 128 (doto (. sequence (createTrack))
ocsenave@243 129 (.add (midi-meta 0 3 [-1 3 33 79 114 105 103 105 110 97 108 32
ocsenave@243 130 99 111 109 112 111 115 101 114 58 32 74 117 110 105 99 104 105 32 77
ocsenave@243 131 97 115 117 100 97]))
ocsenave@242 132
ocsenave@243 133 (.add (midi-short 0 [-80 0 0])) ;; control change = -80
ocsenave@243 134 (.add (midi-short 0 [-80 7 100])) ;; control change, volume, 100
ocsenave@243 135 (.add (midi-short 0 [-80 10 64])) ;; control change, pan, 64 (middle?)
ocsenave@243 136 (.add (midi-short 0 [-80 32 0])) ;; ctrl chg, LSB ctrl 0 = bank 0
ocsenave@243 137 (.add (midi-short 0 [-64 01])) ;; program/instrument change = -64
ocsenave@243 138 (.add (midi-short 0 [-80 101 0]))
ocsenave@243 139 (.add (midi-short 1 [-80 100 0]))
ocsenave@243 140 (.add (midi-short 2 [-80 6 2]))
ocsenave@243 141 (.add (midi-short 3 [-80 38 0]))
ocsenave@243 142 (.add (midi-short 3 [-32 0 56])) ;; pitch bend?! = -32
ocsenave@243 143 (.add (midi-short 3 [-112 68 100])) ;; note on = -112
ocsenave@243 144 (.add (midi-short 20 [-112 68 0]))
ocsenave@243 145 (.add (midi-short 40 [-112 68 100]))
ocsenave@243 146 (.add (midi-short 60 [-112 68 0]))
ocsenave@243 147 (.add (midi-short 80 [-112 68 100]))
ocsenave@243 148 (.add (midi-short 100 [-112 68 0]))
ocsenave@243 149 (.add (midi-short 120 [-80 7 100])) ;; control change
ocsenave@243 150 (.add (midi-short 120 [-112 76 100])) ;; note-on
ocsenave@243 151 (.add (midi-short 181 [-80 7 90])) ;; control change
ocsenave@243 152 (.add (midi-short 209 [-80 7 80])) ;; control change
ocsenave@243 153 (.add (midi-short 240 [-80 7 65])) ;; control change
ocsenave@243 154 (.add (midi-short 270 [-80 7 50])) ;; control change
ocsenave@243 155 (.add (midi-short 300 [-112 76 0])) ;; note on = -112
ocsenave@243 156 (.add (midi-short 360 [-80 7 0])))
ocsenave@243 157 ;;(.add (midi-short 360 [-1 47 0])) ;; system reset = -1
ocsenave@242 158
ocsenave@243 159 sequence
ocsenave@306 160 ))
ocsenave@242 161
ocsenave@243 162
ocsenave@306 163
ocsenave@306 164
ocsenave@306 165 (defn read-memory
ocsenave@306 166 ([mem start length]
ocsenave@306 167 (take length
ocsenave@306 168 (drop start
ocsenave@306 169 mem)))
ocsenave@306 170 ([start length]
ocsenave@306 171 (read-memory (rom(root)) start length)))
ocsenave@242 172
ocsenave@242 173 ;;; ROM MUSIC MANIPULATION
ocsenave@242 174
ocsenave@242 175 (def songs;; music-headers
ocsenave@242 176 {
ocsenave@242 177 :pallet 0x822E
ocsenave@242 178 :pkmn-center 0x8237
ocsenave@242 179 :gym 0x8240
ocsenave@242 180 :city-1 0x8249 ;;virian, pewter, saffron
ocsenave@242 181 :city-2 0x8255 ;; cerulean, fuchsia
ocsenave@242 182 :celedon 0x825E
ocsenave@242 183 :cinnibar 0x8267
ocsenave@242 184 :vermilion 0x8270
ocsenave@242 185 :lavender 0x827C
ocsenave@242 186 :ss-anne 0x8288
ocsenave@242 187 :meet-prof 0x8291
ocsenave@242 188 :meet-blue 0x829A
ocsenave@242 189 :follow 0x82A3
ocsenave@309 190 :evolution 0x82AF
ocsenave@309 191 :sfx-heal 0x82B8
ocsenave@242 192 :route-1 0x82C1 ;; route 1,2
ocsenave@242 193 :route-2 0x82CD ;; route 24, 25
ocsenave@242 194 :route-3 0x82D9 ;; route 3-10,16-22
ocsenave@242 195 :route-4 0x82E5 ;; route 11-15
ocsenave@242 196 :route-5 0x82F1 ;; indigo plateau
ocsenave@242 197
ocsenave@309 198 ;;:1 0xc977 ;; fourteen "tracks" X
ocsenave@309 199 :1 0x801cb ;; slot machine music
ocsenave@309 200 :2 0x801d4
ocsenave@309 201 :3 0x801dd
ocsenave@309 202
ocsenave@309 203 :4 0x202be ;; uber slow battle songs?
ocsenave@309 204 :5 0x202c7 ;; can't play with pallet or bike (wrong base)
ocsenave@309 205 :6 0x202d9
ocsenave@309 206 :7 0x202e2
ocsenave@309 207 :8 0x202eb
ocsenave@309 208 :9 0x202f4
ocsenave@309 209
ocsenave@242 210 :title 0x7C249
ocsenave@242 211 :credits 0x7C255
ocsenave@242 212 :hall-of-fame 0x7C25E
ocsenave@242 213 :lab-prof 0x7C267
ocsenave@242 214 :jigglypuff 0x7C270
ocsenave@242 215 :bike 0x7C276
ocsenave@242 216 :surfing 0x7C282
ocsenave@242 217 :casino 0x7C28B
ocsenave@309 218 :intro 0x7C294
ocsenave@309 219 :power-plant 0x7C29D ;; power plant, unknown dungeon
ocsenave@309 220 :viridian-forest 0x7C2A9 ;;viridian forest, seafoam islands
ocsenave@309 221 :victory-rd 0x7C2B5 ;;mt moon, rock tunnel, victory rd
ocsenave@309 222 :mansion 0x7C2C1
ocsenave@309 223 :pkmn-tower 0x7C2CD
ocsenave@309 224 :silph 0x7C2D6
ocsenave@309 225 :trainer-bad 0x7C2DF
ocsenave@309 226 :trainer-girl 0x7C2E8
ocsenave@309 227 :trainer-angry 0x7C2F1
ocsenave@242 228 })
ocsenave@242 229
ocsenave@242 230
ocsenave@242 231 (defn low-high-format
ocsenave@242 232 "Returns the number represented by the bytes."
ocsenave@242 233 [low high]
ocsenave@242 234 (+ low (* 256 high)))
ocsenave@243 235 (defn high-low-format
ocsenave@243 236 "Returns the number represented by the bytes."
ocsenave@243 237 [high low]
ocsenave@243 238 (+ low (* 256 high)))
ocsenave@243 239
ocsenave@242 240
ocsenave@242 241 (defn rom-tracks
ocsenave@242 242 "Given a valid address to a music header, returns a list of the
ocsenave@242 243 data tracks"
ocsenave@242 244 [address]
ocsenave@242 245 (let [rom (rom (root))
ocsenave@242 246 tracklist
ocsenave@242 247 ((fn extract-tracklist [mem n]
ocsenave@242 248 (if (= (nth mem 2) n)
ocsenave@242 249 (cons (low-high-format (first mem)
ocsenave@242 250 (second mem))
ocsenave@242 251 (extract-tracklist (drop 3 mem) (inc n)))
ocsenave@242 252 '()))
ocsenave@242 253
ocsenave@242 254 (take 12 (drop (inc address) rom))
ocsenave@242 255 1
ocsenave@242 256 )]
ocsenave@242 257
ocsenave@243 258 tracklist
ocsenave@242 259 (map
ocsenave@242 260 (fn [trk] (take-while #(not= 0xFF %) (drop trk rom)))
ocsenave@242 261 tracklist)
ocsenave@242 262
ocsenave@242 263 ))
ocsenave@242 264
ocsenave@242 265
ocsenave@242 266
ocsenave@309 267 (defn find-music []
ocsenave@309 268 (let [extract-song
ocsenave@309 269 (fn [mem]
ocsenave@309 270 (if (and
ocsenave@309 271 (> (count mem) 6)
ocsenave@309 272 (zero? (rem (first mem) 16))
ocsenave@309 273 (not(zero? (first mem)))
ocsenave@309 274 (= (nth mem 3) 1)
ocsenave@309 275 (= (nth mem 6) 2))
ocsenave@309 276 (take 12 mem)))]
ocsenave@309 277 (loop [mem (rom)
ocsenave@309 278 results []
ocsenave@309 279 ptr 0]
ocsenave@309 280 (cond (empty? mem)
ocsenave@309 281 results
ocsenave@243 282
ocsenave@309 283 (nil? (extract-song mem))
ocsenave@309 284 (recur (rest mem)
ocsenave@309 285 results
ocsenave@309 286 (inc ptr))
ocsenave@309 287 :else
ocsenave@309 288 (recur (rest mem)
ocsenave@309 289 (conj results
ocsenave@309 290 [(hex ptr) (extract-song mem)])
ocsenave@309 291 (inc ptr))))))
ocsenave@309 292
ocsenave@309 293 (defn music-header
ocsenave@309 294 "Given a valid address to a music header, returns the music header."
ocsenave@309 295 [address]
ocsenave@309 296 (let [
ocsenave@309 297 rom (rom)
ocsenave@309 298 data (drop address rom)
ocsenave@309 299 ]
ocsenave@309 300 (->
ocsenave@309 301 (loop [n 1 k 3]
ocsenave@309 302 (if (= n (nth data k))
ocsenave@309 303 (recur (inc n) (+ k 3))
ocsenave@309 304 k))
ocsenave@309 305 (take data))))
ocsenave@309 306
ocsenave@309 307 (defn pallet-song [song-name]
ocsenave@309 308 (write-rom!
ocsenave@309 309 (rewrite-memory
ocsenave@309 310 (vec(rom))
ocsenave@309 311 0x822e
ocsenave@309 312 (music-header (songs song-name)))))
ocsenave@309 313
ocsenave@309 314 (defn bike-song [song-name]
ocsenave@309 315 (write-rom!
ocsenave@309 316 (rewrite-memory
ocsenave@309 317 (vec(rom))
ocsenave@309 318 0x7c276
ocsenave@309 319 (music-header (songs song-name)))))
ocsenave@309 320
ocsenave@309 321 (defn bike-song* [address]
ocsenave@309 322 (write-rom!
ocsenave@309 323 (rewrite-memory
ocsenave@309 324 (vec(rom))
ocsenave@309 325 0x7c276
ocsenave@309 326 (music-header address))))
ocsenave@309 327
ocsenave@309 328
ocsenave@309 329 (defn pallet-song* [address]
ocsenave@309 330 (write-rom!
ocsenave@309 331 (rewrite-memory
ocsenave@309 332 (vec(rom))
ocsenave@309 333 0x822e
ocsenave@309 334 (music-header address))))
ocsenave@306 335 ;; (defn note?
ocsenave@306 336 ;; "Does the given byte correspond to a note?"
ocsenave@306 337 ;; [n])
ocsenave@243 338
ocsenave@306 339 ;; (comment defn parse-ops
ocsenave@306 340 ;; "Consumes the list of opcodes, returning a runnable MIDI Sequence object."
ocsenave@306 341 ;; [ops]
ocsenave@306 342 ;; (
ocsenave@306 343 ;; (fn [midi ops]
ocsenave@306 344 ;; (let [x (first ops)]
ocsenave@306 345 ;; (cond (empty? ops) midi
ocsenave@306 346 ;; (= x 0xDA)
ocsenave@306 347 ;; ;; set tempo (high-low (nth ops 1)(nth ops 2))
ocsenave@306 348 ;; (recur (identity midi) (drop 3 ops))
ocsenave@243 349
ocsenave@306 350 ;; (note? x)
ocsenave@243 351
ocsenave@242 352
ocsenave@306 353 ;; )
ocsenave@242 354
ocsenave@306 355 ;; (doto (Sequence. (float 30) 15) ;; 30 fps, 15 frames per beat
ocsenave@306 356 ;; (.createTrack))
ocsenave@306 357 ;; ops
ocsenave@306 358 ;; ))))
ocsenave@242 359
ocsenave@242 360
ocsenave@242 361
ocsenave@242 362
ocsenave@242 363
ocsenave@242 364
ocsenave@242 365
ocsenave@242 366 ;; 8237-823F Pokecenter
ocsenave@242 367 ;; 8240-8248 Gym
ocsenave@242 368 ;; 8249-8254 Viridian / Pewter / Saffron
ocsenave@242 369 ;; 8255-825D Cerulean / Fuchsia
ocsenave@242 370 ;; 825E-8266 Celedon
ocsenave@242 371 ;; 8267-826F Cinnibar
ocsenave@242 372 ;; 8270-827B Vermilion
ocsenave@242 373 ;; 827C-8287 Lavender
ocsenave@242 374 ;; 8288-8290 S.S. Anne
ocsenave@242 375 ;; 8291-8299 Meet Prof. Oak
ocsenave@242 376 ;; 829A-82A2 Meet Rival
ocsenave@242 377 ;; 82A3-82AE Guy Walks you to Museum
ocsenave@242 378 ;; 82AF-82B7 Safari Zone
ocsenave@242 379 ;; 82B8-82C0 Pokemon get healed
ocsenave@242 380 ;; 82C1-82CC Routes 1 / 2
ocsenave@242 381 ;; 82CD-82D8 Routes 24 / 25
ocsenave@242 382 ;; 82D9-82E4 Routes 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 16 / 17 / 18 / 19 / 20 / 21 / 22
ocsenave@242 383 ;; 82E5-82F0 Routes 11 / 12 / 13 / 14 / 15
ocsenave@242 384 ;; 82F1-82FD Route 23 / Indigo Plateau
ocsenave@242 385 ;; 7C249-7C254 Title Screen
ocsenave@242 386 ;; 7C255-7C25D Credits
ocsenave@242 387 ;; 7C25E-7C266 Hall of FAme Registration
ocsenave@242 388 ;; 7C267-7C26F PRof Oak's LAb
ocsenave@242 389 ;; 7C270-7C275 Jigglypuff's Song
ocsenave@242 390 ;; 7C276-7C281 Bike Riding
ocsenave@242 391 ;; 7C282-7C28A Surfing
ocsenave@242 392 ;; 7C28B-7C293 Casino
ocsenave@242 393 ;; 7C294-7C29F Introduction Battle
ocsenave@242 394 ;; 7C2A0-7C2AB Power Plant / Unknown Dungeon
ocsenave@242 395 ;; 7C2AC-7C2B7 Viridian Forest / Seafoam Islands
ocsenave@242 396 ;; 7C2B8-7C2C3 Mt. Moon / Rock Tunnel / Victory Road
ocsenave@242 397 ;; 7C2C4-7C2CF Cinnibar Mansion
ocsenave@242 398 ;; 7C2D0-7C2D8 Pokemon Tower
ocsenave@242 399 ;; 7C2D9-7C2E1 Silph Co
ocsenave@242 400 ;; 7C2E2-7C2EA Meet Bad Trainer
ocsenave@242 401 ;; 7C2EB-7C2F3 Meet Girl Trainer
ocsenave@242 402 ;; 7C2F4-7C2FC Meet Angry Trainer
rlm@445 403