Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 418:f211cd655ccb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
completed basic music playing kernel
author Robert McIntyre <rlm@mit.edu>
date Tue, 17 Apr 2012 06:36:17 -0500
parents 0b6624c1291c
children 971bd1774eab
comparison
equal deleted inserted replaced
417:0b6624c1291c 418:f211cd655ccb
81 0x2A ;; load frequency low-bits 81 0x2A ;; load frequency low-bits
82 0xE0 82 0xE0
83 0x18 ;; set frequency-low-bits 83 0x18 ;; set frequency-low-bits
84 84
85 0x7E ;; load duration 85 0x7E ;; load duration
86 ;;0x2B ;; 86 0x2B ;;
87 ;;0x2B 87 0x2B ;; HL-2 -> HL
88 ]) ;; HL-2 -> HL 88 ])
89 89
90 (defn music-step [] 90 (defn music-step []
91 (flatten 91 (flatten
92 [(play-note) 92 [(play-note)
93 0xF5 ;; push A 93 0xF5 ;; push A
94 0xF0 94 0xF0
95 0x05 ;; load current ticks 95 0x05 ;; load current ticks
96 0x90 ;; B holds previous sub-ticks, subtract it from A 96 0xB8 ;; B holds previous sub-ticks, subtract it from A
97 ;; if A-B caused a carry, then (B > A) is true, and 97 ;; if A-B caused a carry, then (B > A) is true, and
98 ;; A = current-sub-tics, B = previous-sub-ticks, so 98 ;; A = current-sub-tics, B = previous-sub-ticks, so
99 ;; current-sub-ticks < previous-sub-ticks, which means that the 99 ;; current-sub-ticks < previous-sub-ticks, which means that the
100 ;; timer counter HAS overflowed. 100 ;; timer counter HAS overflowed.
101 0x30 ;; increment C only if last result caused carry 101 0x30 ;; increment C only if last result caused carry
102 0x01 102 0x01
103 0x00;;0x0C 103 0x0C
104 104
105 0x47 ;; update sub-ticks (A->B) 105 0x47 ;; update sub-ticks (A->B)
106 106
107 0xF1 ;; pop AF, now A contains desired-ticks 107 0xF1 ;; pop AF, now A contains desired-ticks
108 108
119 0x23 ;; HL + 3 -> HL 119 0x23 ;; HL + 3 -> HL
120 120
121 0x0E 121 0x0E
122 0x00])) ;; 0->C (current-ticks) 122 0x00])) ;; 0->C (current-ticks)
123 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
124 (defn music-kernel [] 142 (defn music-kernel []
125 (flatten 143 (flatten
126 [(clear-music-registers) 144 [(clear-music-registers)
145
127 0x21 146 0x21
128 0x00 147 0x00
129 0xD0 ;; set HL to 0xD000 == music-start 148 0xD0 ;; set HL to 0xD000 == music-start
130 0x0E 149 0x0E
131 0x00 ;; 0->C 150 0x00 ;; 0->C
132 0x06 151 0x06
133 0x00 ;; 0->B 152 0x00 ;; 0->B
134 153
135 0x3E 154 0x3E
136 0x00 155 0x01
137 0xE0 156 0xE0
138 0x06 ;; set TMA to 0 157 0x06 ;; set TMA to 0
139 158
140 0x3E 159 0x3E
141 (Integer/parseInt "00000111" 2) 160 (Integer/parseInt "00000111" 2)
142 0xE0 161 0xE0
143 0x07 ;; set TAC to 16384 Hz 162 0x07 ;; set TAC to 16384 Hz and activate timer
144 163
164 0xF0
165 0x07
166
145 (music-step) 167 (music-step)
146 0x18 168 0x18
147 (->signed-8-bit (+ (- (count (music-step))) 169 (->signed-8-bit (+ (- (count (music-step)))
148 -2))])) 170 -2))]))
149 171
150 172 (def one-note
151 (defn play-music [steps music-bytes] 173 [0xA0 0x00 0xFF])
174
175 (def many-notes
176 (flatten (repeat 10 one-note)))
177
178 (def increasing-notes
179 [0xA0 0x00 0x55
180 0xA1 0x00 0x55
181 0xA2 0x00 0x55
182 0xA3 0x00 0x55
183 0xA4 0x00 0x55
184 0xA5 0x00 0x55
185 0xA6 0x00 0x55
186 0xA7 0x00 0x55])
187
188 (defn play-music [music-bytes]
152 (let [program-target 0xC000 189 (let [program-target 0xC000
153 music-target 0xD000] 190 music-target 0xD000]
154 (-> (set-memory-range (second (music-base)) 191 (-> (set-memory-range (second (music-base))
155 program-target (music-kernel)) 192 program-target (music-kernel))
156 (set-memory-range music-target music-bytes) 193 (set-memory-range music-target music-bytes)
167 (HL! 0xD000) 204 (HL! 0xD000)
168 )) 205 ))
169 206
170 207
171 (defn run-program 208 (defn run-program
172 ([program] (run-program program 90)) 209 ([program]
173 ([program steps]
174 (let [target 0xC000] 210 (let [target 0xC000]
175 (-> (set-memory-range (second (music-base)) 211 (-> (set-memory-range (second (music-base))
176 target program) 212 target program)
177 (PC! target))))) 213 (PC! target)))))
178 214
179 215 (defn trippy []
216 (run-moves (play-music many-notes ) (repeat 8000 [])))
217