Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 417:0b6624c1291c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
made basic tone player.
author Robert McIntyre <rlm@mit.edu>
date Mon, 16 Apr 2012 14:08:56 -0500
parents
children f211cd655ccb
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@417 7 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@417 8
rlm@417 9
rlm@417 10 (def music-base new-kernel)
rlm@417 11
rlm@417 12
rlm@417 13
rlm@417 14
rlm@417 15 (defn store [n address]
rlm@417 16 (flatten
rlm@417 17 [0xF5
rlm@417 18 0xE5
rlm@417 19
rlm@417 20 0x3E
rlm@417 21 n
rlm@417 22
rlm@417 23 0x21
rlm@417 24 (reverse (disect-bytes-2 address))
rlm@417 25
rlm@417 26 0x77
rlm@417 27
rlm@417 28 0xE1
rlm@417 29 0xF1]))
rlm@417 30
rlm@417 31 (defn infinite-loop []
rlm@417 32 [0x18 0xFE])
rlm@417 33
rlm@417 34
rlm@417 35
rlm@417 36 (def divider-register 0xFF04)
rlm@417 37
rlm@417 38
rlm@417 39 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 40
rlm@417 41 (defn clear-music-registers []
rlm@417 42 (flatten
rlm@417 43 [(store (Integer/parseInt "00000000" 2) 0xFF10)
rlm@417 44 (store (Integer/parseInt "00000000" 2) 0xFF11)
rlm@417 45 (store (Integer/parseInt "00000000" 2) 0xFF12)
rlm@417 46 (store (Integer/parseInt "00000000" 2) 0xFF13)
rlm@417 47 (store (Integer/parseInt "00000000" 2) 0xFF14)
rlm@417 48
rlm@417 49 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 50 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 51 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 52 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 53
rlm@417 54 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 55 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 56 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 57 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 58 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 59
rlm@417 60 (store (Integer/parseInt "00000000" 2) 0xFF20)
rlm@417 61 (store (Integer/parseInt "00000000" 2) 0xFF21)
rlm@417 62 (store (Integer/parseInt "00000000" 2) 0xFF22)
rlm@417 63 (store (Integer/parseInt "00000000" 2) 0xFF23)]))
rlm@417 64
rlm@417 65 (defn play-note
rlm@417 66 "Play the note referenced by HL in the appropiate channel.
rlm@417 67 Leaves desired-duration in A."
rlm@417 68 []
rlm@417 69 [0x2A ;; load volume/frequency-high info
rlm@417 70 0xF5 ;; push A
rlm@417 71 0xE6
rlm@417 72 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@417 73 0xE0
rlm@417 74 0x17 ;; set volume
rlm@417 75 0xF1 ;; pop A
rlm@417 76 0xE6
rlm@417 77 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@417 78 0xE0
rlm@417 79 0x19 ;; set frequency-high
rlm@417 80
rlm@417 81 0x2A ;; load frequency low-bits
rlm@417 82 0xE0
rlm@417 83 0x18 ;; set frequency-low-bits
rlm@417 84
rlm@417 85 0x7E ;; load duration
rlm@417 86 ;;0x2B ;;
rlm@417 87 ;;0x2B
rlm@417 88 ]) ;; HL-2 -> HL
rlm@417 89
rlm@417 90 (defn music-step []
rlm@417 91 (flatten
rlm@417 92 [(play-note)
rlm@417 93 0xF5 ;; push A
rlm@417 94 0xF0
rlm@417 95 0x05 ;; load current ticks
rlm@417 96 0x90 ;; B holds previous sub-ticks, subtract it from A
rlm@417 97 ;; if A-B caused a carry, then (B > A) is true, and
rlm@417 98 ;; A = current-sub-tics, B = previous-sub-ticks, so
rlm@417 99 ;; current-sub-ticks < previous-sub-ticks, which means that the
rlm@417 100 ;; timer counter HAS overflowed.
rlm@417 101 0x30 ;; increment C only if last result caused carry
rlm@417 102 0x01
rlm@417 103 0x00;;0x0C
rlm@417 104
rlm@417 105 0x47 ;; update sub-ticks (A->B)
rlm@417 106
rlm@417 107 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 108
rlm@417 109 0xB9 ;; compare with current ticks
rlm@417 110
rlm@417 111 ;; if desired-ticks = current ticks
rlm@417 112 ;; go to next note ; set current set ticks to 0.
rlm@417 113
rlm@417 114 0x20
rlm@417 115 0x05
rlm@417 116
rlm@417 117 0x23
rlm@417 118 0x23
rlm@417 119 0x23 ;; HL + 3 -> HL
rlm@417 120
rlm@417 121 0x0E
rlm@417 122 0x00])) ;; 0->C (current-ticks)
rlm@417 123
rlm@417 124 (defn music-kernel []
rlm@417 125 (flatten
rlm@417 126 [(clear-music-registers)
rlm@417 127 0x21
rlm@417 128 0x00
rlm@417 129 0xD0 ;; set HL to 0xD000 == music-start
rlm@417 130 0x0E
rlm@417 131 0x00 ;; 0->C
rlm@417 132 0x06
rlm@417 133 0x00 ;; 0->B
rlm@417 134
rlm@417 135 0x3E
rlm@417 136 0x00
rlm@417 137 0xE0
rlm@417 138 0x06 ;; set TMA to 0
rlm@417 139
rlm@417 140 0x3E
rlm@417 141 (Integer/parseInt "00000111" 2)
rlm@417 142 0xE0
rlm@417 143 0x07 ;; set TAC to 16384 Hz
rlm@417 144
rlm@417 145 (music-step)
rlm@417 146 0x18
rlm@417 147 (->signed-8-bit (+ (- (count (music-step)))
rlm@417 148 -2))]))
rlm@417 149
rlm@417 150
rlm@417 151 (defn play-music [steps music-bytes]
rlm@417 152 (let [program-target 0xC000
rlm@417 153 music-target 0xD000]
rlm@417 154 (-> (set-memory-range (second (music-base))
rlm@417 155 program-target (music-kernel))
rlm@417 156 (set-memory-range music-target music-bytes)
rlm@417 157 (PC! program-target))))
rlm@417 158
rlm@417 159
rlm@417 160 (defn test-note [music-bytes]
rlm@417 161 (-> (set-memory-range (second (music-base))
rlm@417 162 0xC000 (concat (clear-music-registers)
rlm@417 163 (play-note)
rlm@417 164 (infinite-loop)))
rlm@417 165 (set-memory-range 0xD000 music-bytes)
rlm@417 166 (PC! 0xC000)
rlm@417 167 (HL! 0xD000)
rlm@417 168 ))
rlm@417 169
rlm@417 170
rlm@417 171 (defn run-program
rlm@417 172 ([program] (run-program program 90))
rlm@417 173 ([program steps]
rlm@417 174 (let [target 0xC000]
rlm@417 175 (-> (set-memory-range (second (music-base))
rlm@417 176 target program)
rlm@417 177 (PC! target)))))
rlm@417 178
rlm@417 179