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@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@417:    0x7E   ;; load duration
rlm@418:    0x2B   ;; 
rlm@418:    0x2B   ;; HL-2 -> HL
rlm@418:    ]) 
rlm@417: 
rlm@417: (defn music-step []
rlm@417:   (flatten
rlm@417:    [(play-note)
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@417:     0x05
rlm@417: 
rlm@417:     0x23
rlm@417:     0x23
rlm@417:     0x23 ;; HL + 3 -> HL
rlm@417:     
rlm@417:     0x0E
rlm@417:     0x00])) ;; 0->C (current-ticks)
rlm@417: 
rlm@418: (defn test-timer []
rlm@418:   (flatten
rlm@418:    [0x3E
rlm@418:     0x01
rlm@418:     0xE0
rlm@418:     0x06 ;; set TMA to 0
rlm@418:     
rlm@418:     0x3E
rlm@418:     (Integer/parseInt "00000100" 2)
rlm@418:     0xE0
rlm@418:     0x07 ;; set TAC to 16384 Hz and activate timer
rlm@418:     
rlm@418:     (repeat
rlm@418:      500
rlm@418:      [0xF0
rlm@418:       0x05])]))
rlm@418: 
rlm@418: 
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@417:     (Integer/parseInt "00000111" 2)
rlm@417:     0xE0
rlm@418:     0x07 ;; set TAC to 16384 Hz and activate timer
rlm@417: 
rlm@418:     0xF0
rlm@418:     0x07
rlm@418:     
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@418:    0xA7 0x00 0x55])
rlm@418:    
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: