view clojure/com/aurellem/music/midi_util.clj @ 306:2873f50b7291

beginning to work on cry data
author Dylan Holmes <ocsenave@gmail.com>
date Sat, 31 Mar 2012 01:27:46 -0500
parents 5b59c6f17cd5
children e6a5dfd31230
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 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 :safari 0x82AF
191 :sfx-heal 0x82BA
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 :title 0x7C249
199 :credits 0x7C255
200 :hall-of-fame 0x7C25E
201 :lab-prof 0x7C267
202 :jigglypuff 0x7C270
203 :bike 0x7C276
204 :surfing 0x7C282
205 :casino 0x7C28B
206 :intro-battle 0x7C294
207 :power-plant 0x7C2A0 ;; power plant, unknown dungeon
208 :viridian-forest 0x7C2AC ;;viridian forest, seafoam islands
209 :victory-rd 0x7C2B8 ;;mt moon, rock tunnel, victory rd
210 :mansion 0x7C2C4
211 :pkmn-tower 0x7C2D0
212 :silph 0x7C2D9
213 :trainer-bad 0x7C2E2
214 :trainer-girl 0x7C2EB
215 :trainer-angry 0x7C2F4
216 })
219 (defn low-high-format
220 "Returns the number represented by the bytes."
221 [low high]
222 (+ low (* 256 high)))
223 (defn high-low-format
224 "Returns the number represented by the bytes."
225 [high low]
226 (+ low (* 256 high)))
229 (defn rom-tracks
230 "Given a valid address to a music header, returns a list of the
231 data tracks"
232 [address]
233 (let [rom (rom (root))
234 tracklist
235 ((fn extract-tracklist [mem n]
236 (if (= (nth mem 2) n)
237 (cons (low-high-format (first mem)
238 (second mem))
239 (extract-tracklist (drop 3 mem) (inc n)))
240 '()))
242 (take 12 (drop (inc address) rom))
243 1
244 )]
246 tracklist
247 (map
248 (fn [trk] (take-while #(not= 0xFF %) (drop trk rom)))
249 tracklist)
251 ))
256 ;; (defn note?
257 ;; "Does the given byte correspond to a note?"
258 ;; [n])
260 ;; (comment defn parse-ops
261 ;; "Consumes the list of opcodes, returning a runnable MIDI Sequence object."
262 ;; [ops]
263 ;; (
264 ;; (fn [midi ops]
265 ;; (let [x (first ops)]
266 ;; (cond (empty? ops) midi
267 ;; (= x 0xDA)
268 ;; ;; set tempo (high-low (nth ops 1)(nth ops 2))
269 ;; (recur (identity midi) (drop 3 ops))
271 ;; (note? x)
274 ;; )
276 ;; (doto (Sequence. (float 30) 15) ;; 30 fps, 15 frames per beat
277 ;; (.createTrack))
278 ;; ops
279 ;; ))))
287 ;; 8237-823F Pokecenter
288 ;; 8240-8248 Gym
289 ;; 8249-8254 Viridian / Pewter / Saffron
290 ;; 8255-825D Cerulean / Fuchsia
291 ;; 825E-8266 Celedon
292 ;; 8267-826F Cinnibar
293 ;; 8270-827B Vermilion
294 ;; 827C-8287 Lavender
295 ;; 8288-8290 S.S. Anne
296 ;; 8291-8299 Meet Prof. Oak
297 ;; 829A-82A2 Meet Rival
298 ;; 82A3-82AE Guy Walks you to Museum
299 ;; 82AF-82B7 Safari Zone
300 ;; 82B8-82C0 Pokemon get healed
301 ;; 82C1-82CC Routes 1 / 2
302 ;; 82CD-82D8 Routes 24 / 25
303 ;; 82D9-82E4 Routes 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 16 / 17 / 18 / 19 / 20 / 21 / 22
304 ;; 82E5-82F0 Routes 11 / 12 / 13 / 14 / 15
305 ;; 82F1-82FD Route 23 / Indigo Plateau
306 ;; 7C249-7C254 Title Screen
307 ;; 7C255-7C25D Credits
308 ;; 7C25E-7C266 Hall of FAme Registration
309 ;; 7C267-7C26F PRof Oak's LAb
310 ;; 7C270-7C275 Jigglypuff's Song
311 ;; 7C276-7C281 Bike Riding
312 ;; 7C282-7C28A Surfing
313 ;; 7C28B-7C293 Casino
314 ;; 7C294-7C29F Introduction Battle
315 ;; 7C2A0-7C2AB Power Plant / Unknown Dungeon
316 ;; 7C2AC-7C2B7 Viridian Forest / Seafoam Islands
317 ;; 7C2B8-7C2C3 Mt. Moon / Rock Tunnel / Victory Road
318 ;; 7C2C4-7C2CF Cinnibar Mansion
319 ;; 7C2D0-7C2D8 Pokemon Tower
320 ;; 7C2D9-7C2E1 Silph Co
321 ;; 7C2E2-7C2EA Meet Bad Trainer
322 ;; 7C2EB-7C2F3 Meet Girl Trainer
323 ;; 7C2F4-7C2FC Meet Angry Trainer