Mercurial > vba-clojure

annotate clojure/com/aurellem/music/midi_util.clj @ 593:daa3497bbe12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
increased speed to travel to floor two of celadon dept. store.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 12:38:26 -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