1.1 --- a/clojure/com/aurellem/music/midi_util.clj	Mon Apr 02 20:30:02 2012 -0500
     1.2 +++ b/clojure/com/aurellem/music/midi_util.clj	Mon Apr 02 20:30:28 2012 -0500
     1.3 @@ -10,9 +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   (:import [com.aurellem.gb.gb_driver SaveState]))
    1.13  
    1.14  
    1.15 @@ -29,12 +30,6 @@
    1.16  
    1.17  
    1.18  
    1.19 -(def midi-play-file
    1.20 -  "Plays the MIDI file at the given location. The MIDI file runs in
    1.21 -the current thread until it finishes or is cancelled."
    1.22 -  (comp midi-play-seq midi-load))
    1.23 -
    1.24 -
    1.25  (defn midi-play-seq
    1.26    "Plays the MIDI Sequence. The MIDI runs in
    1.27  the current thread until it finishes or is cancelled."
    1.28 @@ -56,6 +51,14 @@
    1.29              (finally (.close song))))))
    1.30  
    1.31  
    1.32 +(def midi-play-file
    1.33 +  "Plays the MIDI file at the given location. The MIDI file runs in
    1.34 +the current thread until it finishes or is cancelled."
    1.35 +  (comp midi-play-seq midi-load))
    1.36 +
    1.37 +
    1.38 +
    1.39 +
    1.40  (defn midi-test-1 []
    1.41    (-> (.
    1.42         (midi-load
    1.43 @@ -154,10 +157,18 @@
    1.44        ;;(.add (midi-short 360 [-1 47 0])) ;; system reset = -1
    1.45  
    1.46      sequence
    1.47 -    )))
    1.48 +    ))
    1.49  
    1.50  
    1.51 -  
    1.52 +
    1.53 +
    1.54 +(defn read-memory 
    1.55 +  ([mem start length]
    1.56 +     (take length
    1.57 +           (drop start
    1.58 +                 mem)))
    1.59 +  ([start length]
    1.60 +     (read-memory (rom(root)) start length)))
    1.61  
    1.62  ;;; ROM MUSIC MANIPULATION
    1.63  
    1.64 @@ -176,14 +187,26 @@
    1.65     :meet-prof 0x8291
    1.66     :meet-blue 0x829A
    1.67     :follow 0x82A3
    1.68 -   :safari 0x82AF
    1.69 -   :sfx-heal 0x82BA
    1.70 +   :evolution 0x82AF
    1.71 +   :sfx-heal 0x82B8
    1.72     :route-1 0x82C1 ;; route 1,2
    1.73     :route-2 0x82CD ;; route 24, 25
    1.74     :route-3 0x82D9 ;; route 3-10,16-22
    1.75     :route-4 0x82E5 ;; route 11-15
    1.76     :route-5 0x82F1 ;; indigo plateau
    1.77  
    1.78 +   ;;:1 0xc977 ;; fourteen "tracks" X
    1.79 +   :1 0x801cb  ;; slot machine music
    1.80 +   :2 0x801d4  
    1.81 +   :3 0x801dd 
    1.82 +
    1.83 +   :4 0x202be ;; uber slow battle songs?
    1.84 +   :5 0x202c7 ;; can't play with pallet or bike (wrong base)
    1.85 +   :6 0x202d9
    1.86 +   :7 0x202e2
    1.87 +   :8 0x202eb
    1.88 +   :9 0x202f4
    1.89 +   
    1.90     :title 0x7C249
    1.91     :credits 0x7C255
    1.92     :hall-of-fame 0x7C25E
    1.93 @@ -192,19 +215,16 @@
    1.94     :bike 0x7C276
    1.95     :surfing 0x7C282
    1.96     :casino 0x7C28B
    1.97 -   :intro-battle 0x7C294
    1.98 -   :power-plant 0x7C2A0 ;; power plant, unknown dungeon
    1.99 -   :viridian-forest 0x7C2AC ;;viridian forest, seafoam islands
   1.100 -   :victory-rd 0x7C2B8 ;;mt moon, rock tunnel, victory rd 
   1.101 -   :mansion 0x7C2C4
   1.102 -   :pkmn-tower 0x7C2D0
   1.103 -   :silph 0x7C2D9
   1.104 -   :trainer-bad 0x7C2E2
   1.105 -   :trainer-girl 0x7C2EB 
   1.106 -   :trainer-angry 0x7C2F4
   1.107 -   })
   1.108 -   
   1.109 -
   1.110 +   :intro 0x7C294
   1.111 +   :power-plant 0x7C29D ;; power plant, unknown dungeon
   1.112 +   :viridian-forest 0x7C2A9 ;;viridian forest, seafoam islands
   1.113 +   :victory-rd 0x7C2B5 ;;mt moon, rock tunnel, victory rd 
   1.114 +   :mansion 0x7C2C1
   1.115 +   :pkmn-tower 0x7C2CD
   1.116 +   :silph 0x7C2D6
   1.117 +   :trainer-bad 0x7C2DF
   1.118 +   :trainer-girl 0x7C2E8 
   1.119 +   :trainer-angry 0x7C2F1
   1.120     })
   1.121  
   1.122  
   1.123 @@ -244,31 +264,98 @@
   1.124    
   1.125  
   1.126  
   1.127 +(defn find-music []
   1.128 +  (let [extract-song
   1.129 +        (fn [mem]
   1.130 +          (if (and
   1.131 +               (> (count mem) 6)
   1.132 +               (zero? (rem (first mem) 16))
   1.133 +               (not(zero? (first mem)))
   1.134 +               (= (nth mem 3) 1)
   1.135 +               (= (nth mem 6) 2))
   1.136 +            (take 12 mem)))]
   1.137 +    (loop [mem (rom)
   1.138 +           results []
   1.139 +           ptr 0]
   1.140 +      (cond (empty? mem)
   1.141 +            results
   1.142  
   1.143 -(defn note?
   1.144 -  "Does the given byte correspond to a note?"
   1.145 -  [n]
   1.146 +            (nil? (extract-song mem))
   1.147 +            (recur (rest mem)
   1.148 +                   results
   1.149 +                   (inc ptr))
   1.150 +            :else
   1.151 +            (recur (rest mem)
   1.152 +                   (conj results
   1.153 +                         [(hex ptr) (extract-song mem)])
   1.154 +                   (inc ptr))))))
   1.155 +           
   1.156 +(defn music-header
   1.157 +  "Given a valid address to a music header, returns the music header."
   1.158 +  [address]
   1.159 +  (let [
   1.160 +        rom (rom)
   1.161 +        data   (drop address rom)
   1.162 +        ]
   1.163 +    (->
   1.164 +     (loop [n 1 k 3]
   1.165 +       (if (= n (nth data k))
   1.166 +         (recur (inc n) (+ k 3))
   1.167 +         k))
   1.168 +     (take data))))
   1.169 +
   1.170 +(defn pallet-song [song-name]
   1.171 +  (write-rom!
   1.172 +   (rewrite-memory
   1.173 +    (vec(rom))
   1.174 +    0x822e
   1.175 +    (music-header (songs song-name)))))
   1.176 +
   1.177 +(defn bike-song [song-name]
   1.178 +  (write-rom!
   1.179 +   (rewrite-memory
   1.180 +    (vec(rom))
   1.181 +    0x7c276
   1.182 +    (music-header (songs song-name)))))
   1.183 +
   1.184 +(defn bike-song* [address]
   1.185 +  (write-rom!
   1.186 +   (rewrite-memory
   1.187 +    (vec(rom))
   1.188 +    0x7c276
   1.189 +    (music-header address))))
   1.190 +
   1.191 +
   1.192 +(defn pallet-song* [address]
   1.193 +  (write-rom!
   1.194 +   (rewrite-memory
   1.195 +    (vec(rom))
   1.196 +    0x822e
   1.197 +    (music-header address))))
   1.198 +;; (defn note?
   1.199 +;;   "Does the given byte correspond to a note?"
   1.200 +;;   [n])
   1.201    
   1.202 -(defn parse-ops
   1.203 -  "Consumes the list of opcodes, returning a runnable MIDI Sequence object."
   1.204 -  [ops]
   1.205 -  (
   1.206 -   (fn [midi ops]
   1.207 -     (let [x (first ops)]
   1.208 -       (cond (empty? ops) midi
   1.209 -             (= x 0xDA)
   1.210 -               ;; set tempo (high-low (nth ops 1)(nth ops 2))
   1.211 -             (recur (identity midi) (drop 3 ops))
   1.212 +;; (comment defn parse-ops
   1.213 +;;   "Consumes the list of opcodes, returning a runnable MIDI Sequence object."
   1.214 +;;   [ops]
   1.215 +;;   (
   1.216 +;;    (fn [midi ops]
   1.217 +;;      (let [x (first ops)]
   1.218 +;;        (cond (empty? ops) midi
   1.219 +;;              (= x 0xDA)
   1.220 +;;                ;; set tempo (high-low (nth ops 1)(nth ops 2))
   1.221 +;;              (recur (identity midi) (drop 3 ops))
   1.222               
   1.223 -             (note? x)
   1.224 +;;              (note? x)
   1.225               
   1.226  
   1.227 -             )
   1.228 +;;              )
   1.229  
   1.230 -   (doto (Sequence. (float 30) 15) ;; 30 fps, 15 frames per beat
   1.231 -     (.createTrack))
   1.232 -   ops
   1.233 -   ))
   1.234 +;;    (doto (Sequence. (float 30) 15) ;; 30 fps, 15 frames per beat
   1.235 +;;      (.createTrack))
   1.236 +;;    ops
   1.237 +;;   ))))
   1.238  
   1.239  
   1.240