Mercurial > vba-clojure
comparison clojure/com/aurellem/run/music.clj @ 461:a2ae4213deb7
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)) |