(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 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))

   (assert (<= 0 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]))

 

 (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])]))

 

 (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)]

              ;;(println (re-seq command-parse-1 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)))))