# HG changeset patch # User Robert McIntyre # Date 1334603336 18000 # Node ID 0b6624c1291c60d13886fbe11876107050fa4b57 # Parent 21b8b3350b2055dee8b4636710507d71d0011d3a made basic tone player. diff -r 21b8b3350b20 -r 0b6624c1291c .hgignore --- a/.hgignore Sat Apr 14 05:41:55 2012 -0500 +++ b/.hgignore Mon Apr 16 14:08:56 2012 -0500 @@ -15,3 +15,4 @@ java/dist/* java/headers/* java/.ant-targets-build.xml +html/* diff -r 21b8b3350b20 -r 0b6624c1291c clojure/com/aurellem/gb/util.clj --- a/clojure/com/aurellem/gb/util.clj Sat Apr 14 05:41:55 2012 -0500 +++ b/clojure/com/aurellem/gb/util.clj Mon Apr 16 14:08:56 2012 -0500 @@ -3,8 +3,10 @@ (:import java.io.File) (:import [com.aurellem.gb.gb_driver SaveState])) -(defn A [state] - (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8)) +(defn A + ([state] + (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8)) + ([] (A @current-state))) (defn B [state] (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8)) @@ -112,8 +114,12 @@ ([] (print-op @current-state))) (defn d-tick - ([state] - (-> state print-pc print-op tick))) + ([] (d-tick 1)) + ([n] (d-tick n @current-state)) + ([n state] + (reduce (fn [state _] + (-> state print-pc print-op tick)) + state (range n)))) (defn print-interrupt [^SaveState state] diff -r 21b8b3350b20 -r 0b6624c1291c clojure/com/aurellem/run/bootstrap_1.clj --- a/clojure/com/aurellem/run/bootstrap_1.clj Sat Apr 14 05:41:55 2012 -0500 +++ b/clojure/com/aurellem/run/bootstrap_1.clj Mon Apr 16 14:08:56 2012 -0500 @@ -858,6 +858,13 @@ (transfer-control target) (do-nothing 1))))) +(defn gen-new-kernel-checkpoint! [] + (write-script! (do-nothing 10 (relocate-main-bootstrap)) + "new-kernel")) + +(defn new-kernel [] (read-script "new-kernel")) + + (def mid-game-data (subvec (vec (memory (mid-game))) pokemon-list-start @@ -865,7 +872,7 @@ (def mid-game-map-address 0x46BC) -(defn set-mid-game-data +(defn-memo set-mid-game-data ([] (set-mid-game-data (relocate-main-bootstrap))) ([script] (->> script @@ -888,7 +895,7 @@ pokemon-list-start (+ pokemon-list-start 500)))) -(defn return-to-pokemon-kernel +(defn-memo return-to-pokemon-kernel ([] (return-to-pokemon-kernel (set-mid-game-data))) ([script] (let [scratch (+ 200 pokemon-box-1-address) diff -r 21b8b3350b20 -r 0b6624c1291c clojure/com/aurellem/run/music.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/run/music.clj Mon Apr 16 14:08:56 2012 -0500 @@ -0,0 +1,179 @@ +(ns com.aurellem.run.music + (:use (com.aurellem.gb saves gb-driver util constants + items vbm characters money + rlm-assembly)) + (:use (com.aurellem.run util title save-corruption + bootstrap-0 bootstrap-1)) + (:import [com.aurellem.gb.gb_driver SaveState])) + + +(def music-base new-kernel) + + + + +(defn store [n address] + (flatten + [0xF5 + 0xE5 + + 0x3E + n + + 0x21 + (reverse (disect-bytes-2 address)) + + 0x77 + + 0xE1 + 0xF1])) + +(defn infinite-loop [] + [0x18 0xFE]) + + + +(def divider-register 0xFF04) + + +(defrecord Bit-Note [frequency volume duration duty]) + +(defn clear-music-registers [] + (flatten + [(store (Integer/parseInt "00000000" 2) 0xFF10) + (store (Integer/parseInt "00000000" 2) 0xFF11) + (store (Integer/parseInt "00000000" 2) 0xFF12) + (store (Integer/parseInt "00000000" 2) 0xFF13) + (store (Integer/parseInt "00000000" 2) 0xFF14) + + (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000 + (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000 + (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low + (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high + + (store (Integer/parseInt "00000000" 2) 0xFF1A) + (store (Integer/parseInt "00000000" 2) 0xFF1B) + (store (Integer/parseInt "00000000" 2) 0xFF1C) + (store (Integer/parseInt "00000000" 2) 0xFF1D) + (store (Integer/parseInt "00000000" 2) 0xFF1E) + + (store (Integer/parseInt "00000000" 2) 0xFF20) + (store (Integer/parseInt "00000000" 2) 0xFF21) + (store (Integer/parseInt "00000000" 2) 0xFF22) + (store (Integer/parseInt "00000000" 2) 0xFF23)])) + +(defn play-note + "Play the note referenced by HL in the appropiate channel. + Leaves desired-duration in A." + [] + [0x2A ;; load volume/frequency-high info + 0xF5 ;; push A + 0xE6 + (Integer/parseInt "11110000" 2) ;; volume mask + 0xE0 + 0x17 ;; set volume + 0xF1 ;; pop A + 0xE6 + (Integer/parseInt "00000111" 2) ;; frequency-high mask + 0xE0 + 0x19 ;; set frequency-high + + 0x2A ;; load frequency low-bits + 0xE0 + 0x18 ;; set frequency-low-bits + + 0x7E ;; load duration + ;;0x2B ;; + ;;0x2B + ]) ;; HL-2 -> HL + +(defn music-step [] + (flatten + [(play-note) + 0xF5 ;; push A + 0xF0 + 0x05 ;; load current ticks + 0x90 ;; B holds previous sub-ticks, subtract it from A + ;; if A-B caused a carry, then (B > A) is true, and + ;; A = current-sub-tics, B = previous-sub-ticks, so + ;; current-sub-ticks < previous-sub-ticks, which means that the + ;; timer counter HAS overflowed. + 0x30 ;; increment C only if last result caused carry + 0x01 + 0x00;;0x0C + + 0x47 ;; update sub-ticks (A->B) + + 0xF1 ;; pop AF, now A contains desired-ticks + + 0xB9 ;; compare with current ticks + + ;; if desired-ticks = current ticks + ;; go to next note ; set current set ticks to 0. + + 0x20 + 0x05 + + 0x23 + 0x23 + 0x23 ;; HL + 3 -> HL + + 0x0E + 0x00])) ;; 0->C (current-ticks) + +(defn music-kernel [] + (flatten + [(clear-music-registers) + 0x21 + 0x00 + 0xD0 ;; set HL to 0xD000 == music-start + 0x0E + 0x00 ;; 0->C + 0x06 + 0x00 ;; 0->B + + 0x3E + 0x00 + 0xE0 + 0x06 ;; set TMA to 0 + + 0x3E + (Integer/parseInt "00000111" 2) + 0xE0 + 0x07 ;; set TAC to 16384 Hz + + (music-step) + 0x18 + (->signed-8-bit (+ (- (count (music-step))) + -2))])) + + +(defn play-music [steps music-bytes] + (let [program-target 0xC000 + music-target 0xD000] + (-> (set-memory-range (second (music-base)) + program-target (music-kernel)) + (set-memory-range music-target music-bytes) + (PC! program-target)))) + + +(defn test-note [music-bytes] + (-> (set-memory-range (second (music-base)) + 0xC000 (concat (clear-music-registers) + (play-note) + (infinite-loop))) + (set-memory-range 0xD000 music-bytes) + (PC! 0xC000) + (HL! 0xD000) + )) + + +(defn run-program + ([program] (run-program program 90)) + ([program steps] + (let [target 0xC000] + (-> (set-memory-range (second (music-base)) + target program) + (PC! target))))) + + diff -r 21b8b3350b20 -r 0b6624c1291c moves/new-kernel.vbm Binary file moves/new-kernel.vbm has changed diff -r 21b8b3350b20 -r 0b6624c1291c save-states/new-kernel.sav Binary file save-states/new-kernel.sav has changed