Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 465:34bf4b64d9d1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
remove dead code.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 03:55:00 -0500
parents 413c66186baa
children b31cd6651375
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@426 7 (:require clojure.string)
rlm@426 8 (:import [com.aurellem.gb.gb_driver SaveState])
rlm@426 9 (:import java.io.File))
rlm@417 10
rlm@427 11 (def third-kind
rlm@427 12 (File. "/home/r/proj/midi/third-kind.mid"))
rlm@417 13
rlm@455 14 (def pony
rlm@455 15 (File. "/home/r/proj/vba-clojure/music/pony-title.mid"))
rlm@455 16
rlm@455 17 (def sync-test
rlm@455 18 (File. "/home/r/proj/vba-clojure/music/sync-test.mid"))
rlm@455 19
rlm@454 20
rlm@427 21 (defn raw-midi-text [#^File midi-file]
rlm@427 22 (:out
rlm@427 23 (clojure.java.shell/sh
rlm@427 24 "midicsv"
rlm@427 25 (.getCanonicalPath midi-file)
rlm@427 26 "-")))
rlm@427 27
rlm@427 28 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
rlm@427 29
rlm@427 30 (defmulti parse-command :command)
rlm@427 31
rlm@427 32 (defn discard-args [command] (dissoc command :args))
rlm@427 33
rlm@427 34 (defmethod parse-command :Start_track
rlm@427 35 [command] (discard-args command))
rlm@427 36
rlm@427 37 (defmethod parse-command :End_track
rlm@427 38 [command] (discard-args command))
rlm@427 39
rlm@427 40 (defmethod parse-command :default
rlm@427 41 [command] command)
rlm@427 42
rlm@427 43 (defn parse-number-list
rlm@427 44 [number-list-str]
rlm@427 45 (map #(Integer/parseInt %)
rlm@427 46 (clojure.string/split number-list-str #", ")))
rlm@427 47
rlm@427 48 (defmethod parse-command :Tempo
rlm@427 49 [command]
rlm@427 50 (update-in command [:args] #(Integer/parseInt %)))
rlm@427 51
rlm@427 52 (defn parse-midi-note-list
rlm@427 53 [midi-note-list-str]
rlm@427 54 (let [[channel note velocity]
rlm@427 55 (parse-number-list midi-note-list-str)]
rlm@427 56 {:channel channel :note note :velocity velocity}))
rlm@427 57
rlm@427 58 (defmethod parse-command :Note_on_c
rlm@427 59 [command]
rlm@427 60 (update-in command [:args] parse-midi-note-list))
rlm@427 61
rlm@427 62 (defmethod parse-command :Note_off_c
rlm@427 63 [command]
rlm@427 64 (update-in command [:args] parse-midi-note-list))
rlm@427 65
rlm@427 66 (defmethod parse-command :Header
rlm@427 67 [command]
rlm@427 68 (let [args (:args command)
rlm@427 69 [format num-tracks division] (parse-number-list args)]
rlm@427 70 (assoc command :args
rlm@427 71 {:format format
rlm@427 72 :num-tracks num-tracks
rlm@427 73 :division division})))
rlm@427 74
rlm@427 75 (defmethod parse-command :Program_c
rlm@427 76 [command]
rlm@427 77 (let [args (:args command)
rlm@427 78 [channel program-num] (parse-number-list args)]
rlm@427 79 (assoc command :args
rlm@427 80 {:channel channel
rlm@427 81 :program-num program-num})))
rlm@427 82
rlm@427 83 (defn parse-midi [#^File midi-file]
rlm@427 84 (map
rlm@427 85 (comp parse-command
rlm@427 86 (fn [line]
rlm@427 87 (let [[[_ channel time command args]]
rlm@427 88 (re-seq command-line line)]
rlm@427 89 {:channel (Integer/parseInt channel)
rlm@427 90 :time (Integer/parseInt time)
rlm@427 91 :command (keyword command)
rlm@427 92 :args (apply str (drop 2 args))})))
rlm@427 93 (drop-last
rlm@427 94 (clojure.string/split-lines
rlm@427 95 (raw-midi-text midi-file)))))
rlm@427 96
rlm@417 97 (def music-base new-kernel)
rlm@417 98
rlm@417 99 (defn store [n address]
rlm@417 100 (flatten
rlm@417 101 [0xF5
rlm@417 102 0xE5
rlm@417 103
rlm@417 104 0x3E
rlm@417 105 n
rlm@417 106
rlm@417 107 0x21
rlm@417 108 (reverse (disect-bytes-2 address))
rlm@417 109
rlm@417 110 0x77
rlm@417 111
rlm@417 112 0xE1
rlm@417 113 0xF1]))
rlm@417 114
rlm@417 115 (defn infinite-loop []
rlm@417 116 [0x18 0xFE])
rlm@417 117
rlm@417 118 (def divider-register 0xFF04)
rlm@417 119
rlm@417 120 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 121
rlm@417 122 (defn clear-music-registers []
rlm@417 123 (flatten
rlm@433 124 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
rlm@433 125 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
rlm@433 126 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
rlm@433 127 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
rlm@433 128 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
rlm@417 129
rlm@417 130 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 131 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 132 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 133 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 134
rlm@417 135 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 136 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 137 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 138 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 139 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 140
rlm@433 141 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
rlm@433 142 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
rlm@433 143 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
rlm@433 144 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
rlm@433 145 ]))
rlm@417 146
rlm@424 147
rlm@424 148 ;; mini-midi syntax
rlm@424 149
rlm@424 150 ;; codes
rlm@424 151 ;; note-code == 0x00
rlm@424 152 ;; change-duty-code = 0x01
rlm@424 153 ;; silence-code = 0x02
rlm@424 154
rlm@424 155 ;; silence format
rlm@424 156 ;; 2 bytes
rlm@424 157 ;; [silence-code (0x02)]
rlm@424 158 ;; [duration-8-bits]
rlm@424 159
rlm@424 160 ;; note data format
rlm@424 161 ;; 4 bytes
rlm@424 162 ;; [note-code (0x00)]
rlm@424 163 ;; [volume-4-bits 0 frequency-high-3-bits]
rlm@424 164 ;; [frequengy-low-8-bits]
rlm@424 165 ;; [duration-8-bits]
rlm@424 166
rlm@424 167 ;; change-duty-format
rlm@424 168 ;; 2 bytes
rlm@424 169 ;; [change-duty-code (0x01)]
rlm@424 170 ;; [new-duty]
rlm@424 171
rlm@425 172 (def note-code 0x00)
rlm@425 173 (def change-duty-code 0x01)
rlm@425 174 (def silence-code 0x02)
rlm@425 175
rlm@424 176 (defn do-message
rlm@424 177 "Read the message which starts at the current value of HL and do
rlm@424 178 what it says. Duration is left in A, and HL is advanced
rlm@424 179 appropraitely."
rlm@461 180 ([] (do-message 0x16 1))
rlm@461 181 ([sound-base-address wave-duty]
rlm@461 182 (assert (<= 0 wave-duty 3))
rlm@433 183 (let [switch
rlm@433 184 [0x2A ;; load message code into A, increment HL
rlm@433 185
rlm@433 186 ;; switch on message
rlm@433 187 0xFE
rlm@433 188 note-code
rlm@433 189
rlm@433 190 0x20
rlm@433 191 :note-length]
rlm@424 192
rlm@433 193 play-note
rlm@461 194 [0x3E ;; set wave-duty
rlm@461 195 (bit-shift-left wave-duty 6)
rlm@461 196 0xE0
rlm@461 197 sound-base-address
rlm@461 198 0x2A ;; load volume/frequency-high info
rlm@433 199 0xF5 ;; push A
rlm@433 200 0xE6
rlm@433 201 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433 202 0xE0
rlm@433 203 (inc sound-base-address) ;;0x17 ;; set volume
rlm@433 204 0xF1 ;; pop A
rlm@433 205 0xE6
rlm@433 206 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433 207 0xE0
rlm@433 208 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
rlm@433 209
rlm@433 210 0x2A ;; load frequency low-bits
rlm@433 211 0xE0
rlm@433 212 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
rlm@433 213 0x2A]] ;; load duration
rlm@433 214 (replace
rlm@433 215 {:note-length (count play-note)}
rlm@433 216 (concat switch play-note)))))
rlm@424 217
rlm@433 218 ;; (defn play-note
rlm@433 219 ;; "Play the note referenced by HL in the appropiate channel.
rlm@433 220 ;; Leaves desired-duration in A."
rlm@433 221
rlm@433 222 ;; [0x2A ;; load volume/frequency-high info
rlm@433 223 ;; 0xF5 ;; push A
rlm@433 224 ;; 0xE6
rlm@433 225 ;; (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433 226 ;; 0xE0
rlm@433 227 ;; 0x17 ;; set volume
rlm@433 228 ;; 0xF1 ;; pop A
rlm@433 229 ;; 0xE6
rlm@433 230 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433 231 ;; 0xE0
rlm@433 232 ;; 0x19 ;; set frequency-high
rlm@417 233
rlm@433 234 ;; 0x2A ;; load frequency low-bits
rlm@433 235 ;; 0xE0
rlm@433 236 ;; 0x18 ;; set frequency-low-bits
rlm@417 237
rlm@433 238 ;; 0x2A ;; load duration
rlm@433 239 ;; ])
rlm@417 240
rlm@461 241 (defn music-step [sound-base-address wave-duty]
rlm@432 242 ;; C == current-ticks
rlm@432 243 ;; A == desired-ticks
rlm@435 244
rlm@435 245 (flatten
rlm@435 246 [;; restore variables from stack
rlm@435 247 0xE1 ;; pop HL
rlm@435 248 0xC1 ;; pop CB
rlm@435 249 0xF1 ;; pop AF
rlm@432 250
rlm@435 251
rlm@435 252 0xF5 ;; push A
rlm@417 253 0xF0
rlm@432 254 0x05 ;; load current ticks from 0xF005
rlm@431 255 0xB8 ;;
rlm@417 256 0x30 ;; increment C only if last result caused carry
rlm@417 257 0x01
rlm@418 258 0x0C
rlm@417 259
rlm@417 260 0x47 ;; update sub-ticks (A->B)
rlm@417 261
rlm@417 262 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 263
rlm@417 264 0xB9 ;; compare with current ticks
rlm@417 265
rlm@417 266 ;; if desired-ticks = current ticks
rlm@417 267 ;; go to next note ; set current set ticks to 0.
rlm@417 268
rlm@417 269 0x20
rlm@461 270 (+ (count (do-message 0 0)) 2)
rlm@417 271
rlm@461 272 (do-message sound-base-address wave-duty)
rlm@417 273
rlm@417 274 0x0E
rlm@435 275 0x00 ;; 0->C (current-ticks)
rlm@417 276
rlm@435 277 ;; save variables to stack
rlm@435 278 0xF5 ;; push AF
rlm@435 279 0xC5 ;; push CB
rlm@435 280 0xE5 ;; push HL
rlm@435 281
rlm@435 282
rlm@435 283 ]))
rlm@435 284
rlm@435 285 (def music-1 0x11)
rlm@434 286 (def music-2 0x16)
rlm@434 287
rlm@461 288 (defn music-kernel [wave-duty-1 wave-duty-2]
rlm@417 289 (flatten
rlm@432 290 [;; global initilization section
rlm@432 291 (clear-music-registers)
rlm@432 292
rlm@417 293 0x3E
rlm@418 294 0x01
rlm@417 295 0xE0
rlm@417 296 0x06 ;; set TMA to 0
rlm@417 297
rlm@417 298 0x3E
rlm@423 299 (Integer/parseInt "00000110" 2)
rlm@417 300 0xE0
rlm@423 301 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 302
rlm@435 303 ;; initialize frame 1
rlm@432 304 0x21
rlm@432 305 0x00
rlm@437 306 0xA0 ;; set HL to 0xA000 == music-start 1
rlm@432 307 0x0E
rlm@432 308 0x00 ;; 0->C
rlm@432 309 0x06
rlm@432 310 0x00 ;; 0->B
rlm@435 311
rlm@433 312 0xAF ;; 0->A
rlm@432 313
rlm@435 314 0xF5 ;; push AF
rlm@435 315 0xC5 ;; push CB
rlm@435 316 0xE5 ;; push HL
rlm@432 317
rlm@435 318 ;; initialize frame 2
rlm@436 319 0x21
rlm@436 320 0x00
rlm@437 321 0xB0 ;; set HL to 0xB000 == music-start 2
rlm@436 322
rlm@436 323 0xF5 ;; push AF
rlm@436 324 0xC5 ;; push CB
rlm@436 325 0xE5 ;; push HL
rlm@436 326
rlm@436 327
rlm@437 328 ;; main music loop
rlm@437 329
rlm@437 330 0xE8 ;; SP + 6; activate frame 1
rlm@437 331 6
rlm@461 332 (music-step music-1 wave-duty-1)
rlm@437 333 ;;(repeat (count (music-step music-1)) 0x00)
rlm@435 334
rlm@437 335 0xE8 ;; SP - 6; activate frame 2
rlm@437 336 (->signed-8-bit -6)
rlm@437 337 ;;(repeat (count (music-step music-2)) 0x00)
rlm@461 338 (music-step music-2 wave-duty-2)
rlm@433 339
rlm@424 340
rlm@417 341 0x18
rlm@437 342 (->signed-8-bit (+
rlm@437 343 ;; two music-steps
rlm@461 344 (- (* 2 (count (music-step 0 0))))
rlm@437 345 -2 ;; this jump instruction
rlm@437 346 -2 ;; activate frame 1
rlm@437 347 -2 ;; activate frame 2
rlm@437 348 ))]))
rlm@417 349
rlm@424 350 (defn frequency-code->frequency
rlm@424 351 [code]
rlm@424 352 (assert (<= 0 code 2047))
rlm@424 353 (/ 131072 (- 2048 code)))
rlm@424 354
rlm@424 355 (defn clamp [x low high]
rlm@424 356 (cond (> x high) high
rlm@424 357 (< x low) low
rlm@424 358 true x))
rlm@424 359
rlm@424 360 (defn frequency->frequency-code
rlm@424 361 [frequency]
rlm@424 362 (clamp
rlm@424 363 (Math/round
rlm@424 364 (float
rlm@424 365 (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424 366 0x00 2048))
rlm@424 367
rlm@424 368 (defn note-codes [frequency volume duration]
rlm@424 369 (assert (<= 0 volume 0xF))
rlm@430 370 (if (<= duration 0xFF)
rlm@430 371 (let [frequency-code
rlm@430 372 (frequency->frequency-code frequency)
rlm@430 373 volume&high-frequency
rlm@430 374 (+ (bit-shift-left volume 4)
rlm@430 375 (bit-shift-right frequency-code 8))
rlm@430 376 low-frequency
rlm@430 377 (bit-and 0xFF frequency-code)]
rlm@430 378 [note-code
rlm@430 379 volume&high-frequency
rlm@430 380 low-frequency
rlm@430 381 duration])
rlm@430 382 (vec
rlm@430 383 (flatten
rlm@430 384 [(note-codes frequency volume 0xFF)
rlm@430 385 (note-codes frequency volume (- duration 0xFF))]))))
rlm@430 386
rlm@424 387
rlm@427 388 (defn midi-code->frequency
rlm@427 389 [midi-code]
rlm@427 390 (* 8.1757989156
rlm@427 391 (Math/pow 2 (* (float (/ 12)) midi-code))))
rlm@427 392
rlm@427 393 ;; division == clock-pulses / quarter-note
rlm@427 394 ;; tempo == microseconds / quarter-note
rlm@427 395
rlm@427 396 ;; have: clock-pulses
rlm@427 397 ;; want: seconds
rlm@427 398
rlm@427 399
rlm@428 400 (defn silence [length]
rlm@428 401 {:frequency 1
rlm@428 402 :duration length
rlm@428 403 :volume 0})
rlm@427 404
rlm@462 405 (defn track-info [#^File midi-file]
rlm@462 406 (let [events (parse-midi midi-file)
rlm@462 407 track-titles (commands :Title_t events)
rlm@462 408 track-info
rlm@462 409 (map #(read-string (read-string (:args %))) track-titles)
rlm@462 410 track-map
rlm@462 411 (zipmap track-info track-titles)]
rlm@462 412 track-map))
rlm@462 413
rlm@462 414 (defn target-tracks
rlm@462 415 "return the track-numbers in the form [voice-0 voice-1 noise]"
rlm@462 416 [#^File midi-file]
rlm@462 417 (let [track-data (track-info midi-file)
rlm@462 418 track-order
rlm@462 419 (zipmap (map :out (keys track-data))
rlm@462 420 (vals track-data))
rlm@462 421 channel-nums (map (comp :channel track-order) (range 3))]
rlm@462 422 channel-nums))
rlm@462 423
rlm@438 424 (defn commands
rlm@438 425 "return all events where #(= (:command %) command)"
rlm@438 426 [command s]
rlm@438 427 (filter #(= command (:command %)) s))
rlm@438 428
rlm@438 429 (defn midi-track->mini-midi [#^File midi-file track-num]
rlm@427 430 (let [midi-events (parse-midi midi-file)
rlm@427 431
rlm@438 432 note-on-events (commands :Note_on_c midi-events)
rlm@438 433 note-off-events (commands :Note_off_c midi-events)
rlm@427 434
rlm@438 435 select-channel
rlm@438 436 (fn [n s]
rlm@462 437 (sort-by :time (filter #(= n (:channel %)) s)))
rlm@438 438
rlm@438 439 channel-on (select-channel track-num note-on-events)
rlm@427 440
rlm@438 441 channel-off (select-channel track-num note-off-events)
rlm@427 442
rlm@438 443
rlm@438 444 tempo (:args (first (commands :Tempo midi-events)))
rlm@438 445 division
rlm@438 446 (:division (:args (first (commands :Header midi-events))))
rlm@428 447
rlm@428 448 notes
rlm@428 449 (map
rlm@428 450 (fn [note-on note-off]
rlm@428 451 {:frequency (midi-code->frequency (:note (:args note-on)))
rlm@428 452 :duration
rlm@428 453 (/ (* (/ tempo division)
rlm@428 454 (- (:time note-off) (:time note-on)))
rlm@428 455 1e6) ;; convert clock-pulses into seconds
rlm@428 456 :volume (int (/ (:velocity (:args note-on)) 10))
rlm@428 457 :time-stamp (/ (* (/ tempo division)
rlm@428 458 (:time note-on)) 1e6)})
rlm@438 459 channel-on channel-off)
rlm@428 460
rlm@428 461 silences
rlm@428 462 (map (fn [note-1 note-2]
rlm@428 463 (let [note-1-space (- (:time-stamp note-2)
rlm@428 464 (:time-stamp note-1))
rlm@428 465 note-1-length (:duration note-1)]
rlm@428 466 (silence (- note-1-space note-1-length))))
rlm@428 467 ;; to handle silence at the beginning.
rlm@428 468 (concat [(assoc (silence 0)
rlm@428 469 :time-stamp 0)] notes)
rlm@428 470 notes)
rlm@428 471
rlm@428 472 notes-with-silence
rlm@456 473 (concat
rlm@456 474 (filter (comp not zero? :duration)
rlm@456 475 (interleave silences notes))
rlm@456 476 [(silence 3)])]
rlm@456 477
rlm@456 478 (map
rlm@456 479 (fn [note-event]
rlm@456 480 (note-codes (:frequency note-event)
rlm@456 481 (:volume note-event)
rlm@456 482 (int (* (:duration note-event) 0x100))))
rlm@456 483 notes-with-silence)))
rlm@456 484
rlm@438 485 (defn midi->mini-midi [#^File midi-file]
rlm@462 486 (let [targets (target-tracks midi-file)
rlm@462 487 get-track (fn [n]
rlm@462 488 (if (not (nil? n))
rlm@462 489 (midi-track->mini-midi midi-file n)
rlm@463 490 []))
rlm@463 491 duty-info (keys (track-info midi-file))]
rlm@463 492
rlm@462 493 {:voice-1 (get-track (nth targets 0))
rlm@462 494 :voice-2 (get-track (nth targets 1))
rlm@463 495 :noise (get-track (nth targets 2))
rlm@463 496 :duty (zipmap (map :out duty-info)
rlm@464 497 (map #(get % :duty 0) duty-info))}))
rlm@438 498
rlm@438 499 (defn play-midi [#^File midi-file]
rlm@438 500 (let [track-1-target 0xA000
rlm@438 501 track-2-target 0xB000
rlm@438 502 program-target 0xC000
rlm@438 503 mini-midi (midi->mini-midi midi-file)
rlm@461 504 long-silence (flatten (note-codes 20 0 9001))
rlm@463 505
rlm@463 506 voice-1 (flatten (:voice-1 mini-midi))
rlm@464 507 wave-duty-1 ((:duty mini-midi) 0 0)
rlm@463 508
rlm@463 509 voice-2 (flatten (:voice-2 mini-midi))
rlm@464 510 wave-duty-2 ((:duty mini-midi) 1 0)
rlm@461 511 ]
rlm@438 512
rlm@438 513 (-> (second (music-base))
rlm@438 514 (set-memory-range track-1-target long-silence)
rlm@438 515 (set-memory-range track-2-target long-silence)
rlm@463 516 (set-memory-range track-1-target voice-1)
rlm@463 517 (set-memory-range track-2-target voice-2)
rlm@461 518 (set-memory-range
rlm@461 519 program-target
rlm@461 520 (music-kernel wave-duty-1 wave-duty-2))
rlm@438 521 (PC! program-target))))
rlm@438 522
rlm@424 523 (def C4 (partial note-codes 261.63))
rlm@424 524 (def D4 (partial note-codes 293.66))
rlm@424 525 (def E4 (partial note-codes 329.63))
rlm@424 526 (def F4 (partial note-codes 349.23))
rlm@424 527 (def G4 (partial note-codes 392))
rlm@424 528 (def A4 (partial note-codes 440))
rlm@424 529 (def B4 (partial note-codes 493.88))
rlm@424 530 (def C5 (partial note-codes 523.3))
rlm@424 531
rlm@430 532 (def scale
rlm@430 533 (flatten
rlm@430 534 [(C4 0xF 0x40)
rlm@430 535 (D4 0xF 0x40)
rlm@430 536 (E4 0xF 0x40)
rlm@430 537 (F4 0xF 0x40)
rlm@430 538 (G4 0xF 0x40)
rlm@430 539 (A4 0xF 0x40)
rlm@430 540 (B4 0xF 0x40)
rlm@430 541 (C5 0xF 0x40)]))
rlm@424 542
rlm@418 543 (defn play-music [music-bytes]
rlm@417 544 (let [program-target 0xC000
rlm@437 545 music-target 0xA000]
rlm@417 546 (-> (set-memory-range (second (music-base))
rlm@417 547 program-target (music-kernel))
rlm@417 548 (set-memory-range music-target music-bytes)
rlm@417 549 (PC! program-target))))
rlm@417 550
rlm@417 551 (defn run-program
rlm@418 552 ([program]
rlm@417 553 (let [target 0xC000]
rlm@417 554 (-> (set-memory-range (second (music-base))
rlm@417 555 target program)
rlm@417 556 (PC! target)))))
rlm@417 557
rlm@424 558 (defn test-timer []
rlm@424 559 (flatten
rlm@424 560 [0x3E
rlm@424 561 0x01
rlm@424 562 0xE0
rlm@424 563 0x06 ;; set TMA to 0
rlm@424 564
rlm@424 565 0x3E
rlm@424 566 (Integer/parseInt "00000100" 2)
rlm@424 567 0xE0
rlm@424 568 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424 569
rlm@424 570 (repeat
rlm@424 571 500
rlm@424 572 [0xF0
rlm@424 573 0x05])]))
rlm@426 574
rlm@426 575