Mercurial > vba-clojure

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