rlm@417: (ns com.aurellem.run.music
rlm@417:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@417:                          items vbm characters money
rlm@417:                          rlm-assembly))
rlm@417:   (:use (com.aurellem.run util title save-corruption
rlm@417:                           bootstrap-0 bootstrap-1))
rlm@417:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@417: 
rlm@417: 
rlm@417: (def music-base new-kernel)
rlm@417: 
rlm@417: 
rlm@417: 
rlm@417: 
rlm@417: (defn store [n address]
rlm@417:   (flatten
rlm@417:    [0xF5
rlm@417:     0xE5
rlm@417:     
rlm@417:     0x3E
rlm@417:     n
rlm@417:     
rlm@417:     0x21
rlm@417:     (reverse (disect-bytes-2 address))
rlm@417: 
rlm@417:     0x77
rlm@417:     
rlm@417:     0xE1
rlm@417:     0xF1]))
rlm@417: 
rlm@417: (defn infinite-loop []
rlm@417:   [0x18 0xFE])
rlm@417: 
rlm@417: 
rlm@417: 
rlm@417: (def divider-register 0xFF04)
rlm@417: 
rlm@417: 
rlm@417: (defrecord Bit-Note [frequency volume duration duty])
rlm@417: 
rlm@417: (defn clear-music-registers []
rlm@417:   (flatten
rlm@417:    [(store (Integer/parseInt "00000000" 2) 0xFF10)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF11)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF12)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF13)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF14)
rlm@417: 
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417: 
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417: 
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF20)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF21)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF22)
rlm@417:     (store (Integer/parseInt "00000000" 2) 0xFF23)]))
rlm@417: 
rlm@424: 
rlm@424: ;; mini-midi syntax
rlm@424: 
rlm@424: ;; codes
rlm@424: ;; note-code == 0x00
rlm@424: ;; change-duty-code = 0x01
rlm@424: ;; silence-code = 0x02
rlm@424: 
rlm@424: ;; silence format
rlm@424: ;;  2 bytes
rlm@424: ;;  [silence-code (0x02)]
rlm@424: ;;  [duration-8-bits]
rlm@424: 
rlm@424: ;; note data format
rlm@424: ;;  4 bytes
rlm@424: ;;  [note-code (0x00)]
rlm@424: ;;  [volume-4-bits 0 frequency-high-3-bits]
rlm@424: ;;  [frequengy-low-8-bits]
rlm@424: ;;  [duration-8-bits]
rlm@424: 
rlm@424: ;; change-duty-format
rlm@424: ;;  2 bytes
rlm@424: ;;  [change-duty-code (0x01)]
rlm@424: ;;  [new-duty]
rlm@424: 
rlm@424: (defn do-message
rlm@424:   "Read the message which starts at the current value of HL and do
rlm@424:    what it says. Duration is left in A, and HL is advanced
rlm@424:    appropraitely."
rlm@424:   []
rlm@424: 
rlm@424:   )
rlm@424: 
rlm@424: 
rlm@424: 
rlm@424: 
rlm@424: 
rlm@424: 
rlm@417: (defn play-note
rlm@417:   "Play the note referenced by HL in the appropiate channel.
rlm@417:    Leaves desired-duration in A."
rlm@417:   []
rlm@417:   [0x2A   ;; load volume/frequency-high info
rlm@417:    0xF5   ;; push A
rlm@417:    0xE6
rlm@417:    (Integer/parseInt "11110000" 2) ;; volume mask
rlm@417:    0xE0
rlm@417:    0x17   ;; set volume
rlm@417:    0xF1   ;; pop A
rlm@417:    0xE6
rlm@417:    (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@417:    0xE0   
rlm@417:    0x19   ;; set frequency-high
rlm@417:    
rlm@417:    0x2A   ;; load frequency low-bits
rlm@417:    0xE0
rlm@417:    0x18   ;; set frequency-low-bits
rlm@417: 
rlm@424:    0x2A   ;; load duration
rlm@418:    ]) 
rlm@417: 
rlm@417: (defn music-step []
rlm@417:   (flatten
rlm@424:    [
rlm@417:     0xF5 ;; push A
rlm@417:     0xF0
rlm@417:     0x05 ;; load current ticks
rlm@418:     0xB8 ;; B holds previous sub-ticks, subtract it from A
rlm@417:     ;; if A-B caused a carry, then (B > A) is true, and
rlm@417:     ;; A = current-sub-tics, B = previous-sub-ticks, so
rlm@417:     ;; current-sub-ticks < previous-sub-ticks, which means that the
rlm@417:     ;; timer counter HAS overflowed.
rlm@417:     0x30 ;; increment C only if last result caused carry
rlm@417:     0x01
rlm@418:     0x0C
rlm@417: 
rlm@417:     0x47 ;; update sub-ticks (A->B)
rlm@417: 
rlm@417:     0xF1 ;; pop AF, now A contains desired-ticks
rlm@417: 
rlm@417:     0xB9 ;; compare with current ticks
rlm@417: 
rlm@417:     ;; if desired-ticks = current ticks
rlm@417:     ;;   go to next note ; set current set ticks to 0.
rlm@417: 
rlm@417:     0x20
rlm@424:     (+ (count (play-note)) 2)
rlm@417: 
rlm@424:     (play-note)
rlm@417:     
rlm@417:     0x0E
rlm@417:     0x00])) ;; 0->C (current-ticks)
rlm@417: 
rlm@417: (defn music-kernel []
rlm@417:   (flatten
rlm@417:    [(clear-music-registers)
rlm@418: 
rlm@417:     0x21
rlm@417:     0x00
rlm@417:     0xD0 ;; set HL to 0xD000 == music-start
rlm@417:     0x0E
rlm@417:     0x00 ;; 0->C
rlm@417:     0x06
rlm@417:     0x00 ;; 0->B
rlm@417: 
rlm@417:     0x3E
rlm@418:     0x01
rlm@417:     0xE0
rlm@417:     0x06 ;; set TMA to 0
rlm@417:     
rlm@417:     0x3E
rlm@423:     (Integer/parseInt "00000110" 2)
rlm@417:     0xE0
rlm@423:     0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417: 
rlm@424: 
rlm@424:     0xAF ;; initialiaze A to zero
rlm@424: 
rlm@424: 
rlm@417:     (music-step)
rlm@417:     0x18
rlm@417:     (->signed-8-bit (+ (- (count (music-step)))
rlm@417:                        -2))]))
rlm@417: 
rlm@418: (def one-note
rlm@418:   [0xA0 0x00 0xFF])
rlm@417: 
rlm@418: (def many-notes
rlm@418:   (flatten (repeat 10 one-note)))
rlm@418: 
rlm@418: (def increasing-notes
rlm@418:   [0xA0 0x00 0x55
rlm@418:    0xA1 0x00 0x55
rlm@418:    0xA2 0x00 0x55
rlm@418:    0xA3 0x00 0x55
rlm@418:    0xA4 0x00 0x55
rlm@418:    0xA5 0x00 0x55
rlm@418:    0xA6 0x00 0x55
rlm@423:    0xA6 0x55 0xFF
rlm@423:    0xA6 0x55 0xFF
rlm@423:    0xA6 0x55 0xFF
rlm@423:    0x00 0x00 0xFF
rlm@423:    ])
rlm@424: 
rlm@424: (defn frequency-code->frequency
rlm@424:   [code]
rlm@424:   (assert (<= 0 code 2047))
rlm@424:   (/ 131072 (- 2048 code)))
rlm@424: 
rlm@424: (defn clamp [x low high]
rlm@424:   (cond  (> x high) high
rlm@424:          (< x low)  low
rlm@424:          true x))
rlm@424: 
rlm@424: (defn frequency->frequency-code
rlm@424:   [frequency]
rlm@424:   (clamp
rlm@424:    (Math/round
rlm@424:     (float
rlm@424:      (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424:    0x00 2048))
rlm@424:     
rlm@424: (defn note-codes [frequency volume duration]
rlm@424:   (assert (<= 0 volume 0xF))
rlm@424:   (assert (<= 0 duration 0xFF))
rlm@424:   (let [frequency-code
rlm@424:         (frequency->frequency-code frequency)
rlm@424:         volume&high-frequency
rlm@424:         (+ (bit-shift-left volume 4)
rlm@424:            (bit-shift-right frequency-code 8))
rlm@424:         low-frequency
rlm@424:         (bit-and 0xFF frequency-code)]
rlm@424:     [volume&high-frequency
rlm@424:      low-frequency
rlm@424:      duration]))
rlm@424: 
rlm@424: (def C4 (partial note-codes 261.63))
rlm@424: (def D4 (partial note-codes 293.66))
rlm@424: (def E4 (partial note-codes 329.63))
rlm@424: (def F4 (partial note-codes 349.23))
rlm@424: (def G4 (partial note-codes 392))
rlm@424: (def A4 (partial note-codes 440))
rlm@424: (def B4 (partial note-codes 493.88))
rlm@424: (def C5 (partial note-codes 523.3))
rlm@424: 
rlm@424: (def scale
rlm@424:   (flatten
rlm@424:    [(C4 0xF 0x40)
rlm@424:     (D4 0xF 0x40)
rlm@424:     (E4 0xF 0x40)
rlm@424:     (F4 0xF 0x40)
rlm@424:     (G4 0xF 0x40)
rlm@424:     (A4 0xF 0x40)
rlm@424:     (B4 0xF 0x40)
rlm@424:     (C5 0xF 0x40)]))
rlm@424:                  
rlm@418: (defn play-music [music-bytes]
rlm@417:   (let [program-target 0xC000
rlm@417:         music-target 0xD000]
rlm@417:     (-> (set-memory-range (second (music-base))
rlm@417:                           program-target (music-kernel))
rlm@417:         (set-memory-range music-target music-bytes)
rlm@417:         (PC! program-target))))
rlm@417: 
rlm@417: 
rlm@417: (defn test-note [music-bytes]
rlm@417:   (-> (set-memory-range (second (music-base))
rlm@417:                         0xC000 (concat (clear-music-registers)
rlm@417:                                        (play-note)
rlm@417:                                        (infinite-loop)))
rlm@417:       (set-memory-range 0xD000 music-bytes)
rlm@417:       (PC! 0xC000)
rlm@417:       (HL! 0xD000)
rlm@417:       ))
rlm@417: 
rlm@417: 
rlm@417: (defn run-program
rlm@418:   ([program]
rlm@417:      (let [target 0xC000]
rlm@417:        (-> (set-memory-range (second (music-base))
rlm@417:                              target program)
rlm@417:            (PC! target)))))
rlm@417: 
rlm@418: (defn trippy []
rlm@418:   (run-moves (play-music many-notes ) (repeat 8000 [])))
rlm@417: 
rlm@424: (defn test-timer []
rlm@424:   (flatten
rlm@424:    [0x3E
rlm@424:     0x01
rlm@424:     0xE0
rlm@424:     0x06 ;; set TMA to 0
rlm@424:     
rlm@424:     0x3E
rlm@424:     (Integer/parseInt "00000100" 2)
rlm@424:     0xE0
rlm@424:     0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424:     
rlm@424:     (repeat
rlm@424:      500
rlm@424:      [0xF0
rlm@424:       0x05])]))