1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/run/music.clj	Mon Apr 16 14:08:56 2012 -0500
     1.3 @@ -0,0 +1,179 @@
     1.4 +(ns com.aurellem.run.music
     1.5 +  (:use (com.aurellem.gb saves gb-driver util constants
     1.6 +                         items vbm characters money
     1.7 +                         rlm-assembly))
     1.8 +  (:use (com.aurellem.run util title save-corruption
     1.9 +                          bootstrap-0 bootstrap-1))
    1.10 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    1.11 +
    1.12 +
    1.13 +(def music-base new-kernel)
    1.14 +
    1.15 +
    1.16 +
    1.17 +
    1.18 +(defn store [n address]
    1.19 +  (flatten
    1.20 +   [0xF5
    1.21 +    0xE5
    1.22 +    
    1.23 +    0x3E
    1.24 +    n
    1.25 +    
    1.26 +    0x21
    1.27 +    (reverse (disect-bytes-2 address))
    1.28 +
    1.29 +    0x77
    1.30 +    
    1.31 +    0xE1
    1.32 +    0xF1]))
    1.33 +
    1.34 +(defn infinite-loop []
    1.35 +  [0x18 0xFE])
    1.36 +
    1.37 +
    1.38 +
    1.39 +(def divider-register 0xFF04)
    1.40 +
    1.41 +
    1.42 +(defrecord Bit-Note [frequency volume duration duty])
    1.43 +
    1.44 +(defn clear-music-registers []
    1.45 +  (flatten
    1.46 +   [(store (Integer/parseInt "00000000" 2) 0xFF10)
    1.47 +    (store (Integer/parseInt "00000000" 2) 0xFF11)
    1.48 +    (store (Integer/parseInt "00000000" 2) 0xFF12)
    1.49 +    (store (Integer/parseInt "00000000" 2) 0xFF13)
    1.50 +    (store (Integer/parseInt "00000000" 2) 0xFF14)
    1.51 +
    1.52 +    (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
    1.53 +    (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
    1.54 +    (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
    1.55 +    (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
    1.56 +
    1.57 +    (store (Integer/parseInt "00000000" 2) 0xFF1A)
    1.58 +    (store (Integer/parseInt "00000000" 2) 0xFF1B)
    1.59 +    (store (Integer/parseInt "00000000" 2) 0xFF1C)
    1.60 +    (store (Integer/parseInt "00000000" 2) 0xFF1D)
    1.61 +    (store (Integer/parseInt "00000000" 2) 0xFF1E)
    1.62 +
    1.63 +    (store (Integer/parseInt "00000000" 2) 0xFF20)
    1.64 +    (store (Integer/parseInt "00000000" 2) 0xFF21)
    1.65 +    (store (Integer/parseInt "00000000" 2) 0xFF22)
    1.66 +    (store (Integer/parseInt "00000000" 2) 0xFF23)]))
    1.67 +
    1.68 +(defn play-note
    1.69 +  "Play the note referenced by HL in the appropiate channel.
    1.70 +   Leaves desired-duration in A."
    1.71 +  []
    1.72 +  [0x2A   ;; load volume/frequency-high info
    1.73 +   0xF5   ;; push A
    1.74 +   0xE6
    1.75 +   (Integer/parseInt "11110000" 2) ;; volume mask
    1.76 +   0xE0
    1.77 +   0x17   ;; set volume
    1.78 +   0xF1   ;; pop A
    1.79 +   0xE6
    1.80 +   (Integer/parseInt "00000111" 2) ;; frequency-high mask
    1.81 +   0xE0   
    1.82 +   0x19   ;; set frequency-high
    1.83 +   
    1.84 +   0x2A   ;; load frequency low-bits
    1.85 +   0xE0
    1.86 +   0x18   ;; set frequency-low-bits
    1.87 +
    1.88 +   0x7E   ;; load duration
    1.89 +   ;;0x2B   ;; 
    1.90 +   ;;0x2B
    1.91 +   ]) ;; HL-2 -> HL
    1.92 +
    1.93 +(defn music-step []
    1.94 +  (flatten
    1.95 +   [(play-note)
    1.96 +    0xF5 ;; push A
    1.97 +    0xF0
    1.98 +    0x05 ;; load current ticks
    1.99 +    0x90 ;; B holds previous sub-ticks, subtract it from A
   1.100 +    ;; if A-B caused a carry, then (B > A) is true, and
   1.101 +    ;; A = current-sub-tics, B = previous-sub-ticks, so
   1.102 +    ;; current-sub-ticks < previous-sub-ticks, which means that the
   1.103 +    ;; timer counter HAS overflowed.
   1.104 +    0x30 ;; increment C only if last result caused carry
   1.105 +    0x01
   1.106 +    0x00;;0x0C
   1.107 +
   1.108 +    0x47 ;; update sub-ticks (A->B)
   1.109 +
   1.110 +    0xF1 ;; pop AF, now A contains desired-ticks
   1.111 +
   1.112 +    0xB9 ;; compare with current ticks
   1.113 +
   1.114 +    ;; if desired-ticks = current ticks
   1.115 +    ;;   go to next note ; set current set ticks to 0.
   1.116 +
   1.117 +    0x20
   1.118 +    0x05
   1.119 +
   1.120 +    0x23
   1.121 +    0x23
   1.122 +    0x23 ;; HL + 3 -> HL
   1.123 +    
   1.124 +    0x0E
   1.125 +    0x00])) ;; 0->C (current-ticks)
   1.126 +
   1.127 +(defn music-kernel []
   1.128 +  (flatten
   1.129 +   [(clear-music-registers)
   1.130 +    0x21
   1.131 +    0x00
   1.132 +    0xD0 ;; set HL to 0xD000 == music-start
   1.133 +    0x0E
   1.134 +    0x00 ;; 0->C
   1.135 +    0x06
   1.136 +    0x00 ;; 0->B
   1.137 +
   1.138 +    0x3E
   1.139 +    0x00
   1.140 +    0xE0
   1.141 +    0x06 ;; set TMA to 0
   1.142 +    
   1.143 +    0x3E
   1.144 +    (Integer/parseInt "00000111" 2)
   1.145 +    0xE0
   1.146 +    0x07 ;; set TAC to 16384 Hz
   1.147 +
   1.148 +    (music-step)
   1.149 +    0x18
   1.150 +    (->signed-8-bit (+ (- (count (music-step)))
   1.151 +                       -2))]))
   1.152 +
   1.153 +
   1.154 +(defn play-music [steps music-bytes]
   1.155 +  (let [program-target 0xC000
   1.156 +        music-target 0xD000]
   1.157 +    (-> (set-memory-range (second (music-base))
   1.158 +                          program-target (music-kernel))
   1.159 +        (set-memory-range music-target music-bytes)
   1.160 +        (PC! program-target))))
   1.161 +
   1.162 +
   1.163 +(defn test-note [music-bytes]
   1.164 +  (-> (set-memory-range (second (music-base))
   1.165 +                        0xC000 (concat (clear-music-registers)
   1.166 +                                       (play-note)
   1.167 +                                       (infinite-loop)))
   1.168 +      (set-memory-range 0xD000 music-bytes)
   1.169 +      (PC! 0xC000)
   1.170 +      (HL! 0xD000)
   1.171 +      ))
   1.172 +
   1.173 +
   1.174 +(defn run-program
   1.175 +  ([program] (run-program program 90))
   1.176 +  ([program steps]
   1.177 +     (let [target 0xC000]
   1.178 +       (-> (set-memory-range (second (music-base))
   1.179 +                             target program)
   1.180 +           (PC! target)))))
   1.181 +
   1.182 +