1.1 --- a/.hgignore	Sat Apr 14 12:24:00 2012 -0500
     1.2 +++ b/.hgignore	Tue Apr 17 06:36:43 2012 -0500
     1.3 @@ -15,3 +15,4 @@
     1.4  java/dist/*
     1.5  java/headers/*
     1.6  java/.ant-targets-build.xml
     1.7 +html/*

     2.1 --- a/clojure/com/aurellem/gb/util.clj	Sat Apr 14 12:24:00 2012 -0500
     2.2 +++ b/clojure/com/aurellem/gb/util.clj	Tue Apr 17 06:36:43 2012 -0500
     2.3 @@ -3,8 +3,10 @@
     2.4    (:import java.io.File)
     2.5    (:import [com.aurellem.gb.gb_driver SaveState]))
     2.6  
     2.7 -(defn A [state]
     2.8 -  (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
     2.9 +(defn A
    2.10 +  ([state]
    2.11 +     (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
    2.12 +  ([] (A @current-state)))
    2.13  
    2.14  (defn B [state]
    2.15    (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
    2.16 @@ -112,8 +114,12 @@
    2.17    ([] (print-op @current-state)))
    2.18  
    2.19  (defn d-tick
    2.20 -  ([state]
    2.21 -  (-> state print-pc print-op tick)))
    2.22 +  ([] (d-tick 1))
    2.23 +  ([n] (d-tick n @current-state))
    2.24 +  ([n state]
    2.25 +     (reduce (fn [state _]
    2.26 +               (-> state print-pc print-op tick))
    2.27 +             state (range n))))
    2.28  
    2.29  (defn print-interrupt
    2.30    [^SaveState state]

     3.1 --- a/clojure/com/aurellem/run/bootstrap_1.clj	Sat Apr 14 12:24:00 2012 -0500
     3.2 +++ b/clojure/com/aurellem/run/bootstrap_1.clj	Tue Apr 17 06:36:43 2012 -0500
     3.3 @@ -858,6 +858,13 @@
     3.4              (transfer-control target)
     3.5              (do-nothing 1)))))
     3.6  
     3.7 +(defn gen-new-kernel-checkpoint! []
     3.8 +  (write-script! (do-nothing 10 (relocate-main-bootstrap))
     3.9 +                 "new-kernel"))
    3.10 +
    3.11 +(defn new-kernel [] (read-script "new-kernel"))
    3.12 +
    3.13 +
    3.14  (def mid-game-data
    3.15    (subvec (vec (memory (mid-game)))
    3.16            pokemon-list-start
    3.17 @@ -865,7 +872,7 @@
    3.18  
    3.19  (def mid-game-map-address 0x46BC)
    3.20  
    3.21 -(defn set-mid-game-data
    3.22 +(defn-memo set-mid-game-data
    3.23    ([] (set-mid-game-data (relocate-main-bootstrap)))
    3.24    ([script]
    3.25       (->> script
    3.26 @@ -888,7 +895,7 @@
    3.27               pokemon-list-start
    3.28               (+ pokemon-list-start 500))))
    3.29  
    3.30 -(defn return-to-pokemon-kernel
    3.31 +(defn-memo return-to-pokemon-kernel
    3.32    ([] (return-to-pokemon-kernel (set-mid-game-data)))
    3.33    ([script]
    3.34       (let [scratch (+ 200 pokemon-box-1-address)

     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/clojure/com/aurellem/run/music.clj	Tue Apr 17 06:36:43 2012 -0500
     4.3 @@ -0,0 +1,217 @@
     4.4 +(ns com.aurellem.run.music
     4.5 +  (:use (com.aurellem.gb saves gb-driver util constants
     4.6 +                         items vbm characters money
     4.7 +                         rlm-assembly))
     4.8 +  (:use (com.aurellem.run util title save-corruption
     4.9 +                          bootstrap-0 bootstrap-1))
    4.10 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    4.11 +
    4.12 +
    4.13 +(def music-base new-kernel)
    4.14 +
    4.15 +
    4.16 +
    4.17 +
    4.18 +(defn store [n address]
    4.19 +  (flatten
    4.20 +   [0xF5
    4.21 +    0xE5
    4.22 +    
    4.23 +    0x3E
    4.24 +    n
    4.25 +    
    4.26 +    0x21
    4.27 +    (reverse (disect-bytes-2 address))
    4.28 +
    4.29 +    0x77
    4.30 +    
    4.31 +    0xE1
    4.32 +    0xF1]))
    4.33 +
    4.34 +(defn infinite-loop []
    4.35 +  [0x18 0xFE])
    4.36 +
    4.37 +
    4.38 +
    4.39 +(def divider-register 0xFF04)
    4.40 +
    4.41 +
    4.42 +(defrecord Bit-Note [frequency volume duration duty])
    4.43 +
    4.44 +(defn clear-music-registers []
    4.45 +  (flatten
    4.46 +   [(store (Integer/parseInt "00000000" 2) 0xFF10)
    4.47 +    (store (Integer/parseInt "00000000" 2) 0xFF11)
    4.48 +    (store (Integer/parseInt "00000000" 2) 0xFF12)
    4.49 +    (store (Integer/parseInt "00000000" 2) 0xFF13)
    4.50 +    (store (Integer/parseInt "00000000" 2) 0xFF14)
    4.51 +
    4.52 +    (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
    4.53 +    (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
    4.54 +    (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
    4.55 +    (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
    4.56 +
    4.57 +    (store (Integer/parseInt "00000000" 2) 0xFF1A)
    4.58 +    (store (Integer/parseInt "00000000" 2) 0xFF1B)
    4.59 +    (store (Integer/parseInt "00000000" 2) 0xFF1C)
    4.60 +    (store (Integer/parseInt "00000000" 2) 0xFF1D)
    4.61 +    (store (Integer/parseInt "00000000" 2) 0xFF1E)
    4.62 +
    4.63 +    (store (Integer/parseInt "00000000" 2) 0xFF20)
    4.64 +    (store (Integer/parseInt "00000000" 2) 0xFF21)
    4.65 +    (store (Integer/parseInt "00000000" 2) 0xFF22)
    4.66 +    (store (Integer/parseInt "00000000" 2) 0xFF23)]))
    4.67 +
    4.68 +(defn play-note
    4.69 +  "Play the note referenced by HL in the appropiate channel.
    4.70 +   Leaves desired-duration in A."
    4.71 +  []
    4.72 +  [0x2A   ;; load volume/frequency-high info
    4.73 +   0xF5   ;; push A
    4.74 +   0xE6
    4.75 +   (Integer/parseInt "11110000" 2) ;; volume mask
    4.76 +   0xE0
    4.77 +   0x17   ;; set volume
    4.78 +   0xF1   ;; pop A
    4.79 +   0xE6
    4.80 +   (Integer/parseInt "00000111" 2) ;; frequency-high mask
    4.81 +   0xE0   
    4.82 +   0x19   ;; set frequency-high
    4.83 +   
    4.84 +   0x2A   ;; load frequency low-bits
    4.85 +   0xE0
    4.86 +   0x18   ;; set frequency-low-bits
    4.87 +
    4.88 +   0x7E   ;; load duration
    4.89 +   0x2B   ;; 
    4.90 +   0x2B   ;; HL-2 -> HL
    4.91 +   ]) 
    4.92 +
    4.93 +(defn music-step []
    4.94 +  (flatten
    4.95 +   [(play-note)
    4.96 +    0xF5 ;; push A
    4.97 +    0xF0
    4.98 +    0x05 ;; load current ticks
    4.99 +    0xB8 ;; B holds previous sub-ticks, subtract it from A
   4.100 +    ;; if A-B caused a carry, then (B > A) is true, and
   4.101 +    ;; A = current-sub-tics, B = previous-sub-ticks, so
   4.102 +    ;; current-sub-ticks < previous-sub-ticks, which means that the
   4.103 +    ;; timer counter HAS overflowed.
   4.104 +    0x30 ;; increment C only if last result caused carry
   4.105 +    0x01
   4.106 +    0x0C
   4.107 +
   4.108 +    0x47 ;; update sub-ticks (A->B)
   4.109 +
   4.110 +    0xF1 ;; pop AF, now A contains desired-ticks
   4.111 +
   4.112 +    0xB9 ;; compare with current ticks
   4.113 +
   4.114 +    ;; if desired-ticks = current ticks
   4.115 +    ;;   go to next note ; set current set ticks to 0.
   4.116 +
   4.117 +    0x20
   4.118 +    0x05
   4.119 +
   4.120 +    0x23
   4.121 +    0x23
   4.122 +    0x23 ;; HL + 3 -> HL
   4.123 +    
   4.124 +    0x0E
   4.125 +    0x00])) ;; 0->C (current-ticks)
   4.126 +
   4.127 +(defn test-timer []
   4.128 +  (flatten
   4.129 +   [0x3E
   4.130 +    0x01
   4.131 +    0xE0
   4.132 +    0x06 ;; set TMA to 0
   4.133 +    
   4.134 +    0x3E
   4.135 +    (Integer/parseInt "00000100" 2)
   4.136 +    0xE0
   4.137 +    0x07 ;; set TAC to 16384 Hz and activate timer
   4.138 +    
   4.139 +    (repeat
   4.140 +     500
   4.141 +     [0xF0
   4.142 +      0x05])]))
   4.143 +
   4.144 +
   4.145 +(defn music-kernel []
   4.146 +  (flatten
   4.147 +   [(clear-music-registers)
   4.148 +
   4.149 +    0x21
   4.150 +    0x00
   4.151 +    0xD0 ;; set HL to 0xD000 == music-start
   4.152 +    0x0E
   4.153 +    0x00 ;; 0->C
   4.154 +    0x06
   4.155 +    0x00 ;; 0->B
   4.156 +
   4.157 +    0x3E
   4.158 +    0x01
   4.159 +    0xE0
   4.160 +    0x06 ;; set TMA to 0
   4.161 +    
   4.162 +    0x3E
   4.163 +    (Integer/parseInt "00000111" 2)
   4.164 +    0xE0
   4.165 +    0x07 ;; set TAC to 16384 Hz and activate timer
   4.166 +
   4.167 +    0xF0
   4.168 +    0x07
   4.169 +    
   4.170 +    (music-step)
   4.171 +    0x18
   4.172 +    (->signed-8-bit (+ (- (count (music-step)))
   4.173 +                       -2))]))
   4.174 +
   4.175 +(def one-note
   4.176 +  [0xA0 0x00 0xFF])
   4.177 +
   4.178 +(def many-notes
   4.179 +  (flatten (repeat 10 one-note)))
   4.180 +
   4.181 +(def increasing-notes
   4.182 +  [0xA0 0x00 0x55
   4.183 +   0xA1 0x00 0x55
   4.184 +   0xA2 0x00 0x55
   4.185 +   0xA3 0x00 0x55
   4.186 +   0xA4 0x00 0x55
   4.187 +   0xA5 0x00 0x55
   4.188 +   0xA6 0x00 0x55
   4.189 +   0xA7 0x00 0x55])
   4.190 +   
   4.191 +(defn play-music [music-bytes]
   4.192 +  (let [program-target 0xC000
   4.193 +        music-target 0xD000]
   4.194 +    (-> (set-memory-range (second (music-base))
   4.195 +                          program-target (music-kernel))
   4.196 +        (set-memory-range music-target music-bytes)
   4.197 +        (PC! program-target))))
   4.198 +
   4.199 +
   4.200 +(defn test-note [music-bytes]
   4.201 +  (-> (set-memory-range (second (music-base))
   4.202 +                        0xC000 (concat (clear-music-registers)
   4.203 +                                       (play-note)
   4.204 +                                       (infinite-loop)))
   4.205 +      (set-memory-range 0xD000 music-bytes)
   4.206 +      (PC! 0xC000)
   4.207 +      (HL! 0xD000)
   4.208 +      ))
   4.209 +
   4.210 +
   4.211 +(defn run-program
   4.212 +  ([program]
   4.213 +     (let [target 0xC000]
   4.214 +       (-> (set-memory-range (second (music-base))
   4.215 +                             target program)
   4.216 +           (PC! target)))))
   4.217 +
   4.218 +(defn trippy []
   4.219 +  (run-moves (play-music many-notes ) (repeat 8000 [])))
   4.220 +

     5.1 Binary file moves/new-kernel.vbm has changed

     6.1 Binary file save-states/new-kernel.sav has changed