Mercurial > vba-clojure
diff clojure/com/aurellem/music/midi_util.clj @ 309:e6a5dfd31230
made progress on music; fixed several music pointers I grabbed from the internet.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sat, 31 Mar 2012 06:47:05 -0500 |
parents | 2873f50b7291 |
children | ea5ed834be11 |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/music/midi_util.clj Sat Mar 31 04:25:49 2012 -0500 1.2 +++ b/clojure/com/aurellem/music/midi_util.clj Sat Mar 31 06:47:05 2012 -0500 1.3 @@ -10,10 +10,10 @@ 1.4 (com.sun.media.sound FastShortMessage) 1.5 (java.io File)) 1.6 1.7 - (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly characters)) 1.8 + (:use (com.aurellem.gb saves util mem-util constants gb-driver vbm items assembly characters)) 1.9 (:use (com.aurellem.run title)) 1.10 (:use (com.aurellem.exp pokemon item-bridge)) 1.11 - (:use (com.aurellem.world practice)) 1.12 +;; (:use (com.aurellem.world practice)) 1.13 (:import [com.aurellem.gb.gb_driver SaveState])) 1.14 1.15 1.16 @@ -187,14 +187,26 @@ 1.17 :meet-prof 0x8291 1.18 :meet-blue 0x829A 1.19 :follow 0x82A3 1.20 - :safari 0x82AF 1.21 - :sfx-heal 0x82BA 1.22 + :evolution 0x82AF 1.23 + :sfx-heal 0x82B8 1.24 :route-1 0x82C1 ;; route 1,2 1.25 :route-2 0x82CD ;; route 24, 25 1.26 :route-3 0x82D9 ;; route 3-10,16-22 1.27 :route-4 0x82E5 ;; route 11-15 1.28 :route-5 0x82F1 ;; indigo plateau 1.29 1.30 + ;;:1 0xc977 ;; fourteen "tracks" X 1.31 + :1 0x801cb ;; slot machine music 1.32 + :2 0x801d4 1.33 + :3 0x801dd 1.34 + 1.35 + :4 0x202be ;; uber slow battle songs? 1.36 + :5 0x202c7 ;; can't play with pallet or bike (wrong base) 1.37 + :6 0x202d9 1.38 + :7 0x202e2 1.39 + :8 0x202eb 1.40 + :9 0x202f4 1.41 + 1.42 :title 0x7C249 1.43 :credits 0x7C255 1.44 :hall-of-fame 0x7C25E 1.45 @@ -203,16 +215,16 @@ 1.46 :bike 0x7C276 1.47 :surfing 0x7C282 1.48 :casino 0x7C28B 1.49 - :intro-battle 0x7C294 1.50 - :power-plant 0x7C2A0 ;; power plant, unknown dungeon 1.51 - :viridian-forest 0x7C2AC ;;viridian forest, seafoam islands 1.52 - :victory-rd 0x7C2B8 ;;mt moon, rock tunnel, victory rd 1.53 - :mansion 0x7C2C4 1.54 - :pkmn-tower 0x7C2D0 1.55 - :silph 0x7C2D9 1.56 - :trainer-bad 0x7C2E2 1.57 - :trainer-girl 0x7C2EB 1.58 - :trainer-angry 0x7C2F4 1.59 + :intro 0x7C294 1.60 + :power-plant 0x7C29D ;; power plant, unknown dungeon 1.61 + :viridian-forest 0x7C2A9 ;;viridian forest, seafoam islands 1.62 + :victory-rd 0x7C2B5 ;;mt moon, rock tunnel, victory rd 1.63 + :mansion 0x7C2C1 1.64 + :pkmn-tower 0x7C2CD 1.65 + :silph 0x7C2D6 1.66 + :trainer-bad 0x7C2DF 1.67 + :trainer-girl 0x7C2E8 1.68 + :trainer-angry 0x7C2F1 1.69 }) 1.70 1.71 1.72 @@ -252,7 +264,74 @@ 1.73 1.74 1.75 1.76 +(defn find-music [] 1.77 + (let [extract-song 1.78 + (fn [mem] 1.79 + (if (and 1.80 + (> (count mem) 6) 1.81 + (zero? (rem (first mem) 16)) 1.82 + (not(zero? (first mem))) 1.83 + (= (nth mem 3) 1) 1.84 + (= (nth mem 6) 2)) 1.85 + (take 12 mem)))] 1.86 + (loop [mem (rom) 1.87 + results [] 1.88 + ptr 0] 1.89 + (cond (empty? mem) 1.90 + results 1.91 1.92 + (nil? (extract-song mem)) 1.93 + (recur (rest mem) 1.94 + results 1.95 + (inc ptr)) 1.96 + :else 1.97 + (recur (rest mem) 1.98 + (conj results 1.99 + [(hex ptr) (extract-song mem)]) 1.100 + (inc ptr)))))) 1.101 + 1.102 +(defn music-header 1.103 + "Given a valid address to a music header, returns the music header." 1.104 + [address] 1.105 + (let [ 1.106 + rom (rom) 1.107 + data (drop address rom) 1.108 + ] 1.109 + (-> 1.110 + (loop [n 1 k 3] 1.111 + (if (= n (nth data k)) 1.112 + (recur (inc n) (+ k 3)) 1.113 + k)) 1.114 + (take data)))) 1.115 + 1.116 +(defn pallet-song [song-name] 1.117 + (write-rom! 1.118 + (rewrite-memory 1.119 + (vec(rom)) 1.120 + 0x822e 1.121 + (music-header (songs song-name))))) 1.122 + 1.123 +(defn bike-song [song-name] 1.124 + (write-rom! 1.125 + (rewrite-memory 1.126 + (vec(rom)) 1.127 + 0x7c276 1.128 + (music-header (songs song-name))))) 1.129 + 1.130 +(defn bike-song* [address] 1.131 + (write-rom! 1.132 + (rewrite-memory 1.133 + (vec(rom)) 1.134 + 0x7c276 1.135 + (music-header address)))) 1.136 + 1.137 + 1.138 +(defn pallet-song* [address] 1.139 + (write-rom! 1.140 + (rewrite-memory 1.141 + (vec(rom)) 1.142 + 0x822e 1.143 + (music-header address)))) 1.144 ;; (defn note? 1.145 ;; "Does the given byte correspond to a note?" 1.146 ;; [n])