Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 478:43e0307d6ddc

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