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@427
|
11 (def third-kind
|
rlm@427
|
12 (File. "/home/r/proj/midi/third-kind.mid"))
|
rlm@417
|
13
|
rlm@455
|
14 (def pony
|
rlm@455
|
15 (File. "/home/r/proj/vba-clojure/music/pony-title.mid"))
|
rlm@455
|
16
|
rlm@455
|
17 (def sync-test
|
rlm@455
|
18 (File. "/home/r/proj/vba-clojure/music/sync-test.mid"))
|
rlm@455
|
19
|
rlm@454
|
20
|
rlm@427
|
21 (defn raw-midi-text [#^File midi-file]
|
rlm@427
|
22 (:out
|
rlm@427
|
23 (clojure.java.shell/sh
|
rlm@427
|
24 "midicsv"
|
rlm@427
|
25 (.getCanonicalPath midi-file)
|
rlm@427
|
26 "-")))
|
rlm@427
|
27
|
rlm@427
|
28 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
|
rlm@427
|
29
|
rlm@427
|
30 (defmulti parse-command :command)
|
rlm@427
|
31
|
rlm@427
|
32 (defn discard-args [command] (dissoc command :args))
|
rlm@427
|
33
|
rlm@427
|
34 (defmethod parse-command :Start_track
|
rlm@427
|
35 [command] (discard-args command))
|
rlm@427
|
36
|
rlm@427
|
37 (defmethod parse-command :End_track
|
rlm@427
|
38 [command] (discard-args command))
|
rlm@427
|
39
|
rlm@427
|
40 (defmethod parse-command :default
|
rlm@427
|
41 [command] command)
|
rlm@427
|
42
|
rlm@427
|
43 (defn parse-number-list
|
rlm@427
|
44 [number-list-str]
|
rlm@427
|
45 (map #(Integer/parseInt %)
|
rlm@427
|
46 (clojure.string/split number-list-str #", ")))
|
rlm@427
|
47
|
rlm@427
|
48 (defmethod parse-command :Tempo
|
rlm@427
|
49 [command]
|
rlm@427
|
50 (update-in command [:args] #(Integer/parseInt %)))
|
rlm@427
|
51
|
rlm@427
|
52 (defn parse-midi-note-list
|
rlm@427
|
53 [midi-note-list-str]
|
rlm@427
|
54 (let [[channel note velocity]
|
rlm@427
|
55 (parse-number-list midi-note-list-str)]
|
rlm@427
|
56 {:channel channel :note note :velocity velocity}))
|
rlm@427
|
57
|
rlm@427
|
58 (defmethod parse-command :Note_on_c
|
rlm@427
|
59 [command]
|
rlm@427
|
60 (update-in command [:args] parse-midi-note-list))
|
rlm@427
|
61
|
rlm@427
|
62 (defmethod parse-command :Note_off_c
|
rlm@427
|
63 [command]
|
rlm@427
|
64 (update-in command [:args] parse-midi-note-list))
|
rlm@427
|
65
|
rlm@427
|
66 (defmethod parse-command :Header
|
rlm@427
|
67 [command]
|
rlm@427
|
68 (let [args (:args command)
|
rlm@427
|
69 [format num-tracks division] (parse-number-list args)]
|
rlm@427
|
70 (assoc command :args
|
rlm@427
|
71 {:format format
|
rlm@427
|
72 :num-tracks num-tracks
|
rlm@427
|
73 :division division})))
|
rlm@427
|
74
|
rlm@427
|
75 (defmethod parse-command :Program_c
|
rlm@427
|
76 [command]
|
rlm@427
|
77 (let [args (:args command)
|
rlm@427
|
78 [channel program-num] (parse-number-list args)]
|
rlm@427
|
79 (assoc command :args
|
rlm@427
|
80 {:channel channel
|
rlm@427
|
81 :program-num program-num})))
|
rlm@427
|
82
|
rlm@427
|
83 (defn parse-midi [#^File midi-file]
|
rlm@427
|
84 (map
|
rlm@427
|
85 (comp parse-command
|
rlm@427
|
86 (fn [line]
|
rlm@427
|
87 (let [[[_ channel time command args]]
|
rlm@427
|
88 (re-seq command-line line)]
|
rlm@427
|
89 {:channel (Integer/parseInt channel)
|
rlm@427
|
90 :time (Integer/parseInt time)
|
rlm@427
|
91 :command (keyword command)
|
rlm@427
|
92 :args (apply str (drop 2 args))})))
|
rlm@427
|
93 (drop-last
|
rlm@427
|
94 (clojure.string/split-lines
|
rlm@427
|
95 (raw-midi-text midi-file)))))
|
rlm@427
|
96
|
rlm@417
|
97 (def music-base new-kernel)
|
rlm@417
|
98
|
rlm@417
|
99 (defn store [n address]
|
rlm@417
|
100 (flatten
|
rlm@417
|
101 [0xF5
|
rlm@417
|
102 0xE5
|
rlm@417
|
103
|
rlm@417
|
104 0x3E
|
rlm@417
|
105 n
|
rlm@417
|
106
|
rlm@417
|
107 0x21
|
rlm@417
|
108 (reverse (disect-bytes-2 address))
|
rlm@417
|
109
|
rlm@417
|
110 0x77
|
rlm@417
|
111
|
rlm@417
|
112 0xE1
|
rlm@417
|
113 0xF1]))
|
rlm@417
|
114
|
rlm@417
|
115 (defn infinite-loop []
|
rlm@417
|
116 [0x18 0xFE])
|
rlm@417
|
117
|
rlm@417
|
118 (def divider-register 0xFF04)
|
rlm@417
|
119
|
rlm@417
|
120 (defrecord Bit-Note [frequency volume duration duty])
|
rlm@417
|
121
|
rlm@417
|
122 (defn clear-music-registers []
|
rlm@417
|
123 (flatten
|
rlm@433
|
124 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
|
rlm@433
|
125 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
|
rlm@433
|
126 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
|
rlm@433
|
127 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
|
rlm@433
|
128 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
|
rlm@417
|
129
|
rlm@417
|
130 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
|
rlm@417
|
131 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
|
rlm@417
|
132 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
|
rlm@417
|
133 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
|
rlm@417
|
134
|
rlm@417
|
135 (store (Integer/parseInt "00000000" 2) 0xFF1A)
|
rlm@417
|
136 (store (Integer/parseInt "00000000" 2) 0xFF1B)
|
rlm@417
|
137 (store (Integer/parseInt "00000000" 2) 0xFF1C)
|
rlm@417
|
138 (store (Integer/parseInt "00000000" 2) 0xFF1D)
|
rlm@417
|
139 (store (Integer/parseInt "00000000" 2) 0xFF1E)
|
rlm@417
|
140
|
rlm@433
|
141 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
|
rlm@433
|
142 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
|
rlm@433
|
143 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
|
rlm@433
|
144 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
|
rlm@433
|
145 ]))
|
rlm@417
|
146
|
rlm@424
|
147
|
rlm@424
|
148 ;; mini-midi syntax
|
rlm@424
|
149
|
rlm@424
|
150 ;; codes
|
rlm@424
|
151 ;; note-code == 0x00
|
rlm@424
|
152 ;; change-duty-code = 0x01
|
rlm@424
|
153 ;; silence-code = 0x02
|
rlm@424
|
154
|
rlm@424
|
155 ;; silence format
|
rlm@424
|
156 ;; 2 bytes
|
rlm@424
|
157 ;; [silence-code (0x02)]
|
rlm@424
|
158 ;; [duration-8-bits]
|
rlm@424
|
159
|
rlm@424
|
160 ;; note data format
|
rlm@424
|
161 ;; 4 bytes
|
rlm@424
|
162 ;; [note-code (0x00)]
|
rlm@424
|
163 ;; [volume-4-bits 0 frequency-high-3-bits]
|
rlm@424
|
164 ;; [frequengy-low-8-bits]
|
rlm@424
|
165 ;; [duration-8-bits]
|
rlm@424
|
166
|
rlm@424
|
167 ;; change-duty-format
|
rlm@424
|
168 ;; 2 bytes
|
rlm@424
|
169 ;; [change-duty-code (0x01)]
|
rlm@424
|
170 ;; [new-duty]
|
rlm@424
|
171
|
rlm@425
|
172 (def note-code 0x00)
|
rlm@425
|
173 (def change-duty-code 0x01)
|
rlm@425
|
174 (def silence-code 0x02)
|
rlm@425
|
175
|
rlm@424
|
176 (defn do-message
|
rlm@424
|
177 "Read the message which starts at the current value of HL and do
|
rlm@424
|
178 what it says. Duration is left in A, and HL is advanced
|
rlm@424
|
179 appropraitely."
|
rlm@433
|
180 ([] (do-message 0x16))
|
rlm@433
|
181 ([sound-base-address]
|
rlm@433
|
182 (let [switch
|
rlm@433
|
183 [0x2A ;; load message code into A, increment HL
|
rlm@433
|
184
|
rlm@433
|
185 ;; switch on message
|
rlm@433
|
186 0xFE
|
rlm@433
|
187 note-code
|
rlm@433
|
188
|
rlm@433
|
189 0x20
|
rlm@433
|
190 :note-length]
|
rlm@424
|
191
|
rlm@433
|
192 play-note
|
rlm@433
|
193 [0x2A ;; load volume/frequency-high info
|
rlm@433
|
194 0xF5 ;; push A
|
rlm@433
|
195 0xE6
|
rlm@433
|
196 (Integer/parseInt "11110000" 2) ;; volume mask
|
rlm@433
|
197 0xE0
|
rlm@433
|
198 (inc sound-base-address) ;;0x17 ;; set volume
|
rlm@433
|
199 0xF1 ;; pop A
|
rlm@433
|
200 0xE6
|
rlm@433
|
201 (Integer/parseInt "00000111" 2) ;; frequency-high mask
|
rlm@433
|
202 0xE0
|
rlm@433
|
203 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
|
rlm@433
|
204
|
rlm@433
|
205 0x2A ;; load frequency low-bits
|
rlm@433
|
206 0xE0
|
rlm@433
|
207 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
|
rlm@433
|
208 0x2A]] ;; load duration
|
rlm@433
|
209 (replace
|
rlm@433
|
210 {:note-length (count play-note)}
|
rlm@433
|
211 (concat switch play-note)))))
|
rlm@424
|
212
|
rlm@433
|
213 ;; (defn play-note
|
rlm@433
|
214 ;; "Play the note referenced by HL in the appropiate channel.
|
rlm@433
|
215 ;; Leaves desired-duration in A."
|
rlm@433
|
216
|
rlm@433
|
217 ;; [0x2A ;; load volume/frequency-high info
|
rlm@433
|
218 ;; 0xF5 ;; push A
|
rlm@433
|
219 ;; 0xE6
|
rlm@433
|
220 ;; (Integer/parseInt "11110000" 2) ;; volume mask
|
rlm@433
|
221 ;; 0xE0
|
rlm@433
|
222 ;; 0x17 ;; set volume
|
rlm@433
|
223 ;; 0xF1 ;; pop A
|
rlm@433
|
224 ;; 0xE6
|
rlm@433
|
225 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
|
rlm@433
|
226 ;; 0xE0
|
rlm@433
|
227 ;; 0x19 ;; set frequency-high
|
rlm@417
|
228
|
rlm@433
|
229 ;; 0x2A ;; load frequency low-bits
|
rlm@433
|
230 ;; 0xE0
|
rlm@433
|
231 ;; 0x18 ;; set frequency-low-bits
|
rlm@417
|
232
|
rlm@433
|
233 ;; 0x2A ;; load duration
|
rlm@433
|
234 ;; ])
|
rlm@417
|
235
|
rlm@434
|
236 (defn music-step [sound-base-address]
|
rlm@432
|
237 ;; C == current-ticks
|
rlm@432
|
238 ;; A == desired-ticks
|
rlm@435
|
239
|
rlm@435
|
240 (flatten
|
rlm@435
|
241 [;; restore variables from stack
|
rlm@435
|
242 0xE1 ;; pop HL
|
rlm@435
|
243 0xC1 ;; pop CB
|
rlm@435
|
244 0xF1 ;; pop AF
|
rlm@432
|
245
|
rlm@435
|
246
|
rlm@435
|
247 0xF5 ;; push A
|
rlm@417
|
248 0xF0
|
rlm@432
|
249 0x05 ;; load current ticks from 0xF005
|
rlm@431
|
250 0xB8 ;;
|
rlm@417
|
251 0x30 ;; increment C only if last result caused carry
|
rlm@417
|
252 0x01
|
rlm@418
|
253 0x0C
|
rlm@417
|
254
|
rlm@417
|
255 0x47 ;; update sub-ticks (A->B)
|
rlm@417
|
256
|
rlm@417
|
257 0xF1 ;; pop AF, now A contains desired-ticks
|
rlm@417
|
258
|
rlm@417
|
259 0xB9 ;; compare with current ticks
|
rlm@417
|
260
|
rlm@417
|
261 ;; if desired-ticks = current ticks
|
rlm@417
|
262 ;; go to next note ; set current set ticks to 0.
|
rlm@417
|
263
|
rlm@417
|
264 0x20
|
rlm@434
|
265 (+ (count (do-message 0)) 2)
|
rlm@417
|
266
|
rlm@434
|
267 (do-message sound-base-address)
|
rlm@417
|
268
|
rlm@417
|
269 0x0E
|
rlm@435
|
270 0x00 ;; 0->C (current-ticks)
|
rlm@417
|
271
|
rlm@435
|
272 ;; save variables to stack
|
rlm@435
|
273 0xF5 ;; push AF
|
rlm@435
|
274 0xC5 ;; push CB
|
rlm@435
|
275 0xE5 ;; push HL
|
rlm@435
|
276
|
rlm@435
|
277
|
rlm@435
|
278 ]))
|
rlm@435
|
279
|
rlm@435
|
280 (def music-1 0x11)
|
rlm@434
|
281 (def music-2 0x16)
|
rlm@434
|
282
|
rlm@417
|
283 (defn music-kernel []
|
rlm@417
|
284 (flatten
|
rlm@432
|
285 [;; global initilization section
|
rlm@432
|
286 (clear-music-registers)
|
rlm@432
|
287
|
rlm@417
|
288 0x3E
|
rlm@418
|
289 0x01
|
rlm@417
|
290 0xE0
|
rlm@417
|
291 0x06 ;; set TMA to 0
|
rlm@417
|
292
|
rlm@417
|
293 0x3E
|
rlm@423
|
294 (Integer/parseInt "00000110" 2)
|
rlm@417
|
295 0xE0
|
rlm@423
|
296 0x07 ;; set TAC to 65536 Hz and activate timer
|
rlm@417
|
297
|
rlm@435
|
298 ;; initialize frame 1
|
rlm@432
|
299 0x21
|
rlm@432
|
300 0x00
|
rlm@437
|
301 0xA0 ;; set HL to 0xA000 == music-start 1
|
rlm@432
|
302 0x0E
|
rlm@432
|
303 0x00 ;; 0->C
|
rlm@432
|
304 0x06
|
rlm@432
|
305 0x00 ;; 0->B
|
rlm@435
|
306
|
rlm@433
|
307 0xAF ;; 0->A
|
rlm@432
|
308
|
rlm@435
|
309 0xF5 ;; push AF
|
rlm@435
|
310 0xC5 ;; push CB
|
rlm@435
|
311 0xE5 ;; push HL
|
rlm@432
|
312
|
rlm@435
|
313 ;; initialize frame 2
|
rlm@436
|
314 0x21
|
rlm@436
|
315 0x00
|
rlm@437
|
316 0xB0 ;; set HL to 0xB000 == music-start 2
|
rlm@436
|
317
|
rlm@436
|
318 0xF5 ;; push AF
|
rlm@436
|
319 0xC5 ;; push CB
|
rlm@436
|
320 0xE5 ;; push HL
|
rlm@436
|
321
|
rlm@436
|
322
|
rlm@437
|
323 ;; main music loop
|
rlm@437
|
324
|
rlm@437
|
325 0xE8 ;; SP + 6; activate frame 1
|
rlm@437
|
326 6
|
rlm@437
|
327 (music-step music-1)
|
rlm@437
|
328 ;;(repeat (count (music-step music-1)) 0x00)
|
rlm@435
|
329
|
rlm@437
|
330 0xE8 ;; SP - 6; activate frame 2
|
rlm@437
|
331 (->signed-8-bit -6)
|
rlm@437
|
332 ;;(repeat (count (music-step music-2)) 0x00)
|
rlm@437
|
333 (music-step music-2)
|
rlm@433
|
334
|
rlm@424
|
335
|
rlm@417
|
336 0x18
|
rlm@437
|
337 (->signed-8-bit (+
|
rlm@437
|
338 ;; two music-steps
|
rlm@437
|
339 (- (* 2 (count (music-step 0))))
|
rlm@437
|
340 -2 ;; this jump instruction
|
rlm@437
|
341 -2 ;; activate frame 1
|
rlm@437
|
342 -2 ;; activate frame 2
|
rlm@437
|
343 ))]))
|
rlm@417
|
344
|
rlm@424
|
345 (defn frequency-code->frequency
|
rlm@424
|
346 [code]
|
rlm@424
|
347 (assert (<= 0 code 2047))
|
rlm@424
|
348 (/ 131072 (- 2048 code)))
|
rlm@424
|
349
|
rlm@424
|
350 (defn clamp [x low high]
|
rlm@424
|
351 (cond (> x high) high
|
rlm@424
|
352 (< x low) low
|
rlm@424
|
353 true x))
|
rlm@424
|
354
|
rlm@424
|
355 (defn frequency->frequency-code
|
rlm@424
|
356 [frequency]
|
rlm@424
|
357 (clamp
|
rlm@424
|
358 (Math/round
|
rlm@424
|
359 (float
|
rlm@424
|
360 (/ (- (* 2048 frequency) 131072) frequency)))
|
rlm@424
|
361 0x00 2048))
|
rlm@424
|
362
|
rlm@424
|
363 (defn note-codes [frequency volume duration]
|
rlm@424
|
364 (assert (<= 0 volume 0xF))
|
rlm@430
|
365 (if (<= duration 0xFF)
|
rlm@430
|
366 (let [frequency-code
|
rlm@430
|
367 (frequency->frequency-code frequency)
|
rlm@430
|
368 volume&high-frequency
|
rlm@430
|
369 (+ (bit-shift-left volume 4)
|
rlm@430
|
370 (bit-shift-right frequency-code 8))
|
rlm@430
|
371 low-frequency
|
rlm@430
|
372 (bit-and 0xFF frequency-code)]
|
rlm@430
|
373 [note-code
|
rlm@430
|
374 volume&high-frequency
|
rlm@430
|
375 low-frequency
|
rlm@430
|
376 duration])
|
rlm@430
|
377 (vec
|
rlm@430
|
378 (flatten
|
rlm@430
|
379 [(note-codes frequency volume 0xFF)
|
rlm@430
|
380 (note-codes frequency volume (- duration 0xFF))]))))
|
rlm@430
|
381
|
rlm@424
|
382
|
rlm@427
|
383 (defn midi-code->frequency
|
rlm@427
|
384 [midi-code]
|
rlm@427
|
385 (* 8.1757989156
|
rlm@427
|
386 (Math/pow 2 (* (float (/ 12)) midi-code))))
|
rlm@427
|
387
|
rlm@427
|
388 ;; division == clock-pulses / quarter-note
|
rlm@427
|
389 ;; tempo == microseconds / quarter-note
|
rlm@427
|
390
|
rlm@427
|
391 ;; have: clock-pulses
|
rlm@427
|
392 ;; want: seconds
|
rlm@427
|
393
|
rlm@427
|
394
|
rlm@428
|
395 (defn silence [length]
|
rlm@428
|
396 {:frequency 1
|
rlm@428
|
397 :duration length
|
rlm@428
|
398 :volume 0})
|
rlm@427
|
399
|
rlm@438
|
400 (defn commands
|
rlm@438
|
401 "return all events where #(= (:command %) command)"
|
rlm@438
|
402 [command s]
|
rlm@438
|
403 (filter #(= command (:command %)) s))
|
rlm@438
|
404
|
rlm@438
|
405 (defn midi-track->mini-midi [#^File midi-file track-num]
|
rlm@427
|
406 (let [midi-events (parse-midi midi-file)
|
rlm@427
|
407
|
rlm@438
|
408 note-on-events (commands :Note_on_c midi-events)
|
rlm@438
|
409 note-off-events (commands :Note_off_c midi-events)
|
rlm@427
|
410
|
rlm@438
|
411 select-channel
|
rlm@438
|
412 (fn [n s]
|
rlm@438
|
413 (sort-by :time (filter #(= n (:channel (:args %))) s)))
|
rlm@438
|
414
|
rlm@438
|
415 channel-on (select-channel track-num note-on-events)
|
rlm@427
|
416
|
rlm@438
|
417 channel-off (select-channel track-num note-off-events)
|
rlm@427
|
418
|
rlm@438
|
419
|
rlm@438
|
420 tempo (:args (first (commands :Tempo midi-events)))
|
rlm@438
|
421 division
|
rlm@438
|
422 (:division (:args (first (commands :Header midi-events))))
|
rlm@428
|
423
|
rlm@428
|
424 notes
|
rlm@428
|
425 (map
|
rlm@428
|
426 (fn [note-on note-off]
|
rlm@428
|
427 {:frequency (midi-code->frequency (:note (:args note-on)))
|
rlm@428
|
428 :duration
|
rlm@428
|
429 (/ (* (/ tempo division)
|
rlm@428
|
430 (- (:time note-off) (:time note-on)))
|
rlm@428
|
431 1e6) ;; convert clock-pulses into seconds
|
rlm@428
|
432 :volume (int (/ (:velocity (:args note-on)) 10))
|
rlm@428
|
433 :time-stamp (/ (* (/ tempo division)
|
rlm@428
|
434 (:time note-on)) 1e6)})
|
rlm@438
|
435 channel-on channel-off)
|
rlm@428
|
436
|
rlm@428
|
437 silences
|
rlm@428
|
438 (map (fn [note-1 note-2]
|
rlm@428
|
439 (let [note-1-space (- (:time-stamp note-2)
|
rlm@428
|
440 (:time-stamp note-1))
|
rlm@428
|
441 note-1-length (:duration note-1)]
|
rlm@428
|
442 (silence (- note-1-space note-1-length))))
|
rlm@428
|
443 ;; to handle silence at the beginning.
|
rlm@428
|
444 (concat [(assoc (silence 0)
|
rlm@428
|
445 :time-stamp 0)] notes)
|
rlm@428
|
446 notes)
|
rlm@428
|
447
|
rlm@428
|
448 notes-with-silence
|
rlm@456
|
449 (concat
|
rlm@456
|
450 (filter (comp not zero? :duration)
|
rlm@456
|
451 (interleave silences notes))
|
rlm@456
|
452 [(silence 3)])]
|
rlm@456
|
453
|
rlm@456
|
454 (map
|
rlm@456
|
455 (fn [note-event]
|
rlm@456
|
456 (note-codes (:frequency note-event)
|
rlm@456
|
457 (:volume note-event)
|
rlm@456
|
458 (int (* (:duration note-event) 0x100))))
|
rlm@456
|
459 notes-with-silence)))
|
rlm@456
|
460
|
rlm@428
|
461
|
rlm@438
|
462 (defn midi->mini-midi [#^File midi-file]
|
rlm@455
|
463 {:track-1 (flatten (midi-track->mini-midi midi-file 0))
|
rlm@455
|
464 :track-2 (flatten (midi-track->mini-midi midi-file 1))})
|
rlm@438
|
465
|
rlm@438
|
466 (defn play-midi [#^File midi-file]
|
rlm@438
|
467 (let [track-1-target 0xA000
|
rlm@438
|
468 track-2-target 0xB000
|
rlm@438
|
469 program-target 0xC000
|
rlm@438
|
470 mini-midi (midi->mini-midi midi-file)
|
rlm@438
|
471 long-silence (flatten (note-codes 20 0 9001))]
|
rlm@438
|
472
|
rlm@438
|
473 (-> (second (music-base))
|
rlm@438
|
474 (set-memory-range track-1-target long-silence)
|
rlm@438
|
475 (set-memory-range track-2-target long-silence)
|
rlm@438
|
476 (set-memory-range track-1-target (:track-1 mini-midi))
|
rlm@438
|
477 (set-memory-range track-2-target (:track-2 mini-midi))
|
rlm@438
|
478 (set-memory-range program-target (music-kernel))
|
rlm@438
|
479 (PC! program-target))))
|
rlm@438
|
480
|
rlm@424
|
481 (def C4 (partial note-codes 261.63))
|
rlm@424
|
482 (def D4 (partial note-codes 293.66))
|
rlm@424
|
483 (def E4 (partial note-codes 329.63))
|
rlm@424
|
484 (def F4 (partial note-codes 349.23))
|
rlm@424
|
485 (def G4 (partial note-codes 392))
|
rlm@424
|
486 (def A4 (partial note-codes 440))
|
rlm@424
|
487 (def B4 (partial note-codes 493.88))
|
rlm@424
|
488 (def C5 (partial note-codes 523.3))
|
rlm@424
|
489
|
rlm@430
|
490 (def scale
|
rlm@430
|
491 (flatten
|
rlm@430
|
492 [(C4 0xF 0x40)
|
rlm@430
|
493 (D4 0xF 0x40)
|
rlm@430
|
494 (E4 0xF 0x40)
|
rlm@430
|
495 (F4 0xF 0x40)
|
rlm@430
|
496 (G4 0xF 0x40)
|
rlm@430
|
497 (A4 0xF 0x40)
|
rlm@430
|
498 (B4 0xF 0x40)
|
rlm@430
|
499 (C5 0xF 0x40)]))
|
rlm@424
|
500
|
rlm@418
|
501 (defn play-music [music-bytes]
|
rlm@417
|
502 (let [program-target 0xC000
|
rlm@437
|
503 music-target 0xA000]
|
rlm@417
|
504 (-> (set-memory-range (second (music-base))
|
rlm@417
|
505 program-target (music-kernel))
|
rlm@417
|
506 (set-memory-range music-target music-bytes)
|
rlm@417
|
507 (PC! program-target))))
|
rlm@417
|
508
|
rlm@417
|
509
|
rlm@438
|
510
|
rlm@437
|
511 ;; (defn test-note [music-bytes]
|
rlm@437
|
512 ;; (-> (set-memory-range (second (music-base))
|
rlm@437
|
513 ;; 0xC000 (concat (clear-music-registers)
|
rlm@437
|
514 ;; (play-note)
|
rlm@437
|
515 ;; (infinite-loop)))
|
rlm@437
|
516 ;; (set-memory-range 0xD000 music-bytes)
|
rlm@437
|
517 ;; (PC! 0xC000)
|
rlm@437
|
518 ;; (HL! 0xD000)
|
rlm@437
|
519 ;; ))
|
rlm@417
|
520
|
rlm@417
|
521
|
rlm@417
|
522 (defn run-program
|
rlm@418
|
523 ([program]
|
rlm@417
|
524 (let [target 0xC000]
|
rlm@417
|
525 (-> (set-memory-range (second (music-base))
|
rlm@417
|
526 target program)
|
rlm@417
|
527 (PC! target)))))
|
rlm@417
|
528
|
rlm@424
|
529 (defn test-timer []
|
rlm@424
|
530 (flatten
|
rlm@424
|
531 [0x3E
|
rlm@424
|
532 0x01
|
rlm@424
|
533 0xE0
|
rlm@424
|
534 0x06 ;; set TMA to 0
|
rlm@424
|
535
|
rlm@424
|
536 0x3E
|
rlm@424
|
537 (Integer/parseInt "00000100" 2)
|
rlm@424
|
538 0xE0
|
rlm@424
|
539 0x07 ;; set TAC to 16384 Hz and activate timer
|
rlm@424
|
540
|
rlm@424
|
541 (repeat
|
rlm@424
|
542 500
|
rlm@424
|
543 [0xF0
|
rlm@424
|
544 0x05])]))
|
rlm@426
|
545
|
rlm@426
|
546
|