Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 555:2d9bf762a073

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