Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 424:7bd806c4dbb6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
changed assembly to handle mini-midi messages of different lengths.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 04:45:55 -0500
parents 971bd1774eab
children df4e03672b05
comparison
equal deleted inserted replaced
423:971bd1774eab 424:7bd806c4dbb6
59 59
60 (store (Integer/parseInt "00000000" 2) 0xFF20) 60 (store (Integer/parseInt "00000000" 2) 0xFF20)
61 (store (Integer/parseInt "00000000" 2) 0xFF21) 61 (store (Integer/parseInt "00000000" 2) 0xFF21)
62 (store (Integer/parseInt "00000000" 2) 0xFF22) 62 (store (Integer/parseInt "00000000" 2) 0xFF22)
63 (store (Integer/parseInt "00000000" 2) 0xFF23)])) 63 (store (Integer/parseInt "00000000" 2) 0xFF23)]))
64
65
66 ;; mini-midi syntax
67
68 ;; codes
69 ;; note-code == 0x00
70 ;; change-duty-code = 0x01
71 ;; silence-code = 0x02
72
73 ;; silence format
74 ;; 2 bytes
75 ;; [silence-code (0x02)]
76 ;; [duration-8-bits]
77
78 ;; note data format
79 ;; 4 bytes
80 ;; [note-code (0x00)]
81 ;; [volume-4-bits 0 frequency-high-3-bits]
82 ;; [frequengy-low-8-bits]
83 ;; [duration-8-bits]
84
85 ;; change-duty-format
86 ;; 2 bytes
87 ;; [change-duty-code (0x01)]
88 ;; [new-duty]
89
90 (defn do-message
91 "Read the message which starts at the current value of HL and do
92 what it says. Duration is left in A, and HL is advanced
93 appropraitely."
94 []
95
96 )
97
98
99
100
101
64 102
65 (defn play-note 103 (defn play-note
66 "Play the note referenced by HL in the appropiate channel. 104 "Play the note referenced by HL in the appropiate channel.
67 Leaves desired-duration in A." 105 Leaves desired-duration in A."
68 [] 106 []
80 118
81 0x2A ;; load frequency low-bits 119 0x2A ;; load frequency low-bits
82 0xE0 120 0xE0
83 0x18 ;; set frequency-low-bits 121 0x18 ;; set frequency-low-bits
84 122
85 0x7E ;; load duration 123 0x2A ;; load duration
86 0x2B ;;
87 0x2B ;; HL-2 -> HL
88 ]) 124 ])
89 125
90 (defn music-step [] 126 (defn music-step []
91 (flatten 127 (flatten
92 [(play-note) 128 [
93 0xF5 ;; push A 129 0xF5 ;; push A
94 0xF0 130 0xF0
95 0x05 ;; load current ticks 131 0x05 ;; load current ticks
96 0xB8 ;; B holds previous sub-ticks, subtract it from A 132 0xB8 ;; B holds previous sub-ticks, subtract it from A
97 ;; if A-B caused a carry, then (B > A) is true, and 133 ;; if A-B caused a carry, then (B > A) is true, and
110 146
111 ;; if desired-ticks = current ticks 147 ;; if desired-ticks = current ticks
112 ;; go to next note ; set current set ticks to 0. 148 ;; go to next note ; set current set ticks to 0.
113 149
114 0x20 150 0x20
115 0x05 151 (+ (count (play-note)) 2)
116 152
117 0x23 153 (play-note)
118 0x23
119 0x23 ;; HL + 3 -> HL
120 154
121 0x0E 155 0x0E
122 0x00])) ;; 0->C (current-ticks) 156 0x00])) ;; 0->C (current-ticks)
123
124 (defn test-timer []
125 (flatten
126 [0x3E
127 0x01
128 0xE0
129 0x06 ;; set TMA to 0
130
131 0x3E
132 (Integer/parseInt "00000100" 2)
133 0xE0
134 0x07 ;; set TAC to 16384 Hz and activate timer
135
136 (repeat
137 500
138 [0xF0
139 0x05])]))
140
141 157
142 (defn music-kernel [] 158 (defn music-kernel []
143 (flatten 159 (flatten
144 [(clear-music-registers) 160 [(clear-music-registers)
145 161
159 0x3E 175 0x3E
160 (Integer/parseInt "00000110" 2) 176 (Integer/parseInt "00000110" 2)
161 0xE0 177 0xE0
162 0x07 ;; set TAC to 65536 Hz and activate timer 178 0x07 ;; set TAC to 65536 Hz and activate timer
163 179
164 0xF0 180
165 0x07 181 0xAF ;; initialiaze A to zero
166 182
183
167 (music-step) 184 (music-step)
168 0x18 185 0x18
169 (->signed-8-bit (+ (- (count (music-step))) 186 (->signed-8-bit (+ (- (count (music-step)))
170 -2))])) 187 -2))]))
171 188
186 0xA6 0x55 0xFF 203 0xA6 0x55 0xFF
187 0xA6 0x55 0xFF 204 0xA6 0x55 0xFF
188 0xA6 0x55 0xFF 205 0xA6 0x55 0xFF
189 0x00 0x00 0xFF 206 0x00 0x00 0xFF
190 ]) 207 ])
191 208
192 209 (defn frequency-code->frequency
210 [code]
211 (assert (<= 0 code 2047))
212 (/ 131072 (- 2048 code)))
213
214 (defn clamp [x low high]
215 (cond (> x high) high
216 (< x low) low
217 true x))
218
219 (defn frequency->frequency-code
220 [frequency]
221 (clamp
222 (Math/round
223 (float
224 (/ (- (* 2048 frequency) 131072) frequency)))
225 0x00 2048))
226
227 (defn note-codes [frequency volume duration]
228 (assert (<= 0 volume 0xF))
229 (assert (<= 0 duration 0xFF))
230 (let [frequency-code
231 (frequency->frequency-code frequency)
232 volume&high-frequency
233 (+ (bit-shift-left volume 4)
234 (bit-shift-right frequency-code 8))
235 low-frequency
236 (bit-and 0xFF frequency-code)]
237 [volume&high-frequency
238 low-frequency
239 duration]))
240
241 (def C4 (partial note-codes 261.63))
242 (def D4 (partial note-codes 293.66))
243 (def E4 (partial note-codes 329.63))
244 (def F4 (partial note-codes 349.23))
245 (def G4 (partial note-codes 392))
246 (def A4 (partial note-codes 440))
247 (def B4 (partial note-codes 493.88))
248 (def C5 (partial note-codes 523.3))
249
250 (def scale
251 (flatten
252 [(C4 0xF 0x40)
253 (D4 0xF 0x40)
254 (E4 0xF 0x40)
255 (F4 0xF 0x40)
256 (G4 0xF 0x40)
257 (A4 0xF 0x40)
258 (B4 0xF 0x40)
259 (C5 0xF 0x40)]))
260
193 (defn play-music [music-bytes] 261 (defn play-music [music-bytes]
194 (let [program-target 0xC000 262 (let [program-target 0xC000
195 music-target 0xD000] 263 music-target 0xD000]
196 (-> (set-memory-range (second (music-base)) 264 (-> (set-memory-range (second (music-base))
197 program-target (music-kernel)) 265 program-target (music-kernel))
218 (PC! target))))) 286 (PC! target)))))
219 287
220 (defn trippy [] 288 (defn trippy []
221 (run-moves (play-music many-notes ) (repeat 8000 []))) 289 (run-moves (play-music many-notes ) (repeat 8000 [])))
222 290
291 (defn test-timer []
292 (flatten
293 [0x3E
294 0x01
295 0xE0
296 0x06 ;; set TMA to 0
297
298 0x3E
299 (Integer/parseInt "00000100" 2)
300 0xE0
301 0x07 ;; set TAC to 16384 Hz and activate timer
302
303 (repeat
304 500
305 [0xF0
306 0x05])]))