Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 423:971bd1774eab

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
increased resolution of music-kernel timer.
author Robert McIntyre <rlm@mit.edu>
date Tue, 17 Apr 2012 06:53:48 -0500
parents f211cd655ccb
children 7bd806c4dbb6
rev   line source
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@417 7 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@417 8
rlm@417 9
rlm@417 10 (def music-base new-kernel)
rlm@417 11
rlm@417 12
rlm@417 13
rlm@417 14
rlm@417 15 (defn store [n address]
rlm@417 16 (flatten
rlm@417 17 [0xF5
rlm@417 18 0xE5
rlm@417 19
rlm@417 20 0x3E
rlm@417 21 n
rlm@417 22
rlm@417 23 0x21
rlm@417 24 (reverse (disect-bytes-2 address))
rlm@417 25
rlm@417 26 0x77
rlm@417 27
rlm@417 28 0xE1
rlm@417 29 0xF1]))
rlm@417 30
rlm@417 31 (defn infinite-loop []
rlm@417 32 [0x18 0xFE])
rlm@417 33
rlm@417 34
rlm@417 35
rlm@417 36 (def divider-register 0xFF04)
rlm@417 37
rlm@417 38
rlm@417 39 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 40
rlm@417 41 (defn clear-music-registers []
rlm@417 42 (flatten
rlm@417 43 [(store (Integer/parseInt "00000000" 2) 0xFF10)
rlm@417 44 (store (Integer/parseInt "00000000" 2) 0xFF11)
rlm@417 45 (store (Integer/parseInt "00000000" 2) 0xFF12)
rlm@417 46 (store (Integer/parseInt "00000000" 2) 0xFF13)
rlm@417 47 (store (Integer/parseInt "00000000" 2) 0xFF14)
rlm@417 48
rlm@417 49 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 50 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 51 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 52 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 53
rlm@417 54 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 55 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 56 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 57 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 58 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 59
rlm@417 60 (store (Integer/parseInt "00000000" 2) 0xFF20)
rlm@417 61 (store (Integer/parseInt "00000000" 2) 0xFF21)
rlm@417 62 (store (Integer/parseInt "00000000" 2) 0xFF22)
rlm@417 63 (store (Integer/parseInt "00000000" 2) 0xFF23)]))
rlm@417 64
rlm@417 65 (defn play-note
rlm@417 66 "Play the note referenced by HL in the appropiate channel.
rlm@417 67 Leaves desired-duration in A."
rlm@417 68 []
rlm@417 69 [0x2A ;; load volume/frequency-high info
rlm@417 70 0xF5 ;; push A
rlm@417 71 0xE6
rlm@417 72 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@417 73 0xE0
rlm@417 74 0x17 ;; set volume
rlm@417 75 0xF1 ;; pop A
rlm@417 76 0xE6
rlm@417 77 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@417 78 0xE0
rlm@417 79 0x19 ;; set frequency-high
rlm@417 80
rlm@417 81 0x2A ;; load frequency low-bits
rlm@417 82 0xE0
rlm@417 83 0x18 ;; set frequency-low-bits
rlm@417 84
rlm@417 85 0x7E ;; load duration
rlm@418 86 0x2B ;;
rlm@418 87 0x2B ;; HL-2 -> HL
rlm@418 88 ])
rlm@417 89
rlm@417 90 (defn music-step []
rlm@417 91 (flatten
rlm@417 92 [(play-note)
rlm@417 93 0xF5 ;; push A
rlm@417 94 0xF0
rlm@417 95 0x05 ;; load current ticks
rlm@418 96 0xB8 ;; B holds previous sub-ticks, subtract it from A
rlm@417 97 ;; if A-B caused a carry, then (B > A) is true, and
rlm@417 98 ;; A = current-sub-tics, B = previous-sub-ticks, so
rlm@417 99 ;; current-sub-ticks < previous-sub-ticks, which means that the
rlm@417 100 ;; timer counter HAS overflowed.
rlm@417 101 0x30 ;; increment C only if last result caused carry
rlm@417 102 0x01
rlm@418 103 0x0C
rlm@417 104
rlm@417 105 0x47 ;; update sub-ticks (A->B)
rlm@417 106
rlm@417 107 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 108
rlm@417 109 0xB9 ;; compare with current ticks
rlm@417 110
rlm@417 111 ;; if desired-ticks = current ticks
rlm@417 112 ;; go to next note ; set current set ticks to 0.
rlm@417 113
rlm@417 114 0x20
rlm@417 115 0x05
rlm@417 116
rlm@417 117 0x23
rlm@417 118 0x23
rlm@417 119 0x23 ;; HL + 3 -> HL
rlm@417 120
rlm@417 121 0x0E
rlm@417 122 0x00])) ;; 0->C (current-ticks)
rlm@417 123
rlm@418 124 (defn test-timer []
rlm@418 125 (flatten
rlm@418 126 [0x3E
rlm@418 127 0x01
rlm@418 128 0xE0
rlm@418 129 0x06 ;; set TMA to 0
rlm@418 130
rlm@418 131 0x3E
rlm@418 132 (Integer/parseInt "00000100" 2)
rlm@418 133 0xE0
rlm@418 134 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@418 135
rlm@418 136 (repeat
rlm@418 137 500
rlm@418 138 [0xF0
rlm@418 139 0x05])]))
rlm@418 140
rlm@418 141
rlm@417 142 (defn music-kernel []
rlm@417 143 (flatten
rlm@417 144 [(clear-music-registers)
rlm@418 145
rlm@417 146 0x21
rlm@417 147 0x00
rlm@417 148 0xD0 ;; set HL to 0xD000 == music-start
rlm@417 149 0x0E
rlm@417 150 0x00 ;; 0->C
rlm@417 151 0x06
rlm@417 152 0x00 ;; 0->B
rlm@417 153
rlm@417 154 0x3E
rlm@418 155 0x01
rlm@417 156 0xE0
rlm@417 157 0x06 ;; set TMA to 0
rlm@417 158
rlm@417 159 0x3E
rlm@423 160 (Integer/parseInt "00000110" 2)
rlm@417 161 0xE0
rlm@423 162 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 163
rlm@418 164 0xF0
rlm@418 165 0x07
rlm@418 166
rlm@417 167 (music-step)
rlm@417 168 0x18
rlm@417 169 (->signed-8-bit (+ (- (count (music-step)))
rlm@417 170 -2))]))
rlm@417 171
rlm@418 172 (def one-note
rlm@418 173 [0xA0 0x00 0xFF])
rlm@417 174
rlm@418 175 (def many-notes
rlm@418 176 (flatten (repeat 10 one-note)))
rlm@418 177
rlm@418 178 (def increasing-notes
rlm@418 179 [0xA0 0x00 0x55
rlm@418 180 0xA1 0x00 0x55
rlm@418 181 0xA2 0x00 0x55
rlm@418 182 0xA3 0x00 0x55
rlm@418 183 0xA4 0x00 0x55
rlm@418 184 0xA5 0x00 0x55
rlm@418 185 0xA6 0x00 0x55
rlm@423 186 0xA6 0x55 0xFF
rlm@423 187 0xA6 0x55 0xFF
rlm@423 188 0xA6 0x55 0xFF
rlm@423 189 0x00 0x00 0xFF
rlm@423 190 ])
rlm@423 191
rlm@418 192
rlm@418 193 (defn play-music [music-bytes]
rlm@417 194 (let [program-target 0xC000
rlm@417 195 music-target 0xD000]
rlm@417 196 (-> (set-memory-range (second (music-base))
rlm@417 197 program-target (music-kernel))
rlm@417 198 (set-memory-range music-target music-bytes)
rlm@417 199 (PC! program-target))))
rlm@417 200
rlm@417 201
rlm@417 202 (defn test-note [music-bytes]
rlm@417 203 (-> (set-memory-range (second (music-base))
rlm@417 204 0xC000 (concat (clear-music-registers)
rlm@417 205 (play-note)
rlm@417 206 (infinite-loop)))
rlm@417 207 (set-memory-range 0xD000 music-bytes)
rlm@417 208 (PC! 0xC000)
rlm@417 209 (HL! 0xD000)
rlm@417 210 ))
rlm@417 211
rlm@417 212
rlm@417 213 (defn run-program
rlm@418 214 ([program]
rlm@417 215 (let [target 0xC000]
rlm@417 216 (-> (set-memory-range (second (music-base))
rlm@417 217 target program)
rlm@417 218 (PC! target)))))
rlm@417 219
rlm@418 220 (defn trippy []
rlm@418 221 (run-moves (play-music many-notes ) (repeat 8000 [])))
rlm@417 222