view clojure/com/aurellem/music/midi_util.clj @ 573:40f62391db9d

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