Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 425:df4e03672b05

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
implemented note-code message.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 05:45:25 -0500
parents 7bd806c4dbb6
children c03f28aa98d9
rev   line source
rlm@417 1 (ns com.aurellem.run.music
rlm@417 2 (:use (com.aurellem.gb saves gb-driver util constants
rlm@417 3 items vbm characters money
rlm@417 4 rlm-assembly))
rlm@417 5 (:use (com.aurellem.run util title save-corruption
rlm@417 6 bootstrap-0 bootstrap-1))
rlm@417 7 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@417 8
rlm@417 9
rlm@417 10 (def music-base new-kernel)
rlm@417 11
rlm@417 12
rlm@417 13
rlm@417 14
rlm@417 15 (defn store [n address]
rlm@417 16 (flatten
rlm@417 17 [0xF5
rlm@417 18 0xE5
rlm@417 19
rlm@417 20 0x3E
rlm@417 21 n
rlm@417 22
rlm@417 23 0x21
rlm@417 24 (reverse (disect-bytes-2 address))
rlm@417 25
rlm@417 26 0x77
rlm@417 27
rlm@417 28 0xE1
rlm@417 29 0xF1]))
rlm@417 30
rlm@417 31 (defn infinite-loop []
rlm@417 32 [0x18 0xFE])
rlm@417 33
rlm@417 34
rlm@417 35
rlm@417 36 (def divider-register 0xFF04)
rlm@417 37
rlm@417 38
rlm@417 39 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 40
rlm@417 41 (defn clear-music-registers []
rlm@417 42 (flatten
rlm@417 43 [(store (Integer/parseInt "00000000" 2) 0xFF10)
rlm@417 44 (store (Integer/parseInt "00000000" 2) 0xFF11)
rlm@417 45 (store (Integer/parseInt "00000000" 2) 0xFF12)
rlm@417 46 (store (Integer/parseInt "00000000" 2) 0xFF13)
rlm@417 47 (store (Integer/parseInt "00000000" 2) 0xFF14)
rlm@417 48
rlm@417 49 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 50 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 51 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 52 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 53
rlm@417 54 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 55 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 56 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 57 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 58 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 59
rlm@417 60 (store (Integer/parseInt "00000000" 2) 0xFF20)
rlm@417 61 (store (Integer/parseInt "00000000" 2) 0xFF21)
rlm@417 62 (store (Integer/parseInt "00000000" 2) 0xFF22)
rlm@417 63 (store (Integer/parseInt "00000000" 2) 0xFF23)]))
rlm@417 64
rlm@424 65
rlm@424 66 ;; mini-midi syntax
rlm@424 67
rlm@424 68 ;; codes
rlm@424 69 ;; note-code == 0x00
rlm@424 70 ;; change-duty-code = 0x01
rlm@424 71 ;; silence-code = 0x02
rlm@424 72
rlm@424 73 ;; silence format
rlm@424 74 ;; 2 bytes
rlm@424 75 ;; [silence-code (0x02)]
rlm@424 76 ;; [duration-8-bits]
rlm@424 77
rlm@424 78 ;; note data format
rlm@424 79 ;; 4 bytes
rlm@424 80 ;; [note-code (0x00)]
rlm@424 81 ;; [volume-4-bits 0 frequency-high-3-bits]
rlm@424 82 ;; [frequengy-low-8-bits]
rlm@424 83 ;; [duration-8-bits]
rlm@424 84
rlm@424 85 ;; change-duty-format
rlm@424 86 ;; 2 bytes
rlm@424 87 ;; [change-duty-code (0x01)]
rlm@424 88 ;; [new-duty]
rlm@424 89
rlm@425 90 (def note-code 0x00)
rlm@425 91 (def change-duty-code 0x01)
rlm@425 92 (def silence-code 0x02)
rlm@425 93
rlm@425 94
rlm@424 95 (defn do-message
rlm@424 96 "Read the message which starts at the current value of HL and do
rlm@424 97 what it says. Duration is left in A, and HL is advanced
rlm@424 98 appropraitely."
rlm@424 99 []
rlm@425 100 (let [switch
rlm@425 101 [0x2A ;; load message code into A, increment HL
rlm@425 102
rlm@425 103 ;; switch on message
rlm@425 104 0xFE
rlm@425 105 note-code
rlm@425 106
rlm@425 107 0x20
rlm@425 108 :note-length]
rlm@424 109
rlm@425 110 play-note
rlm@425 111 [0x2A ;; load volume/frequency-high info
rlm@425 112 0xF5 ;; push A
rlm@425 113 0xE6
rlm@425 114 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@425 115 0xE0
rlm@425 116 0x17 ;; set volume
rlm@425 117 0xF1 ;; pop A
rlm@425 118 0xE6
rlm@425 119 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@425 120 0xE0
rlm@425 121 0x19 ;; set frequency-high
rlm@425 122
rlm@425 123 0x2A ;; load frequency low-bits
rlm@425 124 0xE0
rlm@425 125 0x18 ;; set frequency-low-bits
rlm@425 126
rlm@425 127 0x2A]] ;; load duration
rlm@425 128 (replace
rlm@425 129 {:note-length (count play-note)}
rlm@425 130 (concat switch play-note))))
rlm@424 131
rlm@417 132 (defn play-note
rlm@417 133 "Play the note referenced by HL in the appropiate channel.
rlm@417 134 Leaves desired-duration in A."
rlm@417 135 []
rlm@417 136 [0x2A ;; load volume/frequency-high info
rlm@417 137 0xF5 ;; push A
rlm@417 138 0xE6
rlm@417 139 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@417 140 0xE0
rlm@417 141 0x17 ;; set volume
rlm@417 142 0xF1 ;; pop A
rlm@417 143 0xE6
rlm@417 144 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@417 145 0xE0
rlm@417 146 0x19 ;; set frequency-high
rlm@417 147
rlm@417 148 0x2A ;; load frequency low-bits
rlm@417 149 0xE0
rlm@417 150 0x18 ;; set frequency-low-bits
rlm@417 151
rlm@424 152 0x2A ;; load duration
rlm@418 153 ])
rlm@417 154
rlm@417 155 (defn music-step []
rlm@417 156 (flatten
rlm@424 157 [
rlm@417 158 0xF5 ;; push A
rlm@417 159 0xF0
rlm@417 160 0x05 ;; load current ticks
rlm@418 161 0xB8 ;; B holds previous sub-ticks, subtract it from A
rlm@417 162 ;; if A-B caused a carry, then (B > A) is true, and
rlm@417 163 ;; A = current-sub-tics, B = previous-sub-ticks, so
rlm@417 164 ;; current-sub-ticks < previous-sub-ticks, which means that the
rlm@417 165 ;; timer counter HAS overflowed.
rlm@417 166 0x30 ;; increment C only if last result caused carry
rlm@417 167 0x01
rlm@418 168 0x0C
rlm@417 169
rlm@417 170 0x47 ;; update sub-ticks (A->B)
rlm@417 171
rlm@417 172 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 173
rlm@417 174 0xB9 ;; compare with current ticks
rlm@417 175
rlm@417 176 ;; if desired-ticks = current ticks
rlm@417 177 ;; go to next note ; set current set ticks to 0.
rlm@417 178
rlm@417 179 0x20
rlm@425 180 (+ (count (do-message)) 2)
rlm@417 181
rlm@425 182 (do-message)
rlm@417 183
rlm@417 184 0x0E
rlm@417 185 0x00])) ;; 0->C (current-ticks)
rlm@417 186
rlm@417 187 (defn music-kernel []
rlm@417 188 (flatten
rlm@417 189 [(clear-music-registers)
rlm@418 190
rlm@417 191 0x21
rlm@417 192 0x00
rlm@417 193 0xD0 ;; set HL to 0xD000 == music-start
rlm@417 194 0x0E
rlm@417 195 0x00 ;; 0->C
rlm@417 196 0x06
rlm@417 197 0x00 ;; 0->B
rlm@417 198
rlm@417 199 0x3E
rlm@418 200 0x01
rlm@417 201 0xE0
rlm@417 202 0x06 ;; set TMA to 0
rlm@417 203
rlm@417 204 0x3E
rlm@423 205 (Integer/parseInt "00000110" 2)
rlm@417 206 0xE0
rlm@423 207 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 208
rlm@424 209
rlm@424 210 0xAF ;; initialiaze A to zero
rlm@424 211
rlm@424 212
rlm@417 213 (music-step)
rlm@417 214 0x18
rlm@417 215 (->signed-8-bit (+ (- (count (music-step)))
rlm@417 216 -2))]))
rlm@417 217
rlm@424 218 (defn frequency-code->frequency
rlm@424 219 [code]
rlm@424 220 (assert (<= 0 code 2047))
rlm@424 221 (/ 131072 (- 2048 code)))
rlm@424 222
rlm@424 223 (defn clamp [x low high]
rlm@424 224 (cond (> x high) high
rlm@424 225 (< x low) low
rlm@424 226 true x))
rlm@424 227
rlm@424 228 (defn frequency->frequency-code
rlm@424 229 [frequency]
rlm@424 230 (clamp
rlm@424 231 (Math/round
rlm@424 232 (float
rlm@424 233 (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424 234 0x00 2048))
rlm@424 235
rlm@424 236 (defn note-codes [frequency volume duration]
rlm@424 237 (assert (<= 0 volume 0xF))
rlm@424 238 (assert (<= 0 duration 0xFF))
rlm@424 239 (let [frequency-code
rlm@424 240 (frequency->frequency-code frequency)
rlm@424 241 volume&high-frequency
rlm@424 242 (+ (bit-shift-left volume 4)
rlm@424 243 (bit-shift-right frequency-code 8))
rlm@424 244 low-frequency
rlm@424 245 (bit-and 0xFF frequency-code)]
rlm@425 246 [note-code
rlm@425 247 volume&high-frequency
rlm@424 248 low-frequency
rlm@424 249 duration]))
rlm@424 250
rlm@424 251 (def C4 (partial note-codes 261.63))
rlm@424 252 (def D4 (partial note-codes 293.66))
rlm@424 253 (def E4 (partial note-codes 329.63))
rlm@424 254 (def F4 (partial note-codes 349.23))
rlm@424 255 (def G4 (partial note-codes 392))
rlm@424 256 (def A4 (partial note-codes 440))
rlm@424 257 (def B4 (partial note-codes 493.88))
rlm@424 258 (def C5 (partial note-codes 523.3))
rlm@424 259
rlm@424 260 (def scale
rlm@424 261 (flatten
rlm@424 262 [(C4 0xF 0x40)
rlm@424 263 (D4 0xF 0x40)
rlm@424 264 (E4 0xF 0x40)
rlm@424 265 (F4 0xF 0x40)
rlm@424 266 (G4 0xF 0x40)
rlm@424 267 (A4 0xF 0x40)
rlm@424 268 (B4 0xF 0x40)
rlm@424 269 (C5 0xF 0x40)]))
rlm@424 270
rlm@418 271 (defn play-music [music-bytes]
rlm@417 272 (let [program-target 0xC000
rlm@417 273 music-target 0xD000]
rlm@417 274 (-> (set-memory-range (second (music-base))
rlm@417 275 program-target (music-kernel))
rlm@417 276 (set-memory-range music-target music-bytes)
rlm@417 277 (PC! program-target))))
rlm@417 278
rlm@417 279
rlm@417 280 (defn test-note [music-bytes]
rlm@417 281 (-> (set-memory-range (second (music-base))
rlm@417 282 0xC000 (concat (clear-music-registers)
rlm@417 283 (play-note)
rlm@417 284 (infinite-loop)))
rlm@417 285 (set-memory-range 0xD000 music-bytes)
rlm@417 286 (PC! 0xC000)
rlm@417 287 (HL! 0xD000)
rlm@417 288 ))
rlm@417 289
rlm@417 290
rlm@417 291 (defn run-program
rlm@418 292 ([program]
rlm@417 293 (let [target 0xC000]
rlm@417 294 (-> (set-memory-range (second (music-base))
rlm@417 295 target program)
rlm@417 296 (PC! target)))))
rlm@417 297
rlm@418 298 (defn trippy []
rlm@418 299 (run-moves (play-music many-notes ) (repeat 8000 [])))
rlm@417 300
rlm@424 301 (defn test-timer []
rlm@424 302 (flatten
rlm@424 303 [0x3E
rlm@424 304 0x01
rlm@424 305 0xE0
rlm@424 306 0x06 ;; set TMA to 0
rlm@424 307
rlm@424 308 0x3E
rlm@424 309 (Integer/parseInt "00000100" 2)
rlm@424 310 0xE0
rlm@424 311 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424 312
rlm@424 313 (repeat
rlm@424 314 500
rlm@424 315 [0xF0
rlm@424 316 0x05])]))