(ns com.aurellem.run.music

   (:use (com.aurellem.gb saves gb-driver util constants

                          items vbm characters money

                          rlm-assembly))

   (:use (com.aurellem.run util title save-corruption

                           bootstrap-0 bootstrap-1))

   (:require clojure.string)

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

   (:import java.io.File))

 

 (def third-kind

   (File. "/home/r/proj/midi/third-kind.mid"))

 

 (defn raw-midi-text [#^File midi-file]

   (:out 

    (clojure.java.shell/sh

     "midicsv"

     (.getCanonicalPath midi-file)

     "-")))

 

 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")

 

 (defmulti parse-command :command)

 

 (defn discard-args [command] (dissoc command :args))

 

 (defmethod parse-command :Start_track

   [command] (discard-args command))

 

 (defmethod parse-command :End_track

   [command] (discard-args command))

 

 (defmethod parse-command :default

   [command] command)

 

 (defn parse-number-list

   [number-list-str]

   (map #(Integer/parseInt %)

        (clojure.string/split number-list-str #", ")))

 

 (defmethod parse-command :Tempo

   [command]

   (update-in command [:args] #(Integer/parseInt %)))

 

 (defn parse-midi-note-list

   [midi-note-list-str]

   (let [[channel note velocity]

         (parse-number-list midi-note-list-str)]

     {:channel channel :note note :velocity velocity}))

 

 (defmethod parse-command :Note_on_c

   [command]

   (update-in command [:args] parse-midi-note-list))

 

 (defmethod parse-command :Note_off_c

   [command]

   (update-in command [:args] parse-midi-note-list))

 

 (defmethod parse-command :Header

   [command]

   (let [args (:args command)

         [format num-tracks division] (parse-number-list args)]

     (assoc command :args

            {:format format

             :num-tracks num-tracks

             :division division})))

         

 (defmethod parse-command :Program_c

   [command]

   (let [args (:args command)

         [channel program-num] (parse-number-list args)]

     (assoc command :args

            {:channel channel

             :program-num program-num})))

 

 (defn parse-midi [#^File midi-file]

   (map

    (comp parse-command

          (fn [line]

            (let [[[_ channel time command args]]

                  (re-seq command-line line)]

              {:channel (Integer/parseInt channel)

               :time (Integer/parseInt time)

               :command (keyword command)

               :args (apply str (drop 2 args))})))

    (drop-last

     (clojure.string/split-lines

      (raw-midi-text midi-file)))))

   

 (def music-base new-kernel)

 

 (defn store [n address]

   (flatten

    [0xF5

     0xE5

     

     0x3E

     n

     

     0x21

     (reverse (disect-bytes-2 address))

 

     0x77

     

     0xE1

     0xF1]))

 

 (defn infinite-loop []

   [0x18 0xFE])

 

 (def divider-register 0xFF04)

 

 (defrecord Bit-Note [frequency volume duration duty])

 

 (defn clear-music-registers []

   (flatten

    [(store (Integer/parseInt "00000000" 2) 0xFF10)

     (store (Integer/parseInt "00000000" 2) 0xFF11)

     (store (Integer/parseInt "00000000" 2) 0xFF12)

     (store (Integer/parseInt "00000000" 2) 0xFF13)

     (store (Integer/parseInt "00000000" 2) 0xFF14)

 

     (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000

     (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000

     (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low

     (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high

 

     (store (Integer/parseInt "00000000" 2) 0xFF1A)

     (store (Integer/parseInt "00000000" 2) 0xFF1B)

     (store (Integer/parseInt "00000000" 2) 0xFF1C)

     (store (Integer/parseInt "00000000" 2) 0xFF1D)

     (store (Integer/parseInt "00000000" 2) 0xFF1E)

 

     (store (Integer/parseInt "00000000" 2) 0xFF20)

     (store (Integer/parseInt "00000000" 2) 0xFF21)

     (store (Integer/parseInt "00000000" 2) 0xFF22)

     (store (Integer/parseInt "00000000" 2) 0xFF23)]))

 

 

 ;; mini-midi syntax

 

 ;; codes

 ;; note-code == 0x00

 ;; change-duty-code = 0x01

 ;; silence-code = 0x02

 

 ;; silence format

 ;;  2 bytes

 ;;  [silence-code (0x02)]

 ;;  [duration-8-bits]

 

 ;; note data format

 ;;  4 bytes

 ;;  [note-code (0x00)]

 ;;  [volume-4-bits 0 frequency-high-3-bits]

 ;;  [frequengy-low-8-bits]

 ;;  [duration-8-bits]

 

 ;; change-duty-format

 ;;  2 bytes

 ;;  [change-duty-code (0x01)]

 ;;  [new-duty]

 

 (def note-code 0x00)

 (def change-duty-code 0x01)

 (def silence-code 0x02)

 

 (defn do-message

   "Read the message which starts at the current value of HL and do

    what it says. Duration is left in A, and HL is advanced

    appropraitely."

   []

   (let [switch

         [0x2A ;; load message code into A, increment HL

          

          ;; switch on message

          0xFE

          note-code

          

          0x20

          :note-length]

 

         play-note

         [0x2A   ;; load volume/frequency-high info

          0xF5   ;; push A

          0xE6

          (Integer/parseInt "11110000" 2) ;; volume mask

          0xE0

          0x17   ;; set volume

          0xF1   ;; pop A

          0xE6

          (Integer/parseInt "00000111" 2) ;; frequency-high mask

          0xE0   

          0x19   ;; set frequency-high

          

          0x2A   ;; load frequency low-bits

          0xE0

          0x18   ;; set frequency-low-bits

          

          0x2A]]   ;; load duration

     (replace

      {:note-length (count play-note)}

      (concat switch play-note))))

 

 (defn play-note

   "Play the note referenced by HL in the appropiate channel.

    Leaves desired-duration in A."

   []

   [0x2A   ;; load volume/frequency-high info

    0xF5   ;; push A

    0xE6

    (Integer/parseInt "11110000" 2) ;; volume mask

    0xE0

    0x17   ;; set volume

    0xF1   ;; pop A

    0xE6

    (Integer/parseInt "00000111" 2) ;; frequency-high mask

    0xE0   

    0x19   ;; set frequency-high

    

    0x2A   ;; load frequency low-bits

    0xE0

    0x18   ;; set frequency-low-bits

 

    0x2A   ;; load duration

    ]) 

 

 (defn music-step []

   (flatten

    [

     0xF5 ;; push A

     0xF0

     0x05 ;; load current ticks

     0xB8 ;; B holds previous sub-ticks, subtract it from A

     ;; if A-B caused a carry, then (B > A) is true, and

     ;; A = current-sub-tics, B = previous-sub-ticks, so

     ;; current-sub-ticks < previous-sub-ticks, which means that the

     ;; timer counter HAS overflowed.

     0x30 ;; increment C only if last result caused carry

     0x01

     0x0C

 

     0x47 ;; update sub-ticks (A->B)

 

     0xF1 ;; pop AF, now A contains desired-ticks

 

     0xB9 ;; compare with current ticks

 

     ;; if desired-ticks = current ticks

     ;;   go to next note ; set current set ticks to 0.

 

     0x20

     (+ (count (do-message)) 2)

 

     (do-message)

     

     0x0E

     0x00])) ;; 0->C (current-ticks)

 

 (defn music-kernel []

   (flatten

    [(clear-music-registers)

 

     0x21

     0x00

     0xD0 ;; set HL to 0xD000 == music-start

     0x0E

     0x00 ;; 0->C

     0x06

     0x00 ;; 0->B

 

     0x3E

     0x01

     0xE0

     0x06 ;; set TMA to 0

     

     0x3E

     (Integer/parseInt "00000110" 2)

     0xE0

     0x07 ;; set TAC to 65536 Hz and activate timer

 

 

     0xAF ;; initialiaze A to zero

 

 

     (music-step)

     0x18

     (->signed-8-bit (+ (- (count (music-step)))

                        -2))]))

 

 (defn frequency-code->frequency

   [code]

   (assert (<= 0 code 2047))

   (/ 131072 (- 2048 code)))

 

 (defn clamp [x low high]

   (cond  (> x high) high

          (< x low)  low

          true x))

 

 (defn frequency->frequency-code

   [frequency]

   (clamp

    (Math/round

     (float

      (/ (- (* 2048 frequency) 131072) frequency)))

    0x00 2048))

     

 (defn note-codes [frequency volume duration]

   (assert (<= 0 volume 0xF))

   (if (<= duration 0xFF)

     (let [frequency-code

           (frequency->frequency-code frequency)

           volume&high-frequency

           (+ (bit-shift-left volume 4)

              (bit-shift-right frequency-code 8))

           low-frequency

           (bit-and 0xFF frequency-code)]

       [note-code

        volume&high-frequency

        low-frequency

        duration])

     (vec

      (flatten 

       [(note-codes frequency volume 0xFF)

        (note-codes frequency volume (- duration 0xFF))]))))

   

 

 (defn midi-code->frequency

   [midi-code]

   (* 8.1757989156

      (Math/pow 2 (* (float (/ 12)) midi-code))))

 

 ;; division == clock-pulses / quarter-note

 ;; tempo    == microseconds / quarter-note

 

 ;; have: clock-pulses

 ;; want: seconds

 

 

 (defn silence [length]

   {:frequency 1

    :duration length

    :volume 0})

 

 (defn midi->mini-midi [#^File midi-file]

   (let [midi-events (parse-midi midi-file)

 

         note-on-events

         (filter #(= :Note_on_c (:command %)) midi-events)

         note-off-events

         (filter #(= :Note_off_c (:command %)) midi-events)

 

         channel-1-on

         (sort-by :time

                  (filter #(= 1 (:channel (:args %)))

                   note-on-events))

         channel-1-off

         (sort-by :time

                  (filter #(= 1 (:channel (:args %)))

                          note-off-events))

         

         

         tempo (:args (first (filter #(= :Tempo (:command %)) midi-events)))

         division (:division

                   (:args (first (filter #(= :Header (:command %)) midi-events))))

 

         notes

         (map

          (fn [note-on note-off]

            {:frequency (midi-code->frequency (:note (:args note-on)))

             :duration

             (/ (* (/ tempo division)

                   (- (:time note-off) (:time note-on)))

                1e6) ;; convert clock-pulses into seconds

             :volume (int (/ (:velocity (:args note-on)) 10))

             :time-stamp (/ (* (/ tempo division)

                               (:time note-on)) 1e6)})

          channel-1-on channel-1-off)

 

         silences

         (map (fn [note-1 note-2]

                (let [note-1-space (- (:time-stamp note-2)

                                      (:time-stamp note-1))

                      note-1-length (:duration note-1)]

                  (silence (- note-1-space note-1-length))))

              ;; to handle silence at the beginning.

              (concat [(assoc (silence 0)

                         :time-stamp 0)] notes)

              notes)

         

         notes-with-silence

         (filter (comp not zero? :duration) (interleave silences notes))

         ]

 

     (map

      (fn [note-event]

        (note-codes (:frequency note-event)

                    (:volume note-event)

                    (int (* (:duration note-event) 0x100))))

      notes-with-silence)))

 

 

 (def C4 (partial note-codes 261.63))

 (def D4 (partial note-codes 293.66))

 (def E4 (partial note-codes 329.63))

 (def F4 (partial note-codes 349.23))

 (def G4 (partial note-codes 392))

 (def A4 (partial note-codes 440))

 (def B4 (partial note-codes 493.88))

 (def C5 (partial note-codes 523.3))

 

 (def scale

   (flatten

    [(C4 0xF 0x40)

     (D4 0xF 0x40)

     (E4 0xF 0x40)

     (F4 0xF 0x40)

     (G4 0xF 0x40)

     (A4 0xF 0x40)

     (B4 0xF 0x40)

     (C5 0xF 0x40)]))

                  

 (defn play-music [music-bytes]

   (let [program-target 0xC000

         music-target 0xD000]

     (-> (set-memory-range (second (music-base))

                           program-target (music-kernel))

         (set-memory-range music-target music-bytes)

         (PC! program-target))))

 

 

 (defn test-note [music-bytes]

   (-> (set-memory-range (second (music-base))

                         0xC000 (concat (clear-music-registers)

                                        (play-note)

                                        (infinite-loop)))

       (set-memory-range 0xD000 music-bytes)

       (PC! 0xC000)

       (HL! 0xD000)

       ))

 

 

 (defn run-program

   ([program]

      (let [target 0xC000]

        (-> (set-memory-range (second (music-base))

                              target program)

            (PC! target)))))

 

 (defn test-timer []

   (flatten

    [0x3E

     0x01

     0xE0

     0x06 ;; set TMA to 0

     

     0x3E

     (Integer/parseInt "00000100" 2)

     0xE0

     0x07 ;; set TAC to 16384 Hz and activate timer

     

     (repeat

      500

      [0xF0

       0x05])]))