Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 513:3dbb863eb801

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
accuracy of displayed image is much improved, but there the palettes are still messed up.
author Robert McIntyre <rlm@mit.edu>
date Fri, 22 Jun 2012 18:58:47 -0500
parents a6d060a64246
children 2de44c6184ee
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@461 328 (defn music-kernel [wave-duty-1 wave-duty-2]
rlm@417 329 (flatten
rlm@432 330 [;; global initilization section
rlm@432 331 (clear-music-registers)
rlm@432 332
rlm@417 333 0x3E
rlm@418 334 0x01
rlm@417 335 0xE0
rlm@417 336 0x06 ;; set TMA to 0
rlm@417 337
rlm@417 338 0x3E
rlm@423 339 (Integer/parseInt "00000110" 2)
rlm@417 340 0xE0
rlm@423 341 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 342
rlm@435 343 ;; initialize frame 1
rlm@432 344 0x21
rlm@432 345 0x00
rlm@437 346 0xA0 ;; set HL to 0xA000 == music-start 1
rlm@432 347 0x0E
rlm@432 348 0x00 ;; 0->C
rlm@432 349 0x06
rlm@432 350 0x00 ;; 0->B
rlm@435 351
rlm@433 352 0xAF ;; 0->A
rlm@432 353
rlm@435 354 0xF5 ;; push AF
rlm@435 355 0xC5 ;; push CB
rlm@435 356 0xE5 ;; push HL
rlm@432 357
rlm@435 358 ;; initialize frame 2
rlm@436 359 0x21
rlm@436 360 0x00
rlm@437 361 0xB0 ;; set HL to 0xB000 == music-start 2
rlm@436 362
rlm@436 363 0xF5 ;; push AF
rlm@436 364 0xC5 ;; push CB
rlm@436 365 0xE5 ;; push HL
rlm@436 366
rlm@436 367
rlm@466 368 ;; initialize frame 3 (noise)
rlm@466 369 0x21
rlm@466 370 0x00
rlm@466 371 0xA9 ;; 0xA9OO -> HL
rlm@466 372
rlm@466 373 0xF5 ;; push AF
rlm@466 374 0xC5 ;; push CB
rlm@466 375 0xE5 ;; push HL
rlm@466 376
rlm@437 377 ;; main music loop
rlm@437 378
rlm@466 379 0xE8 ;; SP + 12; activate frame 1
rlm@466 380 12
rlm@466 381 (music-step music-1 wave-duty-1 false)
rlm@435 382
rlm@437 383 0xE8 ;; SP - 6; activate frame 2
rlm@437 384 (->signed-8-bit -6)
rlm@466 385 (music-step music-2 wave-duty-2 false)
rlm@466 386
rlm@466 387 0xE8 ;; SP - 6; activate frame 3
rlm@466 388 (->signed-8-bit -6)
rlm@466 389 (music-step nil nil true)
rlm@424 390
rlm@417 391 0x18
rlm@437 392 (->signed-8-bit (+
rlm@437 393 ;; two music-steps
rlm@466 394 (- (* 2 (count (music-step 0 0 false))))
rlm@482 395 ;; one noise
rlm@466 396 (- (count (music-step nil nil true)))
rlm@437 397 -2 ;; this jump instruction
rlm@437 398 -2 ;; activate frame 1
rlm@437 399 -2 ;; activate frame 2
rlm@466 400 -2 ;; activate frame 3
rlm@437 401 ))]))
rlm@417 402
rlm@424 403 (defn frequency-code->frequency
rlm@424 404 [code]
rlm@424 405 (assert (<= 0 code 2047))
rlm@424 406 (/ 131072 (- 2048 code)))
rlm@424 407
rlm@424 408 (defn clamp [x low high]
rlm@424 409 (cond (> x high) high
rlm@424 410 (< x low) low
rlm@424 411 true x))
rlm@424 412
rlm@424 413 (defn frequency->frequency-code
rlm@424 414 [frequency]
rlm@424 415 (clamp
rlm@424 416 (Math/round
rlm@424 417 (float
rlm@424 418 (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424 419 0x00 2048))
rlm@424 420
rlm@424 421 (defn note-codes [frequency volume duration]
rlm@424 422 (assert (<= 0 volume 0xF))
rlm@430 423 (if (<= duration 0xFF)
rlm@430 424 (let [frequency-code
rlm@430 425 (frequency->frequency-code frequency)
rlm@430 426 volume&high-frequency
rlm@430 427 (+ (bit-shift-left volume 4)
rlm@430 428 (bit-shift-right frequency-code 8))
rlm@430 429 low-frequency
rlm@430 430 (bit-and 0xFF frequency-code)]
rlm@430 431 [note-code
rlm@430 432 volume&high-frequency
rlm@430 433 low-frequency
rlm@430 434 duration])
rlm@430 435 (vec
rlm@430 436 (flatten
rlm@430 437 [(note-codes frequency volume 0xFF)
rlm@430 438 (note-codes frequency volume (- duration 0xFF))]))))
rlm@430 439
rlm@424 440
rlm@427 441 (defn midi-code->frequency
rlm@427 442 [midi-code]
rlm@427 443 (* 8.1757989156
rlm@427 444 (Math/pow 2 (* (float (/ 12)) midi-code))))
rlm@427 445
rlm@427 446 ;; division == clock-pulses / quarter-note
rlm@427 447 ;; tempo == microseconds / quarter-note
rlm@427 448
rlm@427 449 ;; have: clock-pulses
rlm@427 450 ;; want: seconds
rlm@427 451
rlm@427 452
rlm@496 453 (defn silent-note [length]
rlm@428 454 {:frequency 1
rlm@428 455 :duration length
rlm@428 456 :volume 0})
rlm@427 457
rlm@466 458 (defn commands
rlm@466 459 "return all events where #(= (:command %) command)"
rlm@466 460 [command s]
rlm@466 461 (filter #(= command (:command %)) s))
rlm@466 462
rlm@462 463 (defn track-info [#^File midi-file]
rlm@462 464 (let [events (parse-midi midi-file)
rlm@462 465 track-titles (commands :Title_t events)
rlm@462 466 track-info
rlm@462 467 (map #(read-string (read-string (:args %))) track-titles)
rlm@462 468 track-map
rlm@462 469 (zipmap track-info track-titles)]
rlm@462 470 track-map))
rlm@462 471
rlm@462 472 (defn target-tracks
rlm@462 473 "return the track-numbers in the form [voice-0 voice-1 noise]"
rlm@462 474 [#^File midi-file]
rlm@462 475 (let [track-data (track-info midi-file)
rlm@462 476 track-order
rlm@462 477 (zipmap (map :out (keys track-data))
rlm@462 478 (vals track-data))
rlm@462 479 channel-nums (map (comp :channel track-order) (range 3))]
rlm@462 480 channel-nums))
rlm@438 481
rlm@467 482 (defn midi-track->abstract-mini-midi
rlm@467 483 [#^File midi-file track-num]
rlm@467 484 (let [midi-events (parse-midi midi-file)
rlm@427 485
rlm@438 486 note-on-events (commands :Note_on_c midi-events)
rlm@438 487 note-off-events (commands :Note_off_c midi-events)
rlm@427 488
rlm@438 489 select-channel
rlm@438 490 (fn [n s]
rlm@462 491 (sort-by :time (filter #(= n (:channel %)) s)))
rlm@438 492
rlm@438 493 channel-on (select-channel track-num note-on-events)
rlm@427 494
rlm@438 495 channel-off (select-channel track-num note-off-events)
rlm@427 496
rlm@438 497
rlm@438 498 tempo (:args (first (commands :Tempo midi-events)))
rlm@438 499 division
rlm@438 500 (:division (:args (first (commands :Header midi-events))))
rlm@428 501
rlm@428 502 notes
rlm@428 503 (map
rlm@428 504 (fn [note-on note-off]
rlm@428 505 {:frequency (midi-code->frequency (:note (:args note-on)))
rlm@467 506 :midi-code (:note (:args note-on))
rlm@428 507 :duration
rlm@428 508 (/ (* (/ tempo division)
rlm@428 509 (- (:time note-off) (:time note-on)))
rlm@428 510 1e6) ;; convert clock-pulses into seconds
rlm@428 511 :volume (int (/ (:velocity (:args note-on)) 10))
rlm@428 512 :time-stamp (/ (* (/ tempo division)
rlm@428 513 (:time note-on)) 1e6)})
rlm@438 514 channel-on channel-off)
rlm@428 515
rlm@428 516 silences
rlm@428 517 (map (fn [note-1 note-2]
rlm@428 518 (let [note-1-space (- (:time-stamp note-2)
rlm@428 519 (:time-stamp note-1))
rlm@428 520 note-1-length (:duration note-1)]
rlm@496 521 (silent-note (- note-1-space note-1-length))))
rlm@428 522 ;; to handle silence at the beginning.
rlm@496 523 (concat [(assoc (silent-note 0)
rlm@428 524 :time-stamp 0)] notes)
rlm@428 525 notes)
rlm@428 526
rlm@428 527 notes-with-silence
rlm@456 528 (concat
rlm@456 529 (filter (comp not zero? :duration)
rlm@456 530 (interleave silences notes))
rlm@496 531 [(silent-note 3)])]
rlm@467 532 notes-with-silence))
rlm@467 533
rlm@467 534 (defn midi-track->mini-midi-voice [#^File midi-file track-num]
rlm@467 535 (let [abstract-mini-midi
rlm@467 536 (midi-track->abstract-mini-midi midi-file track-num)]
rlm@456 537 (map
rlm@456 538 (fn [note-event]
rlm@456 539 (note-codes (:frequency note-event)
rlm@456 540 (:volume note-event)
rlm@456 541 (int (* (:duration note-event) 0x100))))
rlm@467 542 abstract-mini-midi)))
rlm@467 543
rlm@468 544 (def midi-code->gb-noise-code
rlm@468 545 {nil 0xFF
rlm@482 546 35 90
rlm@468 547 38 20
rlm@468 548 39 0
rlm@468 549 })
rlm@468 550
rlm@467 551 (defn noise-codes [code volume duration]
rlm@467 552 (assert (<= 0 volume 0xF))
rlm@467 553 (if (<= duration 0xFF)
rlm@468 554 [(midi-code->gb-noise-code code code)
rlm@467 555 (bit-shift-left volume 4)
rlm@467 556 duration]
rlm@467 557 (vec
rlm@467 558 (flatten
rlm@467 559 [(noise-codes code volume 0xFF)
rlm@467 560 (noise-codes code volume (- duration 0xFF))]))))
rlm@467 561
rlm@467 562 (defn midi-track->mini-midi-noise [#^File midi-file track-num]
rlm@467 563 (let [abstract-mini-midi
rlm@467 564 (midi-track->abstract-mini-midi midi-file track-num)]
rlm@467 565 (map
rlm@467 566 (fn [noise-event]
rlm@467 567 (noise-codes (:midi-code noise-event)
rlm@467 568 (:volume noise-event)
rlm@467 569 (int (* (:duration noise-event) 0x100))))
rlm@467 570 abstract-mini-midi)))
rlm@467 571
rlm@467 572
rlm@438 573 (defn midi->mini-midi [#^File midi-file]
rlm@462 574 (let [targets (target-tracks midi-file)
rlm@463 575 duty-info (keys (track-info midi-file))]
rlm@463 576
rlm@467 577 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
rlm@467 578 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
rlm@467 579 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))
rlm@463 580 :duty (zipmap (map :out duty-info)
rlm@464 581 (map #(get % :duty 0) duty-info))}))
rlm@438 582
rlm@438 583 (defn play-midi [#^File midi-file]
rlm@467 584 (let [voice-1-target 0xA000
rlm@467 585 voice-2-target 0xB000
rlm@467 586 noise-target 0xA900
rlm@438 587 program-target 0xC000
rlm@438 588 mini-midi (midi->mini-midi midi-file)
rlm@467 589 long-silence (flatten (note-codes 20 0 20001))
rlm@467 590 long-noise-silence
rlm@467 591 (interleave (range 500) (repeat 0x00) (repeat 255))
rlm@467 592
rlm@463 593 voice-1 (flatten (:voice-1 mini-midi))
rlm@464 594 wave-duty-1 ((:duty mini-midi) 0 0)
rlm@463 595
rlm@463 596 voice-2 (flatten (:voice-2 mini-midi))
rlm@464 597 wave-duty-2 ((:duty mini-midi) 1 0)
rlm@466 598
rlm@466 599 noise (flatten (:noise mini-midi))
rlm@461 600 ]
rlm@438 601
rlm@438 602 (-> (second (music-base))
rlm@467 603 (set-memory-range voice-1-target long-silence)
rlm@467 604 (set-memory-range voice-2-target long-silence)
rlm@467 605 (set-memory-range noise-target long-noise-silence)
rlm@467 606 (set-memory-range voice-1-target voice-1)
rlm@467 607 (set-memory-range voice-2-target voice-2)
rlm@467 608 (set-memory-range noise-target noise)
rlm@461 609 (set-memory-range
rlm@461 610 program-target
rlm@461 611 (music-kernel wave-duty-1 wave-duty-2))
rlm@438 612 (PC! program-target))))
rlm@438 613
rlm@467 614 (defn test-noise []
rlm@467 615 (let [noise-pattern
rlm@467 616 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
rlm@467 617 (interleave (range 10) (repeat 0x00) (repeat 255)))]
rlm@467 618
rlm@467 619 (-> (second (music-base))
rlm@467 620 (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467 621 (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467 622 (PC! 0xC000))))
rlm@467 623
rlm@467 624 (defn test-play-noise [noise-code]
rlm@468 625 (Thread/sleep 300)
rlm@468 626 (println "playing noise:" noise-code)
rlm@467 627 (run-moves
rlm@467 628 (let [noise-pattern
rlm@467 629 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
rlm@467 630 (-> (second (music-base))
rlm@467 631 (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467 632 (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467 633 (PC! 0xC000)))
rlm@468 634 (repeat 20 [])))
rlm@467 635
rlm@467 636 (defn test-all-noises []
rlm@467 637 (dorun (map test-play-noise (range 0x100))))
rlm@467 638
rlm@424 639 (def C4 (partial note-codes 261.63))
rlm@424 640 (def D4 (partial note-codes 293.66))
rlm@424 641 (def E4 (partial note-codes 329.63))
rlm@424 642 (def F4 (partial note-codes 349.23))
rlm@424 643 (def G4 (partial note-codes 392))
rlm@424 644 (def A4 (partial note-codes 440))
rlm@424 645 (def B4 (partial note-codes 493.88))
rlm@424 646 (def C5 (partial note-codes 523.3))
rlm@424 647
rlm@430 648 (def scale
rlm@430 649 (flatten
rlm@430 650 [(C4 0xF 0x40)
rlm@430 651 (D4 0xF 0x40)
rlm@430 652 (E4 0xF 0x40)
rlm@430 653 (F4 0xF 0x40)
rlm@430 654 (G4 0xF 0x40)
rlm@430 655 (A4 0xF 0x40)
rlm@430 656 (B4 0xF 0x40)
rlm@430 657 (C5 0xF 0x40)]))
rlm@424 658
rlm@418 659 (defn play-music [music-bytes]
rlm@417 660 (let [program-target 0xC000
rlm@437 661 music-target 0xA000]
rlm@417 662 (-> (set-memory-range (second (music-base))
rlm@417 663 program-target (music-kernel))
rlm@417 664 (set-memory-range music-target music-bytes)
rlm@417 665 (PC! program-target))))
rlm@417 666
rlm@417 667 (defn run-program
rlm@418 668 ([program]
rlm@417 669 (let [target 0xC000]
rlm@417 670 (-> (set-memory-range (second (music-base))
rlm@417 671 target program)
rlm@417 672 (PC! target)))))
rlm@417 673
rlm@424 674 (defn test-timer []
rlm@424 675 (flatten
rlm@424 676 [0x3E
rlm@424 677 0x01
rlm@424 678 0xE0
rlm@424 679 0x06 ;; set TMA to 0
rlm@424 680
rlm@424 681 0x3E
rlm@424 682 (Integer/parseInt "00000100" 2)
rlm@424 683 0xE0
rlm@424 684 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424 685
rlm@424 686 (repeat
rlm@424 687 500
rlm@424 688 [0xF0
rlm@424 689 0x05])]))
rlm@426 690
rlm@480 691 (defn play-pony []
rlm@481 692 (println "playing" (.getName pony-csv))
rlm@480 693 (run-moves (play-midi pony-csv) (repeat 1800 [])))
rlm@426 694
rlm@480 695 (defn play-regret []
rlm@481 696 (println "playing" (.getName regret-csv))
rlm@480 697 (run-moves (play-midi regret-csv) (repeat 3380 [])))
rlm@480 698
rlm@480 699 (defn play-mother []
rlm@481 700 (println "playing" (.getName mother-csv))
rlm@480 701 (run-moves (play-midi mother-csv) (repeat 2200 [])))
rlm@480 702
rlm@480 703 (defn demo [] (play-mother) (play-regret) (play-pony))
rlm@480 704
rlm@480 705
rlm@480 706