(ns com.aurellem.music.midi-util

   ;;(:import javax.sound.sampled)

   (:import (javax.sound.midi MidiSystem

                              Sequence

                              Track

                              MidiEvent

                              MetaMessage

                              

                              ShortMessage)

            (com.sun.media.sound FastShortMessage)

            (java.io File))

   

  (:use (com.aurellem.gb saves util mem-util constants gb-driver vbm items assembly characters))

  (:use (com.aurellem.run title))

  (:use (com.aurellem.exp pokemon item-bridge))

 ;; (:use (com.aurellem.world practice))

  (:import [com.aurellem.gb.gb_driver SaveState]))

 

 

 ;;; PURE MIDI MANIPULATION

 

 (defn midi-load

   "Takes a path to a MIDI file and returns a Sequence object."

   [path]

   ((fn [file]

     (if (.exists file)

       (MidiSystem/getSequence file)

       nil))

    (File. path)))

 

 

 

 (defn midi-play-seq

   "Plays the MIDI Sequence. The MIDI runs in

 the current thread until it finishes or is cancelled."

   [midi]

     (if (nil? midi) nil

         (let [song

               (doto

                   (MidiSystem/getSequencer) 

                 (.open)

                 (.setSequence midi)

                 (.start))]

           (try

             (loop []

               (if (. song (isRunning))

                 (do

                   (Thread/sleep 10)

                   (recur))

                 ))

             (finally (.close song))))))

 

 

 (def midi-play-file

   "Plays the MIDI file at the given location. The MIDI file runs in

 the current thread until it finishes or is cancelled."

   (comp midi-play-seq midi-load))

 

 

 

 

 (defn midi-test-1 []

   (-> (.

        (midi-load

         "/home/ocsenave/bk_robert/sounds/sounds/www.vgmusic.com/console/nintendo/gameboy/PkmRB-Item.mid")

        (getTracks))

       

       (vec)

       (nth 1)

 

       ((fn[trk]

          (map #(. trk (get %))

               (range 0 (. trk size)))))

 

       ((fn [evts]

          (map (juxt #(.getTick %)  #(vec (.getMessage (.getMessage

          %))) #(.getMessage %) ) evts)

          )

       

       )))

 

 

 

 

 

 (defn midi-short

   "Creates a MIDI event containing a ShortMessage."

   [tick [status & ns]]

   (MidiEvent.

    (apply

     (fn

       ([x] (doto (ShortMessage.) (.setMessage x)))

       ([x y] (doto (ShortMessage.) (.setMessage x y 0)))

       ([x y z] (doto (ShortMessage.) (.setMessage x y z)))

       ([x y z w] (doto (ShortMessage.) (.setMessage x y z w))))

     status

     ns)

    tick))

 

 (defn midi-meta

   "Creates a MIDI event containing a MetaMessage"

   [tick type  ns]

   (MidiEvent.

    (doto (MetaMessage.)

      (.setMessage type

                  (byte-array (map byte ns))

                  (count ns)))

    tick))

 

 

    

 (defn sign

   "Interpret the bits of n as a signed two's-complement byte"

   [n]

   (if (>= n 128) (- n 256)

       n))

 

 (defn unsign

   "Interpret the bits as an unsigned byte."

   [n]

   (if (neg? n) (+ n 256) n))

 

 

 

 

 (defn midi-test-2 []

   (let [sequence (Sequence. (float 30) 12)] ;; 30 fps, 10 frames per beat

     (doto (. sequence (createTrack))

       (.add (midi-meta 0 3 [-1 3 33 79 114 105 103 105 110 97 108 32

       99 111 109 112 111 115 101 114 58 32 74 117 110 105 99 104 105 32 77

                             97 115 117 100 97]))

 

       (.add (midi-short 0 [-80 0 0])) ;; control change = -80

       (.add (midi-short 0 [-80 7 100])) ;; control change, volume, 100

       (.add (midi-short 0 [-80 10 64])) ;; control change, pan, 64 (middle?)

       (.add (midi-short 0 [-80 32 0]))  ;; ctrl chg, LSB ctrl 0 = bank 0

       (.add (midi-short 0 [-64 01]))  ;; program/instrument change = -64

       (.add (midi-short 0 [-80 101 0]))

       (.add (midi-short 1 [-80 100 0]))

       (.add (midi-short 2 [-80 6 2]))

       (.add (midi-short 3 [-80 38 0]))

       (.add (midi-short 3 [-32 0 56])) ;; pitch bend?! = -32

       (.add (midi-short 3 [-112 68 100])) ;; note on = -112

       (.add (midi-short 20 [-112 68 0]))

       (.add (midi-short 40 [-112 68 100]))

       (.add (midi-short 60 [-112 68 0]))

       (.add (midi-short 80 [-112 68 100]))

       (.add (midi-short 100 [-112 68 0]))

       (.add (midi-short 120 [-80 7 100])) ;; control change

       (.add (midi-short 120 [-112 76 100])) ;; note-on

       (.add (midi-short 181 [-80 7 90]))  ;; control change

       (.add (midi-short 209 [-80 7 80])) ;; control change

       (.add (midi-short 240 [-80 7 65])) ;; control change

       (.add (midi-short 270 [-80 7 50])) ;; control change

       (.add (midi-short 300 [-112 76 0])) ;; note on = -112

       (.add (midi-short 360 [-80 7 0])))

       ;;(.add (midi-short 360 [-1 47 0])) ;; system reset = -1

 

     sequence

     ))

 

 

 

 

 (defn read-memory 

   ([mem start length]

      (take length

            (drop start

                  mem)))

   ([start length]

      (read-memory (rom(root)) start length)))

 

 ;;; ROM MUSIC MANIPULATION

 

 (def songs;; music-headers

   {

    :pallet 0x822E

    :pkmn-center 0x8237

    :gym 0x8240

    :city-1 0x8249 ;;virian, pewter, saffron

    :city-2 0x8255 ;; cerulean, fuchsia

    :celedon 0x825E

    :cinnibar 0x8267

    :vermilion 0x8270

    :lavender 0x827C

    :ss-anne 0x8288

    :meet-prof 0x8291

    :meet-blue 0x829A

    :follow 0x82A3

    :evolution 0x82AF

    :sfx-heal 0x82B8

    :route-1 0x82C1 ;; route 1,2

    :route-2 0x82CD ;; route 24, 25

    :route-3 0x82D9 ;; route 3-10,16-22

    :route-4 0x82E5 ;; route 11-15

    :route-5 0x82F1 ;; indigo plateau

 

    ;;:1 0xc977 ;; fourteen "tracks" X

    :1 0x801cb  ;; slot machine music

    :2 0x801d4  

    :3 0x801dd 

 

    :4 0x202be ;; uber slow battle songs?

    :5 0x202c7 ;; can't play with pallet or bike (wrong base)

    :6 0x202d9

    :7 0x202e2

    :8 0x202eb

    :9 0x202f4

    

    :title 0x7C249

    :credits 0x7C255

    :hall-of-fame 0x7C25E

    :lab-prof 0x7C267

    :jigglypuff 0x7C270

    :bike 0x7C276

    :surfing 0x7C282

    :casino 0x7C28B

    :intro 0x7C294

    :power-plant 0x7C29D ;; power plant, unknown dungeon

    :viridian-forest 0x7C2A9 ;;viridian forest, seafoam islands

    :victory-rd 0x7C2B5 ;;mt moon, rock tunnel, victory rd 

    :mansion 0x7C2C1

    :pkmn-tower 0x7C2CD

    :silph 0x7C2D6

    :trainer-bad 0x7C2DF

    :trainer-girl 0x7C2E8 

    :trainer-angry 0x7C2F1

    })

 

 

 (defn low-high-format

   "Returns the number represented by the bytes."

   [low high]

   (+ low (* 256  high)))

 (defn high-low-format

   "Returns the number represented by the bytes."

   [high low]

   (+ low (* 256 high)))

 

 

 (defn rom-tracks

   "Given a valid address to a music header, returns a list of the

 data tracks"

   [address]

   (let [rom (rom (root))

         tracklist

         ((fn extract-tracklist [mem n]

            (if (= (nth mem 2) n)

              (cons (low-high-format (first mem)

                        (second mem))

                    (extract-tracklist (drop 3 mem) (inc n)))              

              '()))

      

          (take 12 (drop (inc address) rom))

          1

          )]

 

     tracklist

     (map

      (fn [trk] (take-while #(not= 0xFF %) (drop trk rom)))

      tracklist)

 

     ))

   

 

 

 (defn find-music []

   (let [extract-song

         (fn [mem]

           (if (and

                (> (count mem) 6)

                (zero? (rem (first mem) 16))

                (not(zero? (first mem)))

                (= (nth mem 3) 1)

                (= (nth mem 6) 2))

             (take 12 mem)))]

     (loop [mem (rom)

            results []

            ptr 0]

       (cond (empty? mem)

             results

 

             (nil? (extract-song mem))

             (recur (rest mem)

                    results

                    (inc ptr))

             :else

             (recur (rest mem)

                    (conj results

                          [(hex ptr) (extract-song mem)])

                    (inc ptr))))))

            

 (defn music-header

   "Given a valid address to a music header, returns the music header."

   [address]

   (let [

         rom (rom)

         data   (drop address rom)

         ]

     (->

      (loop [n 1 k 3]

        (if (= n (nth data k))

          (recur (inc n) (+ k 3))

          k))

      (take data))))

 

 (defn pallet-song [song-name]

   (write-rom!

    (rewrite-memory

     (vec(rom))

     0x822e

     (music-header (songs song-name)))))

 

 (defn bike-song [song-name]

   (write-rom!

    (rewrite-memory

     (vec(rom))

     0x7c276

     (music-header (songs song-name)))))

 

 (defn bike-song* [address]

   (write-rom!

    (rewrite-memory

     (vec(rom))

     0x7c276

     (music-header address))))

 

 

 (defn pallet-song* [address]

   (write-rom!

    (rewrite-memory

     (vec(rom))

     0x822e

     (music-header address))))

 ;; (defn note?

 ;;   "Does the given byte correspond to a note?"

 ;;   [n])

   

 ;; (comment defn parse-ops

 ;;   "Consumes the list of opcodes, returning a runnable MIDI Sequence object."

 ;;   [ops]

 ;;   (

 ;;    (fn [midi ops]

 ;;      (let [x (first ops)]

 ;;        (cond (empty? ops) midi

 ;;              (= x 0xDA)

 ;;                ;; set tempo (high-low (nth ops 1)(nth ops 2))

 ;;              (recur (identity midi) (drop 3 ops))

              

 ;;              (note? x)

              

 

 ;;              )

 

 ;;    (doto (Sequence. (float 30) 15) ;; 30 fps, 15 frames per beat

 ;;      (.createTrack))

 ;;    ops

 ;;   ))))

 

 

 

 

 

 

   

 ;; 8237-823F Pokecenter 

 ;; 8240-8248 Gym 

 ;; 8249-8254 Viridian / Pewter / Saffron 

 ;; 8255-825D Cerulean / Fuchsia 

 ;; 825E-8266 Celedon 

 ;; 8267-826F Cinnibar 

 ;; 8270-827B Vermilion 

 ;; 827C-8287 Lavender 

 ;; 8288-8290 S.S. Anne 

 ;; 8291-8299 Meet Prof. Oak 

 ;; 829A-82A2 Meet Rival 

 ;; 82A3-82AE Guy Walks you to Museum 

 ;; 82AF-82B7 Safari Zone 

 ;; 82B8-82C0 Pokemon get healed 

 ;; 82C1-82CC Routes 1 / 2 

 ;; 82CD-82D8 Routes 24 / 25 

 ;; 82D9-82E4 Routes 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 16 / 17 / 18 / 19 / 20 / 21 / 22 

 ;; 82E5-82F0 Routes 11 / 12 / 13 / 14 / 15 

 ;; 82F1-82FD Route 23 / Indigo Plateau 

 ;; 7C249-7C254 Title Screen 

 ;; 7C255-7C25D Credits 

 ;; 7C25E-7C266 Hall of FAme Registration 

 ;; 7C267-7C26F PRof Oak's LAb 

 ;; 7C270-7C275 Jigglypuff's Song 

 ;; 7C276-7C281 Bike Riding 

 ;; 7C282-7C28A Surfing 

 ;; 7C28B-7C293 Casino 

 ;; 7C294-7C29F Introduction Battle 

 ;; 7C2A0-7C2AB Power Plant / Unknown Dungeon 

 ;; 7C2AC-7C2B7 Viridian Forest / Seafoam Islands 

 ;; 7C2B8-7C2C3 Mt. Moon / Rock Tunnel / Victory Road 

 ;; 7C2C4-7C2CF Cinnibar Mansion 

 ;; 7C2D0-7C2D8 Pokemon Tower 

 ;; 7C2D9-7C2E1 Silph Co 

 ;; 7C2E2-7C2EA Meet Bad Trainer 

 ;; 7C2EB-7C2F3 Meet Girl Trainer 

 ;; 7C2F4-7C2FC Meet Angry Trainer