Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 461:a2ae4213deb7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
implemented adjustable wave-duty for the two pitch channels.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 03:01:28 -0500
parents 9c192737034d
children 32375de697e5
comparison
equal deleted inserted replaced
460:497b47dd180e 461:a2ae4213deb7
175 175
176 (defn do-message 176 (defn do-message
177 "Read the message which starts at the current value of HL and do 177 "Read the message which starts at the current value of HL and do
178 what it says. Duration is left in A, and HL is advanced 178 what it says. Duration is left in A, and HL is advanced
179 appropraitely." 179 appropraitely."
180 ([] (do-message 0x16)) 180 ([] (do-message 0x16 1))
181 ([sound-base-address] 181 ([sound-base-address wave-duty]
182 (assert (<= 0 wave-duty 3))
182 (let [switch 183 (let [switch
183 [0x2A ;; load message code into A, increment HL 184 [0x2A ;; load message code into A, increment HL
184 185
185 ;; switch on message 186 ;; switch on message
186 0xFE 187 0xFE
188 189
189 0x20 190 0x20
190 :note-length] 191 :note-length]
191 192
192 play-note 193 play-note
193 [0x2A ;; load volume/frequency-high info 194 [0x3E ;; set wave-duty
195 (bit-shift-left wave-duty 6)
196 0xE0
197 sound-base-address
198 0x2A ;; load volume/frequency-high info
194 0xF5 ;; push A 199 0xF5 ;; push A
195 0xE6 200 0xE6
196 (Integer/parseInt "11110000" 2) ;; volume mask 201 (Integer/parseInt "11110000" 2) ;; volume mask
197 0xE0 202 0xE0
198 (inc sound-base-address) ;;0x17 ;; set volume 203 (inc sound-base-address) ;;0x17 ;; set volume
231 ;; 0x18 ;; set frequency-low-bits 236 ;; 0x18 ;; set frequency-low-bits
232 237
233 ;; 0x2A ;; load duration 238 ;; 0x2A ;; load duration
234 ;; ]) 239 ;; ])
235 240
236 (defn music-step [sound-base-address] 241 (defn music-step [sound-base-address wave-duty]
237 ;; C == current-ticks 242 ;; C == current-ticks
238 ;; A == desired-ticks 243 ;; A == desired-ticks
239 244
240 (flatten 245 (flatten
241 [;; restore variables from stack 246 [;; restore variables from stack
260 265
261 ;; if desired-ticks = current ticks 266 ;; if desired-ticks = current ticks
262 ;; go to next note ; set current set ticks to 0. 267 ;; go to next note ; set current set ticks to 0.
263 268
264 0x20 269 0x20
265 (+ (count (do-message 0)) 2) 270 (+ (count (do-message 0 0)) 2)
266 271
267 (do-message sound-base-address) 272 (do-message sound-base-address wave-duty)
268 273
269 0x0E 274 0x0E
270 0x00 ;; 0->C (current-ticks) 275 0x00 ;; 0->C (current-ticks)
271 276
272 ;; save variables to stack 277 ;; save variables to stack
278 ])) 283 ]))
279 284
280 (def music-1 0x11) 285 (def music-1 0x11)
281 (def music-2 0x16) 286 (def music-2 0x16)
282 287
283 (defn music-kernel [] 288 (defn music-kernel [wave-duty-1 wave-duty-2]
284 (flatten 289 (flatten
285 [;; global initilization section 290 [;; global initilization section
286 (clear-music-registers) 291 (clear-music-registers)
287 292
288 0x3E 293 0x3E
322 327
323 ;; main music loop 328 ;; main music loop
324 329
325 0xE8 ;; SP + 6; activate frame 1 330 0xE8 ;; SP + 6; activate frame 1
326 6 331 6
327 (music-step music-1) 332 (music-step music-1 wave-duty-1)
328 ;;(repeat (count (music-step music-1)) 0x00) 333 ;;(repeat (count (music-step music-1)) 0x00)
329 334
330 0xE8 ;; SP - 6; activate frame 2 335 0xE8 ;; SP - 6; activate frame 2
331 (->signed-8-bit -6) 336 (->signed-8-bit -6)
332 ;;(repeat (count (music-step music-2)) 0x00) 337 ;;(repeat (count (music-step music-2)) 0x00)
333 (music-step music-2) 338 (music-step music-2 wave-duty-2)
334 339
335 340
336 0x18 341 0x18
337 (->signed-8-bit (+ 342 (->signed-8-bit (+
338 ;; two music-steps 343 ;; two music-steps
339 (- (* 2 (count (music-step 0)))) 344 (- (* 2 (count (music-step 0 0))))
340 -2 ;; this jump instruction 345 -2 ;; this jump instruction
341 -2 ;; activate frame 1 346 -2 ;; activate frame 1
342 -2 ;; activate frame 2 347 -2 ;; activate frame 2
343 ))])) 348 ))]))
344 349
466 (defn play-midi [#^File midi-file] 471 (defn play-midi [#^File midi-file]
467 (let [track-1-target 0xA000 472 (let [track-1-target 0xA000
468 track-2-target 0xB000 473 track-2-target 0xB000
469 program-target 0xC000 474 program-target 0xC000
470 mini-midi (midi->mini-midi midi-file) 475 mini-midi (midi->mini-midi midi-file)
471 long-silence (flatten (note-codes 20 0 9001))] 476 long-silence (flatten (note-codes 20 0 9001))
477 wave-duty-1 2
478 wave-duty-2 2
479 ]
472 480
473 (-> (second (music-base)) 481 (-> (second (music-base))
474 (set-memory-range track-1-target long-silence) 482 (set-memory-range track-1-target long-silence)
475 (set-memory-range track-2-target long-silence) 483 (set-memory-range track-2-target long-silence)
476 (set-memory-range track-1-target (:track-1 mini-midi)) 484 (set-memory-range track-1-target (:track-1 mini-midi))
477 (set-memory-range track-2-target (:track-2 mini-midi)) 485 (set-memory-range track-2-target (:track-2 mini-midi))
478 (set-memory-range program-target (music-kernel)) 486 (set-memory-range
487 program-target
488 (music-kernel wave-duty-1 wave-duty-2))
479 (PC! program-target)))) 489 (PC! program-target))))
480 490
481 (def C4 (partial note-codes 261.63)) 491 (def C4 (partial note-codes 261.63))
482 (def D4 (partial note-codes 293.66)) 492 (def D4 (partial note-codes 293.66))
483 (def E4 (partial note-codes 329.63)) 493 (def E4 (partial note-codes 329.63))