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

completed basic music playing kernel
author Robert McIntyre <rlm@mit.edu>
date Tue, 17 Apr 2012 06:36:17 -0500
parents 0b6624c1291c
children 971bd1774eab
line wrap: on
line source
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]))
10 (def music-base new-kernel)
15 (defn store [n address]
16 (flatten
17 [0xF5
18 0xE5
20 0x3E
21 n
23 0x21
24 (reverse (disect-bytes-2 address))
26 0x77
28 0xE1
29 0xF1]))
31 (defn infinite-loop []
32 [0x18 0xFE])
36 (def divider-register 0xFF04)
39 (defrecord Bit-Note [frequency volume duration duty])
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)
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
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)
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)]))
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
81 0x2A ;; load frequency low-bits
82 0xE0
83 0x18 ;; set frequency-low-bits
85 0x7E ;; load duration
86 0x2B ;;
87 0x2B ;; HL-2 -> HL
88 ])
90 (defn music-step []
91 (flatten
92 [(play-note)
93 0xF5 ;; push A
94 0xF0
95 0x05 ;; load current ticks
96 0xB8 ;; 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 0x0C
105 0x47 ;; update sub-ticks (A->B)
107 0xF1 ;; pop AF, now A contains desired-ticks
109 0xB9 ;; compare with current ticks
111 ;; if desired-ticks = current ticks
112 ;; go to next note ; set current set ticks to 0.
114 0x20
115 0x05
117 0x23
118 0x23
119 0x23 ;; HL + 3 -> HL
121 0x0E
122 0x00])) ;; 0->C (current-ticks)
124 (defn test-timer []
125 (flatten
126 [0x3E
127 0x01
128 0xE0
129 0x06 ;; set TMA to 0
131 0x3E
132 (Integer/parseInt "00000100" 2)
133 0xE0
134 0x07 ;; set TAC to 16384 Hz and activate timer
136 (repeat
137 500
138 [0xF0
139 0x05])]))
142 (defn music-kernel []
143 (flatten
144 [(clear-music-registers)
146 0x21
147 0x00
148 0xD0 ;; set HL to 0xD000 == music-start
149 0x0E
150 0x00 ;; 0->C
151 0x06
152 0x00 ;; 0->B
154 0x3E
155 0x01
156 0xE0
157 0x06 ;; set TMA to 0
159 0x3E
160 (Integer/parseInt "00000111" 2)
161 0xE0
162 0x07 ;; set TAC to 16384 Hz and activate timer
164 0xF0
165 0x07
167 (music-step)
168 0x18
169 (->signed-8-bit (+ (- (count (music-step)))
170 -2))]))
172 (def one-note
173 [0xA0 0x00 0xFF])
175 (def many-notes
176 (flatten (repeat 10 one-note)))
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])
188 (defn play-music [music-bytes]
189 (let [program-target 0xC000
190 music-target 0xD000]
191 (-> (set-memory-range (second (music-base))
192 program-target (music-kernel))
193 (set-memory-range music-target music-bytes)
194 (PC! program-target))))
197 (defn test-note [music-bytes]
198 (-> (set-memory-range (second (music-base))
199 0xC000 (concat (clear-music-registers)
200 (play-note)
201 (infinite-loop)))
202 (set-memory-range 0xD000 music-bytes)
203 (PC! 0xC000)
204 (HL! 0xD000)
205 ))
208 (defn run-program
209 ([program]
210 (let [target 0xC000]
211 (-> (set-memory-range (second (music-base))
212 target program)
213 (PC! target)))))
215 (defn trippy []
216 (run-moves (play-music many-notes ) (repeat 8000 [])))