changeset 145:412ca096a9ba

major refactoring complete.
author Robert McIntyre <rlm@mit.edu>
date Mon, 19 Mar 2012 21:23:46 -0500
parents ec477931f077
children c5914665012d
files clojure/com/aurellem/assembly.clj clojure/com/aurellem/cruft/gb_driver.clj clojure/com/aurellem/cruft/title.clj clojure/com/aurellem/dylans-code clojure/com/aurellem/exp/assembly.clj clojure/com/aurellem/exp/item_bridge.clj clojure/com/aurellem/exp/items.clj clojure/com/aurellem/exp/pokemon.clj clojure/com/aurellem/exp/rival_name.clj clojure/com/aurellem/experiments/items.clj clojure/com/aurellem/gb/assembly.clj clojure/com/aurellem/gb/characters.clj clojure/com/aurellem/gb/gb_driver.clj clojure/com/aurellem/gb/items.clj clojure/com/aurellem/gb/util.clj clojure/com/aurellem/gb/vbm.clj clojure/com/aurellem/gb_driver.clj clojure/com/aurellem/item_bridge.clj clojure/com/aurellem/items.clj clojure/com/aurellem/pokemon.clj clojure/com/aurellem/rival_name.clj clojure/com/aurellem/run/save_corruption.clj clojure/com/aurellem/run/speedruns.clj clojure/com/aurellem/run/title.clj clojure/com/aurellem/save_corruption.clj clojure/com/aurellem/speedruns.clj clojure/com/aurellem/title.clj clojure/com/aurellem/util.clj clojure/com/aurellem/vbm.clj
diffstat 29 files changed, 3604 insertions(+), 3990 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/assembly.clj	Mon Mar 19 20:43:38 2012 -0500
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,1505 +0,0 @@
     1.4 -(ns com.aurellem.assembly
     1.5 -  (:use (com.aurellem gb-driver vbm title items))
     1.6 -  (:import [com.aurellem.gb_driver SaveState]))
     1.7 -
     1.8 -(defn mid-game []
     1.9 -  (read-state "mid-game"))
    1.10 -
    1.11 -(defn inject-assembly
    1.12 -  ([^SaveState state
    1.13 -   program-counter registers
    1.14 -   assembly-code]
    1.15 -  (let [scratch-memory (memory state)]
    1.16 -    ;; inject assembly code
    1.17 -    (dorun (map (fn [index val]
    1.18 -                  (aset scratch-memory index val))
    1.19 -                (range program-counter
    1.20 -                       (+ program-counter (count assembly-code)))
    1.21 -                assembly-code))
    1.22 -    (-> state
    1.23 -        (write-memory! scratch-memory)
    1.24 -        (write-registers! registers)
    1.25 -        (PC! program-counter)))))
    1.26 -
    1.27 -(defn inject-item-assembly
    1.28 -  ([^SaveState state assembly-code]
    1.29 -     (inject-assembly state (inc item-list-start)
    1.30 -                      (registers state)
    1.31 -                      assembly-code))
    1.32 -  ([assembly-code]
    1.33 -     (inject-item-assembly @current-state assembly-code)))
    1.34 -
    1.35 -(defn info
    1.36 -  ([^SaveState state]
    1.37 -     (println (format "PC: 0x%04X" (PC state)))
    1.38 -     (println "Instruction:"
    1.39 -              (format "0x%02X" (aget (memory state) (PC state))))
    1.40 -     state))    
    1.41 -
    1.42 -(defn print-interrupt
    1.43 -  [^SaveState state]
    1.44 -  (println (format "IE: %d" (IE state)))
    1.45 -  state)
    1.46 -
    1.47 -(defn print-listing [state begin end]
    1.48 -  (dorun (map 
    1.49 -          (fn [opcode line]
    1.50 -            (println (format "0x%04X:  0x%02X" line opcode)))
    1.51 -          (subvec  (vec (memory state)) begin end)
    1.52 -          (range begin end)))
    1.53 -  state)
    1.54 -
    1.55 -(defn run-assembly
    1.56 -  ([info-fn assembly n]
    1.57 -     (let [final-state
    1.58 -           (reduce (fn [state _]
    1.59 -                     (tick (info-fn state)))
    1.60 -                   (inject-item-assembly
    1.61 -                     (mid-game) assembly)
    1.62 -                   (range n))]
    1.63 -       final-state))
    1.64 -  ([assembly n]
    1.65 -     (run-assembly info assembly n)))
    1.66 -
    1.67 -(def buttons-port 0xFF00)
    1.68 -
    1.69 -(defn A [state]
    1.70 -  (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
    1.71 -
    1.72 -(defn B [state]
    1.73 -  (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
    1.74 -
    1.75 -(defn D [state]
    1.76 -  (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
    1.77 -
    1.78 -(defn H [state]
    1.79 -  (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
    1.80 -
    1.81 -(defn C [state]
    1.82 -  (bit-and 0xFF (BC state)))
    1.83 -(defn F [state]
    1.84 -  (bit-and 0xFF (AF state)))
    1.85 -(defn E [state]
    1.86 -  (bit-and 0xFF (DE state)))
    1.87 -(defn L [state]
    1.88 -  (bit-and 0xFF (HL state)))
    1.89 -
    1.90 -
    1.91 -
    1.92 -
    1.93 -
    1.94 -(defn binary-str [num]
    1.95 -  (format "%08d"
    1.96 -          (Integer/parseInt
    1.97 -           (Integer/toBinaryString num) 10)))
    1.98 -
    1.99 -(defn view-register [state name reg-fn]
   1.100 -  (println (format "%s: %s" name
   1.101 -                   (binary-str (reg-fn state))))
   1.102 -  state)
   1.103 -
   1.104 -(defn view-memory [state mem]
   1.105 -  (println (format "mem 0x%04X = %s" mem
   1.106 -                   (binary-str (aget (memory state) mem))))
   1.107 -  state)
   1.108 -
   1.109 -(defn trace [state]
   1.110 -  (loop [program-counters [(first (registers @current-state)) ]
   1.111 -         opcodes [(aget (memory @current-state) (PC @current-state))]]
   1.112 -    (let [frame-boundary?
   1.113 -          (com.aurellem.gb.Gb/tick)]
   1.114 -      (if frame-boundary?
   1.115 -        [program-counters opcodes]
   1.116 -        (recur
   1.117 -         (conj program-counters
   1.118 -               (first (registers @current-state)))
   1.119 -         (conj opcodes
   1.120 -               (aget (memory @current-state)
   1.121 -                     (PC @current-state))))))))
   1.122 -
   1.123 -(defn print-trace [state n]
   1.124 -  (let [[program-counters opcodes] (trace state)]
   1.125 -    (dorun (map (fn [pc op] (println (format "%04X: 0x%02X" pc op)))
   1.126 -                (take n program-counters)
   1.127 -                (take n opcodes)))))
   1.128 -
   1.129 -(defn good-trace []
   1.130 -  (-> (mid-game) (tick) (IE! 0)
   1.131 -      (set-inv-mem [0x00 0x00 0X00 0x00])
   1.132 -      (PC! item-list-start)(print-interrupt)
   1.133 -      (info) (tick) (info) (tick) (info)))
   1.134 -
   1.135 -(defn read-down-button []
   1.136 -  (-> (tick (mid-game))
   1.137 -      (IE! 0) ; disable interrupts
   1.138 -      (inject-item-assembly
   1.139 -       ;; write 00010000 to 0xFF00 to select joypad
   1.140 -       [0x18   ;D31D                    ; jump over          
   1.141 -        0x01   ;D31E                    ; the next 8 bits
   1.142 -                                        ;D31F
   1.143 -        (Integer/parseInt "00100000" 2) ; data section 
   1.144 -        
   1.145 -        0xFA   ;D320                    ; load (D31F) into A
   1.146 -        0x1F   ;D321      -->       
   1.147 -        0xD3   ;D322      -->  D31F     
   1.148 -
   1.149 -        0xEA   ;D323                    ; load (A), which is 
   1.150 -        0x00   ;D324      -->           ; 00010000, into FF00
   1.151 -        0xFF   ;D325      -->  FF00     
   1.152 -        
   1.153 -        0x18   ;D326                    ; this is the place where
   1.154 -        0x01   ;D327                    ; we will store whether
   1.155 -        0x00   ;D328                    ; "down" is pressed.
   1.156 -
   1.157 -        0xFA   ;D329                    ; (FF00) -> A
   1.158 -        0x00   ;D32A                   
   1.159 -        0xFF   ;D32B
   1.160 -
   1.161 -        0xCB   ;D32C                    ; Test whether "down"
   1.162 -        0x5F   ;D32D                    ; is pressed.
   1.163 -
   1.164 -        0x28   ;D32E                    ; if down is pressed,
   1.165 -        0x03   ;D32F                    ; skip the next section 
   1.166 -                                        ; of code.
   1.167 -        ;; down-is-not-pressed
   1.168 -        0xC3   ;D330
   1.169 -        0x1D   ;D331                    ; return to beginning
   1.170 -        0xD3   ;D332
   1.171 -        
   1.172 -        ;; down-is-pressed 
   1.173 -        0xEA   ;D334                    ; write A to D328 if 
   1.174 -        0x28   ;D335                    ; "down" was pressed
   1.175 -        0xD3   ;D336
   1.176 -
   1.177 -        0xC3   ;D330
   1.178 -        0x1D   ;D331                    ; return to beginning
   1.179 -        0xD3   ;D332
   1.180 -        ])))
   1.181 -
   1.182 -(defn test-read-down []
   1.183 - (= (view-memory (step (step (read-down-button) [:d])) 0xD328)
   1.184 -    (view-memory (step (step (read-down-button))) 0xD328)))
   1.185 -
   1.186 -(defn count-frames []
   1.187 -  (-> (tick (mid-game))
   1.188 -      (IE! 0) ; disable interrupts
   1.189 -      (inject-item-assembly
   1.190 -       [0x18   ;D31D                    ; jump over          
   1.191 -        0x02   ;D31E                    ; the next 2 bytes
   1.192 -        0x00   ;D31F                    ; frame-count
   1.193 -        0x00   ;D320                    ; v-blank-prev
   1.194 -        
   1.195 -        0xFA   ;D321
   1.196 -        0x41   ;D322                    ; load (FF41) into A
   1.197 -        0xFF   ;D323                    ; this contains mode flags
   1.198 -        
   1.199 -        ;; if we're in v-blank, the bit-1 is 0
   1.200 -        ;; and bit-2 is 1  Otherwise, it is not v-blank.
   1.201 -        0xCB   ;D324                     ; test bit-1 of A
   1.202 -        0x4F   ;D325                         
   1.203 -
   1.204 -        0xC2   ;D326                     ; if bit-1 is not 0
   1.205 -        0x44   ;D327                     ; GOTO not-v-blank
   1.206 -        0xD3   ;D328
   1.207 -        
   1.208 -        0xCB   ;D329                     ; test bit-0 of A 
   1.209 -        0x47   ;D32A
   1.210 -
   1.211 -        0xCA   ;D32B                     ; if bit-0 is not 1
   1.212 -        0x44   ;D32C                     ; GOTO not-v-blank
   1.213 -        0xD3   ;D32D
   1.214 -        ;;; in v-blank mode
   1.215 -           ;; if v-blank-prev was 0,
   1.216 -           ;; increment frame-count
   1.217 -
   1.218 -        0xFA   ;D32E                    ; load v-blank-prev to A
   1.219 -        0x20   ;D32F
   1.220 -        0xD3   ;D330
   1.221 -        
   1.222 -        0xCB   ;D331
   1.223 -        0x47   ;D332                    ; test bit-0 of A 
   1.224 -
   1.225 -        0x20   ;D333                    ; skip next section
   1.226 -        0x07   ;D334                    ; if v-blank-prev was not zero 
   1.227 -        
   1.228 -           ;; v-blank was 0, increment frame-count
   1.229 -        0xFA   ;D335                    ; load frame-count into A
   1.230 -        0x1F   ;D336
   1.231 -        0xD3   ;D337                   
   1.232 -
   1.233 -        0x3C   ;D338                    ; inc A
   1.234 -
   1.235 -        0xEA   ;D339                    ; load A into frame-count
   1.236 -        0x1F   ;D33A
   1.237 -        0xD3   ;D33B
   1.238 -
   1.239 -           ;; set v-blank-prev to 1
   1.240 -        0x3E   ;D33C                    ; load 1 into A
   1.241 -        0x01   ;D33D                    
   1.242 -
   1.243 -        0xEA   ;D33E                    ; load A into v-blank-prev
   1.244 -        0x20   ;D33F
   1.245 -        0xD3   ;D340
   1.246 -
   1.247 -        0xC3   ;D341                   ; return to beginning
   1.248 -        0x1D   ;D342
   1.249 -        0xD3   ;D343
   1.250 -
   1.251 -        ;;; not in v-blank mode
   1.252 -           ;; set v-blank-prev to 0
   1.253 -        0x3E   ;D344                    ; load 0 into A        
   1.254 -        0x00   ;D345
   1.255 -
   1.256 -        0xEA   ;D346                    ; load A into v-blank-prev
   1.257 -        0x20   ;D347
   1.258 -        0xD3   ;D348
   1.259 -
   1.260 -        0xC3   ;D349                   ; return to beginning
   1.261 -        0x1D   ;D34A
   1.262 -        0xD3   ;D34B
   1.263 -        ])))
   1.264 -
   1.265 -(defn step-count-frames []
   1.266 -  (-> (read-down-button)
   1.267 -      (info)
   1.268 -      (tick)  ;; skip over data section
   1.269 -      (info)  
   1.270 -      (view-register "Register A" A)
   1.271 -      (tick)  ;; load-data into A
   1.272 -      (view-register "Register A" A)
   1.273 -      (info)
   1.274 -      (view-memory 0xFF00)
   1.275 -      (tick) ;; load A into 0xFF00
   1.276 -      (view-memory 0xFF00)
   1.277 -      (info)
   1.278 -      (tick)
   1.279 -      (info)
   1.280 -      (tick)
   1.281 -      (info)
   1.282 -      (tick)
   1.283 -      (info)
   1.284 -      (tick)
   1.285 -      (info)
   1.286 -      (tick)
   1.287 -      (info)
   1.288 -      (tick)
   1.289 -      (print-inventory)))
   1.290 -
   1.291 -(defn test-count-frames []
   1.292 -  (= 255 (aget (memory ((apply comp (repeat 255 step))
   1.293 -                        (count-frames)))
   1.294 -               0xD31F)))
   1.295 -
   1.296 -;; specs for main bootstrap program
   1.297 -;; starts in "mode-select" mode
   1.298 -;;   Each button press takes place in a single frame.
   1.299 -;;   mode-select-mode takes one of the main buttons
   1.300 -;;   which selects one of up to eight modes
   1.301 -;;   mode 1 activated by the "A" button
   1.302 -;;   the next two button presses indicates the start
   1.303 -;;   memory location which to which the bootstrap
   1.304 -;;   program will write.
   1.305 -;;   This is done by using each of the eight buttons to
   1.306 -;;   spell out an 8 bit number.  The order of buttons is
   1.307 -;;   [:d :u :l :r :start :select :b :a]
   1.308 -;;   [:a :start :l]  -->  00101001
   1.309 -
   1.310 -;;   the next button press determines how many bytes are to be
   1.311 -;;   written, starting at the start position.
   1.312 -
   1.313 -;;   then, the actual bytes are entered and are written to the
   1.314 -;;   start address in sequence.
   1.315 -
   1.316 -(defn input-number-assembly []
   1.317 -  [0x18   ;D31D                    ; jump over          
   1.318 -   0x02   ;D31E                    ; the next 2 bytes
   1.319 -   0x00   ;D31F                    ; frame-count
   1.320 -   0x00   ;D320                    ; v-blank-prev
   1.321 -   
   1.322 -   0xFA   ;D321
   1.323 -   0x41   ;D322                    ; load (FF41) into A
   1.324 -   0xFF   ;D323                    ; this contains mode flags
   1.325 -   
   1.326 -   ;; if we're in v-blank, the bit-1 is 0
   1.327 -   ;; and bit-2 is 1  Otherwise, it is not v-blank.
   1.328 -   0xCB   ;D324                     ; test bit-1 of A
   1.329 -   0x4F   ;D325                         
   1.330 -
   1.331 -   0xC2   ;D326                     ; if bit-1 is not 0
   1.332 -   0x44   ;D327                     ; GOTO not-v-blank
   1.333 -   0xD3   ;D328
   1.334 -   
   1.335 -   0xCB   ;D329                     ; test bit-0 of A 
   1.336 -   0x47   ;D32A
   1.337 -
   1.338 -   0xCA   ;D32B                     ; if bit-0 is not 1
   1.339 -   0x44   ;D32C                     ; GOTO not-v-blank
   1.340 -   0xD3   ;D32D
   1.341 -   
   1.342 -        ;;; in v-blank mode
   1.343 -
   1.344 -   ;; if v-blank-prev was 0,
   1.345 -   ;; increment frame-count
   1.346 -
   1.347 -   0xFA   ;D32E                    ; load v-blank-prev to A
   1.348 -   0x20   ;D32F
   1.349 -   0xD3   ;D330
   1.350 -   
   1.351 -   0xCB   ;D331
   1.352 -   0x47   ;D332                    ; test bit-0 of A 
   1.353 -
   1.354 -   0x20   ;D333                    ; skip next section
   1.355 -   0x07   ;D334                    ; if v-blank-prev was not zero 
   1.356 -   
   1.357 -   ;; v-blank was 0, increment frame-count
   1.358 -   0xFA   ;D335                    ; load frame-count into A
   1.359 -   0x1F   ;D336
   1.360 -   0xD3   ;D337                   
   1.361 -
   1.362 -   0x3C   ;D338                    ; inc A
   1.363 -
   1.364 -   0xEA   ;D339                    ; load A into frame-count
   1.365 -   0x1F   ;D33A
   1.366 -   0xD3   ;D33B
   1.367 -
   1.368 -   ;; set v-blank-prev to 1
   1.369 -   0x3E   ;D33C                    ; load 1 into A
   1.370 -   0x01   ;D33D                    
   1.371 -
   1.372 -   0xEA   ;D33E                    ; load A into v-blank-prev
   1.373 -   0x20   ;D33F
   1.374 -   0xD3   ;D340
   1.375 -
   1.376 -   0xC3   ;D341                   ; GOTO input handling code
   1.377 -   0x4E   ;D342
   1.378 -   0xD3   ;D343
   1.379 -
   1.380 -        ;;; not in v-blank mode
   1.381 -   ;; set v-blank-prev to 0
   1.382 -   0x3E   ;D344                    ; load 0 into A        
   1.383 -   0x00   ;D345
   1.384 -
   1.385 -   0xEA   ;D346                    ; load A into v-blank-prev
   1.386 -   0x20   ;D347
   1.387 -   0xD3   ;D348
   1.388 -
   1.389 -   0xC3   ;D349                   ; return to beginning
   1.390 -   0x1D   ;D34A
   1.391 -   0xD3   ;D34B
   1.392 -
   1.393 -   0x00   ;D34C                   ; these are here 
   1.394 -   0x00   ;D34D                   ; for glue
   1.395 -   
   1.396 -   
   1.397 -        ;;; calculate input number based on button presses
   1.398 -   0x18   ;D34E                    ;  skip next 3 bytes
   1.399 -   0x03   ;D34F
   1.400 -                                        ;D350
   1.401 -   (Integer/parseInt "00100000" 2) ;  select directional pad
   1.402 -                                        ;D351
   1.403 -   (Integer/parseInt "00010000" 2) ;  select buttons
   1.404 -   0x00   ;D352                    ;  input-number
   1.405 -
   1.406 -   ;; select directional pad, store low bits in B
   1.407 -   
   1.408 -   0xFA   ;D353                    ; load (D350) into A
   1.409 -   0x50   ;D354      -->       
   1.410 -   0xD3   ;D355      -->  D31F     
   1.411 -   
   1.412 -   0xEA   ;D356                    ; load A, which is 
   1.413 -   0x00   ;D357      -->           ; 00010000, into FF00
   1.414 -   0xFF   ;D358      -->  FF00     
   1.415 -
   1.416 -   0x06   ;D359
   1.417 -                                        ;D35A
   1.418 -   (Integer/parseInt "11110000" 2) ; "11110000" -> B 
   1.419 -   0xFA   ;D35B                    ; (FF00) -> A
   1.420 -   0x00   ;D35C                   
   1.421 -   0xFF   ;D35D
   1.422 -
   1.423 -   0xCB   ;D35E                    ; swap nybbles on A
   1.424 -   0x37   ;D35F
   1.425 -   0xA0   ;D360                    ; (AND A B) -> A
   1.426 -   0x47   ;D361                    ; A -> B
   1.427 -
   1.428 -   ;; select buttons store bottom bits in C
   1.429 -   
   1.430 -   0xFA   ;                        ; load (D351) into A
   1.431 -   0x51   ;          -->       
   1.432 -   0xD3   ;          -->  D31F     
   1.433 -   
   1.434 -   0xEA   ;                        ; load (A), which is 
   1.435 -   0x00   ;          -->           ; 00001000, into FF00
   1.436 -   0xFF   ;          -->  FF00     
   1.437 -
   1.438 -   0x0E   ;    
   1.439 -   (Integer/parseInt "00001111" 2) ; "00001111" -> C 
   1.440 -
   1.441 -   0xFA   ;                        ; (FF00) -> A
   1.442 -   0x00   ;                       
   1.443 -   0xFF   ;    
   1.444 -   
   1.445 -   0xA1   ;                        ; (AND A C) -> A
   1.446 -   0x4F   ;                        ; A -> C
   1.447 -
   1.448 -   ;; combine the B and C registers into the input number
   1.449 -   0x79   ;                        ; C -> A
   1.450 -   0xB0   ;                        ; (OR A B) -> A
   1.451 -   0x2F   ;                        ; negate A
   1.452 -
   1.453 -   0xEA   ;                        ; store A into input-number
   1.454 -   0x52   ;
   1.455 -   0xD3   ;
   1.456 -
   1.457 -   0xC3   ;                        ; return to beginning
   1.458 -   0x1D   ;    
   1.459 -   0xD3   ;    
   1.460 -   ])
   1.461 -
   1.462 -
   1.463 -(defn print-pc [state]
   1.464 -  (println (format "PC: 0x%04X" (PC state)))
   1.465 -  state)
   1.466 -
   1.467 -(defn print-op [state]
   1.468 -  (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
   1.469 -  state)
   1.470 -
   1.471 -(defn d-tick
   1.472 -  ([state]
   1.473 -  (-> state print-pc print-op tick)))
   1.474 -
   1.475 -(defn input-number []
   1.476 -  (-> (tick (mid-game))
   1.477 -      (IE! 0) ; disable interrupts
   1.478 -      (inject-item-assembly (input-number-assembly))))
   1.479 -  
   1.480 -(defn test-input-number
   1.481 -  "Input freestyle buttons and observe the effects at the repl."
   1.482 -  []
   1.483 -  (set-state! (input-number)) 
   1.484 -  (dotimes [_ 90000] (step (view-memory @current-state 0xD352))))
   1.485 -
   1.486 -
   1.487 -    
   1.488 -
   1.489 -
   1.490 -
   1.491 -
   1.492 -
   1.493 -
   1.494 -
   1.495 -
   1.496 -
   1.497 -
   1.498 -
   1.499 -
   1.500 -
   1.501 -
   1.502 -
   1.503 -
   1.504 -
   1.505 -
   1.506 -
   1.507 -
   1.508 -
   1.509 -
   1.510 -
   1.511 -
   1.512 -
   1.513 -
   1.514 -(defn write-memory-assembly*
   1.515 -  "Currently, grabs input from the user each frame."
   1.516 -  []
   1.517 -  [
   1.518 -   ;; --------- FRAME METRONOME
   1.519 -   0x18 ;; jump ahead to cleanup. first time only.
   1.520 -   0x40 ;; v-blank-prev [D31E]
   1.521 -
   1.522 -   0xFA ;; load modes into A [D31F]
   1.523 -   0x41
   1.524 -   0xFF
   1.525 -
   1.526 -   0x47 ;; A -> B
   1.527 -   0xCB ;; rotate A
   1.528 -   0x2F
   1.529 -   0x2F ;; invert A
   1.530 -
   1.531 -   0xA0
   1.532 -   0x47 ;; now B_0 contains (VB==1)
   1.533 -
   1.534 -   0xFA ;; load v-blank-prev
   1.535 -   0x1E
   1.536 -   0xD3
   1.537 -
   1.538 -   0x2F ;; complement v-blank-prev
   1.539 -   
   1.540 -   0xA0 ;; A & B --> A
   1.541 -   0x4F ;; now C_0 contains increment?
   1.542 -
   1.543 -
   1.544 -   0x78 ;; B->A
   1.545 -   0xEA ;; spit A --> vbprev
   1.546 -   0x1E
   1.547 -   0xD3
   1.548 -
   1.549 -   0xCB   ;test C_0
   1.550 -   0x41
   1.551 -   0x20   ; JUMP ahead to button input if nonzero
   1.552 -   0x02
   1.553 -   0x18   ; JUMP  back to frame metronome (D31F)
   1.554 -   0xE7
   1.555 -   
   1.556 -   ;; -------- GET BUTTON INPUT
   1.557 -
   1.558 -        ;; btw, C_0 is now 1
   1.559 -        ;; prepare to select bits
   1.560 -
   1.561 -   0x06 ;; load 0x00 into B
   1.562 -   0x00 ;; to initialize for "OR" loop
   1.563 - 
   1.564 -   0x3E ;; load 0x20 into A, to measure dpad
   1.565 -   0x20
   1.566 -
   1.567 -   
   1.568 -   0xE0 ;; load A into [FF00] ;; start of OR loop [D33C]
   1.569 -   0x00
   1.570 -   
   1.571 -   0xF0 ;; load A from [FF00]
   1.572 -   0x00
   1.573 -
   1.574 -   0xE6 ;; bitmask 00001111
   1.575 -   0x0F
   1.576 -   
   1.577 -   0xB0 ;; A or B --> A
   1.578 -   0xCB
   1.579 -   0x41 ;; test bit 0 of C
   1.580 -   0x28 ;; JUMP forward if 0
   1.581 -   0x08
   1.582 -
   1.583 -   0x47 ;; A -> B
   1.584 -   0xCB ;; swap B nybbles
   1.585 -   0x30 
   1.586 -   0x0C ;; increment C
   1.587 -   0x3E ;; load 0x10 into A, to measure btns
   1.588 -   0x10
   1.589 -   0x18 ;; JUMP back to "load A into [FF00]" [20 steps?]
   1.590 -   0xED
   1.591 -
   1.592 -
   1.593 -   ;; ------ TAKE ACTION BASED ON USER INPUT
   1.594 -
   1.595 -   ;; "input mode"
   1.596 -   ;; mode 0x00 : select mode
   1.597 -   ;; mode 0x08 : select bytes-to-write
   1.598 -   ;; mode 0x10 : select hi-bit
   1.599 -   ;; mode 0x18 : select lo-bit
   1.600 -
   1.601 -   ;; "output mode"
   1.602 -   ;; mode 0x20 : write bytes
   1.603 -   ;; mode 0xFF : jump PC
   1.604 -
   1.605 -
   1.606 -   ;; registers
   1.607 -   ;; D : mode select
   1.608 -   ;; E : count of bytes to write
   1.609 -   ;; H : address-high
   1.610 -   ;; L : address-low
   1.611 -   
   1.612 -   ;; now A contains the pressed keys
   1.613 -   0x2F ; complement A, by request. [D34F]
   1.614 -   
   1.615 -   0x47 ; A->B ;; now B contains the pressed keys
   1.616 -   0x7B ; E->A ;; now A contains the count.
   1.617 -
   1.618 -   0xCB ; test bit 5 of D (are we in o/p mode?)
   1.619 -   0x6A
   1.620 -   0x28 ; if test == 0, skip this o/p section
   1.621 -   0x13 ; JUMP
   1.622 -   
   1.623 -   0xCB ; else, test bit 0 of D (fragile; are we in pc mode?)
   1.624 -   0x42
   1.625 -   0x28 ; if test == 0, skip the following command
   1.626 -   0x01
   1.627 -
   1.628 -   ;; output mode I: moving the program counter
   1.629 -   0xE9 ; ** move PC to (HL)
   1.630 -
   1.631 -   ;; output mode II: writing bytes
   1.632 -   0xFE ; A compare 0. finished writing?
   1.633 -   0x00
   1.634 -   0x20 ; if we are not finished, skip cleanup
   1.635 -   0x04 ; JUMP
   1.636 -
   1.637 -   ;; CLEANUP
   1.638 -   ;; btw, A is already zero.
   1.639 -   0xAF ; zero A  [D35F]
   1.640 -   0x57 ; A->D; makes D=0.
   1.641 -   0x18 ; end of frame
   1.642 -   0xBC
   1.643 -   
   1.644 -   ;; ---- end of cleanup
   1.645 -
   1.646 -   
   1.647 -   ;; continue writing bytes
   1.648 -   0x1D ;; decrement E, the number of bytes to write [D363]
   1.649 -   0x78 ;; B->A; now A contains the pressed keys
   1.650 -   0x77 ;; copy A to (HL)
   1.651 -   0x23 ;; increment HL
   1.652 -   0x18 ;; end frame. [goto D31F]
   1.653 -   0xB6 ;; TODO: set skip length backwards
   1.654 -
   1.655 -
   1.656 -   ;; ---- end of o/p section
   1.657 -   
   1.658 -   ;; i/p mode
   1.659 -   ;; adhere to the mode discipline:
   1.660 -   ;; D must be one of 0x00 0x08 0x10 0x18.
   1.661 -
   1.662 -   0x3E ;; load the constant 57 into A. [D369]
   1.663 -   0x57
   1.664 -   0x82 ;; add the mode to A
   1.665 -   0xEA ;; store A into "thing to execute"
   1.666 -   0x74
   1.667 -   0xD3
   1.668 -
   1.669 -   0x3E ;; load the constant 8 into A
   1.670 -   0x08
   1.671 -   0x82 ;; add the mode to A
   1.672 -   
   1.673 -   0x57 ;; store the incremented mode into D
   1.674 -   0x78 ;; B->A; now A contains the pressed keys
   1.675 -   
   1.676 -   0x00 ;; var: thing to execute [D374]
   1.677 -
   1.678 -   0x18 ;; end frame
   1.679 -   0xA8
   1.680 -   ]
   1.681 -  )
   1.682 -
   1.683 -(defn write-mem-dyl []
   1.684 -  (-> (tick (mid-game))
   1.685 -      (IE! 0)
   1.686 -      (inject-item-assembly (write-memory-assembly*))))
   1.687 -
   1.688 -
   1.689 -(defn dylan* []
   1.690 -  (->
   1.691 -   (write-mem-dyl)
   1.692 -
   1.693 -   (tick)
   1.694 -   (tick)
   1.695 -   (tick)
   1.696 -   (tick)
   1.697 -   (tick)
   1.698 -   (tick)
   1.699 -   (tick)
   1.700 -   (tick)
   1.701 -   (tick)
   1.702 -   (tick)
   1.703 -   (tick)
   1.704 -   (tick)
   1.705 -   (tick)
   1.706 -   (tick)
   1.707 -   (tick)
   1.708 -   (tick)
   1.709 -   (tick)
   1.710 -   (tick)
   1.711 -   (tick)
   1.712 -   (tick)
   1.713 -   (tick)
   1.714 -   (tick)
   1.715 -   (tick)
   1.716 -   (tick)
   1.717 -   (tick)
   1.718 -   (tick)
   1.719 -   (tick)
   1.720 -   (tick)
   1.721 -   (tick)
   1.722 -   (tick)
   1.723 -   (tick)
   1.724 -   (tick)
   1.725 -   (tick)
   1.726 -   (tick)
   1.727 -   (tick)
   1.728 -   (tick)
   1.729 -
   1.730 -   ;;(view-memory 0xD374)
   1.731 -   (tick)
   1.732 -   (tick)
   1.733 -   (tick)
   1.734 -   (tick)
   1.735 -   (tick)
   1.736 -   (tick)
   1.737 -   (tick)
   1.738 -   (tick)
   1.739 -   (tick)
   1.740 -   (tick)
   1.741 -   (tick)
   1.742 -   (tick)
   1.743 -   (tick)
   1.744 -   (tick)
   1.745 -   (tick)
   1.746 -   ;;(view-memory 0xD374)
   1.747 -   (d-tick)
   1.748 -
   1.749 -   (view-register "A" A)
   1.750 -   (view-register "B" B)
   1.751 -   (view-register "C" C))
   1.752 -
   1.753 -)
   1.754 -
   1.755 -
   1.756 -(defn dylan []
   1.757 -  (->
   1.758 -   (write-mem-dyl)
   1.759 -   (tick)
   1.760 -   (tick)
   1.761 -   (tick)
   1.762 -   (tick)
   1.763 -   (tick)
   1.764 -   (tick)
   1.765 -   (tick)
   1.766 -   (tick)
   1.767 -   (tick)
   1.768 -   (tick)
   1.769 -   (tick)
   1.770 -   (tick)
   1.771 -   (tick)
   1.772 -   (tick)
   1.773 -   (tick) ;; first loop
   1.774 -
   1.775 -
   1.776 -   (tick)
   1.777 -   (tick)
   1.778 -   (tick)
   1.779 -   (tick)
   1.780 -   (tick)
   1.781 -   (tick)
   1.782 -   (tick)
   1.783 -   (tick)
   1.784 -   (tick)
   1.785 -   (tick)
   1.786 -   (tick)
   1.787 -   (tick)
   1.788 -   (tick) ;; dpad bits
   1.789 -
   1.790 -   (tick)
   1.791 -   (tick)
   1.792 -   (tick)
   1.793 -   (tick)
   1.794 -   (tick)
   1.795 -   (tick)
   1.796 -   (tick)
   1.797 -   (tick)
   1.798 -   (d-tick)
   1.799 -   
   1.800 -
   1.801 -   
   1.802 -   (view-register "A" A)
   1.803 -   (view-register "B" B)
   1.804 -   (view-register "C" C)
   1.805 -   
   1.806 -   ))
   1.807 -
   1.808 -
   1.809 -
   1.810 -
   1.811 -(defn d2 []
   1.812 -  (->
   1.813 -   (write-mem-dyl)
   1.814 -   (view-memory 0xD31F)
   1.815 -   step step step step step
   1.816 -   (view-memory 0xD31F)))
   1.817 -
   1.818 -
   1.819 -
   1.820 -
   1.821 -
   1.822 -
   1.823 -
   1.824 -
   1.825 -
   1.826 -
   1.827 -
   1.828 -
   1.829 -
   1.830 -
   1.831 -
   1.832 -
   1.833 -
   1.834 -
   1.835 -
   1.836 -
   1.837 -(defn write-memory-assembly []
   1.838 -  [
   1.839 -   ;; Main Timing Loop
   1.840 -   ;;   Constantly check for v-blank and Trigger main state machine on
   1.841 -   ;;   every transtion from v-blank to non-v-blank.
   1.842 -    
   1.843 -   0x18   ; D31D                  ; Variable declaration
   1.844 -   0x02   ; D31E                   
   1.845 -   0x00   ; D31F                  ; frame-count
   1.846 -   0x00   ; D320                  ; v-blank-prev 
   1.847 -   
   1.848 -   0xF0   ; D321                  ; load v-blank mode flags into A
   1.849 -   0x41
   1.850 -   0x00
   1.851 -
   1.852 -
   1.853 -   ;; Branch dependent on v-blank.  v-blank happens when the last two
   1.854 -   ;; bits in A are "01"
   1.855 -   0xCB   ; D324                  
   1.856 -   0x4F   ; D325                  
   1.857 -
   1.858 -   0xC2   ; D326                  ; if bit-1 is not 0, then
   1.859 -   0x3E   ; D327                  ; GOTO non-v-blank.
   1.860 -   0xD3   ; D328                  
   1.861 -
   1.862 -   0xCB   ; D329                  
   1.863 -   0x47   ; D32A                  
   1.864 -
   1.865 -   0xCA   ; D32B                  ; if bit-0 is not 1, then
   1.866 -   0x3E   ; D32C                  ; GOTO non-v-blank.
   1.867 -   0xD3   ; D32D                  
   1.868 -
   1.869 -   ;; V-Blank
   1.870 -   ;;   Activate state-machine if this is a transition event.
   1.871 -
   1.872 -   0xFA   ; D32E                  ; load v-bank-prev into A
   1.873 -   0x20   ; D32F                  
   1.874 -   0xD3   ; D330                  
   1.875 -
   1.876 -   0xFE   ; D331                  ; compare A to 0. >--------\ 
   1.877 -   0x00   ; D332                                              \
   1.878 -                                  ;                           |
   1.879 -   ;;   set v-blank-prev to 1.                                |
   1.880 -   0x3E   ; D333                  ; load 1 into A.            |
   1.881 -   0x01   ; D334                                              | 
   1.882 -                                  ;                           |
   1.883 -   0xEA   ; D335                  ; load A into v-blank-prev  |
   1.884 -   0x20   ; D336                                              |
   1.885 -   0xD3   ; D337                                              |
   1.886 -                                  ;                           /
   1.887 -   ;;   if v-blank-prev was 0, activate state-machine <------/
   1.888 -   0xCA   ; D338                  ; if v-blank-prev 
   1.889 -   0x46   ; D339                  ;   was 0, 
   1.890 -   0xD3   ; D33A                  ; GOTO state-machine
   1.891 -
   1.892 -   0xC3   ; D33B                  
   1.893 -   0x1D   ; D33C                  
   1.894 -   0xD3   ; D33D                  ; GOTO beginning
   1.895 -   ;; END V-blank
   1.896 -
   1.897 -   ;; Non-V-Blank
   1.898 -   ;;   Set v-blank-prev to 0
   1.899 -   0x3E   ; D33E                  ; load 0 into A
   1.900 -   0x00   ; D33F                  
   1.901 -
   1.902 -   0xEA   ; D340                  ; load A into v-blank-prev
   1.903 -   0x20   ; D341                  
   1.904 -   0xD3   ; D342
   1.905 -   
   1.906 -   0xC3   ; D343                  
   1.907 -   0x1D   ; D344                  
   1.908 -   0xD3   ; D345                  ; GOTO beginning
   1.909 -   ;; END Not-V-Blank
   1.910 -
   1.911 -   
   1.912 -   ;; Main State Machine -- Input Section
   1.913 -   ;;   This is called once every frame.
   1.914 -   ;;   It collects input and uses it to drive the
   1.915 -   ;;   state transitions.
   1.916 -
   1.917 -   ;; Increment frame-count
   1.918 -   0xFA   ; D346                  ; load frame-count into A
   1.919 -   0x1F   ; D347                  
   1.920 -   0xD3   ; D348
   1.921 -   
   1.922 -   0x3C   ; D349                  ; inc A
   1.923 -
   1.924 -   0xEA   ; D34A                  
   1.925 -   0x1F   ; D34B                  ; load A into frame-count
   1.926 -   0xD3   ; D34C
   1.927 -
   1.928 -   0x00   ; D34D                  ; glue :)
   1.929 -   
   1.930 -   0x18   ;D34E                    ;  skip next 3 bytes
   1.931 -   0x03   ;D34F
   1.932 -          ;D350
   1.933 -   (Integer/parseInt "00100000" 2) ;  select directional pad
   1.934 -          ;D351
   1.935 -   (Integer/parseInt "00010000" 2) ;  select buttons
   1.936 -   0x00   ;D352                    ;  input-number
   1.937 -
   1.938 -   ;; select directional pad; store low bits in B
   1.939 -   
   1.940 -   0xFA   ;D353                    ; load (D350) into A
   1.941 -   0x50   ;D354      -->       
   1.942 -   0xD3   ;D355      -->  D350     
   1.943 -   
   1.944 -   0xE0   ;D356                    ; load (A), which is 
   1.945 -   0x00   ;D357      -->           ; 00010000, into FF00
   1.946 -   0x00   ;D358      -->  FF00     ;; NO-OP
   1.947 -
   1.948 -   0x06   ;D359
   1.949 -          ;D35A
   1.950 -   (Integer/parseInt "11110000" 2) ; "11110000" -> B 
   1.951 -   0xF0   ;D35B                    ; (FF00) -> A
   1.952 -   0x00   ;D35C                   
   1.953 -   0x00   ;D35D                    ;; NO-OP
   1.954 -
   1.955 -   0xCB   ;D35E                    ; swap nybbles on A
   1.956 -   0x37   ;D35F
   1.957 -   0xA0   ;D360                    ; (AND A B) -> A
   1.958 -   0x47   ;D361                    ; A -> B
   1.959 -
   1.960 -   ;; select buttons; store bottom bits in C
   1.961 -   
   1.962 -   0xFA   ;D362                    ; load (D351) into A
   1.963 -   0x51   ;D363      -->       
   1.964 -   0xD3   ;D364      -->  D351     
   1.965 -   
   1.966 -   0xE0   ;D365                    ; load (A), which is 
   1.967 -   0x00   ;D366      -->           ; 00001000, into FF00
   1.968 -   0x00   ;D367      -->  FF00     ;; NO-OP
   1.969 -
   1.970 -   0x0E   ;D368
   1.971 -          ;D369
   1.972 -   (Integer/parseInt "00001111" 2) ; "00001111" -> C 
   1.973 -
   1.974 -   0xF0   ;D36A                    ; (FF00) -> A
   1.975 -   0x00   ;D36B                   
   1.976 -   0x00   ;D36C
   1.977 -   
   1.978 -   0xA1   ;D36D                    ; (AND A C) -> A
   1.979 -   0x4F   ;D36E                    ; A -> C
   1.980 -
   1.981 -   ;; combine the B and C registers into the input number
   1.982 -   0x79   ;D36F                    ; C -> A
   1.983 -   0xB0   ;D370                    ; (OR A B) -> A
   1.984 -   0x2F   ;D371                    ; negate A
   1.985 -
   1.986 -   0xEA   ;D372                    ; store A into input-number
   1.987 -   0x52   ;D373
   1.988 -   0xD3   ;D374
   1.989 -
   1.990 -   0x00   ;D375                  
   1.991 -   0x00   ;D376
   1.992 -   0x00   ;D377
   1.993 -   0x00   ;D378
   1.994 -   0x00   ;D379
   1.995 -   0x00   ;D37A
   1.996 -   0x00   ;D37B                   ; these are here because 
   1.997 -   0x00   ;D37C                   ; I messed up :(
   1.998 -   0x00   ;D37D
   1.999 -   0x00   ;D37E
  1.1000 -   0x00   ;D37F
  1.1001 -   
  1.1002 -   ;; beginning of main state machine   
  1.1003 -   0x18   ;D380                    ; Declaration of variables
  1.1004 -   0x05   ;D381                    ;  5 variables:
  1.1005 -   0x00   ;D382                    ;    current-mode
  1.1006 -   0x00   ;D383                    ;    bytes-to-write
  1.1007 -   0x00   ;D384                    ;    bytes-written
  1.1008 -   0x00   ;D385                    ;    start-point-high
  1.1009 -   0x00   ;D386                    ;    start-point-low
  1.1010 -
  1.1011 -
  1.1012 -   ;; banch on current mode
  1.1013 -   0xFA   ;D387                    ; load current-mode (0xD382)
  1.1014 -   0x82   ;D388                    ; into A
  1.1015 -   0xD3   ;D389
  1.1016 -   0x00   ;D38A
  1.1017 -
  1.1018 -
  1.1019 -   ;;  GOTO Mode 0 (input-mode) if current-mode is 0
  1.1020 -   0xFE   ;D38B
  1.1021 -   0x00   ;D38C                    ; compare A with 0x00
  1.1022 -
  1.1023 -   0xCA   ;D38D                    ; goto Mode 0 if A == 0
  1.1024 -   0xA8   ;D38E
  1.1025 -   0xD3   ;D38F
  1.1026 -
  1.1027 -   ;; GOTO Mode 1 (set-length) if current-mode is 1
  1.1028 -   0xFE   ;D390
  1.1029 -   0x01   ;D391                    ; compare A with 0x01
  1.1030 -
  1.1031 -   0xCA   ;D392                  
  1.1032 -   0xB1   ;D393 
  1.1033 -   0xD3   ;D394                    ; goto Mode 1 if A == 1
  1.1034 -
  1.1035 -   ;; GOTO Mode 2 (set-start-point-high) if current mode is 2
  1.1036 -   0xFE   ;D395                    
  1.1037 -   0x02   ;D396                    ; compare A with 0x02
  1.1038 -
  1.1039 -   0xCA   ;D397
  1.1040 -   0xBF   ;D398
  1.1041 -   0xD3   ;D399                    ; goto Mode 2 if A == 2
  1.1042 -
  1.1043 -   ;; GOTO Mode 3 (set-start-point-low) if current mode is 3
  1.1044 -   0xFE   ;D39A
  1.1045 -   0x03   ;D39B
  1.1046 -
  1.1047 -   0xCA   ;D39C
  1.1048 -   0xCD   ;D39D
  1.1049 -   0xD3   ;D39E                    ; goto Mode 3 if A == 3
  1.1050 -
  1.1051 -   ;; GOTO Mode 4 (write-memory) if current mode is 4
  1.1052 -   0xFE   ;D39F
  1.1053 -   0x04   ;D3A0
  1.1054 -
  1.1055 -   0xCA   ;D3A1
  1.1056 -   0xDB   ;D3A2
  1.1057 -   0xD3   ;D3A3
  1.1058 -
  1.1059 -   0x00   ;D3A4
  1.1060 -   ;; End of Mode checking, goto beginning
  1.1061 -   0xC3   ;D3A5
  1.1062 -   0x1D   ;D3A6
  1.1063 -   0xD3   ;D3A7
  1.1064 -
  1.1065 -
  1.1066 -   ;; Mode 0 -- input-mode mode
  1.1067 -   ;;     means that we are waiting for a mode, so set the mode to
  1.1068 -   ;;     whatever is currently in input-number.  If nothing is
  1.1069 -   ;;     entered, then the program stays in input-mode mode
  1.1070 -
  1.1071 -   ;;   set current-mode to input-number
  1.1072 -   0xFA   ;D3A8                    ; load input-number (0xD352) 
  1.1073 -   0x52   ;D3A9                    ; into A
  1.1074 -   0xD3   ;D3AA
  1.1075 -
  1.1076 -   0xEA   ;D3AB                    ; load A into current-mode
  1.1077 -   0x82   ;D3AC                    ; (0xD382)
  1.1078 -   0xD3   ;D3AD
  1.1079 -
  1.1080 -   0xC3   ;D3AE                    ; go back to beginning
  1.1081 -   0x1D   ;D3AF
  1.1082 -   0xD3   ;D3B0
  1.1083 -   ;; End Mode 0
  1.1084 -
  1.1085 -
  1.1086 -   ;; Mode 1 -- set-length mode
  1.1087 -   ;;      This is the header for writing things to memory.
  1.1088 -   ;;      User specifies the number of bytes to write.
  1.1089 -   ;;      Mode is auto advanced to Mode 2 after this mode
  1.1090 -   ;;      completes.
  1.1091 -
  1.1092 -   ;;      Set bytes left to write to input-number;
  1.1093 -   ;;      set current-mode to 0x02.
  1.1094 -   0xFA   ;D3B1                   ; load input-number (0xD352)
  1.1095 -   0x52   ;D3B2                   ; into A
  1.1096 -   0xD3   ;D3B3
  1.1097 -   
  1.1098 -   0xEA   ;D3B4                   ; load A into bytes-left-to-write
  1.1099 -   0x83   ;D3B5                   ; (0xD383)
  1.1100 -   0xD3   ;D3B6
  1.1101 -
  1.1102 -   0x3E   ;D3B7                   ; load 0x02 into A.
  1.1103 -   0x02   ;D3B8
  1.1104 -   
  1.1105 -   0xEA   ;D3B9                   ; load A to current-mode
  1.1106 -   0x82   ;D3BA                   ; advancing from Mode 1 to 
  1.1107 -   0xD3   ;D3BB                   ; Mode 2
  1.1108 -   
  1.1109 -   0xC3   ;D3BC                   ; go back to beginning
  1.1110 -   0x1D   ;D3BD
  1.1111 -   0xD3   ;D3BE
  1.1112 -   ;; End Mode 1
  1.1113 -
  1.1114 -
  1.1115 -   ;; Mode 2 -- set start-point-high mode
  1.1116 -   ;;      Middle part of the header for writing things to memory.
  1.1117 -   ;;      User specifies the start location in RAM to which 
  1.1118 -   ;;      data will be written.
  1.1119 -   ;;      Mode is auto advanced to Mode 3 after this mode completes.
  1.1120 -
  1.1121 -   ;;      Set start-point-high to input-number;
  1.1122 -   ;;      set current mode to 0x03.
  1.1123 -   0xFA   ;D3BF                   ; load input-number (0xD352)
  1.1124 -   0x52   ;D3C0                   ; into A
  1.1125 -   0xD3   ;D3C1
  1.1126 -
  1.1127 -   0xEA   ;D3C2                   ; load A into start-point-high
  1.1128 -   0x85   ;D3C3                   ; (0xD385)
  1.1129 -   0xD3   ;D3C4
  1.1130 -
  1.1131 -   0x3E   ;D3C5                   ; load 0x03 into A.
  1.1132 -   0x03   ;D3C6
  1.1133 -
  1.1134 -   0xEA   ;D3C7                   ; load A to current-mode,
  1.1135 -   0x82   ;D3C8                   ; advancing from Mode 2 to 
  1.1136 -   0xD3   ;D3C9                   ; Mode 3.
  1.1137 -   
  1.1138 -   0xC3   ;D3CA                   ; go back to beginning
  1.1139 -   0x1D   ;D3CB
  1.1140 -   0xD3   ;D3CC
  1.1141 -   ;;End Mode 2
  1.1142 -
  1.1143 -
  1.1144 -   ;; Mode 3 -- set-start-point-low mode
  1.1145 -   ;;      Final part of header for writing things to memory.
  1.1146 -   ;;      User specifies the low bytes of 16 bit start-point.
  1.1147 -
  1.1148 -   ;;      Set start-point-low to input-number;
  1.1149 -   ;;      set current mode to 0x04
  1.1150 -   0xFA   ;D3CD                   ; load input-number into A
  1.1151 -   0x52   ;D3CE                   
  1.1152 -   0xD3   ;D3CF                   
  1.1153 -
  1.1154 -   0xEA   ;D3D0                   ; load A into start-point-low
  1.1155 -   0x86   ;D3D1                   
  1.1156 -   0xD3   ;D3D2                   
  1.1157 -
  1.1158 -   0x3E   ;D3D3                   ; load 0x04 into A.
  1.1159 -   0x04   ;D3D4                   
  1.1160 -
  1.1161 -   0xEA   ;D3D5                   ; load A to current-mode,
  1.1162 -   0x82   ;D3D6                   ; advancing from Mode 3 to 
  1.1163 -   0xD3   ;D3D7                   ; Mode 4.
  1.1164 -
  1.1165 -   0xC3   ;D3D8                   ; go back to beginning
  1.1166 -   0x1D   ;D3D9                   
  1.1167 -   0xD3   ;D3DA                   
  1.1168 -   
  1.1169 -   ;; Mode 4 -- write bytes mode
  1.1170 -
  1.1171 -   ;;      This is where RAM manipulation happens.  User supplies
  1.1172 -   ;;      bytes every frame, which are written sequentially to
  1.1173 -   ;;      start-point until bytes-to-write have been written. Once
  1.1174 -   ;;      bytes-to-write have been written, the mode is reset to 0.
  1.1175 -
  1.1176 -   ;;   compare bytes-written with bytes-to-write.
  1.1177 -   ;;   if they are the same, then reset mode to 0
  1.1178 -  
  1.1179 -   0xFA   ;D3DB                   ; load bytes-to-write into A
  1.1180 -   0x83   ;D3DC
  1.1181 -   0xD3   ;D3DD
  1.1182 -
  1.1183 -   0x47   ;D3DE                   ; load A into B
  1.1184 -
  1.1185 -   0xFA   ;D3DF                   ; load bytes-written into A
  1.1186 -   0x84   ;D3E0
  1.1187 -   0xD3   ;D3E1
  1.1188 -
  1.1189 -   0xB8   ;D3E2                   ; compare A with B
  1.1190 -
  1.1191 -   0xCA   ;D3E3                   ; if they are equal, go to cleanup
  1.1192 -   0x07   ;D3E4                   
  1.1193 -   0xD4   ;D3E5                   
  1.1194 -
  1.1195 -   ;;  Write Memory Section
  1.1196 -   ;;    Write the input-number, interpreted as an 8-bit number,
  1.1197 -   ;;    into the current target register, determined by
  1.1198 -   ;;    (+ start-point bytes-written).
  1.1199 -   ;;    Then, increment bytes-written by 1.
  1.1200 -   
  1.1201 -   0xFA   ;D3E6                   ; load start-point-high into A
  1.1202 -   0x85   ;D3E7                   
  1.1203 -   0xD3   ;D3E8                   
  1.1204 -
  1.1205 -   0x67   ;D3E9                   ; load A into H
  1.1206 -
  1.1207 -   0xFA   ;D3EA                   ; load start-point-low into A
  1.1208 -   0x86   ;D3EB                   
  1.1209 -   0xD3   ;D3EC
  1.1210 -   
  1.1211 -   0x6F   ;D3ED                   ; load A into L
  1.1212 -   
  1.1213 -   0xFA   ;D3EE                   ; load bytes-written into A
  1.1214 -   0x84   ;D3EF                   
  1.1215 -   0xD3   ;D3F0                   
  1.1216 -   
  1.1217 -   0x00   ;D3F1                   ; These are here because
  1.1218 -   0x00   ;D3F2                   ; I screwed up again.
  1.1219 -   0x00   ;D3F3                   
  1.1220 -
  1.1221 -   0x85   ;D3F4                   ; add L to A; store A in L.
  1.1222 -   0x6F   ;D3F5                   
  1.1223 -
  1.1224 -   0x30   ;D3F6                   ; If the addition overflowed,
  1.1225 -   0x01   ;D3F7                   
  1.1226 -   0x24   ;D3F8                   ; increment H.
  1.1227 -
  1.1228 -   ;;   Now, HL points to the correct place in memory
  1.1229 -   
  1.1230 -   0xFA   ;D3F9                   ; load input-number into A
  1.1231 -   0x52   ;D3FA                   
  1.1232 -   0xD3   ;D3FB                   
  1.1233 -
  1.1234 -   0x77   ;D3FC                   ; load A into (HL)
  1.1235 -
  1.1236 -   0xFA   ;D3FD                   ; load bytes-written into A
  1.1237 -   0x84   ;D3FE                   
  1.1238 -   0xD3   ;D3FF                   
  1.1239 -
  1.1240 -   0x3C   ;D400                   ; increment A
  1.1241 -
  1.1242 -   0xEA   ;D401                   ; load A into bytes-written
  1.1243 -   0x84   ;D402                   
  1.1244 -   0xD3   ;D403
  1.1245 -
  1.1246 -   0xC3   ;D404                   ; go back to beginning.
  1.1247 -   0x1D   ;D405
  1.1248 -   0xD3   ;D406
  1.1249 -   ;;  End Write Memory Section
  1.1250 -
  1.1251 -   ;;  Mode 4 Cleanup Section
  1.1252 -   ;;    reset bytes-written to 0
  1.1253 -   ;;    set mode to 0
  1.1254 -   0x3E   ;D407                   ; load 0 into A
  1.1255 -   0x00   ;D408                  
  1.1256 -
  1.1257 -   0xEA   ;D409                   ; load A into bytes-written
  1.1258 -   0x84   ;D40A                   
  1.1259 -   0xD3   ;D40B                   
  1.1260 -
  1.1261 -   0xEA   ;D40C                   ; load A into current-mode
  1.1262 -   0x82   ;D40D                   
  1.1263 -   0xD3   ;D40E                   
  1.1264 -
  1.1265 -   0xC3   ;D40F                    ; go back to beginning
  1.1266 -   0x1D   ;D410
  1.1267 -   0xD3   ;D411
  1.1268 -
  1.1269 -   ;; End Mode 4
  1.1270 -   
  1.1271 -   ])
  1.1272 -
  1.1273 -
  1.1274 -
  1.1275 -(def frame-count 0xD31F)
  1.1276 -(def input 0xD352)
  1.1277 -(def current-mode      0xD382)
  1.1278 -(def bytes-to-write    0xD383)
  1.1279 -(def bytes-written     0xD384)
  1.1280 -(def start-point-high  0xD385)
  1.1281 -(def start-point-low   0xD386)
  1.1282 -
  1.1283 -
  1.1284 -
  1.1285 -(defn write-memory []
  1.1286 -  (-> (tick (mid-game))
  1.1287 -      (IE! 0) ; disable interrupts
  1.1288 -      (inject-item-assembly (write-memory-assembly))))
  1.1289 -
  1.1290 -(defn test-write-memory []
  1.1291 -  (set-state! (write-memory))
  1.1292 -  (dorun
  1.1293 -   (dotimes [_ 5000]
  1.1294 -     (view-memory (step @current-state) current-mode))))
  1.1295 -
  1.1296 -(def bytes-to-write 0xD383)
  1.1297 -(def start-point 0xD384)
  1.1298 -
  1.1299 -(defn print-blank-assembly
  1.1300 -  [start end]
  1.1301 -  (dorun
  1.1302 -   (map
  1.1303 -    #(println (format "0x00   ;%04X                   " %))
  1.1304 -    (range start end))))
  1.1305 -
  1.1306 -(defn test-mode-2 []
  1.1307 -  (->
  1.1308 -   (write-memory)
  1.1309 -   (view-memory frame-count)
  1.1310 -   (step)
  1.1311 -   (step [:a])
  1.1312 -   (step [:b])
  1.1313 -   (step [:start])
  1.1314 -   (step [])
  1.1315 -   (view-memory frame-count)))
  1.1316 -
  1.1317 -
  1.1318 -
  1.1319 -(defn dylan-test-mode
  1.1320 -  ([] (dylan-test-mode (write-mem-dyl)))
  1.1321 -  ([target-state]
  1.1322 -     (let [
  1.1323 -           v-blank-prev 54046
  1.1324 -           btn-register 65280
  1.1325 -           eggs 0xD374
  1.1326 -           ]
  1.1327 -       
  1.1328 -       (->
  1.1329 -        target-state
  1.1330 -        
  1.1331 -        (tick)
  1.1332 -        (tick)
  1.1333 -        (tick)
  1.1334 -        (tick);; jumps back to beginning
  1.1335 -        
  1.1336 -        (tick)
  1.1337 -        (tick)
  1.1338 -        (tick)
  1.1339 -        (tick)
  1.1340 -        (tick)
  1.1341 -        (tick)
  1.1342 -        (tick)
  1.1343 -        (tick)
  1.1344 -        (tick)
  1.1345 -        (tick)
  1.1346 -        (tick)
  1.1347 -        (tick)
  1.1348 -
  1.1349 -               
  1.1350 -        (tick)
  1.1351 -        (tick)
  1.1352 -        (tick)
  1.1353 -        (tick)
  1.1354 -        (tick)
  1.1355 -        (tick)
  1.1356 -        (tick)
  1.1357 -        (tick)
  1.1358 -        (tick)
  1.1359 -        (tick)
  1.1360 -        (tick)
  1.1361 -        (tick)
  1.1362 -        (tick)
  1.1363 -        (tick)
  1.1364 -        (tick)
  1.1365 -        (tick)
  1.1366 -        (tick)
  1.1367 -        (tick)
  1.1368 -        (tick)
  1.1369 -        (tick)
  1.1370 -        (tick) ;; just complemented A
  1.1371 -
  1.1372 -        (tick)
  1.1373 -        (DE! 0x1800)
  1.1374 -        (AF! 0x7700) ;; change inputs @ A
  1.1375 -        (tick)
  1.1376 -        (tick)
  1.1377 -        (tick)
  1.1378 -        (tick)
  1.1379 -        (tick)
  1.1380 -
  1.1381 -        ;;(view-memory eggs)
  1.1382 -        (tick)
  1.1383 -        (tick)
  1.1384 -        ;;(view-memory eggs)
  1.1385 -        (tick)
  1.1386 -        (tick)
  1.1387 -        (tick)
  1.1388 -        (tick)
  1.1389 -        (tick)
  1.1390 -        (tick)
  1.1391 -        (d-tick)
  1.1392 -
  1.1393 -        
  1.1394 -        ;;(view-memory btn-register) 
  1.1395 -        (view-register "A" A)
  1.1396 -        (view-register "B" B)
  1.1397 -        
  1.1398 -        ;;(view-register "C" C)
  1.1399 -        (view-register "D" D)
  1.1400 -        (view-register "E" E)
  1.1401 -        (view-register "H" H)
  1.1402 -        (view-register "L" L)
  1.1403 -        ))))
  1.1404 -  
  1.1405 -
  1.1406 -
  1.1407 -(defn drive-dylan []
  1.1408 -  (-> (write-mem-dyl)
  1.1409 -      (#(do (println "memory from 0xC00F to 0xC01F:"
  1.1410 -                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
  1.1411 -      (step [])
  1.1412 -      (step [])
  1.1413 -      (step [])
  1.1414 -      (step [:start])
  1.1415 -      (step [:select])
  1.1416 -      (step [:u :d])
  1.1417 -      (step [:a :b :start :select])
  1.1418 -      (step [:a])
  1.1419 -      (step [:b])
  1.1420 -      (step [:a :b])
  1.1421 -      (step [:select])
  1.1422 -      (step [])
  1.1423 -      (step [])
  1.1424 -      (step [])
  1.1425 -      (#(do (println "memory from 0xC00F to 0xC01F:"
  1.1426 -                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
  1.1427 -      ))
  1.1428 -
  1.1429 -(defn test-mode-4
  1.1430 -  ([] (test-mode-4 (write-memory)))
  1.1431 -  ([target-state]
  1.1432 -     (->
  1.1433 -      target-state
  1.1434 -      (#(do (println "memory from 0xC00F to 0xC01F:"
  1.1435 -                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
  1.1436 -      (view-memory current-mode)
  1.1437 -      (step [])
  1.1438 -      (step [])
  1.1439 -      (step [])
  1.1440 -      (#(do (println "after three steps") %))
  1.1441 -      (view-memory current-mode)
  1.1442 -
  1.1443 -      ;; Activate memory writing mode
  1.1444 -      
  1.1445 -      (#(do (println "step with [:a]") %))
  1.1446 -      (step [:a])
  1.1447 -      (view-memory current-mode)
  1.1448 -      (view-memory bytes-to-write)
  1.1449 -      (view-memory start-point-high)
  1.1450 -      (view-memory start-point-low)
  1.1451 -
  1.1452 -      ;; Specify four bytes to be written
  1.1453 -      
  1.1454 -      (#(do (println "step with [:select]")%))
  1.1455 -      (step [:select])
  1.1456 -      (view-memory current-mode)
  1.1457 -      (view-memory bytes-to-write)
  1.1458 -      (view-memory start-point-high)
  1.1459 -      (view-memory start-point-low)
  1.1460 -
  1.1461 -      ;; Specify target memory address as 0xC00F
  1.1462 -      
  1.1463 -      (#(do (println "step with [:u :d]")%))
  1.1464 -      (step [:u :d])
  1.1465 -      (view-memory current-mode)
  1.1466 -      (view-memory bytes-to-write)
  1.1467 -      (view-memory start-point-high)
  1.1468 -      (view-memory start-point-low)
  1.1469 -
  1.1470 -      (#(do (println "step with [:a :b :start :select]")%))
  1.1471 -      (step [:a :b :start :select])
  1.1472 -      (view-memory current-mode)
  1.1473 -      (view-memory bytes-to-write)
  1.1474 -      (view-memory start-point-high)
  1.1475 -      (view-memory start-point-low)
  1.1476 -
  1.1477 -      ;; Start reprogramming memory
  1.1478 -
  1.1479 -      (#(do (println "step with [:a]")%))
  1.1480 -      (step [:a])
  1.1481 -      (view-memory current-mode)
  1.1482 -      (view-memory bytes-written)
  1.1483 -
  1.1484 -      (#(do (println "step with [:b]")%))
  1.1485 -      (step [:b])
  1.1486 -      (view-memory current-mode)
  1.1487 -      (view-memory bytes-written)
  1.1488 -
  1.1489 -      (#(do (println "step with [:a :b]")%))
  1.1490 -      (step [:a :b])
  1.1491 -      (view-memory current-mode)
  1.1492 -      (view-memory bytes-written)
  1.1493 -
  1.1494 -      (#(do (println "step with [:select]")%))
  1.1495 -      (step [:select])
  1.1496 -      (view-memory current-mode)
  1.1497 -      (view-memory bytes-written)
  1.1498 -
  1.1499 -      ;; Reprogramming done, program ready for more commands.
  1.1500 -
  1.1501 -      (#(do (println "step with []")%))
  1.1502 -      (step [])
  1.1503 -      (view-memory current-mode)
  1.1504 -      (view-memory bytes-written)
  1.1505 -      
  1.1506 -      (#(do (println "memory from 0xC00F to 0xC01F:"
  1.1507 -                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %)))))
  1.1508 -
     2.1 --- a/clojure/com/aurellem/cruft/gb_driver.clj	Mon Mar 19 20:43:38 2012 -0500
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,206 +0,0 @@
     2.4 -(ns com.aurellem.gb-driver
     2.5 -  (:import com.aurellem.gb.Gb)
     2.6 -  (:import java.io.File)
     2.7 -  (:import org.apache.commons.io.FileUtils)
     2.8 -  (:import (java.nio IntBuffer ByteOrder)))
     2.9 -
    2.10 -(Gb/loadVBA)
    2.11 -
    2.12 -(def ^:dynamic *max-history* 2e4)
    2.13 -
    2.14 -(def ^:dynamic *backup-saves-to-disk* true)
    2.15 -
    2.16 -(def ^:dynamic *save-history* true)
    2.17 -
    2.18 -(def ^:dynamic *save-state-cache*
    2.19 -  (File. "/home/r/proj/pokemon-escape/save-states/"))
    2.20 -
    2.21 -(def yellow-rom-image
    2.22 -  (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
    2.23 -
    2.24 -(def yellow-save-file
    2.25 -  (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
    2.26 -
    2.27 -(def current-frame (atom 0))
    2.28 -
    2.29 -(defn vba-init []
    2.30 -  (reset! current-frame 0)
    2.31 -  (.delete yellow-save-file)
    2.32 -  (Gb/startEmulator (.getCanonicalPath yellow-rom-image)))
    2.33 -
    2.34 -(defn shutdown [] (Gb/shutdown))
    2.35 -
    2.36 -(defn reset [] (shutdown) (vba-init))
    2.37 -
    2.38 -(defn cpu-data [size arr-fn]
    2.39 -  (let [store (int-array size)]
    2.40 -    (fn [] (arr-fn store) store)))
    2.41 -
    2.42 -(def ram
    2.43 -  (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
    2.44 -
    2.45 -(def rom 
    2.46 -  (cpu-data (Gb/getROMSize) #(Gb/getROM %)))
    2.47 -
    2.48 -(def working-ram 
    2.49 -  (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
    2.50 -
    2.51 -(def video-ram 
    2.52 -  (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
    2.53 -
    2.54 -(def registers
    2.55 -  (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
    2.56 -
    2.57 -(def button-code
    2.58 -  {;; main buttons
    2.59 -   :a         0x0001
    2.60 -   :b         0x0002
    2.61 -
    2.62 -   ;; directional pad
    2.63 -   :r         0x0010
    2.64 -   :l         0x0020
    2.65 -   :u         0x0040
    2.66 -   :d         0x0080
    2.67 -
    2.68 -   ;; meta buttons
    2.69 -   :select    0x0004
    2.70 -   :start     0x0008
    2.71 -
    2.72 -   ;; hard reset -- not really a button
    2.73 -   :reset   0x0800})
    2.74 -
    2.75 -(defn button-mask [buttons]
    2.76 -  (reduce bit-or 0x0000 (map button-code buttons)))
    2.77 -
    2.78 -(defn buttons [mask]
    2.79 -  (loop [buttons []
    2.80 -         masks (seq button-code)]
    2.81 -    (if (empty? masks) buttons
    2.82 -        (let [[button value] (first masks)]
    2.83 -          (if (not= 0x0000 (bit-and value mask))
    2.84 -            (recur (conj buttons button) (rest masks))
    2.85 -            (recur buttons (rest masks)))))))
    2.86 -
    2.87 -(defrecord SaveState [frame save-data])
    2.88 -
    2.89 -(defn frame [] @current-frame)
    2.90 -
    2.91 -(defn save-state []
    2.92 -  (SaveState. (frame) (Gb/saveState)))
    2.93 -
    2.94 -(defn load-state [#^SaveState save]
    2.95 -  (reset! current-frame (:frame save))
    2.96 -  (Gb/loadState (:save-data save)))
    2.97 -
    2.98 -(def empty-history (sorted-map))
    2.99 -
   2.100 -(def history (atom empty-history))
   2.101 -
   2.102 -(defn frame->disk-save [frame]
   2.103 -  (File. *save-state-cache*
   2.104 -         (format "%07d.sav" frame)))
   2.105 -
   2.106 -(defn get-save-from-disk [frame]
   2.107 -  (let [save (frame->disk-save frame)]
   2.108 -    (if (.exists save)
   2.109 -      (let [buf (Gb/saveBuffer)
   2.110 -            bytes (FileUtils/readFileToByteArray save)]
   2.111 -        (.put buf bytes)
   2.112 -        (.flip buf)
   2.113 -        (SaveState. frame buf)))))
   2.114 -
   2.115 -(defn store-save-to-disk [^SaveState save]
   2.116 -  (let [buf (:save-data save)
   2.117 -        bytes (byte-array (.limit buf))
   2.118 -        dest (frame->disk-save (:frame save))]
   2.119 -    (.get buf bytes)
   2.120 -    (FileUtils/writeByteArrayToFile dest bytes)
   2.121 -    (.rewind buf) dest))
   2.122 -
   2.123 -(defn find-save-state [frame]
   2.124 -  (let [save (@history frame)]
   2.125 -    (if (not (nil? save)) save
   2.126 -        (get-save-from-disk frame))))
   2.127 -
   2.128 -(defn goto [frame]
   2.129 -  (let [save (find-save-state frame)]
   2.130 -    (if (nil? save)
   2.131 -      (println frame "is not in history")
   2.132 -      (do
   2.133 -        (reset! current-frame frame)
   2.134 -        (load-state save)))))
   2.135 -
   2.136 -(defn clear-history [] (reset! history empty-history))
   2.137 -
   2.138 -(defn rewind
   2.139 -  ([] (rewind 1))
   2.140 -  ([n] (goto (- @current-frame n))))
   2.141 -
   2.142 -(defn backup-state
   2.143 -  ([] (backup-state (frame)))
   2.144 -  ([frame]
   2.145 -  (let [save (save-state)]
   2.146 -    (swap! history #(assoc % frame save))
   2.147 -    ;;(store-save-to-disk save)
   2.148 -    (if (> (count @history) *max-history*)
   2.149 -      (swap! history #(dissoc % (first (first %))))))))
   2.150 -
   2.151 -(defn advance []
   2.152 -  (if *save-history*
   2.153 -    (backup-state @current-frame))
   2.154 -  (swap! current-frame inc))
   2.155 -
   2.156 -(defn step
   2.157 -  ([] (advance) (Gb/step))
   2.158 -  ([mask-or-buttons]
   2.159 -     (advance)
   2.160 -     (if (number? mask-or-buttons)
   2.161 -       (Gb/step mask-or-buttons)
   2.162 -       (Gb/step (button-mask mask-or-buttons)))))
   2.163 -
   2.164 -(defn play-moves
   2.165 -  ([start moves]
   2.166 -     (goto start)
   2.167 -     (dorun (map step moves))
   2.168 -     (backup-state)
   2.169 -     (frame))
   2.170 -  ([moves]
   2.171 -     (dorun (map step moves))
   2.172 -     (backup-state)
   2.173 -     (frame)))
   2.174 -
   2.175 -(defn play
   2.176 -  ([] (play Integer/MAX_VALUE))
   2.177 -  ([n] (dorun (dotimes [_ n] (step)))))
   2.178 -
   2.179 -(defmacro without-saves [& forms]
   2.180 -  `(binding [*save-history* false]
   2.181 -     ~@forms))
   2.182 -
   2.183 -
   2.184 -(require '(clojure [zip :as zip]))
   2.185 -
   2.186 -
   2.187 -
   2.188 -
   2.189 -(defn tree->str [original]
   2.190 -  (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))]
   2.191 -    (if (zip/end? loc) s
   2.192 -        (let [d (count (zip/path loc))
   2.193 -	      rep
   2.194 -              (str
   2.195 -               s
   2.196 -               (if (and (zip/up loc)
   2.197 -                        (> (count (-> loc zip/up zip/rights)) 0))
   2.198 -                 "|" "")
   2.199 -               (apply str (repeat (dec d) "   "))
   2.200 -               (if (= (count (zip/rights loc)) 0)
   2.201 -                 "`-- "
   2.202 -                 "|-- ")
   2.203 -               (zip/node loc)
   2.204 -               "\n")]
   2.205 -          (recur rep (zip/next loc))))))
   2.206 -
   2.207 -
   2.208 -
   2.209 -
     3.1 --- a/clojure/com/aurellem/cruft/title.clj	Mon Mar 19 20:43:38 2012 -0500
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,141 +0,0 @@
     3.4 -(ns com.aurellem.title
     3.5 -  (:use (com.aurellem gb-driver vbm)))
     3.6 -
     3.7 -(defn delayed-key
     3.8 -  ([key delay total]
     3.9 -     (concat (repeat delay []) [key] (repeat (- total delay 1) [])))
    3.10 -  ([key total]
    3.11 -     (delayed-key key (dec total) total)))
    3.12 -
    3.13 -(defn no-action [length]
    3.14 -  (repeat length []))
    3.15 -
    3.16 -(defn start-summary []
    3.17 -  (nth (registers) 2))
    3.18 -
    3.19 -(defn common-initial-elements [baseline moves]
    3.20 -  (loop [common 0 b baseline m moves]
    3.21 -    (if (empty? m) common
    3.22 -        (if (= (first b) (first m))
    3.23 -          (recur (inc common) (rest b) (rest m))
    3.24 -          common))))
    3.25 -    
    3.26 -(defn earliest-press
    3.27 -  [start-frame
    3.28 -   end-frame
    3.29 -   key
    3.30 -   summary-fn]
    3.31 -  (let [action-length (- end-frame start-frame)
    3.32 -        baseline (no-action action-length)]
    3.33 -    (print "establishing baseline...")
    3.34 -    (play-moves start-frame baseline)
    3.35 -    (let [bad-value (summary-fn)]
    3.36 -      (println bad-value)
    3.37 -      (loop [n 0]
    3.38 -        (let [moves (delayed-key key n action-length)
    3.39 -              header-length
    3.40 -              (common-initial-elements moves baseline)]
    3.41 -          (print "length" (inc n) "...")
    3.42 -          (without-saves
    3.43 -           (play-moves
    3.44 -            (+ start-frame header-length)
    3.45 -            (drop header-length moves)))
    3.46 -          (let [result (summary-fn)]
    3.47 -            (println result)
    3.48 -            (if (not= result bad-value)
    3.49 -              (let [keys (delayed-key key (inc n))]
    3.50 -                  (play-moves start-frame keys)
    3.51 -                  keys)
    3.52 -              (recur (inc n)))))))))
    3.53 -
    3.54 -
    3.55 -(defn search-first
    3.56 -  [start-frame
    3.57 -   baseline
    3.58 -   gen-move-fn
    3.59 -   summary-fn]
    3.60 -  (print "establishing baseline...")
    3.61 -  (play-moves start-frame baseline)
    3.62 -  (let [bad-value (summary-fn)]
    3.63 -    (println bad-value)
    3.64 -    (loop [n 0]
    3.65 -      (let [trial-moves (gen-move-fn n)
    3.66 -            header-length
    3.67 -            (common-initial-elements trial-moves baseline)]
    3.68 -        (print "length" (inc n) "...")
    3.69 -        (without-saves
    3.70 -         (play-moves
    3.71 -          (+ start-frame header-length)
    3.72 -          (drop header-length trial-moves)))
    3.73 -        (let [result (summary-fn)]
    3.74 -          (println result)
    3.75 -          (if (not= result bad-value)
    3.76 -            (let [keys (take (inc n) trial-moves)]
    3.77 -              (play-moves start-frame keys)
    3.78 -              keys)
    3.79 -            (recur (inc n))))))))
    3.80 -
    3.81 -(defn title-search
    3.82 -  [start-frame
    3.83 -   end-frame
    3.84 -   key
    3.85 -   summary-fn]
    3.86 -  (let [action-length (- end-frame start-frame)]
    3.87 -    (search-first
    3.88 -     start-frame
    3.89 -     (no-action action-length)
    3.90 -     (fn [n] (delayed-key key n action-length))
    3.91 -     summary-fn)))
    3.92 -
    3.93 -(defn gen-title []
    3.94 -  (let [start0 (no-action 300)]
    3.95 -    (play-moves 0 start0)
    3.96 -    (let [start->first-press
    3.97 -          (title-search (frame) (+ 50 (frame)) [:a] start-summary)
    3.98 -          first-press->second-press
    3.99 -          (title-search (frame) (+ 100 (frame)) [:start] start-summary)
   3.100 -          second-press->third-press
   3.101 -          (title-search (frame) (+ 151 (frame)) [:a] start-summary)
   3.102 -          new-game
   3.103 -          (title-search (frame) (+ 151 (frame)) [:a] start-summary)]
   3.104 -      (concat
   3.105 -       start0
   3.106 -       start->first-press
   3.107 -       first-press->second-press
   3.108 -       second-press->third-press
   3.109 -       new-game))))
   3.110 -  
   3.111 -(def title
   3.112 -  [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.113 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.114 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.115 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.116 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.117 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.118 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.119 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.120 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.121 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.122 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.123 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.124 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.125 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.126 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] []
   3.127 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.128 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.129 -   [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] []
   3.130 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.131 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.132 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.133 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.134 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.135 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.136 -   [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.137 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.138 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.139 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.140 -   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   3.141 -   [] [] [] [] [] [ :a]])
   3.142 -
   3.143 -
   3.144 -(require '(clojure [zip :as zip]))
   3.145 \ No newline at end of file
     4.1 --- a/clojure/com/aurellem/dylans-code	Mon Mar 19 20:43:38 2012 -0500
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,54 +0,0 @@
     4.4 -
     4.5 -(defn count-frames* []
     4.6 -  (-> (tick (mid-game))
     4.7 -      (IE! 0) ; disable interrupts
     4.8 -      (inject-item-assembly
     4.9 -       ;; write 00010000 to 0xFF00 to select joypad
    4.10 -       [0x18   ;D31D                    ; jump over          
    4.11 -        0x02   ;D31E                    ; the next 2 bytes
    4.12 -        0x00   ;D31F                    ; frame-count
    4.13 -        0x00   ;D320                    ; v-blank-prev
    4.14 -
    4.15 -        
    4.16 -        0xFA   ;D321
    4.17 -        0x41   ;D322                    ; load (FF41) into A
    4.18 -        0xFF   ;D323                    ; this contains mode flags
    4.19 -
    4.20 -        0x47   ;; copy A -> B
    4.21 -        
    4.22 -        0xCB
    4.23 -        0x3F ;; shift A right
    4.24 -        0x2F ;; complement A
    4.25 -
    4.26 -        0xA0 ;; A & B -> A.
    4.27 -        0x47 ;; copy A -> B. Now the first bit of B is (VB == 1)
    4.28 -        
    4.29 -        0xFA
    4.30 -        0x20
    4.31 -        0xD3 ;; load v-blank-prev into A
    4.32 -
    4.33 -        0xA0 ;; A & B -> A. 
    4.34 -        0x4F ;; copy A to C. Now C contains increment-counter?
    4.35 -
    4.36 -        0xFA
    4.37 -        0x1F
    4.38 -        0xD3 ;; load frame-count into A
    4.39 -
    4.40 -        0x81 ;; add increment-counter? to frame-count
    4.41 -        0xEA ;; store A into frame-count
    4.42 -        0x1F
    4.43 -        0xD3
    4.44 -
    4.45 -        0x3E ;; load 1 into A
    4.46 -        0x01
    4.47 -        0xA0 ;; A & B -> A. Now A is (VB==1)
    4.48 -        0xEA ;; store A into v-blank-prev
    4.49 -        0x20
    4.50 -        0xD3
    4.51 -
    4.52 -        0xC3   ;D348                   ; return to beginning
    4.53 -        0x1D   ;D349
    4.54 -        0xD3   ;D34A
    4.55 -
    4.56 -
    4.57 -        ])))
    4.58 \ No newline at end of file
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/clojure/com/aurellem/exp/assembly.clj	Mon Mar 19 21:23:46 2012 -0500
     5.3 @@ -0,0 +1,128 @@
     5.4 +(ns com.aurellem.exp.assembly
     5.5 +   (:use (com.aurellem.gb gb-driver vbm title items))
     5.6 +   (:import [com.aurellem.gb.gb_driver SaveState]))
     5.7 +
     5.8 +
     5.9 +(defn run-item-program
    5.10 +  "This is my first assembly/item program!
    5.11 +   it just increments BC by one.
    5.12 +
    5.13 +   The code places a 3 'great balls' at the beginning of the
    5.14 +   inventory, then directly sets the program counter to start
    5.15 +   executing at the position of the 'great balls' in memory.
    5.16 +
    5.17 +   Since a 'great ball' is represented in memory as 0x03, which
    5.18 +   corresponts to the opcode which increments BC by one, that is
    5.19 +   what happens. Then the program counter to the 0x03 quantity entry
    5.20 +   and BC is incremented again.
    5.21 +
    5.22 +   Obviously, the game crashes more or less immediately after the
    5.23 +   program counter advances past the 'great balls' into the next items
    5.24 +   in the inventory, thus I call shutdown! before anything bad happens."
    5.25 +  []
    5.26 +  (set-inventory (read-state "mid-game") [[:great-ball 3]])
    5.27 +  (print-inventory)
    5.28 +  (println "3 ticks") (tick) (tick) (tick)
    5.29 +  (println "PC before:" (PC))
    5.30 +  (println "BC before:" (BC))
    5.31 +  (PC! (inc item-list-start))
    5.32 +  (println "PC after setting:" (PC))
    5.33 +  (println "data at PC:" (aget (memory) (PC)))
    5.34 +  (println "one tick")
    5.35 +  (tick)
    5.36 +  (println "PC after one tick:" (PC))
    5.37 +  (println "BC after one tick:" (BC))
    5.38 +  (tick)
    5.39 +  (println "PC after two ticks:" (PC))
    5.40 +  (println "BC after two ticks:" (BC))
    5.41 +
    5.42 +  (shutdown!))
    5.43 +
    5.44 +
    5.45 +
    5.46 +
    5.47 +(defn test-opcodes-1
    5.48 +  []
    5.49 +  (let [final-state
    5.50 +        (->
    5.51 +         (read-state "mid-game")
    5.52 +         (set-inv-mem 
    5.53 +          [20 0x02 0x00 0x00 0x02 0x00 0x00
    5.54 +           0x00 0x0 0xFF])
    5.55 +         (print-inventory)
    5.56 +         ;;((fn [_] (println "3 ticks") _))
    5.57 +         (tick) (tick) (tick)
    5.58 +         
    5.59 +         ;;(println "PC before:" (PC))
    5.60 +         ;;(println "BC before:" (BC))
    5.61 +         ;;(println "AF:" (AF))
    5.62 +         (PC! (inc item-list-start))
    5.63 +         (BC! (+ 1 item-list-start))
    5.64 +         ;;(println "PC after setting:" (PC))
    5.65 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.66 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.67 +         
    5.68 +         ;;(println "one tick")
    5.69 +         (tick)
    5.70 +         ;;(println "PC after one tick:" (PC))
    5.71 +         ;;(println "BC after one tick:" (BC))
    5.72 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.73 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.74 +         (tick)
    5.75 +         (AF! 0xFFFF)
    5.76 +         ;;(println "PC after two ticks:" (PC))
    5.77 +         ;;(println "BC after two ticks:" (BC))
    5.78 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.79 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.80 +         (tick)
    5.81 +         ;;(println "PC after three ticks:" (PC))
    5.82 +         ;;(println "BC after three ticks:" (BC))
    5.83 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.84 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.85 +         (tick)
    5.86 +         ;;(println "PC after four ticks:" (PC))
    5.87 +         ;;(println "BC after four ticks:" (BC))
    5.88 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.89 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.90 +         (tick)
    5.91 +         ;;(println "PC after five ticks:" (PC))
    5.92 +         ;;(println "BC after five ticks:" (BC))
    5.93 +         ;;(println "data at PC:" (aget (memory) (PC)))
    5.94 +         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
    5.95 +         (print-inventory)
    5.96 +         )]
    5.97 +    
    5.98 +    (shutdown!)
    5.99 +    final-state))
   5.100 +
   5.101 +
   5.102 +
   5.103 +(defn test-opcodes-2
   5.104 +  []
   5.105 +  (set-inv-mem (read-state "mid-game")
   5.106 +               [20 0x08 0x1D 0xD3 0x00 0x00 0x00
   5.107 +                0x00 0x0 0xFF])
   5.108 +  (print-inventory)
   5.109 +  (println "3 ticks") (tick) (tick) (tick)
   5.110 +  (println "PC before:" (PC))
   5.111 +  (println "SP:" (SP))
   5.112 +  (PC! (inc item-list-start))
   5.113 +  (println "PC after setting:" (PC))
   5.114 +  (println "SP:" (Integer/toBinaryString (SP)))
   5.115 +  (println "data at PC:" (aget (memory) (PC)))
   5.116 +  (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D)))
   5.117 +  (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E)))
   5.118 +  (println "one tick")
   5.119 +  (tick)
   5.120 +  (println "PC after one tick:" (PC))
   5.121 +  (println "data at PC:" (aget (memory) (PC)))
   5.122 +  (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D)))
   5.123 +  (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E)))
   5.124 +  (tick) (tick) (tick)
   5.125 +  (println "PC aftter four tick:" (PC))
   5.126 +  (println "data at PC:" (aget (memory) (PC)))
   5.127 +  (println "data at 0xD31D:" (aget (memory) 0xD31D))
   5.128 +  
   5.129 +  (print-inventory)
   5.130 +  (shutdown!))
   5.131 +
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/clojure/com/aurellem/exp/item_bridge.clj	Mon Mar 19 21:23:46 2012 -0500
     6.3 @@ -0,0 +1,65 @@
     6.4 +(ns com.aurellem.item-bridge
     6.5 +  (:use (com.aurellem gb-driver vbm title save-corruption items assembly))
     6.6 +  (:import [com.aurellem.gb_driver SaveState]))
     6.7 +
     6.8 +
     6.9 +(defn corrupt-item-state []
    6.10 +  (second (destroy-item-end-of-list-marker)))
    6.11 +
    6.12 +(defn corrupt-item-state []
    6.13 +  (read-state "corrupt-items"))
    6.14 +
    6.15 +
    6.16 +(defn view-memory-range [state start end]
    6.17 +  (dorun
    6.18 +   (map (fn [loc val]
    6.19 +          (println (format "%04X : %02X" loc val)))
    6.20 +        
    6.21 +        (range start end) (subvec (vec (memory state)) start end)))
    6.22 +  state)
    6.23 +
    6.24 +(defn almost-broken
    6.25 +  "if one more memory location is turned into 0x03, the game crashes."
    6.26 +  [n]
    6.27 +  (view-memory-range
    6.28 +   (set-inv-mem (mid-game)
    6.29 +                (concat [0xFF] (repeat 64 0x03)
    6.30 +                        (subvec (vec (memory (mid-game)))
    6.31 +                                (+ item-list-start 65)
    6.32 +                                (+ item-list-start 65 n))
    6.33 +                        (repeat (- 255 65 n) 0x03)
    6.34 +                        ))
    6.35 +                
    6.36 +   item-list-start (+ item-list-start 255)))
    6.37 +
    6.38 +(defn actually-broken
    6.39 +  "if one more memory location is turned into 0x03, the game crashes."
    6.40 +  []
    6.41 +  (set-memory (mid-game) 0xD35D 0x03))
    6.42 +
    6.43 +
    6.44 +;; (almost-broken 20) more or less works
    6.45 +
    6.46 +(defn capture-program-counter
    6.47 +  "records the program counter for each tick"
    6.48 +  [^SaveState state ticks]
    6.49 +  (let [i (atom 0)]
    6.50 +    (reduce (fn [[program-counters state] _]
    6.51 +              (println (swap! i inc))
    6.52 +               [(conj program-counters (PC state))
    6.53 +                (tick state)])
    6.54 +              [[] state]
    6.55 +              (range ticks))))
    6.56 +
    6.57 +
    6.58 +(defn capture-program-counter
    6.59 +  [^SaveState state ticks]
    6.60 +  (set-state! state)
    6.61 +  (loop [i 0
    6.62 +         pcs []]
    6.63 +    (if (= i ticks)
    6.64 +      pcs
    6.65 +      (do 
    6.66 +        (com.aurellem.gb.Gb/tick)
    6.67 +        (recur (inc i)
    6.68 +               (conj pcs (first (registers))))))))
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/clojure/com/aurellem/exp/items.clj	Mon Mar 19 21:23:46 2012 -0500
     7.3 @@ -0,0 +1,401 @@
     7.4 +(ns com.aurellem.exp.items
     7.5 +   (:use (com.aurellem.gb gb-driver vbm items))
     7.6 +   (:import [com.aurellem.gb.gb_driver SaveState]))
     7.7 +
     7.8 +;; try just buying five potions in sequence and see what changes
     7.9 +;; each time.
    7.10 +
    7.11 +;; trying to find how items are represented in memory
    7.12 +
    7.13 +(def zero-potions (read-state "zero-potions"))
    7.14 +
    7.15 +(def one-potion (read-state "one-potion"))
    7.16 +
    7.17 +(def two-potions (read-state "two-potions"))
    7.18 +
    7.19 +(def three-potions (read-state "three-potions"))
    7.20 +
    7.21 +(def four-potions (read-state "four-potions"))
    7.22 +
    7.23 +(def five-potions (read-state "five-potions"))
    7.24 +  
    7.25 +  
    7.26 +  ;; result
    7.27 +(defn item-canidates []
    7.28 +  (apply common-differences
    7.29 +         (map (comp vec memory)
    7.30 +              [zero-potions one-potion two-potions three-potions
    7.31 +               four-potions five-potions])))
    7.32 +
    7.33 + (comment [55875 (37 15 49 27 14 44)]
    7.34 +  [55876 (30 1 49 56 55 23)]
    7.35 +  [49158 (154 191 78 135 70 73)]
    7.36 +  [54087 (49 40 37 34 25 22)]
    7.37 +  [49160 (7 24 59 243 50 217)]
    7.38 +  [49704 (31 14 72 33 84 27)]
    7.39 +  [49162 (126 159 183 110 176 179)]
    7.40 +  [39984 (0 254 251 248 127 252)]
    7.41 +  [49904 (29 72 64 78 1 95)]
    7.42 +  [65491 (222 127 149 132 226 38)]
    7.43 +  [65492 (44 20 89 11 253 163)]
    7.44 +  [49335 (52 15 6 14 3 17)]
    7.45 +  [49720 (78 152 96 60 83 103)]
    7.46 +  [65304 (19 89 214 33 18 113)]
    7.47 +  [53561 (132 185 145 162 159 183)]
    7.48 +  [54046 (0 1 2 3 4 5)])
    7.49 +
    7.50 +;;; hmmmmmm...... I guess that the potion quantities are at 54046,
    7.51 +;;;huh?
    7.52 +
    7.53 +
    7.54 +
    7.55 +(defn get-mem []
    7.56 +  (subvec (vec (memory @current-state)) 54040 (+ 54046 100)))
    7.57 +
    7.58 +
    7.59 +;; potion -- 99
    7.60 +[0 16 0 0 1 20 99 255 0 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.61 +
    7.62 +;; potion -- 95
    7.63 +[0 16 0 0 1 20 95 255 0 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.64 +
    7.65 +;; potion -- 95
    7.66 +;; pokeball -- 1
    7.67 +[0 16 0 0 2 20 95 4 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.68 +
    7.69 +;; potion -- 95
    7.70 +;; pokeball -- 10
    7.71 +[0 16 0 0 2 20 95 4 10 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.72 +
    7.73 +
    7.74 +;; pokeball -- 10
    7.75 +;; potion -- 95
    7.76 +[0 16 0 0 2 4 10 20 95 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.77 +
    7.78 +;; pokeball -- 10
    7.79 +;; potion -- 95
    7.80 +;; antidote -- 1
    7.81 +
    7.82 +;;prediction
    7.83 +;;[0 16 0 0 3 4 10 20 95 ?? 1 255 0 0 0 0 0 ....]
    7.84 +  [0 16 0 0 3 4 10 20 95 11 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
    7.85 +
    7.86 +
    7.87 +
    7.88 +;; now it's time to learn the item codes
    7.89 +
    7.90 +(def inventory-begin
    7.91 +  (read-state "inventory-begin"))
    7.92 +
    7.93 +(defn show-item
    7.94 +  "Run a saved pokemon with the first item replaced by the item named
    7.95 +   by n."
    7.96 +  [n]
    7.97 +  (set-state! inventory-begin)
    7.98 +  (let [mem (memory)]
    7.99 +    (aset mem 54044 1)
   7.100 +    (aset mem 54045 n)
   7.101 +    (aset mem 54046 1)
   7.102 +    (aset mem 54047 255)
   7.103 +    (write-memory! mem))
   7.104 +  (step)
   7.105 +  (->> [[] @current-state]
   7.106 +       (play-moves
   7.107 +        [[:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   7.108 +         [] [] [] [] []])))
   7.109 +
   7.110 +
   7.111 +(defn get-item-names []
   7.112 +  (dorun (map (fn [n] (println n)
   7.113 +                (show-item n)
   7.114 +                (Thread/sleep 5000))
   7.115 +              (range 0x00 0xFF))))
   7.116 +
   7.117 +;; results (took about 10 minutes to generate)
   7.118 +
   7.119 +;; 0   garbage
   7.120 +;; 1   master-ball
   7.121 +;; 2   ultra-ball
   7.122 +;; 3   great-ball
   7.123 +;; 4   poke-ball
   7.124 +;; 5   town-map
   7.125 +;; 6   bicycle
   7.126 +;; 7   ?????
   7.127 +;; 8   safari-ball
   7.128 +;; 9   pokedex
   7.129 +;; 10  moon-stone 
   7.130 +;; 11   antidote
   7.131 +;; 12   burn-heal
   7.132 +;; 13   ice-heal
   7.133 +;; 14   awakening
   7.134 +;; 15   parlyz-heal
   7.135 +;; 16   full-restore
   7.136 +;; 17   max-potion
   7.137 +;; 18   hyper-potion
   7.138 +;; 19   super-potion
   7.139 +;; 20   potion
   7.140 +;; 21   boulderbadge
   7.141 +;; 22   cascadebadge
   7.142 +;; 23   thunderbadge
   7.143 +;; 24   rainbowbadge
   7.144 +;; 25   soulbadge
   7.145 +;; 26   marshbadge
   7.146 +;; 27   volcanobadge
   7.147 +;; 28   earthbadge
   7.148 +;; 29   escape-rope
   7.149 +;; 30   repel
   7.150 +;; 31   old amber
   7.151 +;; 32   fire-stone
   7.152 +;; 33   thunderstone
   7.153 +;; 34   water-stone
   7.154 +;; 35   hp-up
   7.155 +;; 36   protein
   7.156 +;; 37   iron
   7.157 +;; 38   carbos
   7.158 +;; 39   calcium
   7.159 +;; 40   rare-candy
   7.160 +;; 41   dome-fossil
   7.161 +;; 42   helix-fossil
   7.162 +;; 43   secret-key
   7.163 +;; 44   ?????
   7.164 +;; 45   bike-voucher
   7.165 +;; 46   x-accuracy
   7.166 +;; 47   leaf-stone
   7.167 +;; 48   card-key
   7.168 +;; 49   nugget
   7.169 +;; 50   pp-up
   7.170 +;; 51   poke-doll
   7.171 +;; 52   full-heal
   7.172 +;; 53   revive
   7.173 +;; 54   max-revive
   7.174 +;; 55   guard-spec.
   7.175 +;; 56   super-repel
   7.176 +;; 57   max-repel
   7.177 +;; 58   dire-hit
   7.178 +;; 59   coin
   7.179 +;; 60   fresh-water
   7.180 +;; 61   soda-pop
   7.181 +;; 62   lemonade
   7.182 +;; 63   s.s.ticket
   7.183 +;; 64   gold-teeth
   7.184 +;; 65   x-attach
   7.185 +;; 66   x-defend
   7.186 +;; 67   x-speed
   7.187 +;; 68   x-special
   7.188 +;; 69   coin-case
   7.189 +;; 70   oak's-parcel
   7.190 +;; 71   itemfinder
   7.191 +;; 72   silph-scope
   7.192 +;; 73   poke-flute
   7.193 +;; 74   lift-key
   7.194 +;; 75   exp.all
   7.195 +;; 76   old-rod
   7.196 +;; 77   good-rod
   7.197 +;; 78   super-rod
   7.198 +;; 79   pp-up
   7.199 +;; 80   ether
   7.200 +;; 81   max-ether
   7.201 +;; 82   elixer
   7.202 +;; 83   max-elixer
   7.203 +;; 84   B2F
   7.204 +;; 85   B1F
   7.205 +;; 86   1F
   7.206 +;; 87   2F
   7.207 +;; 88   3F
   7.208 +;; 89   4F
   7.209 +;; 90   5F
   7.210 +;; 91   6F
   7.211 +;; 92   7F
   7.212 +;; 93   8F
   7.213 +;; 94   9F
   7.214 +;; 95   10F
   7.215 +;; 96   11F
   7.216 +;; 97   B4F
   7.217 +;; 98   garbage
   7.218 +;; 99   garbage
   7.219 +;; 100   garbage
   7.220 +;; 101   garbage
   7.221 +;; 102   garbage
   7.222 +;; 103   garbage
   7.223 +;; 104   garbage
   7.224 +;; 105   garbage
   7.225 +;; 106   garbage
   7.226 +;; 107   garbage
   7.227 +;; 108   garbage
   7.228 +;; 109   garbage
   7.229 +;; 110   garbage
   7.230 +;; 111   garbage
   7.231 +;; 112   garbage
   7.232 +;; 113   garbage
   7.233 +;; 114   garbage
   7.234 +;; 115   garbage
   7.235 +;; 116   garbage
   7.236 +;; 117   garbage
   7.237 +;; 118   garbage
   7.238 +;; 119   4
   7.239 +;; 120   garbage
   7.240 +;; 121   garbage
   7.241 +;; 122   slow
   7.242 +;; 123   garbage
   7.243 +;; 124   garbage
   7.244 +;; 125   garbage
   7.245 +;; 126   garbage
   7.246 +;; 127   garbage
   7.247 +;; 128   garbage
   7.248 +;; 129   garbage
   7.249 +;; 130   garbage
   7.250 +;; 131   slow
   7.251 +;; 132   slow
   7.252 +;; 133   garbage
   7.253 +;; 134   slow
   7.254 +;; 135   garbage
   7.255 +;; 136   garbage
   7.256 +;; 137   slow
   7.257 +;; 138   garbage
   7.258 +;; 139   garbage
   7.259 +;; 140   garbage
   7.260 +;; 141   slow
   7.261 +;; 142   garbage
   7.262 +;; 143   garbage
   7.263 +;; 144   garbage
   7.264 +;; 145   garbage
   7.265 +;; 146   garbage
   7.266 +;; 147   garbage
   7.267 +;; 148   garbage
   7.268 +;; 149   garbage
   7.269 +;; 150   slow
   7.270 +;; 151   garbage
   7.271 +;; 152   Q
   7.272 +;; 153   garbage
   7.273 +;; 154   garbage
   7.274 +;; 155   garbage
   7.275 +;; 156   garbage
   7.276 +;; 157   garbage
   7.277 +;; 158   garbage
   7.278 +;; 159   garbage
   7.279 +;; 160   garbage (alaphabet)
   7.280 +;; 161   garbage
   7.281 +;; 162   garbage
   7.282 +;; 163   garbage
   7.283 +;; 164   rival's
   7.284 +;; 165   name?
   7.285 +;; 166   nickname?
   7.286 +;; 167   slow
   7.287 +;; 168   garbage
   7.288 +;; 169   slow
   7.289 +;; 170   garbage
   7.290 +;; 171   garbage
   7.291 +;; 172   garbage
   7.292 +;; 173   garbage
   7.293 +;; 174   garbage
   7.294 +;; 175   yellow
   7.295 +;; 176   ash
   7.296 +;; 177   jack
   7.297 +;; 178   new-name
   7.298 +;; 179   blue
   7.299 +;; 180   gary
   7.300 +;; 181   john
   7.301 +;; 182   garbage
   7.302 +;; 183   garbage
   7.303 +;; 184   garbage
   7.304 +;; 185   garbage
   7.305 +;; 186   slow
   7.306 +;; 187   garbage
   7.307 +;; 188   garbage
   7.308 +;; 189   garbage
   7.309 +;; 190   garbage
   7.310 +;; 191   garbage
   7.311 +;; 192   garbage
   7.312 +;; 193   garbage
   7.313 +;; 194   garbage
   7.314 +;; 195   slow
   7.315 +;; 196   HM01
   7.316 +;; 197   HM02
   7.317 +;; 198   HM03
   7.318 +;; 199   HM04
   7.319 +;; 200   HM05
   7.320 +;; 201   TM01
   7.321 +;; 202   TM02
   7.322 +;; 203   TM03
   7.323 +;; 204   TM04
   7.324 +;; 205   TM05
   7.325 +;; 206   TM06
   7.326 +;; 207   TM07
   7.327 +;; 208   TM08
   7.328 +;; 209   TM09
   7.329 +;; 210   TM10
   7.330 +;; 211   TM11
   7.331 +;; 212   TM12
   7.332 +;; 213   TM13
   7.333 +;; 214   TM13
   7.334 +;; 215   TM15
   7.335 +;; 216   TM16
   7.336 +;; 217   TM17
   7.337 +;; 218   TM18
   7.338 +;; 219   TM19
   7.339 +;; 220   TM20
   7.340 +;; 221   TM21
   7.341 +;; 222   TM22
   7.342 +;; 223   TM23
   7.343 +;; 224   TM24
   7.344 +;; 225   TM25
   7.345 +;; 226   TM26
   7.346 +;; 227   TM27
   7.347 +;; 228   TM28
   7.348 +;; 229   TM29
   7.349 +;; 230   TM30
   7.350 +;; 231   TM31
   7.351 +;; 232   TM32
   7.352 +;; 233   TM33
   7.353 +;; 234   TM34
   7.354 +;; 235   TM35
   7.355 +;; 236   TM36
   7.356 +;; 237   TM37
   7.357 +;; 238   TM38
   7.358 +;; 239   TM39
   7.359 +;; 240   TM40
   7.360 +;; 241   TM41
   7.361 +;; 242   TM42
   7.362 +;; 243   TM43
   7.363 +;; 244   TM44
   7.364 +;; 245   TM45
   7.365 +;; 246   TM46
   7.366 +;; 247   TM47
   7.367 +;; 248   TM48
   7.368 +;; 249   TM49
   7.369 +;; 250   TM50
   7.370 +;; 251   TM51
   7.371 +;; 252   TM52
   7.372 +;; 253   TM53
   7.373 +;; 254   TM54
   7.374 +;; 255   end-of-list-sentinel   
   7.375 +
   7.376 +
   7.377 +
   7.378 +(def gliched-tms
   7.379 +  [[:TM51 1]
   7.380 +   [:TM52 1]
   7.381 +   [:TM53 1]
   7.382 +   [:TM54 1]])
   7.383 +
   7.384 +(def good-items
   7.385 +  [[:bicycle 1]
   7.386 +   [:ultra-ball 15]
   7.387 +   [:pp-up 1]
   7.388 +   [:master-ball 5]
   7.389 +   [:rare-candy 99]
   7.390 +   [:full-restore 25]
   7.391 +   [:max-revive 8]
   7.392 +   [:max-repel 40]
   7.393 +   [:TM25 1]
   7.394 +   [:TM11 1]
   7.395 +   [:TM15 1]
   7.396 +   ])
   7.397 +  
   7.398 +(def some-badges
   7.399 +  [[:cascadebadge 1]
   7.400 +   [:thunderbadge 1]
   7.401 +   [:rainbowbadge 1]
   7.402 +   [:soulbadge 1]    
   7.403 +   ])
   7.404 +  
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/clojure/com/aurellem/exp/pokemon.clj	Mon Mar 19 21:23:46 2012 -0500
     8.3 @@ -0,0 +1,92 @@
     8.4 +(ns com.aurellem.exp.pokemon
     8.5 +  "Here I find out how pokemon are stored in memory."
     8.6 +  (:use (com.aurellem.gb gb-driver items assembly util
     8.7 +                         characters))
     8.8 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     8.9 +
    8.10 +
    8.11 +(def pidgeot-lvl-36 (mid-game))
    8.12 +
    8.13 +
    8.14 +(def pidgeot-lvl-37 (read-state "pidgeot-lvl-37"))
    8.15 +
    8.16 +
    8.17 +(def pidgeot-lvl-38  (read-state "pidgeot-lvl-38"))
    8.18 +
    8.19 +
    8.20 +(def pidgeot-lvl-39  (read-state "pidgeot-lvl-39"))
    8.21 +
    8.22 +
    8.23 +(def pidgeot-lvl-40  (read-state "pidgeot-lvl-40"))
    8.24 +
    8.25 +
    8.26 +(defn level-analysis []
    8.27 +  (apply common-differences
    8.28 +         (map (comp vec memory)
    8.29 +              [pidgeot-lvl-36
    8.30 +               pidgeot-lvl-37
    8.31 +               pidgeot-lvl-38
    8.32 +               pidgeot-lvl-39
    8.33 +               pidgeot-lvl-40])))
    8.34 +
    8.35 +;; inconclusive -- implies that level is calculated from
    8.36 +;; some other values.
    8.37 +
    8.38 +
    8.39 +(def name-pidgeotto (read-state "name-pidgeotto"))
    8.40 +(def named-A (read-state "named-A"))
    8.41 +(def named-B (read-state "named-B"))
    8.42 +(def named-C (read-state "named-C"))
    8.43 +(def named-D (read-state "named-D"))
    8.44 +(def named-E (read-state "named-E"))
    8.45 +(def named-F (read-state "named-F"))
    8.46 +
    8.47 +(defn name-analysis []
    8.48 +  (apply common-differences
    8.49 +         (map (comp vec memory)
    8.50 +              [named-A
    8.51 +               named-B
    8.52 +               named-C
    8.53 +               named-D
    8.54 +               named-E
    8.55 +               named-F])))
    8.56 +
    8.57 +;; resluted in 3 separate locations that could
    8.58 +;; possibly hold the first letter of the pokemon's name
    8.59 +
    8.60 +0xCF4A
    8.61 +0xD2EB
    8.62 +0xCEED
    8.63 +
    8.64 +;; try changing each of them
    8.65 +
    8.66 +
    8.67 +(defn test-cf4a []
    8.68 +  (continue!
    8.69 +   (set-memory named-A 0xCF4A (character->character-code "Z"))))
    8.70 +;; result -- pidgeotto named "A"
    8.71 +
    8.72 +(defn test-d2eb []
    8.73 +  (continue!
    8.74 +   (set-memory named-A 0xD2EB (character->character-code "Z"))))
    8.75 +;; result -- pidgeotto named "Z"
    8.76 +
    8.77 +(defn test-ceed []
    8.78 +  (continue!
    8.79 +   (set-memory named-A 0xCEED (character->character-code "Z"))))
    8.80 +;; result -- pidgeotto named "A"
    8.81 +
    8.82 +(def sixth-pokemon-name-start 0xD2EB)
    8.83 +
    8.84 +
    8.85 +(defn set-sixth-pokemon-name-first-character
    8.86 +  ([state character]
    8.87 +     (set-memory state sixth-pokemon-name-start
    8.88 +                 (character->character-code character)))
    8.89 +  ([character]
    8.90 +     (set-sixth-pokemon-name-first-character @current-state
    8.91 +                                             character)))
    8.92 +
    8.93 +
    8.94 +
    8.95 +
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/clojure/com/aurellem/exp/rival_name.clj	Mon Mar 19 21:23:46 2012 -0500
     9.3 @@ -0,0 +1,301 @@
     9.4 +(ns com.aurellem.exp.rival-name
     9.5 +  (:use (com.aurellem.gb gb-driver))
     9.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     9.7 +
     9.8 +(defn talk-to-rival []
     9.9 +  (read-state "talk-to-rival"))
    9.10 +
    9.11 +
    9.12 +;; determined by naming rival "ZZZZZZZ" and noticing the
    9.13 +;; pattern in the memory past the item list.
    9.14 +
    9.15 +(def rival-name-start 0xD349)
    9.16 +
    9.17 +(defn set-rival-name [^SaveState state codes]
    9.18 +  (set-state! state)
    9.19 +  (let [mem (memory state)]
    9.20 +    (dorun (map (fn [index val]
    9.21 +                  (aset mem index val))
    9.22 +                (range rival-name-start
    9.23 +                       (+ rival-name-start
    9.24 +                          (count codes))) codes))
    9.25 +    (write-memory! mem)
    9.26 +    (update-state)))
    9.27 +
    9.28 +(defn view-rival-name [name-codes]
    9.29 +  (->
    9.30 +   (set-rival-name (talk-to-rival) name-codes)
    9.31 +   (step [:a])
    9.32 +   (play 50)))
    9.33 +
    9.34 +(defn rival-name-sequence []
    9.35 +  (let [i (atom 1)]
    9.36 +    (fn []
    9.37 +      (let [codes (range @i (+ 5 @i))]
    9.38 +        (println codes)
    9.39 +        (view-rival-name codes)
    9.40 +        (reset! i (+ 5 @i))))))
    9.41 +
    9.42 +
    9.43 +;; results:
    9.44 +
    9.45 +;; 0x00 :  end-of-name-sentinel
    9.46 +;; 0x01 :  
    9.47 +;; 0x02 :  
    9.48 +;; 0x03 :  
    9.49 +;; 0x04 :  
    9.50 +;; 0x05 :  
    9.51 +;; 0x06 :  
    9.52 +;; 0x07 :  
    9.53 +;; 0x08 :  
    9.54 +;; 0x09 :  
    9.55 +;; 0x0A :  
    9.56 +;; 0x0B :  
    9.57 +;; 0x0C :  
    9.58 +;; 0x0D :  
    9.59 +;; 0x0E :  
    9.60 +;; 0x0F :  
    9.61 +;; 0x10 :  
    9.62 +;; 0x11 :  
    9.63 +;; 0x12 :  
    9.64 +;; 0x13 :  
    9.65 +;; 0x14 :  
    9.66 +;; 0x15 :  
    9.67 +;; 0x16 :  
    9.68 +;; 0x17 :  
    9.69 +;; 0x18 :  
    9.70 +;; 0x19 :  
    9.71 +;; 0x1A :  
    9.72 +;; 0x1B :  
    9.73 +;; 0x1C :  
    9.74 +;; 0x1D :  
    9.75 +;; 0x1E :  
    9.76 +;; 0x1F :  
    9.77 +;; 0x20 :  
    9.78 +;; 0x21 :  
    9.79 +;; 0x22 :  
    9.80 +;; 0x23 :  
    9.81 +;; 0x24 :  
    9.82 +;; 0x25 :  
    9.83 +;; 0x26 :  
    9.84 +;; 0x27 :  
    9.85 +;; 0x28 :  
    9.86 +;; 0x29 :  
    9.87 +;; 0x2A :  
    9.88 +;; 0x2B :  
    9.89 +;; 0x2C :  
    9.90 +;; 0x2D :  
    9.91 +;; 0x2E :  
    9.92 +;; 0x2F :  
    9.93 +;; 0x30 :  
    9.94 +;; 0x31 :  
    9.95 +;; 0x32 :  
    9.96 +;; 0x33 :  
    9.97 +;; 0x34 :  
    9.98 +;; 0x35 :  
    9.99 +;; 0x36 :  
   9.100 +;; 0x37 :  
   9.101 +;; 0x38 :  
   9.102 +;; 0x39 :  
   9.103 +;; 0x3A :  
   9.104 +;; 0x3B :  
   9.105 +;; 0x3C :  
   9.106 +;; 0x3D :  
   9.107 +;; 0x3E :  
   9.108 +;; 0x3F :  
   9.109 +;; 0x40 :  
   9.110 +;; 0x41 :  
   9.111 +;; 0x42 :  
   9.112 +;; 0x43 :  
   9.113 +;; 0x44 :  
   9.114 +;; 0x45 :  
   9.115 +;; 0x46 :  
   9.116 +;; 0x47 :  
   9.117 +;; 0x48 :  
   9.118 +;; 0x49 :  
   9.119 +;; 0x4A :  
   9.120 +;; 0x4B :  
   9.121 +;; 0x4C :  
   9.122 +;; 0x4D :  
   9.123 +;; 0x4E :  
   9.124 +;; 0x4F :  
   9.125 +;; 0x50 :  
   9.126 +;; 0x51 :  
   9.127 +;; 0x52 :  
   9.128 +;; 0x53 :  
   9.129 +;; 0x54 :  
   9.130 +;; 0x55 :  
   9.131 +;; 0x56 :  
   9.132 +;; 0x57 :  
   9.133 +;; 0x58 :  
   9.134 +;; 0x59 :  
   9.135 +;; 0x5A :  
   9.136 +;; 0x5B :  
   9.137 +;; 0x5C :  
   9.138 +;; 0x5D :  
   9.139 +;; 0x5E :  
   9.140 +;; 0x5F :  
   9.141 +;; 0x60 :  A (small-bold)
   9.142 +;; 0x61 :  B (small-bold)
   9.143 +;; 0x62 :  C (small-bold)
   9.144 +;; 0x63 :  D (small-bold)
   9.145 +;; 0x64 :  E (small-bold)
   9.146 +;; 0x65 :  F (small-bold)
   9.147 +;; 0x66 :  G (small-bold)
   9.148 +;; 0x67 :  H (small-bold)
   9.149 +;; 0x68 :  I (small-bold)
   9.150 +;; 0x69 :  V (small-bold)
   9.151 +;; 0x6A :  S (small-bold)
   9.152 +;; 0x6B :  L (small-bold)
   9.153 +;; 0x6C :  M (small-bold)
   9.154 +;; 0x6D :  
   9.155 +;; 0x6E :  
   9.156 +;; 0x6F :  
   9.157 +;; 0x70 :  
   9.158 +;; 0x71 :  
   9.159 +;; 0x72 :  
   9.160 +;; 0x73 :  
   9.161 +;; 0x74 :  
   9.162 +;; 0x75 :  
   9.163 +;; 0x76 :  
   9.164 +;; 0x77 :  
   9.165 +;; 0x78 :  
   9.166 +;; 0x79 :  
   9.167 +;; 0x7A :  
   9.168 +;; 0x7B :  
   9.169 +;; 0x7C :  
   9.170 +;; 0x7D :  
   9.171 +;; 0x7E :  
   9.172 +;; 0x7F :  
   9.173 +;; 0x80 :  A
   9.174 +;; 0x81 :  B
   9.175 +;; 0x82 :  C
   9.176 +;; 0x83 :  D
   9.177 +;; 0x84 :  E
   9.178 +;; 0x85 :  F
   9.179 +;; 0x86 :  G
   9.180 +;; 0x87 :  H
   9.181 +;; 0x88 :  I
   9.182 +;; 0x89 :  J
   9.183 +;; 0x8A :  K
   9.184 +;; 0x8B :  L
   9.185 +;; 0x8C :  M
   9.186 +;; 0x8D :  N
   9.187 +;; 0x8E :  O
   9.188 +;; 0x8F :  P
   9.189 +;; 0x90 :  Q
   9.190 +;; 0x91 :  R
   9.191 +;; 0x92 :  S
   9.192 +;; 0x93 :  T
   9.193 +;; 0x94 :  U
   9.194 +;; 0x95 :  V
   9.195 +;; 0x96 :  W
   9.196 +;; 0x97 :  X
   9.197 +;; 0x98 :  Y
   9.198 +;; 0x99 :  Z
   9.199 +;; 0x9A :  (
   9.200 +;; 0x9B :  )
   9.201 +;; 0x9C :  :
   9.202 +;; 0x9D :  ;
   9.203 +;; 0x9E :  
   9.204 +;; 0x9F :  
   9.205 +;; 0xA0 :  a
   9.206 +;; 0xA1 :  b
   9.207 +;; 0xA2 :  c
   9.208 +;; 0xA3 :  d
   9.209 +;; 0xA4 :  e
   9.210 +;; 0xA5 :  f
   9.211 +;; 0xA6 :  g
   9.212 +;; 0xA7 :  h
   9.213 +;; 0xA8 :  i
   9.214 +;; 0xA9 :  j
   9.215 +;; 0xAA :  k
   9.216 +;; 0xAB :  l
   9.217 +;; 0xAC :  m
   9.218 +;; 0xAD :  n
   9.219 +;; 0xAE :  o
   9.220 +;; 0xAF :  p
   9.221 +;; 0xB0 :  q
   9.222 +;; 0xB1 :  r
   9.223 +;; 0xB2 :  s
   9.224 +;; 0xB3 :  t
   9.225 +;; 0xB4 :  u
   9.226 +;; 0xB5 :  v
   9.227 +;; 0xB6 :  w
   9.228 +;; 0xB7 :  x
   9.229 +;; 0xB8 :  y
   9.230 +;; 0xB9 :  z
   9.231 +;; 0xBA :  e-with-grave
   9.232 +;; 0xBB :  
   9.233 +;; 0xBC :  
   9.234 +;; 0xBD :  
   9.235 +;; 0xBE :  
   9.236 +;; 0xBF :  
   9.237 +;; 0xC0 :  
   9.238 +;; 0xC1 :  
   9.239 +;; 0xC2 :  
   9.240 +;; 0xC3 :  
   9.241 +;; 0xC4 :  
   9.242 +;; 0xC5 :  
   9.243 +;; 0xC6 :  
   9.244 +;; 0xC7 :  
   9.245 +;; 0xC8 :  
   9.246 +;; 0xC9 :  
   9.247 +;; 0xCA :  
   9.248 +;; 0xCB :  
   9.249 +;; 0xCC :  
   9.250 +;; 0xCD :  
   9.251 +;; 0xCE :  
   9.252 +;; 0xCF :  
   9.253 +;; 0xD0 :  
   9.254 +;; 0xD1 :  
   9.255 +;; 0xD2 :  
   9.256 +;; 0xD3 :  
   9.257 +;; 0xD4 :  
   9.258 +;; 0xD5 :  
   9.259 +;; 0xD6 :  
   9.260 +;; 0xD7 :  
   9.261 +;; 0xD8 :  
   9.262 +;; 0xD9 :  
   9.263 +;; 0xDA :  
   9.264 +;; 0xDB :  
   9.265 +;; 0xDC :  
   9.266 +;; 0xDD :  
   9.267 +;; 0xDE :  
   9.268 +;; 0xDF :  
   9.269 +;; 0xE0 :  '
   9.270 +;; 0xE1 :  PK
   9.271 +;; 0xE2 :  MN
   9.272 +;; 0xE3 :  
   9.273 +;; 0xE4 :  
   9.274 +;; 0xE5 :  
   9.275 +;; 0xE6 :  ?
   9.276 +;; 0xE7 :  !
   9.277 +;; 0xE8 :  .
   9.278 +;; 0xE9 :  
   9.279 +;; 0xEA :  
   9.280 +;; 0xEB :  
   9.281 +;; 0xEC :  
   9.282 +;; 0xED :  
   9.283 +;; 0xEE :  
   9.284 +;; 0xEF :  male-symbol
   9.285 +;; 0xF0 :  pokemon-money-symbol
   9.286 +;; 0xF1 :  .
   9.287 +;; 0xF2 :  /
   9.288 +;; 0xF3 :  ,
   9.289 +;; 0xF4 :  female-symbol
   9.290 +;; 0xF5 :  
   9.291 +;; 0xF6 :  0 
   9.292 +;; 0xF7 :  1
   9.293 +;; 0xF8 :  2
   9.294 +;; 0xF9 :  3
   9.295 +;; 0xFA :  4
   9.296 +;; 0xFB :  5
   9.297 +;; 0xFC :  6
   9.298 +;; 0xFD :  7
   9.299 +;; 0xFE :  8
   9.300 +;; 0xFF :  9
   9.301 +           
   9.302 +                
   9.303 +
   9.304 +
    10.1 --- a/clojure/com/aurellem/experiments/items.clj	Mon Mar 19 20:43:38 2012 -0500
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,503 +0,0 @@
    10.4 -(ns com.aurellem.experiments.items
    10.5 -   (:use (com.aurellem gb-driver vbm title items))
    10.6 -   (:import [com.aurellem.gb_driver SaveState]))
    10.7 -
    10.8 -;; try just buying five potions in sequence and see what changes
    10.9 -;; each time.
   10.10 -
   10.11 -(defn common-differences [& seqs]
   10.12 -  (let [backbone (range (count (first seqs)))]
   10.13 -    (filter
   10.14 -     (comp (partial apply distinct?) second)
   10.15 -     (zipmap backbone
   10.16 -             (apply (partial map list) seqs)))))
   10.17 -
   10.18 -;; trying to find how items are represented in memory
   10.19 -
   10.20 -(def zero-potions (read-state "zero-potions"))
   10.21 -
   10.22 -(def one-potion (read-state "one-potion"))
   10.23 -
   10.24 -(def two-potions (read-state "two-potions"))
   10.25 -
   10.26 -(def three-potions (read-state "three-potions"))
   10.27 -
   10.28 -(def four-potions (read-state "four-potions"))
   10.29 -
   10.30 -(def five-potions (read-state "five-potions"))
   10.31 -  
   10.32 -  
   10.33 -  ;; result
   10.34 -(defn canidates []
   10.35 -  (apply common-differences
   10.36 -         (map (comp vec memory)
   10.37 -              [zero-potions one-potion two-potions three-potions
   10.38 -               four-potions five-potions])))
   10.39 -
   10.40 - (comment [55875 (37 15 49 27 14 44)]
   10.41 -  [55876 (30 1 49 56 55 23)]
   10.42 -  [49158 (154 191 78 135 70 73)]
   10.43 -  [54087 (49 40 37 34 25 22)]
   10.44 -  [49160 (7 24 59 243 50 217)]
   10.45 -  [49704 (31 14 72 33 84 27)]
   10.46 -  [49162 (126 159 183 110 176 179)]
   10.47 -  [39984 (0 254 251 248 127 252)]
   10.48 -  [49904 (29 72 64 78 1 95)]
   10.49 -  [65491 (222 127 149 132 226 38)]
   10.50 -  [65492 (44 20 89 11 253 163)]
   10.51 -  [49335 (52 15 6 14 3 17)]
   10.52 -  [49720 (78 152 96 60 83 103)]
   10.53 -  [65304 (19 89 214 33 18 113)]
   10.54 -  [53561 (132 185 145 162 159 183)]
   10.55 -  [54046 (0 1 2 3 4 5)])
   10.56 -
   10.57 -;;; hmmmmmm...... I guess that the potion quantities are at 54046,
   10.58 -;;;huh?
   10.59 -
   10.60 -
   10.61 -
   10.62 -(defn get-mem []
   10.63 -  (subvec (vec (memory @current-state)) 54040 (+ 54046 100)))
   10.64 -
   10.65 -
   10.66 -;; potion -- 99
   10.67 -[0 16 0 0 1 20 99 255 0 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.68 -
   10.69 -;; potion -- 95
   10.70 -[0 16 0 0 1 20 95 255 0 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 49 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.71 -
   10.72 -;; potion -- 95
   10.73 -;; pokeball -- 1
   10.74 -[0 16 0 0 2 20 95 4 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.75 -
   10.76 -;; potion -- 95
   10.77 -;; pokeball -- 10
   10.78 -[0 16 0 0 2 20 95 4 10 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.79 -
   10.80 -
   10.81 -;; pokeball -- 10
   10.82 -;; potion -- 95
   10.83 -[0 16 0 0 2 4 10 20 95 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.84 -
   10.85 -;; pokeball -- 10
   10.86 -;; potion -- 95
   10.87 -;; antidote -- 1
   10.88 -
   10.89 -;;prediction
   10.90 -;;[0 16 0 0 3 4 10 20 95 ?? 1 255 0 0 0 0 0 ....]
   10.91 -  [0 16 0 0 3 4 10 20 95 11 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 16 117 129 139 148 132 80 134 128 145 152 80 137 3 0 0 1 191 223 189 2 0 42 8 199 5 2 1 0 1 20 2 4 4 93 77 23 77 122 76 0 255 208 65 240 198 10 10 71 246 41 201 255 252 64 18 201 10 10]
   10.92 -
   10.93 -
   10.94 -
   10.95 -;; now it's time to learn the item codes
   10.96 -
   10.97 -(def inventory-begin
   10.98 -  (read-state "inventory-begin"))
   10.99 -
  10.100 -(defn show-item
  10.101 -  "Run a saved pokemon with the first item replaced by the item named
  10.102 -   by n."
  10.103 -  [n]
  10.104 -  (set-state! inventory-begin)
  10.105 -  (let [mem (memory)]
  10.106 -    (aset mem 54044 1)
  10.107 -    (aset mem 54045 n)
  10.108 -    (aset mem 54046 1)
  10.109 -    (aset mem 54047 255)
  10.110 -    (write-memory! mem))
  10.111 -  (step)
  10.112 -  (->> [[] @current-state]
  10.113 -       (play-moves
  10.114 -        [[:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  10.115 -         [] [] [] [] []])))
  10.116 -
  10.117 -
  10.118 -(defn get-item-names []
  10.119 -  (dorun (map (fn [n] (println n)
  10.120 -                (show-item n)
  10.121 -                (Thread/sleep 5000))
  10.122 -              (range 0x00 0xFF))))
  10.123 -
  10.124 -;; results (took about 10 minutes to generate)
  10.125 -
  10.126 -;; 0   garbage
  10.127 -;; 1   master-ball
  10.128 -;; 2   ultra-ball
  10.129 -;; 3   great-ball
  10.130 -;; 4   poke-ball
  10.131 -;; 5   town-map
  10.132 -;; 6   bicycle
  10.133 -;; 7   ?????
  10.134 -;; 8   safari-ball
  10.135 -;; 9   pokedex
  10.136 -;; 10  moon-stone 
  10.137 -;; 11   antidote
  10.138 -;; 12   burn-heal
  10.139 -;; 13   ice-heal
  10.140 -;; 14   awakening
  10.141 -;; 15   parlyz-heal
  10.142 -;; 16   full-restore
  10.143 -;; 17   max-potion
  10.144 -;; 18   hyper-potion
  10.145 -;; 19   super-potion
  10.146 -;; 20   potion
  10.147 -;; 21   boulderbadge
  10.148 -;; 22   cascadebadge
  10.149 -;; 23   thunderbadge
  10.150 -;; 24   rainbowbadge
  10.151 -;; 25   soulbadge
  10.152 -;; 26   marshbadge
  10.153 -;; 27   volcanobadge
  10.154 -;; 28   earthbadge
  10.155 -;; 29   escape-rope
  10.156 -;; 30   repel
  10.157 -;; 31   old amber
  10.158 -;; 32   fire-stone
  10.159 -;; 33   thunderstone
  10.160 -;; 34   water-stone
  10.161 -;; 35   hp-up
  10.162 -;; 36   protein
  10.163 -;; 37   iron
  10.164 -;; 38   carbos
  10.165 -;; 39   calcium
  10.166 -;; 40   rare-candy
  10.167 -;; 41   dome-fossil
  10.168 -;; 42   helix-fossil
  10.169 -;; 43   secret-key
  10.170 -;; 44   ?????
  10.171 -;; 45   bike-voucher
  10.172 -;; 46   x-accuracy
  10.173 -;; 47   leaf-stone
  10.174 -;; 48   card-key
  10.175 -;; 49   nugget
  10.176 -;; 50   pp-up
  10.177 -;; 51   poke-doll
  10.178 -;; 52   full-heal
  10.179 -;; 53   revive
  10.180 -;; 54   max-revive
  10.181 -;; 55   guard-spec.
  10.182 -;; 56   super-repel
  10.183 -;; 57   max-repel
  10.184 -;; 58   dire-hit
  10.185 -;; 59   coin
  10.186 -;; 60   fresh-water
  10.187 -;; 61   soda-pop
  10.188 -;; 62   lemonade
  10.189 -;; 63   s.s.ticket
  10.190 -;; 64   gold-teeth
  10.191 -;; 65   x-attach
  10.192 -;; 66   x-defend
  10.193 -;; 67   x-speed
  10.194 -;; 68   x-special
  10.195 -;; 69   coin-case
  10.196 -;; 70   oak's-parcel
  10.197 -;; 71   itemfinder
  10.198 -;; 72   silph-scope
  10.199 -;; 73   poke-flute
  10.200 -;; 74   lift-key
  10.201 -;; 75   exp.all
  10.202 -;; 76   old-rod
  10.203 -;; 77   good-rod
  10.204 -;; 78   super-rod
  10.205 -;; 79   pp-up
  10.206 -;; 80   ether
  10.207 -;; 81   max-ether
  10.208 -;; 82   elixer
  10.209 -;; 83   max-elixer
  10.210 -;; 84   B2F
  10.211 -;; 85   B1F
  10.212 -;; 86   1F
  10.213 -;; 87   2F
  10.214 -;; 88   3F
  10.215 -;; 89   4F
  10.216 -;; 90   5F
  10.217 -;; 91   6F
  10.218 -;; 92   7F
  10.219 -;; 93   8F
  10.220 -;; 94   9F
  10.221 -;; 95   10F
  10.222 -;; 96   11F
  10.223 -;; 97   B4F
  10.224 -;; 98   garbage
  10.225 -;; 99   garbage
  10.226 -;; 100   garbage
  10.227 -;; 101   garbage
  10.228 -;; 102   garbage
  10.229 -;; 103   garbage
  10.230 -;; 104   garbage
  10.231 -;; 105   garbage
  10.232 -;; 106   garbage
  10.233 -;; 107   garbage
  10.234 -;; 108   garbage
  10.235 -;; 109   garbage
  10.236 -;; 110   garbage
  10.237 -;; 111   garbage
  10.238 -;; 112   garbage
  10.239 -;; 113   garbage
  10.240 -;; 114   garbage
  10.241 -;; 115   garbage
  10.242 -;; 116   garbage
  10.243 -;; 117   garbage
  10.244 -;; 118   garbage
  10.245 -;; 119   4
  10.246 -;; 120   garbage
  10.247 -;; 121   garbage
  10.248 -;; 122   slow
  10.249 -;; 123   garbage
  10.250 -;; 124   garbage
  10.251 -;; 125   garbage
  10.252 -;; 126   garbage
  10.253 -;; 127   garbage
  10.254 -;; 128   garbage
  10.255 -;; 129   garbage
  10.256 -;; 130   garbage
  10.257 -;; 131   slow
  10.258 -;; 132   slow
  10.259 -;; 133   garbage
  10.260 -;; 134   slow
  10.261 -;; 135   garbage
  10.262 -;; 136   garbage
  10.263 -;; 137   slow
  10.264 -;; 138   garbage
  10.265 -;; 139   garbage
  10.266 -;; 140   garbage
  10.267 -;; 141   slow
  10.268 -;; 142   garbage
  10.269 -;; 143   garbage
  10.270 -;; 144   garbage
  10.271 -;; 145   garbage
  10.272 -;; 146   garbage
  10.273 -;; 147   garbage
  10.274 -;; 148   garbage
  10.275 -;; 149   garbage
  10.276 -;; 150   slow
  10.277 -;; 151   garbage
  10.278 -;; 152   Q
  10.279 -;; 153   garbage
  10.280 -;; 154   garbage
  10.281 -;; 155   garbage
  10.282 -;; 156   garbage
  10.283 -;; 157   garbage
  10.284 -;; 158   garbage
  10.285 -;; 159   garbage
  10.286 -;; 160   garbage (alaphabet)
  10.287 -;; 161   garbage
  10.288 -;; 162   garbage
  10.289 -;; 163   garbage
  10.290 -;; 164   rival's
  10.291 -;; 165   name?
  10.292 -;; 166   nickname?
  10.293 -;; 167   slow
  10.294 -;; 168   garbage
  10.295 -;; 169   slow
  10.296 -;; 170   garbage
  10.297 -;; 171   garbage
  10.298 -;; 172   garbage
  10.299 -;; 173   garbage
  10.300 -;; 174   garbage
  10.301 -;; 175   yellow
  10.302 -;; 176   ash
  10.303 -;; 177   jack
  10.304 -;; 178   new-name
  10.305 -;; 179   blue
  10.306 -;; 180   gary
  10.307 -;; 181   john
  10.308 -;; 182   garbage
  10.309 -;; 183   garbage
  10.310 -;; 184   garbage
  10.311 -;; 185   garbage
  10.312 -;; 186   slow
  10.313 -;; 187   garbage
  10.314 -;; 188   garbage
  10.315 -;; 189   garbage
  10.316 -;; 190   garbage
  10.317 -;; 191   garbage
  10.318 -;; 192   garbage
  10.319 -;; 193   garbage
  10.320 -;; 194   garbage
  10.321 -;; 195   slow
  10.322 -;; 196   HM01
  10.323 -;; 197   HM02
  10.324 -;; 198   HM03
  10.325 -;; 199   HM04
  10.326 -;; 200   HM05
  10.327 -;; 201   TM01
  10.328 -;; 202   TM02
  10.329 -;; 203   TM03
  10.330 -;; 204   TM04
  10.331 -;; 205   TM05
  10.332 -;; 206   TM06
  10.333 -;; 207   TM07
  10.334 -;; 208   TM08
  10.335 -;; 209   TM09
  10.336 -;; 210   TM10
  10.337 -;; 211   TM11
  10.338 -;; 212   TM12
  10.339 -;; 213   TM13
  10.340 -;; 214   TM13
  10.341 -;; 215   TM15
  10.342 -;; 216   TM16
  10.343 -;; 217   TM17
  10.344 -;; 218   TM18
  10.345 -;; 219   TM19
  10.346 -;; 220   TM20
  10.347 -;; 221   TM21
  10.348 -;; 222   TM22
  10.349 -;; 223   TM23
  10.350 -;; 224   TM24
  10.351 -;; 225   TM25
  10.352 -;; 226   TM26
  10.353 -;; 227   TM27
  10.354 -;; 228   TM28
  10.355 -;; 229   TM29
  10.356 -;; 230   TM30
  10.357 -;; 231   TM31
  10.358 -;; 232   TM32
  10.359 -;; 233   TM33
  10.360 -;; 234   TM34
  10.361 -;; 235   TM35
  10.362 -;; 236   TM36
  10.363 -;; 237   TM37
  10.364 -;; 238   TM38
  10.365 -;; 239   TM39
  10.366 -;; 240   TM40
  10.367 -;; 241   TM41
  10.368 -;; 242   TM42
  10.369 -;; 243   TM43
  10.370 -;; 244   TM44
  10.371 -;; 245   TM45
  10.372 -;; 246   TM46
  10.373 -;; 247   TM47
  10.374 -;; 248   TM48
  10.375 -;; 249   TM49
  10.376 -;; 250   TM50
  10.377 -;; 251   TM51
  10.378 -;; 252   TM52
  10.379 -;; 253   TM53
  10.380 -;; 254   TM54
  10.381 -;; 255   end-of-list-sentinel   
  10.382 -
  10.383 -
  10.384 -
  10.385 -(defn run-item-program
  10.386 -  "This is my first assembly/item program!
  10.387 -   it just increments BC by one.
  10.388 -
  10.389 -   The code places a 3 'great balls' at the beginning of the
  10.390 -   inventory, then directly sets the program counter to start
  10.391 -   executing at the position of the 'great balls' in memory.
  10.392 -
  10.393 -   Since a 'great ball' is represented in memory as 0x03, which
  10.394 -   corresponts to the opcode which increments BC by one, that is
  10.395 -   what happens. Then the program counter to the 0x03 quantity entry
  10.396 -   and BC is incremented again.
  10.397 -
  10.398 -   Obviously, the game crashes more or less immediately after the
  10.399 -   program counter advances past the 'great balls' into the next items
  10.400 -   in the inventory, thus I call shutdown! before anything bad happens."
  10.401 -  []
  10.402 -  (set-inventory (read-state "mid-game") [[:great-ball 3]])
  10.403 -  (print-inventory)
  10.404 -  (println "3 ticks") (tick) (tick) (tick)
  10.405 -  (println "PC before:" (PC))
  10.406 -  (println "BC before:" (BC))
  10.407 -  (PC! (inc item-list-start))
  10.408 -  (println "PC after setting:" (PC))
  10.409 -  (println "data at PC:" (aget (memory) (PC)))
  10.410 -  (println "one tick")
  10.411 -  (tick)
  10.412 -  (println "PC after one tick:" (PC))
  10.413 -  (println "BC after one tick:" (BC))
  10.414 -  (tick)
  10.415 -  (println "PC after two ticks:" (PC))
  10.416 -  (println "BC after two ticks:" (BC))
  10.417 -
  10.418 -  (shutdown!))
  10.419 -
  10.420 -
  10.421 -
  10.422 -
  10.423 -(defn test-opcodes-1
  10.424 -  []
  10.425 -  (let [final-state
  10.426 -        (->
  10.427 -         (read-state "mid-game")
  10.428 -         (set-inv-mem 
  10.429 -          [20 0x02 0x00 0x00 0x02 0x00 0x00
  10.430 -           0x00 0x0 0xFF])
  10.431 -         (print-inventory)
  10.432 -         ;;((fn [_] (println "3 ticks") _))
  10.433 -         (tick) (tick) (tick)
  10.434 -         
  10.435 -         ;;(println "PC before:" (PC))
  10.436 -         ;;(println "BC before:" (BC))
  10.437 -         ;;(println "AF:" (AF))
  10.438 -         (PC! (inc item-list-start))
  10.439 -         (BC! (+ 1 item-list-start))
  10.440 -         ;;(println "PC after setting:" (PC))
  10.441 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.442 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.443 -         
  10.444 -         ;;(println "one tick")
  10.445 -         (tick)
  10.446 -         ;;(println "PC after one tick:" (PC))
  10.447 -         ;;(println "BC after one tick:" (BC))
  10.448 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.449 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.450 -         (tick)
  10.451 -         (AF! 0xFFFF)
  10.452 -         ;;(println "PC after two ticks:" (PC))
  10.453 -         ;;(println "BC after two ticks:" (BC))
  10.454 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.455 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.456 -         (tick)
  10.457 -         ;;(println "PC after three ticks:" (PC))
  10.458 -         ;;(println "BC after three ticks:" (BC))
  10.459 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.460 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.461 -         (tick)
  10.462 -         ;;(println "PC after four ticks:" (PC))
  10.463 -         ;;(println "BC after four ticks:" (BC))
  10.464 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.465 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.466 -         (tick)
  10.467 -         ;;(println "PC after five ticks:" (PC))
  10.468 -         ;;(println "BC after five ticks:" (BC))
  10.469 -         ;;(println "data at PC:" (aget (memory) (PC)))
  10.470 -         ;;(println "data at " (BC) "(BC):" (aget (memory) (BC)))
  10.471 -         (print-inventory)
  10.472 -         )]
  10.473 -    
  10.474 -    (shutdown!)
  10.475 -    final-state))
  10.476 -
  10.477 -
  10.478 -
  10.479 -(defn test-opcodes-2
  10.480 -  []
  10.481 -  (set-inv-mem (read-state "mid-game")
  10.482 -               [20 0x08 0x1D 0xD3 0x00 0x00 0x00
  10.483 -                0x00 0x0 0xFF])
  10.484 -  (print-inventory)
  10.485 -  (println "3 ticks") (tick) (tick) (tick)
  10.486 -  (println "PC before:" (PC))
  10.487 -  (println "SP:" (SP))
  10.488 -  (PC! (inc item-list-start))
  10.489 -  (println "PC after setting:" (PC))
  10.490 -  (println "SP:" (Integer/toBinaryString (SP)))
  10.491 -  (println "data at PC:" (aget (memory) (PC)))
  10.492 -  (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D)))
  10.493 -  (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E)))
  10.494 -  (println "one tick")
  10.495 -  (tick)
  10.496 -  (println "PC after one tick:" (PC))
  10.497 -  (println "data at PC:" (aget (memory) (PC)))
  10.498 -  (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D)))
  10.499 -  (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E)))
  10.500 -  (tick) (tick) (tick)
  10.501 -  (println "PC aftter four tick:" (PC))
  10.502 -  (println "data at PC:" (aget (memory) (PC)))
  10.503 -  (println "data at 0xD31D:" (aget (memory) 0xD31D))
  10.504 -  
  10.505 -  (print-inventory)
  10.506 -  (shutdown!))
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/clojure/com/aurellem/gb/assembly.clj	Mon Mar 19 21:23:46 2012 -0500
    11.3 @@ -0,0 +1,1431 @@
    11.4 +(ns com.aurellem.gb.assembly
    11.5 +  (:use (com.aurellem.gb gb-driver vbm util items))
    11.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    11.7 +
    11.8 +(defn inject-assembly
    11.9 +  ([^SaveState state
   11.10 +   program-counter registers
   11.11 +   assembly-code]
   11.12 +  (let [scratch-memory (memory state)]
   11.13 +    ;; inject assembly code
   11.14 +    (dorun (map (fn [index val]
   11.15 +                  (aset scratch-memory index val))
   11.16 +                (range program-counter
   11.17 +                       (+ program-counter (count assembly-code)))
   11.18 +                assembly-code))
   11.19 +    (-> state
   11.20 +        (write-memory! scratch-memory)
   11.21 +        (write-registers! registers)
   11.22 +        (PC! program-counter)))))
   11.23 +
   11.24 +(defn inject-item-assembly
   11.25 +  ([^SaveState state assembly-code]
   11.26 +     (inject-assembly state (inc item-list-start)
   11.27 +                      (registers state)
   11.28 +                      assembly-code))
   11.29 +  ([assembly-code]
   11.30 +     (inject-item-assembly @current-state assembly-code)))
   11.31 +
   11.32 +(defn run-assembly
   11.33 +  ([info-fn assembly n]
   11.34 +     (let [final-state
   11.35 +           (reduce (fn [state _]
   11.36 +                     (tick (info-fn state)))
   11.37 +                   (inject-item-assembly
   11.38 +                     (mid-game) assembly)
   11.39 +                   (range n))]
   11.40 +       final-state))
   11.41 +  ([assembly n]
   11.42 +     (run-assembly d-tick assembly n)))
   11.43 +
   11.44 +(def buttons-port 0xFF00)
   11.45 +
   11.46 +(defn trace [state]
   11.47 +  (loop [program-counters [(first (registers @current-state)) ]
   11.48 +         opcodes [(aget (memory @current-state) (PC @current-state))]]
   11.49 +    (let [frame-boundary?
   11.50 +          (com.aurellem.gb.Gb/tick)]
   11.51 +      (if frame-boundary?
   11.52 +        [program-counters opcodes]
   11.53 +        (recur
   11.54 +         (conj program-counters
   11.55 +               (first (registers @current-state)))
   11.56 +         (conj opcodes
   11.57 +               (aget (memory @current-state)
   11.58 +                     (PC @current-state))))))))
   11.59 +
   11.60 +(defn print-trace [state n]
   11.61 +  (let [[program-counters opcodes] (trace state)]
   11.62 +    (dorun (map (fn [pc op] (println (format "%04X: 0x%02X" pc op)))
   11.63 +                (take n program-counters)
   11.64 +                (take n opcodes)))))
   11.65 +
   11.66 +(defn good-trace []
   11.67 +  (-> (mid-game) (tick) (IE! 0)
   11.68 +      (set-inv-mem [0x00 0x00 0X00 0x00])
   11.69 +      (PC! item-list-start)(print-interrupt)
   11.70 +      (d-tick) (tick) (d-tick) (tick) (d-tick)))
   11.71 +
   11.72 +(defn read-down-button []
   11.73 +  (-> (tick (mid-game))
   11.74 +      (IE! 0) ; disable interrupts
   11.75 +      (inject-item-assembly
   11.76 +       ;; write 00010000 to 0xFF00 to select joypad
   11.77 +       [0x18   ;D31D                    ; jump over          
   11.78 +        0x01   ;D31E                    ; the next 8 bits
   11.79 +                                        ;D31F
   11.80 +        (Integer/parseInt "00100000" 2) ; data section 
   11.81 +        
   11.82 +        0xFA   ;D320                    ; load (D31F) into A
   11.83 +        0x1F   ;D321      -->       
   11.84 +        0xD3   ;D322      -->  D31F     
   11.85 +
   11.86 +        0xEA   ;D323                    ; load (A), which is 
   11.87 +        0x00   ;D324      -->           ; 00010000, into FF00
   11.88 +        0xFF   ;D325      -->  FF00     
   11.89 +        
   11.90 +        0x18   ;D326                    ; this is the place where
   11.91 +        0x01   ;D327                    ; we will store whether
   11.92 +        0x00   ;D328                    ; "down" is pressed.
   11.93 +
   11.94 +        0xFA   ;D329                    ; (FF00) -> A
   11.95 +        0x00   ;D32A                   
   11.96 +        0xFF   ;D32B
   11.97 +
   11.98 +        0xCB   ;D32C                    ; Test whether "down"
   11.99 +        0x5F   ;D32D                    ; is pressed.
  11.100 +
  11.101 +        0x28   ;D32E                    ; if down is pressed,
  11.102 +        0x03   ;D32F                    ; skip the next section 
  11.103 +                                        ; of code.
  11.104 +        ;; down-is-not-pressed
  11.105 +        0xC3   ;D330
  11.106 +        0x1D   ;D331                    ; return to beginning
  11.107 +        0xD3   ;D332
  11.108 +        
  11.109 +        ;; down-is-pressed 
  11.110 +        0xEA   ;D334                    ; write A to D328 if 
  11.111 +        0x28   ;D335                    ; "down" was pressed
  11.112 +        0xD3   ;D336
  11.113 +
  11.114 +        0xC3   ;D330
  11.115 +        0x1D   ;D331                    ; return to beginning
  11.116 +        0xD3   ;D332
  11.117 +        ])))
  11.118 +
  11.119 +(defn test-read-down []
  11.120 + (= (view-memory (step (step (read-down-button) [:d])) 0xD328)
  11.121 +    (view-memory (step (step (read-down-button))) 0xD328)))
  11.122 +
  11.123 +(defn count-frames []
  11.124 +  (-> (tick (mid-game))
  11.125 +      (IE! 0) ; disable interrupts
  11.126 +      (inject-item-assembly
  11.127 +       [0x18   ;D31D                    ; jump over          
  11.128 +        0x02   ;D31E                    ; the next 2 bytes
  11.129 +        0x00   ;D31F                    ; frame-count
  11.130 +        0x00   ;D320                    ; v-blank-prev
  11.131 +        
  11.132 +        0xFA   ;D321
  11.133 +        0x41   ;D322                    ; load (FF41) into A
  11.134 +        0xFF   ;D323                    ; this contains mode flags
  11.135 +        
  11.136 +        ;; if we're in v-blank, the bit-1 is 0
  11.137 +        ;; and bit-2 is 1  Otherwise, it is not v-blank.
  11.138 +        0xCB   ;D324                     ; test bit-1 of A
  11.139 +        0x4F   ;D325                         
  11.140 +
  11.141 +        0xC2   ;D326                     ; if bit-1 is not 0
  11.142 +        0x44   ;D327                     ; GOTO not-v-blank
  11.143 +        0xD3   ;D328
  11.144 +        
  11.145 +        0xCB   ;D329                     ; test bit-0 of A 
  11.146 +        0x47   ;D32A
  11.147 +
  11.148 +        0xCA   ;D32B                     ; if bit-0 is not 1
  11.149 +        0x44   ;D32C                     ; GOTO not-v-blank
  11.150 +        0xD3   ;D32D
  11.151 +        ;;; in v-blank mode
  11.152 +           ;; if v-blank-prev was 0,
  11.153 +           ;; increment frame-count
  11.154 +
  11.155 +        0xFA   ;D32E                    ; load v-blank-prev to A
  11.156 +        0x20   ;D32F
  11.157 +        0xD3   ;D330
  11.158 +        
  11.159 +        0xCB   ;D331
  11.160 +        0x47   ;D332                    ; test bit-0 of A 
  11.161 +
  11.162 +        0x20   ;D333                    ; skip next section
  11.163 +        0x07   ;D334                    ; if v-blank-prev was not zero 
  11.164 +        
  11.165 +           ;; v-blank was 0, increment frame-count
  11.166 +        0xFA   ;D335                    ; load frame-count into A
  11.167 +        0x1F   ;D336
  11.168 +        0xD3   ;D337                   
  11.169 +
  11.170 +        0x3C   ;D338                    ; inc A
  11.171 +
  11.172 +        0xEA   ;D339                    ; load A into frame-count
  11.173 +        0x1F   ;D33A
  11.174 +        0xD3   ;D33B
  11.175 +
  11.176 +           ;; set v-blank-prev to 1
  11.177 +        0x3E   ;D33C                    ; load 1 into A
  11.178 +        0x01   ;D33D                    
  11.179 +
  11.180 +        0xEA   ;D33E                    ; load A into v-blank-prev
  11.181 +        0x20   ;D33F
  11.182 +        0xD3   ;D340
  11.183 +
  11.184 +        0xC3   ;D341                   ; return to beginning
  11.185 +        0x1D   ;D342
  11.186 +        0xD3   ;D343
  11.187 +
  11.188 +        ;;; not in v-blank mode
  11.189 +           ;; set v-blank-prev to 0
  11.190 +        0x3E   ;D344                    ; load 0 into A        
  11.191 +        0x00   ;D345
  11.192 +
  11.193 +        0xEA   ;D346                    ; load A into v-blank-prev
  11.194 +        0x20   ;D347
  11.195 +        0xD3   ;D348
  11.196 +
  11.197 +        0xC3   ;D349                   ; return to beginning
  11.198 +        0x1D   ;D34A
  11.199 +        0xD3   ;D34B
  11.200 +        ])))
  11.201 +
  11.202 +(defn step-count-frames []
  11.203 +  (-> (read-down-button)
  11.204 +      (d-tick)
  11.205 +      (tick)  ;; skip over data section
  11.206 +      (d-tick)  
  11.207 +      (view-register "Register A" A)
  11.208 +      (tick)  ;; load-data into A
  11.209 +      (view-register "Register A" A)
  11.210 +      (d-tick)
  11.211 +      (view-memory 0xFF00)
  11.212 +      (tick) ;; load A into 0xFF00
  11.213 +      (view-memory 0xFF00)
  11.214 +      (d-tick)
  11.215 +      (tick)
  11.216 +      (d-tick)
  11.217 +      (tick)
  11.218 +      (d-tick)
  11.219 +      (tick)
  11.220 +      (d-tick)
  11.221 +      (tick)
  11.222 +      (d-tick)
  11.223 +      (tick)
  11.224 +      (d-tick)
  11.225 +      (tick)
  11.226 +      (print-inventory)))
  11.227 +
  11.228 +(defn test-count-frames []
  11.229 +  (= 255 (aget (memory ((apply comp (repeat 255 step))
  11.230 +                        (count-frames)))
  11.231 +               0xD31F)))
  11.232 +
  11.233 +;; specs for main bootstrap program
  11.234 +;; starts in "mode-select" mode
  11.235 +;;   Each button press takes place in a single frame.
  11.236 +;;   mode-select-mode takes one of the main buttons
  11.237 +;;   which selects one of up to eight modes
  11.238 +;;   mode 1 activated by the "A" button
  11.239 +;;   the next two button presses indicates the start
  11.240 +;;   memory location which to which the bootstrap
  11.241 +;;   program will write.
  11.242 +;;   This is done by using each of the eight buttons to
  11.243 +;;   spell out an 8 bit number.  The order of buttons is
  11.244 +;;   [:d :u :l :r :start :select :b :a]
  11.245 +;;   [:a :start :l]  -->  00101001
  11.246 +
  11.247 +;;   the next button press determines how many bytes are to be
  11.248 +;;   written, starting at the start position.
  11.249 +
  11.250 +;;   then, the actual bytes are entered and are written to the
  11.251 +;;   start address in sequence.
  11.252 +
  11.253 +(defn input-number-assembly []
  11.254 +  [0x18   ;D31D                    ; jump over          
  11.255 +   0x02   ;D31E                    ; the next 2 bytes
  11.256 +   0x00   ;D31F                    ; frame-count
  11.257 +   0x00   ;D320                    ; v-blank-prev
  11.258 +   
  11.259 +   0xFA   ;D321
  11.260 +   0x41   ;D322                    ; load (FF41) into A
  11.261 +   0xFF   ;D323                    ; this contains mode flags
  11.262 +   
  11.263 +   ;; if we're in v-blank, the bit-1 is 0
  11.264 +   ;; and bit-2 is 1  Otherwise, it is not v-blank.
  11.265 +   0xCB   ;D324                     ; test bit-1 of A
  11.266 +   0x4F   ;D325                         
  11.267 +
  11.268 +   0xC2   ;D326                     ; if bit-1 is not 0
  11.269 +   0x44   ;D327                     ; GOTO not-v-blank
  11.270 +   0xD3   ;D328
  11.271 +   
  11.272 +   0xCB   ;D329                     ; test bit-0 of A 
  11.273 +   0x47   ;D32A
  11.274 +
  11.275 +   0xCA   ;D32B                     ; if bit-0 is not 1
  11.276 +   0x44   ;D32C                     ; GOTO not-v-blank
  11.277 +   0xD3   ;D32D
  11.278 +   
  11.279 +        ;;; in v-blank mode
  11.280 +
  11.281 +   ;; if v-blank-prev was 0,
  11.282 +   ;; increment frame-count
  11.283 +
  11.284 +   0xFA   ;D32E                    ; load v-blank-prev to A
  11.285 +   0x20   ;D32F
  11.286 +   0xD3   ;D330
  11.287 +   
  11.288 +   0xCB   ;D331
  11.289 +   0x47   ;D332                    ; test bit-0 of A 
  11.290 +
  11.291 +   0x20   ;D333                    ; skip next section
  11.292 +   0x07   ;D334                    ; if v-blank-prev was not zero 
  11.293 +   
  11.294 +   ;; v-blank was 0, increment frame-count
  11.295 +   0xFA   ;D335                    ; load frame-count into A
  11.296 +   0x1F   ;D336
  11.297 +   0xD3   ;D337                   
  11.298 +
  11.299 +   0x3C   ;D338                    ; inc A
  11.300 +
  11.301 +   0xEA   ;D339                    ; load A into frame-count
  11.302 +   0x1F   ;D33A
  11.303 +   0xD3   ;D33B
  11.304 +
  11.305 +   ;; set v-blank-prev to 1
  11.306 +   0x3E   ;D33C                    ; load 1 into A
  11.307 +   0x01   ;D33D                    
  11.308 +
  11.309 +   0xEA   ;D33E                    ; load A into v-blank-prev
  11.310 +   0x20   ;D33F
  11.311 +   0xD3   ;D340
  11.312 +
  11.313 +   0xC3   ;D341                   ; GOTO input handling code
  11.314 +   0x4E   ;D342
  11.315 +   0xD3   ;D343
  11.316 +
  11.317 +        ;;; not in v-blank mode
  11.318 +   ;; set v-blank-prev to 0
  11.319 +   0x3E   ;D344                    ; load 0 into A        
  11.320 +   0x00   ;D345
  11.321 +
  11.322 +   0xEA   ;D346                    ; load A into v-blank-prev
  11.323 +   0x20   ;D347
  11.324 +   0xD3   ;D348
  11.325 +
  11.326 +   0xC3   ;D349                   ; return to beginning
  11.327 +   0x1D   ;D34A
  11.328 +   0xD3   ;D34B
  11.329 +
  11.330 +   0x00   ;D34C                   ; these are here 
  11.331 +   0x00   ;D34D                   ; for glue
  11.332 +   
  11.333 +   
  11.334 +        ;;; calculate input number based on button presses
  11.335 +   0x18   ;D34E                    ;  skip next 3 bytes
  11.336 +   0x03   ;D34F
  11.337 +                                        ;D350
  11.338 +   (Integer/parseInt "00100000" 2) ;  select directional pad
  11.339 +                                        ;D351
  11.340 +   (Integer/parseInt "00010000" 2) ;  select buttons
  11.341 +   0x00   ;D352                    ;  input-number
  11.342 +
  11.343 +   ;; select directional pad, store low bits in B
  11.344 +   
  11.345 +   0xFA   ;D353                    ; load (D350) into A
  11.346 +   0x50   ;D354      -->       
  11.347 +   0xD3   ;D355      -->  D31F     
  11.348 +   
  11.349 +   0xEA   ;D356                    ; load A, which is 
  11.350 +   0x00   ;D357      -->           ; 00010000, into FF00
  11.351 +   0xFF   ;D358      -->  FF00     
  11.352 +
  11.353 +   0x06   ;D359
  11.354 +                                        ;D35A
  11.355 +   (Integer/parseInt "11110000" 2) ; "11110000" -> B 
  11.356 +   0xFA   ;D35B                    ; (FF00) -> A
  11.357 +   0x00   ;D35C                   
  11.358 +   0xFF   ;D35D
  11.359 +
  11.360 +   0xCB   ;D35E                    ; swap nybbles on A
  11.361 +   0x37   ;D35F
  11.362 +   0xA0   ;D360                    ; (AND A B) -> A
  11.363 +   0x47   ;D361                    ; A -> B
  11.364 +
  11.365 +   ;; select buttons store bottom bits in C
  11.366 +   
  11.367 +   0xFA   ;                        ; load (D351) into A
  11.368 +   0x51   ;          -->       
  11.369 +   0xD3   ;          -->  D31F     
  11.370 +   
  11.371 +   0xEA   ;                        ; load (A), which is 
  11.372 +   0x00   ;          -->           ; 00001000, into FF00
  11.373 +   0xFF   ;          -->  FF00     
  11.374 +
  11.375 +   0x0E   ;    
  11.376 +   (Integer/parseInt "00001111" 2) ; "00001111" -> C 
  11.377 +
  11.378 +   0xFA   ;                        ; (FF00) -> A
  11.379 +   0x00   ;                       
  11.380 +   0xFF   ;    
  11.381 +   
  11.382 +   0xA1   ;                        ; (AND A C) -> A
  11.383 +   0x4F   ;                        ; A -> C
  11.384 +
  11.385 +   ;; combine the B and C registers into the input number
  11.386 +   0x79   ;                        ; C -> A
  11.387 +   0xB0   ;                        ; (OR A B) -> A
  11.388 +   0x2F   ;                        ; negate A
  11.389 +
  11.390 +   0xEA   ;                        ; store A into input-number
  11.391 +   0x52   ;
  11.392 +   0xD3   ;
  11.393 +
  11.394 +   0xC3   ;                        ; return to beginning
  11.395 +   0x1D   ;    
  11.396 +   0xD3   ;    
  11.397 +   ])
  11.398 +
  11.399 +
  11.400 +
  11.401 +(defn input-number []
  11.402 +  (-> (tick (mid-game))
  11.403 +      (IE! 0) ; disable interrupts
  11.404 +      (inject-item-assembly (input-number-assembly))))
  11.405 +  
  11.406 +(defn test-input-number
  11.407 +  "Input freestyle buttons and observe the effects at the repl."
  11.408 +  []
  11.409 +  (set-state! (input-number)) 
  11.410 +  (dotimes [_ 90000] (step (view-memory @current-state 0xD352))))
  11.411 +
  11.412 +
  11.413 +    
  11.414 +
  11.415 +
  11.416 +
  11.417 +
  11.418 +
  11.419 +
  11.420 +
  11.421 +
  11.422 +
  11.423 +
  11.424 +
  11.425 +
  11.426 +
  11.427 +
  11.428 +
  11.429 +
  11.430 +
  11.431 +
  11.432 +
  11.433 +
  11.434 +
  11.435 +
  11.436 +
  11.437 +
  11.438 +
  11.439 +
  11.440 +(defn write-memory-assembly*
  11.441 +  "Currently, grabs input from the user each frame."
  11.442 +  []
  11.443 +  [
  11.444 +   ;; --------- FRAME METRONOME
  11.445 +   0x18 ;; jump ahead to cleanup. first time only.
  11.446 +   0x40 ;; v-blank-prev [D31E]
  11.447 +
  11.448 +   0xFA ;; load modes into A [D31F]
  11.449 +   0x41
  11.450 +   0xFF
  11.451 +
  11.452 +   0x47 ;; A -> B
  11.453 +   0xCB ;; rotate A
  11.454 +   0x2F
  11.455 +   0x2F ;; invert A
  11.456 +
  11.457 +   0xA0
  11.458 +   0x47 ;; now B_0 contains (VB==1)
  11.459 +
  11.460 +   0xFA ;; load v-blank-prev
  11.461 +   0x1E
  11.462 +   0xD3
  11.463 +
  11.464 +   0x2F ;; complement v-blank-prev
  11.465 +   
  11.466 +   0xA0 ;; A & B --> A
  11.467 +   0x4F ;; now C_0 contains increment?
  11.468 +
  11.469 +
  11.470 +   0x78 ;; B->A
  11.471 +   0xEA ;; spit A --> vbprev
  11.472 +   0x1E
  11.473 +   0xD3
  11.474 +
  11.475 +   0xCB   ;test C_0
  11.476 +   0x41
  11.477 +   0x20   ; JUMP ahead to button input if nonzero
  11.478 +   0x02
  11.479 +   0x18   ; JUMP  back to frame metronome (D31F)
  11.480 +   0xE7
  11.481 +   
  11.482 +   ;; -------- GET BUTTON INPUT
  11.483 +
  11.484 +        ;; btw, C_0 is now 1
  11.485 +        ;; prepare to select bits
  11.486 +
  11.487 +   0x06 ;; load 0x00 into B
  11.488 +   0x00 ;; to initialize for "OR" loop
  11.489 + 
  11.490 +   0x3E ;; load 0x20 into A, to measure dpad
  11.491 +   0x20
  11.492 +
  11.493 +   
  11.494 +   0xE0 ;; load A into [FF00] ;; start of OR loop [D33C]
  11.495 +   0x00
  11.496 +   
  11.497 +   0xF0 ;; load A from [FF00]
  11.498 +   0x00
  11.499 +
  11.500 +   0xE6 ;; bitmask 00001111
  11.501 +   0x0F
  11.502 +   
  11.503 +   0xB0 ;; A or B --> A
  11.504 +   0xCB
  11.505 +   0x41 ;; test bit 0 of C
  11.506 +   0x28 ;; JUMP forward if 0
  11.507 +   0x08
  11.508 +
  11.509 +   0x47 ;; A -> B
  11.510 +   0xCB ;; swap B nybbles
  11.511 +   0x30 
  11.512 +   0x0C ;; increment C
  11.513 +   0x3E ;; load 0x10 into A, to measure btns
  11.514 +   0x10
  11.515 +   0x18 ;; JUMP back to "load A into [FF00]" [20 steps?]
  11.516 +   0xED
  11.517 +
  11.518 +
  11.519 +   ;; ------ TAKE ACTION BASED ON USER INPUT
  11.520 +
  11.521 +   ;; "input mode"
  11.522 +   ;; mode 0x00 : select mode
  11.523 +   ;; mode 0x08 : select bytes-to-write
  11.524 +   ;; mode 0x10 : select hi-bit
  11.525 +   ;; mode 0x18 : select lo-bit
  11.526 +
  11.527 +   ;; "output mode"
  11.528 +   ;; mode 0x20 : write bytes
  11.529 +   ;; mode 0xFF : jump PC
  11.530 +
  11.531 +
  11.532 +   ;; registers
  11.533 +   ;; D : mode select
  11.534 +   ;; E : count of bytes to write
  11.535 +   ;; H : address-high
  11.536 +   ;; L : address-low
  11.537 +   
  11.538 +   ;; now A contains the pressed keys
  11.539 +   0x2F ; complement A, by request. [D34F]
  11.540 +   
  11.541 +   0x47 ; A->B ;; now B contains the pressed keys
  11.542 +   0x7B ; E->A ;; now A contains the count.
  11.543 +
  11.544 +   0xCB ; test bit 5 of D (are we in o/p mode?)
  11.545 +   0x6A
  11.546 +   0x28 ; if test == 0, skip this o/p section
  11.547 +   0x13 ; JUMP
  11.548 +   
  11.549 +   0xCB ; else, test bit 0 of D (fragile; are we in pc mode?)
  11.550 +   0x42
  11.551 +   0x28 ; if test == 0, skip the following command
  11.552 +   0x01
  11.553 +
  11.554 +   ;; output mode I: moving the program counter
  11.555 +   0xE9 ; ** move PC to (HL)
  11.556 +
  11.557 +   ;; output mode II: writing bytes
  11.558 +   0xFE ; A compare 0. finished writing?
  11.559 +   0x00
  11.560 +   0x20 ; if we are not finished, skip cleanup
  11.561 +   0x04 ; JUMP
  11.562 +
  11.563 +   ;; CLEANUP
  11.564 +   ;; btw, A is already zero.
  11.565 +   0xAF ; zero A  [D35F]
  11.566 +   0x57 ; A->D; makes D=0.
  11.567 +   0x18 ; end of frame
  11.568 +   0xBC
  11.569 +   
  11.570 +   ;; ---- end of cleanup
  11.571 +
  11.572 +   
  11.573 +   ;; continue writing bytes
  11.574 +   0x1D ;; decrement E, the number of bytes to write [D363]
  11.575 +   0x78 ;; B->A; now A contains the pressed keys
  11.576 +   0x77 ;; copy A to (HL)
  11.577 +   0x23 ;; increment HL
  11.578 +   0x18 ;; end frame. [goto D31F]
  11.579 +   0xB6 ;; TODO: set skip length backwards
  11.580 +
  11.581 +
  11.582 +   ;; ---- end of o/p section
  11.583 +   
  11.584 +   ;; i/p mode
  11.585 +   ;; adhere to the mode discipline:
  11.586 +   ;; D must be one of 0x00 0x08 0x10 0x18.
  11.587 +
  11.588 +   0x3E ;; load the constant 57 into A. [D369]
  11.589 +   0x57
  11.590 +   0x82 ;; add the mode to A
  11.591 +   0xEA ;; store A into "thing to execute"
  11.592 +   0x74
  11.593 +   0xD3
  11.594 +
  11.595 +   0x3E ;; load the constant 8 into A
  11.596 +   0x08
  11.597 +   0x82 ;; add the mode to A
  11.598 +   
  11.599 +   0x57 ;; store the incremented mode into D
  11.600 +   0x78 ;; B->A; now A contains the pressed keys
  11.601 +   
  11.602 +   0x00 ;; var: thing to execute [D374]
  11.603 +
  11.604 +   0x18 ;; end frame
  11.605 +   0xA8
  11.606 +   ]
  11.607 +  )
  11.608 +
  11.609 +(defn write-mem-dyl []
  11.610 +  (-> (tick (mid-game))
  11.611 +      (IE! 0)
  11.612 +      (inject-item-assembly (write-memory-assembly*))))
  11.613 +
  11.614 +
  11.615 +(defn dylan* []
  11.616 +  (->
  11.617 +   (write-mem-dyl)
  11.618 +
  11.619 +   (tick)
  11.620 +   (tick)
  11.621 +   (tick)
  11.622 +   (tick)
  11.623 +   (tick)
  11.624 +   (tick)
  11.625 +   (tick)
  11.626 +   (tick)
  11.627 +   (tick)
  11.628 +   (tick)
  11.629 +   (tick)
  11.630 +   (tick)
  11.631 +   (tick)
  11.632 +   (tick)
  11.633 +   (tick)
  11.634 +   (tick)
  11.635 +   (tick)
  11.636 +   (tick)
  11.637 +   (tick)
  11.638 +   (tick)
  11.639 +   (tick)
  11.640 +   (tick)
  11.641 +   (tick)
  11.642 +   (tick)
  11.643 +   (tick)
  11.644 +   (tick)
  11.645 +   (tick)
  11.646 +   (tick)
  11.647 +   (tick)
  11.648 +   (tick)
  11.649 +   (tick)
  11.650 +   (tick)
  11.651 +   (tick)
  11.652 +   (tick)
  11.653 +   (tick)
  11.654 +   (tick)
  11.655 +
  11.656 +   ;;(view-memory 0xD374)
  11.657 +   (tick)
  11.658 +   (tick)
  11.659 +   (tick)
  11.660 +   (tick)
  11.661 +   (tick)
  11.662 +   (tick)
  11.663 +   (tick)
  11.664 +   (tick)
  11.665 +   (tick)
  11.666 +   (tick)
  11.667 +   (tick)
  11.668 +   (tick)
  11.669 +   (tick)
  11.670 +   (tick)
  11.671 +   (tick)
  11.672 +   ;;(view-memory 0xD374)
  11.673 +   (d-tick)
  11.674 +
  11.675 +   (view-register "A" A)
  11.676 +   (view-register "B" B)
  11.677 +   (view-register "C" C))
  11.678 +
  11.679 +)
  11.680 +
  11.681 +
  11.682 +(defn dylan []
  11.683 +  (->
  11.684 +   (write-mem-dyl)
  11.685 +   (tick)
  11.686 +   (tick)
  11.687 +   (tick)
  11.688 +   (tick)
  11.689 +   (tick)
  11.690 +   (tick)
  11.691 +   (tick)
  11.692 +   (tick)
  11.693 +   (tick)
  11.694 +   (tick)
  11.695 +   (tick)
  11.696 +   (tick)
  11.697 +   (tick)
  11.698 +   (tick)
  11.699 +   (tick) ;; first loop
  11.700 +
  11.701 +
  11.702 +   (tick)
  11.703 +   (tick)
  11.704 +   (tick)
  11.705 +   (tick)
  11.706 +   (tick)
  11.707 +   (tick)
  11.708 +   (tick)
  11.709 +   (tick)
  11.710 +   (tick)
  11.711 +   (tick)
  11.712 +   (tick)
  11.713 +   (tick)
  11.714 +   (tick) ;; dpad bits
  11.715 +
  11.716 +   (tick)
  11.717 +   (tick)
  11.718 +   (tick)
  11.719 +   (tick)
  11.720 +   (tick)
  11.721 +   (tick)
  11.722 +   (tick)
  11.723 +   (tick)
  11.724 +   (d-tick)
  11.725 +   
  11.726 +
  11.727 +   
  11.728 +   (view-register "A" A)
  11.729 +   (view-register "B" B)
  11.730 +   (view-register "C" C)
  11.731 +   
  11.732 +   ))
  11.733 +
  11.734 +
  11.735 +
  11.736 +
  11.737 +(defn d2 []
  11.738 +  (->
  11.739 +   (write-mem-dyl)
  11.740 +   (view-memory 0xD31F)
  11.741 +   step step step step step
  11.742 +   (view-memory 0xD31F)))
  11.743 +
  11.744 +
  11.745 +
  11.746 +
  11.747 +
  11.748 +
  11.749 +
  11.750 +
  11.751 +
  11.752 +
  11.753 +
  11.754 +
  11.755 +
  11.756 +
  11.757 +
  11.758 +
  11.759 +
  11.760 +
  11.761 +
  11.762 +
  11.763 +(defn write-memory-assembly []
  11.764 +  [
  11.765 +   ;; Main Timing Loop
  11.766 +   ;;   Constantly check for v-blank and Trigger main state machine on
  11.767 +   ;;   every transtion from v-blank to non-v-blank.
  11.768 +    
  11.769 +   0x18   ; D31D                  ; Variable declaration
  11.770 +   0x02   ; D31E                   
  11.771 +   0x00   ; D31F                  ; frame-count
  11.772 +   0x00   ; D320                  ; v-blank-prev 
  11.773 +   
  11.774 +   0xF0   ; D321                  ; load v-blank mode flags into A
  11.775 +   0x41
  11.776 +   0x00
  11.777 +
  11.778 +
  11.779 +   ;; Branch dependent on v-blank.  v-blank happens when the last two
  11.780 +   ;; bits in A are "01"
  11.781 +   0xCB   ; D324                  
  11.782 +   0x4F   ; D325                  
  11.783 +
  11.784 +   0xC2   ; D326                  ; if bit-1 is not 0, then
  11.785 +   0x3E   ; D327                  ; GOTO non-v-blank.
  11.786 +   0xD3   ; D328                  
  11.787 +
  11.788 +   0xCB   ; D329                  
  11.789 +   0x47   ; D32A                  
  11.790 +
  11.791 +   0xCA   ; D32B                  ; if bit-0 is not 1, then
  11.792 +   0x3E   ; D32C                  ; GOTO non-v-blank.
  11.793 +   0xD3   ; D32D                  
  11.794 +
  11.795 +   ;; V-Blank
  11.796 +   ;;   Activate state-machine if this is a transition event.
  11.797 +
  11.798 +   0xFA   ; D32E                  ; load v-bank-prev into A
  11.799 +   0x20   ; D32F                  
  11.800 +   0xD3   ; D330                  
  11.801 +
  11.802 +   0xFE   ; D331                  ; compare A to 0. >--------\ 
  11.803 +   0x00   ; D332                                              \
  11.804 +                                  ;                           |
  11.805 +   ;;   set v-blank-prev to 1.                                |
  11.806 +   0x3E   ; D333                  ; load 1 into A.            |
  11.807 +   0x01   ; D334                                              | 
  11.808 +                                  ;                           |
  11.809 +   0xEA   ; D335                  ; load A into v-blank-prev  |
  11.810 +   0x20   ; D336                                              |
  11.811 +   0xD3   ; D337                                              |
  11.812 +                                  ;                           /
  11.813 +   ;;   if v-blank-prev was 0, activate state-machine <------/
  11.814 +   0xCA   ; D338                  ; if v-blank-prev 
  11.815 +   0x46   ; D339                  ;   was 0, 
  11.816 +   0xD3   ; D33A                  ; GOTO state-machine
  11.817 +
  11.818 +   0xC3   ; D33B                  
  11.819 +   0x1D   ; D33C                  
  11.820 +   0xD3   ; D33D                  ; GOTO beginning
  11.821 +   ;; END V-blank
  11.822 +
  11.823 +   ;; Non-V-Blank
  11.824 +   ;;   Set v-blank-prev to 0
  11.825 +   0x3E   ; D33E                  ; load 0 into A
  11.826 +   0x00   ; D33F                  
  11.827 +
  11.828 +   0xEA   ; D340                  ; load A into v-blank-prev
  11.829 +   0x20   ; D341                  
  11.830 +   0xD3   ; D342
  11.831 +   
  11.832 +   0xC3   ; D343                  
  11.833 +   0x1D   ; D344                  
  11.834 +   0xD3   ; D345                  ; GOTO beginning
  11.835 +   ;; END Not-V-Blank
  11.836 +
  11.837 +   
  11.838 +   ;; Main State Machine -- Input Section
  11.839 +   ;;   This is called once every frame.
  11.840 +   ;;   It collects input and uses it to drive the
  11.841 +   ;;   state transitions.
  11.842 +
  11.843 +   ;; Increment frame-count
  11.844 +   0xFA   ; D346                  ; load frame-count into A
  11.845 +   0x1F   ; D347                  
  11.846 +   0xD3   ; D348
  11.847 +   
  11.848 +   0x3C   ; D349                  ; inc A
  11.849 +
  11.850 +   0xEA   ; D34A                  
  11.851 +   0x1F   ; D34B                  ; load A into frame-count
  11.852 +   0xD3   ; D34C
  11.853 +
  11.854 +   0x00   ; D34D                  ; glue :)
  11.855 +   
  11.856 +   0x18   ;D34E                    ;  skip next 3 bytes
  11.857 +   0x03   ;D34F
  11.858 +          ;D350
  11.859 +   (Integer/parseInt "00100000" 2) ;  select directional pad
  11.860 +          ;D351
  11.861 +   (Integer/parseInt "00010000" 2) ;  select buttons
  11.862 +   0x00   ;D352                    ;  input-number
  11.863 +
  11.864 +   ;; select directional pad; store low bits in B
  11.865 +   
  11.866 +   0xFA   ;D353                    ; load (D350) into A
  11.867 +   0x50   ;D354      -->       
  11.868 +   0xD3   ;D355      -->  D350     
  11.869 +   
  11.870 +   0xE0   ;D356                    ; load (A), which is 
  11.871 +   0x00   ;D357      -->           ; 00010000, into FF00
  11.872 +   0x00   ;D358      -->  FF00     ;; NO-OP
  11.873 +
  11.874 +   0x06   ;D359
  11.875 +          ;D35A
  11.876 +   (Integer/parseInt "11110000" 2) ; "11110000" -> B 
  11.877 +   0xF0   ;D35B                    ; (FF00) -> A
  11.878 +   0x00   ;D35C                   
  11.879 +   0x00   ;D35D                    ;; NO-OP
  11.880 +
  11.881 +   0xCB   ;D35E                    ; swap nybbles on A
  11.882 +   0x37   ;D35F
  11.883 +   0xA0   ;D360                    ; (AND A B) -> A
  11.884 +   0x47   ;D361                    ; A -> B
  11.885 +
  11.886 +   ;; select buttons; store bottom bits in C
  11.887 +   
  11.888 +   0xFA   ;D362                    ; load (D351) into A
  11.889 +   0x51   ;D363      -->       
  11.890 +   0xD3   ;D364      -->  D351     
  11.891 +   
  11.892 +   0xE0   ;D365                    ; load (A), which is 
  11.893 +   0x00   ;D366      -->           ; 00001000, into FF00
  11.894 +   0x00   ;D367      -->  FF00     ;; NO-OP
  11.895 +
  11.896 +   0x0E   ;D368
  11.897 +          ;D369
  11.898 +   (Integer/parseInt "00001111" 2) ; "00001111" -> C 
  11.899 +
  11.900 +   0xF0   ;D36A                    ; (FF00) -> A
  11.901 +   0x00   ;D36B                   
  11.902 +   0x00   ;D36C
  11.903 +   
  11.904 +   0xA1   ;D36D                    ; (AND A C) -> A
  11.905 +   0x4F   ;D36E                    ; A -> C
  11.906 +
  11.907 +   ;; combine the B and C registers into the input number
  11.908 +   0x79   ;D36F                    ; C -> A
  11.909 +   0xB0   ;D370                    ; (OR A B) -> A
  11.910 +   0x2F   ;D371                    ; negate A
  11.911 +
  11.912 +   0xEA   ;D372                    ; store A into input-number
  11.913 +   0x52   ;D373
  11.914 +   0xD3   ;D374
  11.915 +
  11.916 +   0x00   ;D375                  
  11.917 +   0x00   ;D376
  11.918 +   0x00   ;D377
  11.919 +   0x00   ;D378
  11.920 +   0x00   ;D379
  11.921 +   0x00   ;D37A
  11.922 +   0x00   ;D37B                   ; these are here because 
  11.923 +   0x00   ;D37C                   ; I messed up :(
  11.924 +   0x00   ;D37D
  11.925 +   0x00   ;D37E
  11.926 +   0x00   ;D37F
  11.927 +   
  11.928 +   ;; beginning of main state machine   
  11.929 +   0x18   ;D380                    ; Declaration of variables
  11.930 +   0x05   ;D381                    ;  5 variables:
  11.931 +   0x00   ;D382                    ;    current-mode
  11.932 +   0x00   ;D383                    ;    bytes-to-write
  11.933 +   0x00   ;D384                    ;    bytes-written
  11.934 +   0x00   ;D385                    ;    start-point-high
  11.935 +   0x00   ;D386                    ;    start-point-low
  11.936 +
  11.937 +
  11.938 +   ;; banch on current mode
  11.939 +   0xFA   ;D387                    ; load current-mode (0xD382)
  11.940 +   0x82   ;D388                    ; into A
  11.941 +   0xD3   ;D389
  11.942 +   0x00   ;D38A
  11.943 +
  11.944 +
  11.945 +   ;;  GOTO Mode 0 (input-mode) if current-mode is 0
  11.946 +   0xFE   ;D38B
  11.947 +   0x00   ;D38C                    ; compare A with 0x00
  11.948 +
  11.949 +   0xCA   ;D38D                    ; goto Mode 0 if A == 0
  11.950 +   0xA8   ;D38E
  11.951 +   0xD3   ;D38F
  11.952 +
  11.953 +   ;; GOTO Mode 1 (set-length) if current-mode is 1
  11.954 +   0xFE   ;D390
  11.955 +   0x01   ;D391                    ; compare A with 0x01
  11.956 +
  11.957 +   0xCA   ;D392                  
  11.958 +   0xB1   ;D393 
  11.959 +   0xD3   ;D394                    ; goto Mode 1 if A == 1
  11.960 +
  11.961 +   ;; GOTO Mode 2 (set-start-point-high) if current mode is 2
  11.962 +   0xFE   ;D395                    
  11.963 +   0x02   ;D396                    ; compare A with 0x02
  11.964 +
  11.965 +   0xCA   ;D397
  11.966 +   0xBF   ;D398
  11.967 +   0xD3   ;D399                    ; goto Mode 2 if A == 2
  11.968 +
  11.969 +   ;; GOTO Mode 3 (set-start-point-low) if current mode is 3
  11.970 +   0xFE   ;D39A
  11.971 +   0x03   ;D39B
  11.972 +
  11.973 +   0xCA   ;D39C
  11.974 +   0xCD   ;D39D
  11.975 +   0xD3   ;D39E                    ; goto Mode 3 if A == 3
  11.976 +
  11.977 +   ;; GOTO Mode 4 (write-memory) if current mode is 4
  11.978 +   0xFE   ;D39F
  11.979 +   0x04   ;D3A0
  11.980 +
  11.981 +   0xCA   ;D3A1
  11.982 +   0xDB   ;D3A2
  11.983 +   0xD3   ;D3A3
  11.984 +
  11.985 +   0x00   ;D3A4
  11.986 +   ;; End of Mode checking, goto beginning
  11.987 +   0xC3   ;D3A5
  11.988 +   0x1D   ;D3A6
  11.989 +   0xD3   ;D3A7
  11.990 +
  11.991 +
  11.992 +   ;; Mode 0 -- input-mode mode
  11.993 +   ;;     means that we are waiting for a mode, so set the mode to
  11.994 +   ;;     whatever is currently in input-number.  If nothing is
  11.995 +   ;;     entered, then the program stays in input-mode mode
  11.996 +
  11.997 +   ;;   set current-mode to input-number
  11.998 +   0xFA   ;D3A8                    ; load input-number (0xD352) 
  11.999 +   0x52   ;D3A9                    ; into A
 11.1000 +   0xD3   ;D3AA
 11.1001 +
 11.1002 +   0xEA   ;D3AB                    ; load A into current-mode
 11.1003 +   0x82   ;D3AC                    ; (0xD382)
 11.1004 +   0xD3   ;D3AD
 11.1005 +
 11.1006 +   0xC3   ;D3AE                    ; go back to beginning
 11.1007 +   0x1D   ;D3AF
 11.1008 +   0xD3   ;D3B0
 11.1009 +   ;; End Mode 0
 11.1010 +
 11.1011 +
 11.1012 +   ;; Mode 1 -- set-length mode
 11.1013 +   ;;      This is the header for writing things to memory.
 11.1014 +   ;;      User specifies the number of bytes to write.
 11.1015 +   ;;      Mode is auto advanced to Mode 2 after this mode
 11.1016 +   ;;      completes.
 11.1017 +
 11.1018 +   ;;      Set bytes left to write to input-number;
 11.1019 +   ;;      set current-mode to 0x02.
 11.1020 +   0xFA   ;D3B1                   ; load input-number (0xD352)
 11.1021 +   0x52   ;D3B2                   ; into A
 11.1022 +   0xD3   ;D3B3
 11.1023 +   
 11.1024 +   0xEA   ;D3B4                   ; load A into bytes-left-to-write
 11.1025 +   0x83   ;D3B5                   ; (0xD383)
 11.1026 +   0xD3   ;D3B6
 11.1027 +
 11.1028 +   0x3E   ;D3B7                   ; load 0x02 into A.
 11.1029 +   0x02   ;D3B8
 11.1030 +   
 11.1031 +   0xEA   ;D3B9                   ; load A to current-mode
 11.1032 +   0x82   ;D3BA                   ; advancing from Mode 1 to 
 11.1033 +   0xD3   ;D3BB                   ; Mode 2
 11.1034 +   
 11.1035 +   0xC3   ;D3BC                   ; go back to beginning
 11.1036 +   0x1D   ;D3BD
 11.1037 +   0xD3   ;D3BE
 11.1038 +   ;; End Mode 1
 11.1039 +
 11.1040 +
 11.1041 +   ;; Mode 2 -- set start-point-high mode
 11.1042 +   ;;      Middle part of the header for writing things to memory.
 11.1043 +   ;;      User specifies the start location in RAM to which 
 11.1044 +   ;;      data will be written.
 11.1045 +   ;;      Mode is auto advanced to Mode 3 after this mode completes.
 11.1046 +
 11.1047 +   ;;      Set start-point-high to input-number;
 11.1048 +   ;;      set current mode to 0x03.
 11.1049 +   0xFA   ;D3BF                   ; load input-number (0xD352)
 11.1050 +   0x52   ;D3C0                   ; into A
 11.1051 +   0xD3   ;D3C1
 11.1052 +
 11.1053 +   0xEA   ;D3C2                   ; load A into start-point-high
 11.1054 +   0x85   ;D3C3                   ; (0xD385)
 11.1055 +   0xD3   ;D3C4
 11.1056 +
 11.1057 +   0x3E   ;D3C5                   ; load 0x03 into A.
 11.1058 +   0x03   ;D3C6
 11.1059 +
 11.1060 +   0xEA   ;D3C7                   ; load A to current-mode,
 11.1061 +   0x82   ;D3C8                   ; advancing from Mode 2 to 
 11.1062 +   0xD3   ;D3C9                   ; Mode 3.
 11.1063 +   
 11.1064 +   0xC3   ;D3CA                   ; go back to beginning
 11.1065 +   0x1D   ;D3CB
 11.1066 +   0xD3   ;D3CC
 11.1067 +   ;;End Mode 2
 11.1068 +
 11.1069 +
 11.1070 +   ;; Mode 3 -- set-start-point-low mode
 11.1071 +   ;;      Final part of header for writing things to memory.
 11.1072 +   ;;      User specifies the low bytes of 16 bit start-point.
 11.1073 +
 11.1074 +   ;;      Set start-point-low to input-number;
 11.1075 +   ;;      set current mode to 0x04
 11.1076 +   0xFA   ;D3CD                   ; load input-number into A
 11.1077 +   0x52   ;D3CE                   
 11.1078 +   0xD3   ;D3CF                   
 11.1079 +
 11.1080 +   0xEA   ;D3D0                   ; load A into start-point-low
 11.1081 +   0x86   ;D3D1                   
 11.1082 +   0xD3   ;D3D2                   
 11.1083 +
 11.1084 +   0x3E   ;D3D3                   ; load 0x04 into A.
 11.1085 +   0x04   ;D3D4                   
 11.1086 +
 11.1087 +   0xEA   ;D3D5                   ; load A to current-mode,
 11.1088 +   0x82   ;D3D6                   ; advancing from Mode 3 to 
 11.1089 +   0xD3   ;D3D7                   ; Mode 4.
 11.1090 +
 11.1091 +   0xC3   ;D3D8                   ; go back to beginning
 11.1092 +   0x1D   ;D3D9                   
 11.1093 +   0xD3   ;D3DA                   
 11.1094 +   
 11.1095 +   ;; Mode 4 -- write bytes mode
 11.1096 +
 11.1097 +   ;;      This is where RAM manipulation happens.  User supplies
 11.1098 +   ;;      bytes every frame, which are written sequentially to
 11.1099 +   ;;      start-point until bytes-to-write have been written. Once
 11.1100 +   ;;      bytes-to-write have been written, the mode is reset to 0.
 11.1101 +
 11.1102 +   ;;   compare bytes-written with bytes-to-write.
 11.1103 +   ;;   if they are the same, then reset mode to 0
 11.1104 +  
 11.1105 +   0xFA   ;D3DB                   ; load bytes-to-write into A
 11.1106 +   0x83   ;D3DC
 11.1107 +   0xD3   ;D3DD
 11.1108 +
 11.1109 +   0x47   ;D3DE                   ; load A into B
 11.1110 +
 11.1111 +   0xFA   ;D3DF                   ; load bytes-written into A
 11.1112 +   0x84   ;D3E0
 11.1113 +   0xD3   ;D3E1
 11.1114 +
 11.1115 +   0xB8   ;D3E2                   ; compare A with B
 11.1116 +
 11.1117 +   0xCA   ;D3E3                   ; if they are equal, go to cleanup
 11.1118 +   0x07   ;D3E4                   
 11.1119 +   0xD4   ;D3E5                   
 11.1120 +
 11.1121 +   ;;  Write Memory Section
 11.1122 +   ;;    Write the input-number, interpreted as an 8-bit number,
 11.1123 +   ;;    into the current target register, determined by
 11.1124 +   ;;    (+ start-point bytes-written).
 11.1125 +   ;;    Then, increment bytes-written by 1.
 11.1126 +   
 11.1127 +   0xFA   ;D3E6                   ; load start-point-high into A
 11.1128 +   0x85   ;D3E7                   
 11.1129 +   0xD3   ;D3E8                   
 11.1130 +
 11.1131 +   0x67   ;D3E9                   ; load A into H
 11.1132 +
 11.1133 +   0xFA   ;D3EA                   ; load start-point-low into A
 11.1134 +   0x86   ;D3EB                   
 11.1135 +   0xD3   ;D3EC
 11.1136 +   
 11.1137 +   0x6F   ;D3ED                   ; load A into L
 11.1138 +   
 11.1139 +   0xFA   ;D3EE                   ; load bytes-written into A
 11.1140 +   0x84   ;D3EF                   
 11.1141 +   0xD3   ;D3F0                   
 11.1142 +   
 11.1143 +   0x00   ;D3F1                   ; These are here because
 11.1144 +   0x00   ;D3F2                   ; I screwed up again.
 11.1145 +   0x00   ;D3F3                   
 11.1146 +
 11.1147 +   0x85   ;D3F4                   ; add L to A; store A in L.
 11.1148 +   0x6F   ;D3F5                   
 11.1149 +
 11.1150 +   0x30   ;D3F6                   ; If the addition overflowed,
 11.1151 +   0x01   ;D3F7                   
 11.1152 +   0x24   ;D3F8                   ; increment H.
 11.1153 +
 11.1154 +   ;;   Now, HL points to the correct place in memory
 11.1155 +   
 11.1156 +   0xFA   ;D3F9                   ; load input-number into A
 11.1157 +   0x52   ;D3FA                   
 11.1158 +   0xD3   ;D3FB                   
 11.1159 +
 11.1160 +   0x77   ;D3FC                   ; load A into (HL)
 11.1161 +
 11.1162 +   0xFA   ;D3FD                   ; load bytes-written into A
 11.1163 +   0x84   ;D3FE                   
 11.1164 +   0xD3   ;D3FF                   
 11.1165 +
 11.1166 +   0x3C   ;D400                   ; increment A
 11.1167 +
 11.1168 +   0xEA   ;D401                   ; load A into bytes-written
 11.1169 +   0x84   ;D402                   
 11.1170 +   0xD3   ;D403
 11.1171 +
 11.1172 +   0xC3   ;D404                   ; go back to beginning.
 11.1173 +   0x1D   ;D405
 11.1174 +   0xD3   ;D406
 11.1175 +   ;;  End Write Memory Section
 11.1176 +
 11.1177 +   ;;  Mode 4 Cleanup Section
 11.1178 +   ;;    reset bytes-written to 0
 11.1179 +   ;;    set mode to 0
 11.1180 +   0x3E   ;D407                   ; load 0 into A
 11.1181 +   0x00   ;D408                  
 11.1182 +
 11.1183 +   0xEA   ;D409                   ; load A into bytes-written
 11.1184 +   0x84   ;D40A                   
 11.1185 +   0xD3   ;D40B                   
 11.1186 +
 11.1187 +   0xEA   ;D40C                   ; load A into current-mode
 11.1188 +   0x82   ;D40D                   
 11.1189 +   0xD3   ;D40E                   
 11.1190 +
 11.1191 +   0xC3   ;D40F                    ; go back to beginning
 11.1192 +   0x1D   ;D410
 11.1193 +   0xD3   ;D411
 11.1194 +
 11.1195 +   ;; End Mode 4
 11.1196 +   
 11.1197 +   ])
 11.1198 +
 11.1199 +
 11.1200 +
 11.1201 +(def frame-count 0xD31F)
 11.1202 +(def input 0xD352)
 11.1203 +(def current-mode      0xD382)
 11.1204 +(def bytes-to-write    0xD383)
 11.1205 +(def bytes-written     0xD384)
 11.1206 +(def start-point-high  0xD385)
 11.1207 +(def start-point-low   0xD386)
 11.1208 +
 11.1209 +
 11.1210 +
 11.1211 +(defn write-memory []
 11.1212 +  (-> (tick (mid-game))
 11.1213 +      (IE! 0) ; disable interrupts
 11.1214 +      (inject-item-assembly (write-memory-assembly))))
 11.1215 +
 11.1216 +(defn test-write-memory []
 11.1217 +  (set-state! (write-memory))
 11.1218 +  (dorun
 11.1219 +   (dotimes [_ 5000]
 11.1220 +     (view-memory (step @current-state) current-mode))))
 11.1221 +
 11.1222 +(def bytes-to-write 0xD383)
 11.1223 +(def start-point 0xD384)
 11.1224 +
 11.1225 +(defn print-blank-assembly
 11.1226 +  [start end]
 11.1227 +  (dorun
 11.1228 +   (map
 11.1229 +    #(println (format "0x00   ;%04X                   " %))
 11.1230 +    (range start end))))
 11.1231 +
 11.1232 +(defn test-mode-2 []
 11.1233 +  (->
 11.1234 +   (write-memory)
 11.1235 +   (view-memory frame-count)
 11.1236 +   (step)
 11.1237 +   (step [:a])
 11.1238 +   (step [:b])
 11.1239 +   (step [:start])
 11.1240 +   (step [])
 11.1241 +   (view-memory frame-count)))
 11.1242 +
 11.1243 +
 11.1244 +
 11.1245 +(defn dylan-test-mode
 11.1246 +  ([] (dylan-test-mode (write-mem-dyl)))
 11.1247 +  ([target-state]
 11.1248 +     (let [
 11.1249 +           v-blank-prev 54046
 11.1250 +           btn-register 65280
 11.1251 +           eggs 0xD374
 11.1252 +           ]
 11.1253 +       
 11.1254 +       (->
 11.1255 +        target-state
 11.1256 +        
 11.1257 +        (tick)
 11.1258 +        (tick)
 11.1259 +        (tick)
 11.1260 +        (tick);; jumps back to beginning
 11.1261 +        
 11.1262 +        (tick)
 11.1263 +        (tick)
 11.1264 +        (tick)
 11.1265 +        (tick)
 11.1266 +        (tick)
 11.1267 +        (tick)
 11.1268 +        (tick)
 11.1269 +        (tick)
 11.1270 +        (tick)
 11.1271 +        (tick)
 11.1272 +        (tick)
 11.1273 +        (tick)
 11.1274 +
 11.1275 +               
 11.1276 +        (tick)
 11.1277 +        (tick)
 11.1278 +        (tick)
 11.1279 +        (tick)
 11.1280 +        (tick)
 11.1281 +        (tick)
 11.1282 +        (tick)
 11.1283 +        (tick)
 11.1284 +        (tick)
 11.1285 +        (tick)
 11.1286 +        (tick)
 11.1287 +        (tick)
 11.1288 +        (tick)
 11.1289 +        (tick)
 11.1290 +        (tick)
 11.1291 +        (tick)
 11.1292 +        (tick)
 11.1293 +        (tick)
 11.1294 +        (tick)
 11.1295 +        (tick)
 11.1296 +        (tick) ;; just complemented A
 11.1297 +
 11.1298 +        (tick)
 11.1299 +        (DE! 0x1800)
 11.1300 +        (AF! 0x7700) ;; change inputs @ A
 11.1301 +        (tick)
 11.1302 +        (tick)
 11.1303 +        (tick)
 11.1304 +        (tick)
 11.1305 +        (tick)
 11.1306 +
 11.1307 +        ;;(view-memory eggs)
 11.1308 +        (tick)
 11.1309 +        (tick)
 11.1310 +        ;;(view-memory eggs)
 11.1311 +        (tick)
 11.1312 +        (tick)
 11.1313 +        (tick)
 11.1314 +        (tick)
 11.1315 +        (tick)
 11.1316 +        (tick)
 11.1317 +        (d-tick)
 11.1318 +
 11.1319 +        
 11.1320 +        ;;(view-memory btn-register) 
 11.1321 +        (view-register "A" A)
 11.1322 +        (view-register "B" B)
 11.1323 +        
 11.1324 +        ;;(view-register "C" C)
 11.1325 +        (view-register "D" D)
 11.1326 +        (view-register "E" E)
 11.1327 +        (view-register "H" H)
 11.1328 +        (view-register "L" L)
 11.1329 +        ))))
 11.1330 +  
 11.1331 +
 11.1332 +
 11.1333 +(defn drive-dylan []
 11.1334 +  (-> (write-mem-dyl)
 11.1335 +      (#(do (println "memory from 0xC00F to 0xC01F:"
 11.1336 +                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
 11.1337 +      (step [])
 11.1338 +      (step [])
 11.1339 +      (step [])
 11.1340 +      (step [:start])
 11.1341 +      (step [:select])
 11.1342 +      (step [:u :d])
 11.1343 +      (step [:a :b :start :select])
 11.1344 +      (step [:a])
 11.1345 +      (step [:b])
 11.1346 +      (step [:a :b])
 11.1347 +      (step [:select])
 11.1348 +      (step [])
 11.1349 +      (step [])
 11.1350 +      (step [])
 11.1351 +      (#(do (println "memory from 0xC00F to 0xC01F:"
 11.1352 +                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
 11.1353 +      ))
 11.1354 +
 11.1355 +(defn test-mode-4
 11.1356 +  ([] (test-mode-4 (write-memory)))
 11.1357 +  ([target-state]
 11.1358 +     (->
 11.1359 +      target-state
 11.1360 +      (#(do (println "memory from 0xC00F to 0xC01F:"
 11.1361 +                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %))
 11.1362 +      (view-memory current-mode)
 11.1363 +      (step [])
 11.1364 +      (step [])
 11.1365 +      (step [])
 11.1366 +      (#(do (println "after three steps") %))
 11.1367 +      (view-memory current-mode)
 11.1368 +
 11.1369 +      ;; Activate memory writing mode
 11.1370 +      
 11.1371 +      (#(do (println "step with [:a]") %))
 11.1372 +      (step [:a])
 11.1373 +      (view-memory current-mode)
 11.1374 +      (view-memory bytes-to-write)
 11.1375 +      (view-memory start-point-high)
 11.1376 +      (view-memory start-point-low)
 11.1377 +
 11.1378 +      ;; Specify four bytes to be written
 11.1379 +      
 11.1380 +      (#(do (println "step with [:select]")%))
 11.1381 +      (step [:select])
 11.1382 +      (view-memory current-mode)
 11.1383 +      (view-memory bytes-to-write)
 11.1384 +      (view-memory start-point-high)
 11.1385 +      (view-memory start-point-low)
 11.1386 +
 11.1387 +      ;; Specify target memory address as 0xC00F
 11.1388 +      
 11.1389 +      (#(do (println "step with [:u :d]")%))
 11.1390 +      (step [:u :d])
 11.1391 +      (view-memory current-mode)
 11.1392 +      (view-memory bytes-to-write)
 11.1393 +      (view-memory start-point-high)
 11.1394 +      (view-memory start-point-low)
 11.1395 +
 11.1396 +      (#(do (println "step with [:a :b :start :select]")%))
 11.1397 +      (step [:a :b :start :select])
 11.1398 +      (view-memory current-mode)
 11.1399 +      (view-memory bytes-to-write)
 11.1400 +      (view-memory start-point-high)
 11.1401 +      (view-memory start-point-low)
 11.1402 +
 11.1403 +      ;; Start reprogramming memory
 11.1404 +
 11.1405 +      (#(do (println "step with [:a]")%))
 11.1406 +      (step [:a])
 11.1407 +      (view-memory current-mode)
 11.1408 +      (view-memory bytes-written)
 11.1409 +
 11.1410 +      (#(do (println "step with [:b]")%))
 11.1411 +      (step [:b])
 11.1412 +      (view-memory current-mode)
 11.1413 +      (view-memory bytes-written)
 11.1414 +
 11.1415 +      (#(do (println "step with [:a :b]")%))
 11.1416 +      (step [:a :b])
 11.1417 +      (view-memory current-mode)
 11.1418 +      (view-memory bytes-written)
 11.1419 +
 11.1420 +      (#(do (println "step with [:select]")%))
 11.1421 +      (step [:select])
 11.1422 +      (view-memory current-mode)
 11.1423 +      (view-memory bytes-written)
 11.1424 +
 11.1425 +      ;; Reprogramming done, program ready for more commands.
 11.1426 +
 11.1427 +      (#(do (println "step with []")%))
 11.1428 +      (step [])
 11.1429 +      (view-memory current-mode)
 11.1430 +      (view-memory bytes-written)
 11.1431 +      
 11.1432 +      (#(do (println "memory from 0xC00F to 0xC01F:"
 11.1433 +                     (subvec (vec (memory %)) 0xC00F 0xC01F)) %)))))
 11.1434 +
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/clojure/com/aurellem/gb/characters.clj	Mon Mar 19 21:23:46 2012 -0500
    12.3 @@ -0,0 +1,116 @@
    12.4 +(ns com.aurellem.gb.characters
    12.5 +  (:use (com.aurellem.gb gb-driver))
    12.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    12.7 +
    12.8 +(def character-code->character
    12.9 +  {
   12.10 +   0x00   "end-of-name-sentinel"
   12.11 +   0x60   "A-bold"
   12.12 +   0x61   "B-bold"
   12.13 +   0x62   "C-bold"
   12.14 +   0x63   "D-bold"
   12.15 +   0x64   "E-bold"
   12.16 +   0x65   "F-bold"
   12.17 +   0x66   "G-bold"
   12.18 +   0x67   "H-bold"
   12.19 +   0x68   "I-bold"
   12.20 +   0x69   "V-bold"
   12.21 +   0x6A   "S-bold"
   12.22 +   0x6B   "L-bold"
   12.23 +   0x6C   "M-bold"
   12.24 +   0x80   "A"
   12.25 +   0x81   "B"
   12.26 +   0x82   "C"
   12.27 +   0x83   "D"
   12.28 +   0x84   "E"
   12.29 +   0x85   "F"
   12.30 +   0x86   "G"
   12.31 +   0x87   "H"
   12.32 +   0x88   "I"
   12.33 +   0x89   "J"
   12.34 +   0x8A   "K"
   12.35 +   0x8B   "L"
   12.36 +   0x8C   "M"
   12.37 +   0x8D   "N"
   12.38 +   0x8E   "O"
   12.39 +   0x8F   "P"
   12.40 +   0x90   "Q"
   12.41 +   0x91   "R"
   12.42 +   0x92   "S"
   12.43 +   0x93   "T"
   12.44 +   0x94   "U"
   12.45 +   0x95   "V"
   12.46 +   0x96   "W"
   12.47 +   0x97   "X"
   12.48 +   0x98   "Y"
   12.49 +   0x99   "Z"
   12.50 +   0x9A   "("
   12.51 +   0x9B   ")"
   12.52 +   0x9C   ":"
   12.53 +   0x9D   ";"
   12.54 +   0xA0   "a"
   12.55 +   0xA1   "b"
   12.56 +   0xA2   "c"
   12.57 +   0xA3   "d"
   12.58 +   0xA4   "e"
   12.59 +   0xA5   "f"
   12.60 +   0xA6   "g"
   12.61 +   0xA7   "h"
   12.62 +   0xA8   "i"
   12.63 +   0xA9   "j"
   12.64 +   0xAA   "k"
   12.65 +   0xAB   "l"
   12.66 +   0xAC   "m"
   12.67 +   0xAD   "n"
   12.68 +   0xAE   "o"
   12.69 +   0xAF   "p"
   12.70 +   0xB0   "q"
   12.71 +   0xB1   "r"
   12.72 +   0xB2   "s"
   12.73 +   0xB3   "t"
   12.74 +   0xB4   "u"
   12.75 +   0xB5   "v"
   12.76 +   0xB6   "w"
   12.77 +   0xB7   "x"
   12.78 +   0xB8   "y"
   12.79 +   0xB9   "z"
   12.80 +   0xBA   "e-with-grave"
   12.81 +   0xE0   "'"
   12.82 +   0xE1   "PK"
   12.83 +   0xE2   "MN"
   12.84 +   0xE6   "?"
   12.85 +   0xE7   "!"
   12.86 +   0xE8   "."
   12.87 +   0xEF   "male-symbol"
   12.88 +   0xF0   "pokemon-money-symbol"
   12.89 +   0xF1   "."
   12.90 +   0xF2   "/"
   12.91 +   0xF3   ","
   12.92 +   0xF4   "female-symbol"
   12.93 +   0xF6   "0 "
   12.94 +   0xF7   "1"
   12.95 +   0xF8   "2"
   12.96 +   0xF9   "3"
   12.97 +   0xFA   "4"
   12.98 +   0xFB   "5"
   12.99 +   0xFC   "6"
  12.100 +   0xFD   "7"
  12.101 +   0xFE   "8"
  12.102 +   0xFF   "9"
  12.103 +   })
  12.104 +
  12.105 +(def character->character-code
  12.106 +  (zipmap (vals character-code->character)
  12.107 +          (keys character-code->character)))
  12.108 +
  12.109 +(defn str->character-codes [s]
  12.110 +  (map character->character-code (map str s)))
  12.111 +
  12.112 +(defn character-codes->str [codes]
  12.113 +  (apply str
  12.114 +         (map #(character-code->character
  12.115 +                %
  12.116 +                (format "[0x%02X]" %))
  12.117 +              codes)))
  12.118 +       
  12.119 +
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/clojure/com/aurellem/gb/gb_driver.clj	Mon Mar 19 21:23:46 2012 -0500
    13.3 @@ -0,0 +1,261 @@
    13.4 +(ns com.aurellem.gb.gb-driver
    13.5 +    (:import com.aurellem.gb.Gb)
    13.6 +    (:import java.io.File)
    13.7 +    (:import org.apache.commons.io.FileUtils)
    13.8 +    (:import (java.nio IntBuffer ByteOrder)))
    13.9 +
   13.10 +;; Savestates
   13.11 +(defrecord SaveState [data])
   13.12 +
   13.13 +(def user-home (File. (System/getProperty "user.home")))
   13.14 +
   13.15 +(def ^:dynamic *save-state-cache*
   13.16 +  (File. user-home "proj/vba-clojure/save-states/"))
   13.17 +
   13.18 +(def current-state (atom nil))
   13.19 +
   13.20 +(defn state-cache-file [name]
   13.21 +  (File. *save-state-cache* (str name ".sav")))
   13.22 +
   13.23 +(defn write-state!
   13.24 +  ([^SaveState name]
   13.25 +     (write-state! @current-state name))
   13.26 +  ([^SaveState save ^String name]
   13.27 +     (let [buffer (:data save)
   13.28 +           bytes (byte-array (.limit buffer))
   13.29 +           dest (state-cache-file name)]
   13.30 +       (.get buffer bytes)
   13.31 +       (FileUtils/writeByteArrayToFile dest bytes)
   13.32 +       (.rewind buffer)
   13.33 +       dest)))
   13.34 +
   13.35 +(defn read-state [name]
   13.36 +  (let [save (state-cache-file name)]
   13.37 +    (if (.exists save)
   13.38 +      (let [buffer (Gb/saveBuffer)
   13.39 +            bytes (FileUtils/readFileToByteArray save)]
   13.40 +        (.put buffer bytes)
   13.41 +        (.flip buffer)
   13.42 +        (SaveState. buffer)))))
   13.43 +;;;;;;;;;;;;;;;;
   13.44 +
   13.45 +;; Gameboy management
   13.46 +(Gb/loadVBA)
   13.47 +
   13.48 +(def yellow-rom-image
   13.49 +  (File. user-home "proj/pokemon-escape/roms/yellow.gbc"))
   13.50 +
   13.51 +(def yellow-save-file
   13.52 +  (File. user-home "proj/pokemon-escape/roms/yellow.sav"))
   13.53 +
   13.54 +(def on? (atom nil))
   13.55 +
   13.56 +(defn shutdown! [] (Gb/shutdown) (reset! on? false))
   13.57 +
   13.58 +(defn restart! []
   13.59 +  (shutdown!)
   13.60 +  (.delete yellow-save-file)
   13.61 +  (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
   13.62 +  (reset! on? true))
   13.63 +
   13.64 +;;; The first state!
   13.65 +(defn gen-root! []
   13.66 +  (restart!)
   13.67 +  (let [state (SaveState. (Gb/saveState))]
   13.68 +    (write-state! state "root" ) state))
   13.69 +
   13.70 +(defn root []
   13.71 +  (if (.exists (state-cache-file "root"))
   13.72 +    (read-state "root")
   13.73 +    (gen-root!)))
   13.74 +
   13.75 +;;;; Press Buttons
   13.76 +
   13.77 +(def button-code
   13.78 +  {;; main buttons
   13.79 +   :a         0x0001
   13.80 +   :b         0x0002
   13.81 +
   13.82 +   ;; directional pad
   13.83 +   :r         0x0010
   13.84 +   :l         0x0020
   13.85 +   :u         0x0040
   13.86 +   :d         0x0080
   13.87 +
   13.88 +   ;; meta buttons
   13.89 +   :select    0x0004
   13.90 +   :start     0x0008
   13.91 +
   13.92 +   ;; pseudo-buttons
   13.93 +   :restart   0x0800 ; hard reset 
   13.94 +   :listen -1        ; listen for user input
   13.95 +   })
   13.96 +
   13.97 +(defn button-mask [buttons]
   13.98 +  (reduce bit-or 0x0000 (map button-code buttons)))
   13.99 +
  13.100 +(defn set-state! [^SaveState state]
  13.101 +  (assert (:data state) "Not a valid state!")
  13.102 +  (if (not @on?) (restart!))
  13.103 +  (if (not= state @current-state)
  13.104 +    (do 
  13.105 +      (Gb/loadState (:data state))
  13.106 +      (reset! current-state state))))
  13.107 +
  13.108 +(defn update-state []
  13.109 +  (reset! current-state
  13.110 +          (SaveState. (Gb/saveState))))
  13.111 +
  13.112 +(defn step
  13.113 +  ([^SaveState state buttons]
  13.114 +     (set-state! state)
  13.115 +     (Gb/step (button-mask buttons))
  13.116 +     (reset! current-state 
  13.117 +             (SaveState. (Gb/saveState))))
  13.118 +  ([^SaveState state]
  13.119 +     (step state [:listen]))
  13.120 +  ([] (step (if @current-state @current-state (root)))))
  13.121 +
  13.122 +(defn tick
  13.123 +  ([] (tick @current-state))
  13.124 +  ([^SaveState state]
  13.125 +     (set-state! state)
  13.126 +     (Gb/tick)
  13.127 +     (update-state)))
  13.128 +
  13.129 +(defn play
  13.130 +  ([^SaveState state n]
  13.131 +     (try
  13.132 +       (set-state! state)
  13.133 +       (dorun (dotimes [_ n]
  13.134 +                (Thread/sleep 1)
  13.135 +                (Gb/step)))
  13.136 +       (finally
  13.137 +             (update-state))))
  13.138 +  ([n]
  13.139 +     (play @current-state n)))
  13.140 +
  13.141 +(defn continue!
  13.142 +  ([state]
  13.143 +     (play state Integer/MAX_VALUE))
  13.144 +  ([]
  13.145 +    (continue! @current-state)))
  13.146 +
  13.147 +(defn play-moves
  13.148 +  ([moves [prev state]]
  13.149 +     (set-state! state)
  13.150 +     (dorun (map (fn [move] (step @current-state move)) moves))
  13.151 +     [(concat prev moves) @current-state]))
  13.152 +  
  13.153 +;;;;;;;;;;;
  13.154 +
  13.155 +
  13.156 +;;;;;;;;;;;;;;; CPU data
  13.157 +
  13.158 +(defn cpu-data [size arr-fn]
  13.159 +  (let [store (int-array size)]
  13.160 +    (fn get-data
  13.161 +      ([] (get-data @current-state))
  13.162 +      ([state]
  13.163 +         (set-state! state) (arr-fn store) store))))
  13.164 +
  13.165 +(defn write-cpu-data [size store-fn]
  13.166 +  (fn store-data
  13.167 +    ([state new-data]
  13.168 +       (set-state! state)
  13.169 +       (let [store (int-array new-data)]
  13.170 +         (assert (= size (count new-data)))
  13.171 +         (store-fn store)
  13.172 +         (update-state)))
  13.173 +    ([new-data]
  13.174 +       (store-data @current-state new-data))))
  13.175 +    
  13.176 +
  13.177 +(def memory
  13.178 +  (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
  13.179 +
  13.180 +(def ram
  13.181 +  (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))
  13.182 +
  13.183 +(def rom 
  13.184 +  (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))
  13.185 +
  13.186 +(def working-ram 
  13.187 +  (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
  13.188 +
  13.189 +(def video-ram 
  13.190 +  (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
  13.191 +
  13.192 +(def registers
  13.193 +  (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
  13.194 +
  13.195 +(def write-memory!
  13.196 +  (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))
  13.197 +
  13.198 +(def write-registers!
  13.199 +  (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))
  13.200 +
  13.201 +;;;;;  Registers  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.202 +
  13.203 +(defmacro gen-get-set-register [name index]
  13.204 +  (let [name-bang (symbol (str name "!"))]
  13.205 +    `(do
  13.206 +       (defn ~name
  13.207 +         ~(str "Retrieve the " name " register from state, or "
  13.208 +               "from @current-state if state is absent.")
  13.209 +         ([state#]
  13.210 +            (nth (registers state#) ~index))
  13.211 +         ([]
  13.212 +            (~name @current-state)))
  13.213 +       (defn ~name-bang
  13.214 +         ~(str "Set the " name " register for state, or "
  13.215 +               "for @current-state if state is absent.")
  13.216 +         ([state# new-register#]
  13.217 +            (set-state! state#)
  13.218 +            (let [registers# (registers state#)]
  13.219 +              (aset registers# ~index new-register#)
  13.220 +              (Gb/writeRegisters registers#)
  13.221 +              (update-state)))
  13.222 +         ([new-register#]
  13.223 +            (~name-bang @current-state new-register#))))))
  13.224 +
  13.225 +;; 16 bit registers
  13.226 +(gen-get-set-register PC 0)
  13.227 +(gen-get-set-register SP 1)
  13.228 +(gen-get-set-register AF 2)
  13.229 +(gen-get-set-register BC 3)
  13.230 +(gen-get-set-register DE 4)
  13.231 +(gen-get-set-register HL 5)
  13.232 +(gen-get-set-register IFF 6)
  13.233 +
  13.234 +;; 8 bit registers
  13.235 +(gen-get-set-register DIV 7)
  13.236 +(gen-get-set-register TIMA 8)
  13.237 +(gen-get-set-register TMA 9)
  13.238 +(gen-get-set-register IF 11)
  13.239 +(gen-get-set-register LCDC 12)
  13.240 +(gen-get-set-register STAT 13)
  13.241 +(gen-get-set-register SCY 14)
  13.242 +(gen-get-set-register SCX 15)
  13.243 +(gen-get-set-register LY 16)
  13.244 +(gen-get-set-register DMA 18)
  13.245 +(gen-get-set-register WY 19)
  13.246 +(gen-get-set-register WX 20)
  13.247 +(gen-get-set-register VBK 21)
  13.248 +(gen-get-set-register HDMA1 22)
  13.249 +(gen-get-set-register HDMA2 23)
  13.250 +(gen-get-set-register HDMA3 24)
  13.251 +(gen-get-set-register HDMA4 25)
  13.252 +(gen-get-set-register HDMA5 26)
  13.253 +(gen-get-set-register SVBK 27)
  13.254 +(gen-get-set-register IE 28)
  13.255 +
  13.256 +;;;;;;;;;;;;;;;
  13.257 +
  13.258 +(defmacro defn-memo
  13.259 +  [& forms]
  13.260 +  (let [fun-name (first forms)]
  13.261 +    `(do
  13.262 +       (defn ~@forms)
  13.263 +       (alter-var-root (var ~fun-name) memoize))))
  13.264 +
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/clojure/com/aurellem/gb/items.clj	Mon Mar 19 21:23:46 2012 -0500
    14.3 @@ -0,0 +1,226 @@
    14.4 +(ns com.aurellem.gb.items
    14.5 +  (:use (com.aurellem.gb gb-driver util))
    14.6 +  ;; this is bullshit
    14.7 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    14.8 +
    14.9 +(defn game-name []
   14.10 +  (map char (subvec (vec (memory)) 0x134 0x142)))
   14.11 +
   14.12 +(def item-list-start 0xD31C)
   14.13 +
   14.14 +(defn item-list [^SaveState state]
   14.15 +  (subvec
   14.16 +   (vec (memory state))
   14.17 +   item-list-start
   14.18 +   (+ item-list-start 150)))
   14.19 +
   14.20 +(def item-code->item-name
   14.21 +  (hash-map
   14.22 +   0x01 :master-ball       
   14.23 +   0x02 :ultra-ball
   14.24 +   0x03 :great-ball
   14.25 +   0x04 :poke-ball
   14.26 +   0x05 :town-map
   14.27 +   0x06 :bicycle
   14.28 +   0x08 :safari-ball
   14.29 +   0x09 :pokedex
   14.30 +   0x0A :moon-stone
   14.31 +   0x0B :antidote
   14.32 +   0x0C :burn-heal
   14.33 +   0x0D :ice-heal
   14.34 +   0x0E :awakening
   14.35 +   0x0F :parlyz-heal
   14.36 +   0x10 :full-restore
   14.37 +   0x11 :max-potion
   14.38 +   0x12 :hyper-potion
   14.39 +   0x13 :super-potion
   14.40 +   0x14 :potion
   14.41 +   0x15 :boulderbadge
   14.42 +   0x16 :cascadebadge
   14.43 +   0x17 :thunderbadge
   14.44 +   0x18 :rainbowbadge
   14.45 +   0x19 :soulbadge
   14.46 +   0x1A :marshbadge
   14.47 +   0x1B :volcanobadge
   14.48 +   0x1C :earthbadge
   14.49 +   0x1D :escape-rope
   14.50 +   0x1E :repel
   14.51 +   0x1F :old-amber
   14.52 +   0x20 :fire-stone
   14.53 +   0x21 :thunderstone
   14.54 +   0x22 :water-stone
   14.55 +   0x23 :hp-up
   14.56 +   0x24 :protein
   14.57 +   0x25 :iron
   14.58 +   0x26 :carbos
   14.59 +   0x27 :calcium
   14.60 +   0x28 :rare-candy
   14.61 +   0x29 :dome-fossil
   14.62 +   0x2A :helix-fossil
   14.63 +   0x2B :secret-key
   14.64 +   0x2D :bike-voucher
   14.65 +   0x2E :x-accuracy
   14.66 +   0x2F :leaf-stone
   14.67 +   0x30 :card-key
   14.68 +   0x31 :nugget
   14.69 +   0x32 :pp-up
   14.70 +   0x33 :poke-doll
   14.71 +   0x34 :full-heal
   14.72 +   0x35 :revive
   14.73 +   0x36 :max-revive
   14.74 +   0x37 :guard-spec
   14.75 +   0x38 :super-repel
   14.76 +   0x39 :max-repel
   14.77 +   0x3A :dire-hit
   14.78 +   0x3B :coin
   14.79 +   0x3C :fresh-water
   14.80 +   0x3D :soda-pop
   14.81 +   0x3E :lemonade
   14.82 +   0x3F :s.s.ticket
   14.83 +   0x40 :gold-teeth
   14.84 +   0x41 :x-attach
   14.85 +   0x42 :x-defend
   14.86 +   0x43 :x-speed
   14.87 +   0x44 :x-special
   14.88 +   0x45 :coin-case
   14.89 +   0x46 :oaks-parcel
   14.90 +   0x47 :itemfinder
   14.91 +   0x48 :silph-scope
   14.92 +   0x49 :poke-flute
   14.93 +   0x4A :lift-key
   14.94 +   0x4B :exp.all
   14.95 +   0x4C :old-rod
   14.96 +   0x4D :good-rod
   14.97 +   0x4E :super-rod
   14.98 +   0x4F :pp-up
   14.99 +   0x50 :ether
  14.100 +   0x51 :max-ether
  14.101 +   0x52 :elixer
  14.102 +   0x53 :max-elixer
  14.103 +   0xC4 :HM01     ;; cut		   
  14.104 +   0xC5 :HM02     ;; fly		   
  14.105 +   0xC6 :HM03     ;; surf		   
  14.106 +   0xC7 :HM04     ;; strength	   
  14.107 +   0xC8 :HM05     ;; flash	   
  14.108 +   0xC9 :TM01     ;; mega punch	   
  14.109 +   0xCA :TM02     ;; razor wind	   
  14.110 +   0xCB :TM03     ;; swords dance	   
  14.111 +   0xCC :TM04     ;; whirlwind	   
  14.112 +   0xCD :TM05     ;; mega kick	   
  14.113 +   0xCE :TM06     ;; toxic	   
  14.114 +   0xCF :TM07     ;; horn drill	   
  14.115 +   0xD0 :TM08     ;; body slam	   
  14.116 +   0xD1 :TM09     ;; take down	   
  14.117 +   0xD2 :TM10     ;; double-edge	   
  14.118 +   0xD3 :TM11     ;; bubblebeam	   
  14.119 +   0xD4 :TM12     ;; water gun	   
  14.120 +   0xD5 :TM13     ;; ice beam 	   
  14.121 +   0xD6 :TM14     ;; blizzard	   
  14.122 +   0xD7 :TM15     ;; hyper beam	   
  14.123 +   0xD8 :TM16     ;; pay day	   
  14.124 +   0xD9 :TM17     ;; submission	   
  14.125 +   0xDA :TM18     ;; counter	   
  14.126 +   0xDB :TM19     ;; seismic toss	   
  14.127 +   0xDC :TM20     ;; rage		   
  14.128 +   0xDD :TM21     ;; mega drain	   
  14.129 +   0xDE :TM22     ;; solarbeam	   
  14.130 +   0xDF :TM23     ;; dragon rage	   
  14.131 +   0xE0 :TM24     ;; thunderbolt	   
  14.132 +   0xE1 :TM25     ;; thunder	   
  14.133 +   0xE2 :TM26     ;; earthquake	   
  14.134 +   0xE3 :TM27     ;; fissure	   
  14.135 +   0xE4 :TM28     ;; dig		   
  14.136 +   0xE5 :TM29     ;; psychic 	   
  14.137 +   0xE6 :TM30     ;; teleport	   
  14.138 +   0xE7 :TM31     ;; mimic	   
  14.139 +   0xE8 :TM32     ;; double team	   
  14.140 +   0xE9 :TM33     ;; reflect	   
  14.141 +   0xEA :TM34     ;; bide		   
  14.142 +   0xEB :TM35     ;; metronome	   
  14.143 +   0xEC :TM36     ;; self destruct   
  14.144 +   0xED :TM37     ;; eggbomb	   
  14.145 +   0xEE :TM38     ;; fire blast	   
  14.146 +   0xEF :TM39     ;; swift	   
  14.147 +   0xF0 :TM40     ;; skull bash	   
  14.148 +   0xF1 :TM41     ;; softboiled	   
  14.149 +   0xF2 :TM42     ;; dream eater	   
  14.150 +   0xF3 :TM43     ;; sky attack	   
  14.151 +   0xF4 :TM44     ;; rest		   
  14.152 +   0xF5 :TM45     ;; thunder wave	   
  14.153 +   0xF6 :TM46     ;; psywave	   
  14.154 +   0xF7 :TM47     ;; explosion	   
  14.155 +   0xF8 :TM48     ;; rock slide	   
  14.156 +   0xF9 :TM49     ;; tri attack	   
  14.157 +   0xFA :TM50     ;; substitute	   
  14.158 +   0xFB :TM51     ;; "cut"	   
  14.159 +   0xFC :TM52     ;; "fly"	   
  14.160 +   0xFD :TM53     ;; "surf"	   
  14.161 +   0xFE :TM54     ;; "strength"      
  14.162 +   0xFF :end-of-list-sentinel))
  14.163 +
  14.164 +(def item-name->item-code
  14.165 +  (zipmap (vals item-code->item-name)
  14.166 +          (keys item-code->item-name)))
  14.167 +
  14.168 +(defn inventory [^SaveState state]
  14.169 +  (let [items (item-list state)]
  14.170 +    (map
  14.171 +     (fn [[item-code quantity]]
  14.172 +       [(item-code->item-name
  14.173 +         item-code
  14.174 +         (str ":0x" (.toUpperCase (Integer/toHexString item-code))))
  14.175 +           quantity])
  14.176 +     (partition
  14.177 +      2
  14.178 +      (next (take-while (partial not= 255) items))))))
  14.179 +
  14.180 +(defn print-inventory
  14.181 +  ([] (print-inventory @current-state))
  14.182 +  ([^SaveState state]
  14.183 +     (println
  14.184 +      (let [inv (inventory state)]
  14.185 +        (reduce
  14.186 +         str
  14.187 +         (concat
  14.188 +          ["+-------------------+----------+\n"
  14.189 +           "|##| Item           | Quantity |\n"
  14.190 +           "+--+----------------+----------+\n"]
  14.191 +
  14.192 +          (map
  14.193 +           (fn [index [item-name quantity]]
  14.194 +             (str 
  14.195 +              (format "|%-2d| %-14s | %3d      |\n" index
  14.196 +                      (apply str (rest (str item-name)))
  14.197 +                      quantity)))
  14.198 +           (range 0 (count inv)) inv)
  14.199 +          ["+--+----------------+----------+\n"]))))
  14.200 +     state))
  14.201 +
  14.202 +(defn inventory-codes [inventory]
  14.203 +  (flatten
  14.204 +   (concat [(count inventory)]
  14.205 +           (map (fn [[item-name quantity]]
  14.206 +                  [(item-name->item-code item-name)
  14.207 +                   quantity]) inventory)
  14.208 +           [(item-name->item-code :end-of-list-sentinel)])))
  14.209 +
  14.210 +(defn set-inv-mem [^SaveState state inv-codes]
  14.211 +  (set-memory-range state item-list-start
  14.212 +                    inv-codes))
  14.213 +  
  14.214 +
  14.215 +(defn set-inventory [^SaveState state new-inventory]
  14.216 +  (set-inv-mem state (inventory-codes new-inventory)))
  14.217 +
  14.218 +(defn give
  14.219 +  ([^SaveState state items]
  14.220 +     (set-inventory state
  14.221 +                    (concat items (inventory state))))
  14.222 +  ([items]
  14.223 +     (give @current-state items)))
  14.224 +
  14.225 +(defn clear-inventory
  14.226 +  ([^SaveState state]
  14.227 +     (set-inventory state []))
  14.228 +  ([] (clear-inventory @current-state)))
  14.229 +
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/clojure/com/aurellem/gb/util.clj	Mon Mar 19 21:23:46 2012 -0500
    15.3 @@ -0,0 +1,100 @@
    15.4 +(ns com.aurellem.gb.util
    15.5 +  (:use (com.aurellem.gb gb-driver vbm))
    15.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    15.7 +
    15.8 +
    15.9 +(defn A [state]
   15.10 +  (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
   15.11 +
   15.12 +(defn B [state]
   15.13 +  (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
   15.14 +
   15.15 +(defn D [state]
   15.16 +  (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
   15.17 +
   15.18 +(defn H [state]
   15.19 +  (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
   15.20 +
   15.21 +(defn C [state]
   15.22 +  (bit-and 0xFF (BC state)))
   15.23 +(defn F [state]
   15.24 +  (bit-and 0xFF (AF state)))
   15.25 +(defn E [state]
   15.26 +  (bit-and 0xFF (DE state)))
   15.27 +(defn L [state]
   15.28 +  (bit-and 0xFF (HL state)))
   15.29 +
   15.30 +(defn binary-str [num]
   15.31 +  (format "%08d"
   15.32 +          (Integer/parseInt
   15.33 +           (Integer/toBinaryString num) 10)))
   15.34 +
   15.35 +(defn view-register [state name reg-fn]
   15.36 +  (println (format "%s: %s" name
   15.37 +                   (binary-str (reg-fn state))))
   15.38 +  state)
   15.39 +
   15.40 +(defn view-memory [state mem]
   15.41 +  (println (format "mem 0x%04X = %s" mem
   15.42 +                   (binary-str (aget (memory state) mem))))
   15.43 +  state)
   15.44 +
   15.45 +(defn print-listing [state begin end]
   15.46 +  (dorun (map 
   15.47 +          (fn [opcode line]
   15.48 +            (println (format "0x%04X:  0x%02X" line opcode)))
   15.49 +          (subvec  (vec (memory state)) begin end)
   15.50 +          (range begin end)))
   15.51 +  state)
   15.52 +
   15.53 +(defn print-pc [state]
   15.54 +  (println (format "PC: 0x%04X" (PC state)))
   15.55 +  state)
   15.56 +
   15.57 +(defn print-op [state]
   15.58 +  (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
   15.59 +  state)
   15.60 +
   15.61 +(defn d-tick
   15.62 +  ([state]
   15.63 +  (-> state print-pc print-op tick)))
   15.64 +
   15.65 +(defn print-interrupt
   15.66 +  [^SaveState state]
   15.67 +  (println (format "IE: %d" (IE state)))
   15.68 +  state)
   15.69 +
   15.70 +(defn set-memory
   15.71 +  ([state location value]
   15.72 +     (set-state! state)
   15.73 +     (let [mem (memory state)]
   15.74 +       (aset mem location value)
   15.75 +       (write-memory! mem)
   15.76 +       (update-state)))
   15.77 +  ([location value]
   15.78 +     (set-memory @current-state location value)))
   15.79 +
   15.80 +(defn set-memory-range
   15.81 +  ([state start values]
   15.82 +     (set-state! state)
   15.83 +     (let [mem (memory state)]
   15.84 +  
   15.85 +       (dorun (map (fn [index val]
   15.86 +                     (aset mem index val))
   15.87 +                   (range start
   15.88 +                          (+ start (count values))) values))
   15.89 +    (write-memory! mem)
   15.90 +    (update-state)))
   15.91 +  ([start values]
   15.92 +     (set-memory-range
   15.93 +      @current-state start values)))
   15.94 +
   15.95 +(defn common-differences [& seqs]
   15.96 +  (let [backbone (range (count (first seqs)))]
   15.97 +    (filter
   15.98 +     (comp (partial apply distinct?) second)
   15.99 +     (zipmap backbone
  15.100 +             (apply (partial map list) seqs)))))
  15.101 +
  15.102 +(defn mid-game []
  15.103 +  (read-state "mid-game"))
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/clojure/com/aurellem/gb/vbm.clj	Mon Mar 19 21:23:46 2012 -0500
    16.3 @@ -0,0 +1,127 @@
    16.4 +(ns com.aurellem.gb.vbm
    16.5 +  (:import java.io.File)
    16.6 +  (:import org.apache.commons.io.FileUtils)
    16.7 +  (:use com.aurellem.gb.gb-driver))
    16.8 +
    16.9 +;;;;;;;;;;;;; read vbm file 
   16.10 +
   16.11 +(def ^:dynamic *moves-cache*
   16.12 +     (File. user-home "proj/pokemon-escape/moves/"))
   16.13 +
   16.14 +(defn buttons [mask]
   16.15 +  (loop [buttons []
   16.16 +         masks (seq (dissoc button-code :listen))]
   16.17 +    (if (empty? masks) buttons
   16.18 +        (let [[button value] (first masks)]
   16.19 +          (if (not= 0x0000 (bit-and value mask))
   16.20 +            (recur (conj buttons button) (rest masks))
   16.21 +            (recur buttons (rest masks)))))))
   16.22 +
   16.23 +(defn vbm-bytes [#^File vbm]
   16.24 +  (let [bytes (FileUtils/readFileToByteArray vbm)
   16.25 +        ints (int-array (count bytes))]
   16.26 +    (areduce bytes idx _ nil
   16.27 +             (aset ints idx
   16.28 +                   (bit-and 0xFF (aget bytes idx))))
   16.29 +    ints))
   16.30 +
   16.31 +(def vbm-header-length 255)
   16.32 +
   16.33 +(defn repair-vbm
   16.34 +  "Two 0's must be inserted after every reset."
   16.35 +  [vbm-masks]
   16.36 +  (loop [fixed []
   16.37 +         pending vbm-masks]
   16.38 +    (if (empty? pending) fixed
   16.39 +        (let [mask (first pending)]
   16.40 +          (if (not= 0x0000 (bit-and mask (button-code :restart)))
   16.41 +            (recur (conj fixed mask 0x0000 0x0000) (next pending))
   16.42 +            (recur (conj fixed mask) (next pending)))))))
   16.43 +
   16.44 +(defn vbm-masks [#^File vbm]
   16.45 +  (repair-vbm
   16.46 +   (map (fn [[a b]]
   16.47 +          (+ (bit-shift-left a 8) b))
   16.48 +        (partition
   16.49 +         2 (drop vbm-header-length (vbm-bytes vbm))))))
   16.50 +
   16.51 +(defn vbm-buttons [#^File vbm]
   16.52 +  (map buttons (vbm-masks vbm)))
   16.53 +
   16.54 +(defn convert-buttons
   16.55 +  "To write a vbm file, we must remove the last two buttons after any
   16.56 +   reset event."
   16.57 +  [buttons]
   16.58 +  (loop [fixed []
   16.59 +         pending buttons]
   16.60 +    (if (empty? pending) fixed
   16.61 +        (let [mask (first pending)]
   16.62 +          (if (contains? (set (first pending)) :reset)
   16.63 +            (recur (conj fixed mask) (drop 3 pending))
   16.64 +            (recur (conj fixed mask) (next pending)))))))
   16.65 +
   16.66 +(defn moves->filename [frame]
   16.67 +  (File. *moves-cache* (format "%07d.vbm" frame)))
   16.68 +
   16.69 +(defn read-moves [frame]
   16.70 +  (let [target (moves->filename frame)]
   16.71 +    (if (.exists target)
   16.72 +      (vbm-buttons target))))
   16.73 +;;;;;;;;;;;;;; write moves to vbm file
   16.74 +
   16.75 +
   16.76 +(def vbm-header
   16.77 +  (byte-array
   16.78 +   (map
   16.79 +    byte
   16.80 +    [86 66 77 26 1 0 0 0 105 74 88 79 89 1 0 0 0 0 0 0 0 1 2 112 0 0 0
   16.81 +     0 0 0 0 0 1 0 0 0 80 79 75 69 77 79 78 32 89 69 76 76 1 -105 124 4
   16.82 +     3 0 0 0 0 0 0 0 0 1 0 0 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.83 +     95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
   16.84 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.85 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.86 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.87 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.88 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.89 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.90 +     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   16.91 +     95 95 95 95])))
   16.92 +
   16.93 +(def vbm-trailer
   16.94 +  (byte-array
   16.95 +   (map byte [0])))
   16.96 +
   16.97 +(defn buttons->vbm-bytes [buttons]
   16.98 +  (let [bytes-in-ints
   16.99 +        (map button-mask (convert-buttons buttons))
  16.100 +        high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
  16.101 +                       bytes-in-ints)
  16.102 +        low-bits (map #(bit-and 0xFF %) bytes-in-ints)
  16.103 +        convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
  16.104 +        contents
  16.105 +        (byte-array
  16.106 +         (concat
  16.107 +          vbm-header
  16.108 +          (map convert-byte (interleave high-bits low-bits))
  16.109 +          vbm-trailer))]
  16.110 +    contents))
  16.111 +        
  16.112 +(defn write-moves! [moves]
  16.113 +  (let [target (moves->filename (count moves))]
  16.114 +    (clojure.java.io/copy (buttons->vbm-bytes moves) target)
  16.115 +    target))
  16.116 +
  16.117 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.118 +
  16.119 +(use 'clojure.java.shell)
  16.120 +
  16.121 +(def vba-linux (File. user-home "bin/vba-linux"))
  16.122 +
  16.123 +(defn play-vbm [#^File vbm]
  16.124 +  (.delete yellow-save-file)
  16.125 +  (if (.exists vbm)
  16.126 +    (sh (.getCanonicalPath vba-linux)
  16.127 +        (str "--playmovie=" (.getCanonicalPath vbm))
  16.128 +        (.getCanonicalPath yellow-rom-image)))
  16.129 +  nil)
  16.130 +
    17.1 --- a/clojure/com/aurellem/gb_driver.clj	Mon Mar 19 20:43:38 2012 -0500
    17.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.3 @@ -1,268 +0,0 @@
    17.4 -(ns com.aurellem.gb-driver
    17.5 -    (:import com.aurellem.gb.Gb)
    17.6 -    (:import java.io.File)
    17.7 -    (:import org.apache.commons.io.FileUtils)
    17.8 -    (:import (java.nio IntBuffer ByteOrder)))
    17.9 -
   17.10 -;; Savestates
   17.11 -(defrecord SaveState [data])
   17.12 -
   17.13 -(def user-home (File. (System/getProperty "user.home")))
   17.14 -
   17.15 -(def ^:dynamic *save-state-cache*
   17.16 -  (File. user-home "proj/vba-clojure/save-states/"))
   17.17 -
   17.18 -(def current-state (atom nil))
   17.19 -
   17.20 -(defn state-cache-file [name]
   17.21 -  (File. *save-state-cache* (str name ".sav")))
   17.22 -
   17.23 -(defn write-state!
   17.24 -  ([^SaveState name]
   17.25 -     (write-state! @current-state name))
   17.26 -  ([^SaveState save ^String name]
   17.27 -     (let [buffer (:data save)
   17.28 -           bytes (byte-array (.limit buffer))
   17.29 -           dest (state-cache-file name)]
   17.30 -       (.get buffer bytes)
   17.31 -       (FileUtils/writeByteArrayToFile dest bytes)
   17.32 -       (.rewind buffer)
   17.33 -       dest)))
   17.34 -
   17.35 -(defn read-state [name]
   17.36 -  (let [save (state-cache-file name)]
   17.37 -    (if (.exists save)
   17.38 -      (let [buffer (Gb/saveBuffer)
   17.39 -            bytes (FileUtils/readFileToByteArray save)]
   17.40 -        (.put buffer bytes)
   17.41 -        (.flip buffer)
   17.42 -        (SaveState. buffer)))))
   17.43 -;;;;;;;;;;;;;;;;
   17.44 -
   17.45 -;; Gameboy management
   17.46 -(Gb/loadVBA)
   17.47 -
   17.48 -(def yellow-rom-image
   17.49 -  (File. user-home "proj/pokemon-escape/roms/yellow.gbc"))
   17.50 -
   17.51 -(def yellow-save-file
   17.52 -  (File. user-home "proj/pokemon-escape/roms/yellow.sav"))
   17.53 -
   17.54 -(def on? (atom nil))
   17.55 -
   17.56 -(defn shutdown! [] (Gb/shutdown) (reset! on? false))
   17.57 -
   17.58 -(defn restart! []
   17.59 -  (shutdown!)
   17.60 -  (.delete yellow-save-file)
   17.61 -  (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
   17.62 -  (reset! on? true))
   17.63 -
   17.64 -;;; The first state!
   17.65 -(defn gen-root! []
   17.66 -  (restart!)
   17.67 -  (let [state (SaveState. (Gb/saveState))]
   17.68 -    (write-state! state "root" ) state))
   17.69 -
   17.70 -(defn root []
   17.71 -  (if (.exists (state-cache-file "root"))
   17.72 -    (read-state "root")
   17.73 -    (gen-root!)))
   17.74 -
   17.75 -;;;; Press Buttons
   17.76 -
   17.77 -(def button-code
   17.78 -  {;; main buttons
   17.79 -   :a         0x0001
   17.80 -   :b         0x0002
   17.81 -
   17.82 -   ;; directional pad
   17.83 -   :r         0x0010
   17.84 -   :l         0x0020
   17.85 -   :u         0x0040
   17.86 -   :d         0x0080
   17.87 -
   17.88 -   ;; meta buttons
   17.89 -   :select    0x0004
   17.90 -   :start     0x0008
   17.91 -
   17.92 -   ;; pseudo-buttons
   17.93 -   :restart   0x0800 ; hard reset 
   17.94 -   :listen -1        ; listen for user input
   17.95 -   })
   17.96 -
   17.97 -(defn button-mask [buttons]
   17.98 -  (reduce bit-or 0x0000 (map button-code buttons)))
   17.99 -
  17.100 -(defn set-state! [^SaveState state]
  17.101 -  (assert (:data state) "Not a valid state!")
  17.102 -  (if (not @on?) (restart!))
  17.103 -  (if (not= state @current-state)
  17.104 -    (do 
  17.105 -      (Gb/loadState (:data state))
  17.106 -      (reset! current-state state))))
  17.107 -
  17.108 -(defn update-state []
  17.109 -  (reset! current-state
  17.110 -          (SaveState. (Gb/saveState))))
  17.111 -
  17.112 -(defn step
  17.113 -  ([^SaveState state buttons]
  17.114 -     (set-state! state)
  17.115 -     (Gb/step (button-mask buttons))
  17.116 -     (reset! current-state 
  17.117 -             (SaveState. (Gb/saveState))))
  17.118 -  ([^SaveState state]
  17.119 -     (step state [:listen]))
  17.120 -  ([] (step (if @current-state @current-state (root)))))
  17.121 -
  17.122 -(defn tick
  17.123 -  ([] (tick @current-state))
  17.124 -  ([^SaveState state]
  17.125 -     (set-state! state)
  17.126 -     (Gb/tick)
  17.127 -     (update-state)))
  17.128 -
  17.129 -(defn play
  17.130 -  ([^SaveState state n]
  17.131 -     (try
  17.132 -       (set-state! state)
  17.133 -       (dorun (dotimes [_ n]
  17.134 -                (Thread/sleep 1)
  17.135 -                (Gb/step)))
  17.136 -       (finally
  17.137 -             (update-state))))
  17.138 -  ([n]
  17.139 -     (play @current-state n)))
  17.140 -
  17.141 -(defn continue!
  17.142 -  ([state]
  17.143 -     (play state Integer/MAX_VALUE))
  17.144 -  ([]
  17.145 -    (continue! @current-state)))
  17.146 -
  17.147 -(defn play-moves
  17.148 -  ([moves [prev state]]
  17.149 -     (set-state! state)
  17.150 -     (dorun (map (fn [move] (step @current-state move)) moves))
  17.151 -     [(concat prev moves) @current-state]))
  17.152 -  
  17.153 -;;;;;;;;;;;
  17.154 -
  17.155 -
  17.156 -;;;;;;;;;;;;;;; CPU data
  17.157 -
  17.158 -(defn cpu-data [size arr-fn]
  17.159 -  (let [store (int-array size)]
  17.160 -    (fn get-data
  17.161 -      ([] (get-data @current-state))
  17.162 -      ([state]
  17.163 -         (set-state! state) (arr-fn store) store))))
  17.164 -
  17.165 -(defn write-cpu-data [size store-fn]
  17.166 -  (fn store-data
  17.167 -    ([state new-data]
  17.168 -       (set-state! state)
  17.169 -       (let [store (int-array new-data)]
  17.170 -         (assert (= size (count new-data)))
  17.171 -         (store-fn store)
  17.172 -         (update-state)))
  17.173 -    ([new-data]
  17.174 -       (store-data @current-state new-data))))
  17.175 -    
  17.176 -
  17.177 -(def memory
  17.178 -  (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
  17.179 -
  17.180 -(def ram
  17.181 -  (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))
  17.182 -
  17.183 -(def rom 
  17.184 -  (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))
  17.185 -
  17.186 -(def working-ram 
  17.187 -  (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
  17.188 -
  17.189 -(def video-ram 
  17.190 -  (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
  17.191 -
  17.192 -(def registers
  17.193 -  (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
  17.194 -
  17.195 -(def write-memory!
  17.196 -  (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))
  17.197 -
  17.198 -(def write-registers!
  17.199 -  (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))
  17.200 -
  17.201 -;;;;;  Registers  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17.202 -
  17.203 -(defmacro gen-get-set-register [name index]
  17.204 -  (let [name-bang (symbol (str name "!"))]
  17.205 -    `(do
  17.206 -       (defn ~name
  17.207 -         ~(str "Retrieve the " name " register from state, or "
  17.208 -               "from @current-state if state is absent.")
  17.209 -         ([state#]
  17.210 -            (nth (registers state#) ~index))
  17.211 -         ([]
  17.212 -            (~name @current-state)))
  17.213 -       (defn ~name-bang
  17.214 -         ~(str "Set the " name " register for state, or "
  17.215 -               "for @current-state if state is absent.")
  17.216 -         ([state# new-register#]
  17.217 -            (set-state! state#)
  17.218 -            (let [registers# (registers state#)]
  17.219 -              (aset registers# ~index new-register#)
  17.220 -              (Gb/writeRegisters registers#)
  17.221 -              (update-state)))
  17.222 -         ([new-register#]
  17.223 -            (~name-bang @current-state new-register#))))))
  17.224 -
  17.225 -;; 16 bit registers
  17.226 -(gen-get-set-register PC 0)
  17.227 -(gen-get-set-register SP 1)
  17.228 -(gen-get-set-register AF 2)
  17.229 -(gen-get-set-register BC 3)
  17.230 -(gen-get-set-register DE 4)
  17.231 -(gen-get-set-register HL 5)
  17.232 -(gen-get-set-register IFF 6)
  17.233 -
  17.234 -;; 8 bit registers
  17.235 -(gen-get-set-register DIV 7)
  17.236 -(gen-get-set-register TIMA 8)
  17.237 -(gen-get-set-register TMA 9)
  17.238 -(gen-get-set-register IF 11)
  17.239 -(gen-get-set-register LCDC 12)
  17.240 -(gen-get-set-register STAT 13)
  17.241 -(gen-get-set-register SCY 14)
  17.242 -(gen-get-set-register SCX 15)
  17.243 -(gen-get-set-register LY 16)
  17.244 -(gen-get-set-register DMA 18)
  17.245 -(gen-get-set-register WY 19)
  17.246 -(gen-get-set-register WX 20)
  17.247 -(gen-get-set-register VBK 21)
  17.248 -(gen-get-set-register HDMA1 22)
  17.249 -(gen-get-set-register HDMA2 23)
  17.250 -(gen-get-set-register HDMA3 24)
  17.251 -(gen-get-set-register HDMA4 25)
  17.252 -(gen-get-set-register HDMA5 26)
  17.253 -(gen-get-set-register SVBK 27)
  17.254 -(gen-get-set-register IE 28)
  17.255 -
  17.256 -(defn set-memory [state location value]
  17.257 -  (set-state! state)
  17.258 -  (let [mem (memory state)]
  17.259 -    (aset mem location value)
  17.260 -    (write-memory! mem)
  17.261 -    (update-state)))
  17.262 -
  17.263 -;;;;;;;;;;;;;;;
  17.264 -
  17.265 -(defmacro defn-memo
  17.266 -  [& forms]
  17.267 -  (let [fun-name (first forms)]
  17.268 -    `(do
  17.269 -       (defn ~@forms)
  17.270 -       (alter-var-root (var ~fun-name) memoize))))
  17.271 -
    18.1 --- a/clojure/com/aurellem/item_bridge.clj	Mon Mar 19 20:43:38 2012 -0500
    18.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.3 @@ -1,65 +0,0 @@
    18.4 -(ns com.aurellem.item-bridge
    18.5 -  (:use (com.aurellem gb-driver vbm title save-corruption items assembly))
    18.6 -  (:import [com.aurellem.gb_driver SaveState]))
    18.7 -
    18.8 -
    18.9 -(defn corrupt-item-state []
   18.10 -  (second (destroy-item-end-of-list-marker)))
   18.11 -
   18.12 -(defn corrupt-item-state []
   18.13 -  (read-state "corrupt-items"))
   18.14 -
   18.15 -
   18.16 -(defn view-memory-range [state start end]
   18.17 -  (dorun
   18.18 -   (map (fn [loc val]
   18.19 -          (println (format "%04X : %02X" loc val)))
   18.20 -        
   18.21 -        (range start end) (subvec (vec (memory state)) start end)))
   18.22 -  state)
   18.23 -
   18.24 -(defn almost-broken
   18.25 -  "if one more memory location is turned into 0x03, the game crashes."
   18.26 -  [n]
   18.27 -  (view-memory-range
   18.28 -   (set-inv-mem (mid-game)
   18.29 -                (concat [0xFF] (repeat 64 0x03)
   18.30 -                        (subvec (vec (memory (mid-game)))
   18.31 -                                (+ item-list-start 65)
   18.32 -                                (+ item-list-start 65 n))
   18.33 -                        (repeat (- 255 65 n) 0x03)
   18.34 -                        ))
   18.35 -                
   18.36 -   item-list-start (+ item-list-start 255)))
   18.37 -
   18.38 -(defn actually-broken
   18.39 -  "if one more memory location is turned into 0x03, the game crashes."
   18.40 -  []
   18.41 -  (set-memory (mid-game) 0xD35D 0x03))
   18.42 -
   18.43 -
   18.44 -;; (almost-broken 20) more or less works
   18.45 -
   18.46 -(defn capture-program-counter
   18.47 -  "records the program counter for each tick"
   18.48 -  [^SaveState state ticks]
   18.49 -  (let [i (atom 0)]
   18.50 -    (reduce (fn [[program-counters state] _]
   18.51 -              (println (swap! i inc))
   18.52 -               [(conj program-counters (PC state))
   18.53 -                (tick state)])
   18.54 -              [[] state]
   18.55 -              (range ticks))))
   18.56 -
   18.57 -
   18.58 -(defn capture-program-counter
   18.59 -  [^SaveState state ticks]
   18.60 -  (set-state! state)
   18.61 -  (loop [i 0
   18.62 -         pcs []]
   18.63 -    (if (= i ticks)
   18.64 -      pcs
   18.65 -      (do 
   18.66 -        (com.aurellem.gb.Gb/tick)
   18.67 -        (recur (inc i)
   18.68 -               (conj pcs (first (registers))))))))
    19.1 --- a/clojure/com/aurellem/items.clj	Mon Mar 19 20:43:38 2012 -0500
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,268 +0,0 @@
    19.4 -(ns com.aurellem.items
    19.5 -  (:use (com.aurellem gb-driver vbm title))
    19.6 -  ;; this is bullshit
    19.7 -  (:import [com.aurellem.gb_driver SaveState]))
    19.8 -
    19.9 -(defn game-name []
   19.10 -  (map char (subvec (vec (memory)) 0x134 0x142)))
   19.11 -
   19.12 -(def item-list-start 0xD31C)
   19.13 -
   19.14 -(defn item-list [^SaveState state]
   19.15 -  (subvec
   19.16 -   (vec (memory state))
   19.17 -   item-list-start
   19.18 -   (+ item-list-start 150)))
   19.19 -
   19.20 -(def item-code->item-name
   19.21 -  (hash-map
   19.22 -   0x01 :master-ball       
   19.23 -   0x02 :ultra-ball
   19.24 -   0x03 :great-ball
   19.25 -   0x04 :poke-ball
   19.26 -   0x05 :town-map
   19.27 -   0x06 :bicycle
   19.28 -   0x08 :safari-ball
   19.29 -   0x09 :pokedex
   19.30 -   0x0A :moon-stone
   19.31 -   0x0B :antidote
   19.32 -   0x0C :burn-heal
   19.33 -   0x0D :ice-heal
   19.34 -   0x0E :awakening
   19.35 -   0x0F :parlyz-heal
   19.36 -   0x10 :full-restore
   19.37 -   0x11 :max-potion
   19.38 -   0x12 :hyper-potion
   19.39 -   0x13 :super-potion
   19.40 -   0x14 :potion
   19.41 -   0x15 :boulderbadge
   19.42 -   0x16 :cascadebadge
   19.43 -   0x17 :thunderbadge
   19.44 -   0x18 :rainbowbadge
   19.45 -   0x19 :soulbadge
   19.46 -   0x1A :marshbadge
   19.47 -   0x1B :volcanobadge
   19.48 -   0x1C :earthbadge
   19.49 -   0x1D :escape-rope
   19.50 -   0x1E :repel
   19.51 -   0x1F :old-amber
   19.52 -   0x20 :fire-stone
   19.53 -   0x21 :thunderstone
   19.54 -   0x22 :water-stone
   19.55 -   0x23 :hp-up
   19.56 -   0x24 :protein
   19.57 -   0x25 :iron
   19.58 -   0x26 :carbos
   19.59 -   0x27 :calcium
   19.60 -   0x28 :rare-candy
   19.61 -   0x29 :dome-fossil
   19.62 -   0x2A :helix-fossil
   19.63 -   0x2B :secret-key
   19.64 -   0x2D :bike-voucher
   19.65 -   0x2E :x-accuracy
   19.66 -   0x2F :leaf-stone
   19.67 -   0x30 :card-key
   19.68 -   0x31 :nugget
   19.69 -   0x32 :pp-up
   19.70 -   0x33 :poke-doll
   19.71 -   0x34 :full-heal
   19.72 -   0x35 :revive
   19.73 -   0x36 :max-revive
   19.74 -   0x37 :guard-spec
   19.75 -   0x38 :super-repel
   19.76 -   0x39 :max-repel
   19.77 -   0x3A :dire-hit
   19.78 -   0x3B :coin
   19.79 -   0x3C :fresh-water
   19.80 -   0x3D :soda-pop
   19.81 -   0x3E :lemonade
   19.82 -   0x3F :s.s.ticket
   19.83 -   0x40 :gold-teeth
   19.84 -   0x41 :x-attach
   19.85 -   0x42 :x-defend
   19.86 -   0x43 :x-speed
   19.87 -   0x44 :x-special
   19.88 -   0x45 :coin-case
   19.89 -   0x46 :oaks-parcel
   19.90 -   0x47 :itemfinder
   19.91 -   0x48 :silph-scope
   19.92 -   0x49 :poke-flute
   19.93 -   0x4A :lift-key
   19.94 -   0x4B :exp.all
   19.95 -   0x4C :old-rod
   19.96 -   0x4D :good-rod
   19.97 -   0x4E :super-rod
   19.98 -   0x4F :pp-up
   19.99 -   0x50 :ether
  19.100 -   0x51 :max-ether
  19.101 -   0x52 :elixer
  19.102 -   0x53 :max-elixer
  19.103 -   0xC4 :HM01     ;; cut		   
  19.104 -   0xC5 :HM02     ;; fly		   
  19.105 -   0xC6 :HM03     ;; surf		   
  19.106 -   0xC7 :HM04     ;; strength	   
  19.107 -   0xC8 :HM05     ;; flash	   
  19.108 -   0xC9 :TM01     ;; mega punch	   
  19.109 -   0xCA :TM02     ;; razor wind	   
  19.110 -   0xCB :TM03     ;; swords dance	   
  19.111 -   0xCC :TM04     ;; whirlwind	   
  19.112 -   0xCD :TM05     ;; mega kick	   
  19.113 -   0xCE :TM06     ;; toxic	   
  19.114 -   0xCF :TM07     ;; horn drill	   
  19.115 -   0xD0 :TM08     ;; body slam	   
  19.116 -   0xD1 :TM09     ;; take down	   
  19.117 -   0xD2 :TM10     ;; double-edge	   
  19.118 -   0xD3 :TM11     ;; bubblebeam	   
  19.119 -   0xD4 :TM12     ;; water gun	   
  19.120 -   0xD5 :TM13     ;; ice beam 	   
  19.121 -   0xD6 :TM14     ;; blizzard	   
  19.122 -   0xD7 :TM15     ;; hyper beam	   
  19.123 -   0xD8 :TM16     ;; pay day	   
  19.124 -   0xD9 :TM17     ;; submission	   
  19.125 -   0xDA :TM18     ;; counter	   
  19.126 -   0xDB :TM19     ;; seismic toss	   
  19.127 -   0xDC :TM20     ;; rage		   
  19.128 -   0xDD :TM21     ;; mega drain	   
  19.129 -   0xDE :TM22     ;; solarbeam	   
  19.130 -   0xDF :TM23     ;; dragon rage	   
  19.131 -   0xE0 :TM24     ;; thunderbolt	   
  19.132 -   0xE1 :TM25     ;; thunder	   
  19.133 -   0xE2 :TM26     ;; earthquake	   
  19.134 -   0xE3 :TM27     ;; fissure	   
  19.135 -   0xE4 :TM28     ;; dig		   
  19.136 -   0xE5 :TM29     ;; psychic 	   
  19.137 -   0xE6 :TM30     ;; teleport	   
  19.138 -   0xE7 :TM31     ;; mimic	   
  19.139 -   0xE8 :TM32     ;; double team	   
  19.140 -   0xE9 :TM33     ;; reflect	   
  19.141 -   0xEA :TM34     ;; bide		   
  19.142 -   0xEB :TM35     ;; metronome	   
  19.143 -   0xEC :TM36     ;; self destruct   
  19.144 -   0xED :TM37     ;; eggbomb	   
  19.145 -   0xEE :TM38     ;; fire blast	   
  19.146 -   0xEF :TM39     ;; swift	   
  19.147 -   0xF0 :TM40     ;; skull bash	   
  19.148 -   0xF1 :TM41     ;; softboiled	   
  19.149 -   0xF2 :TM42     ;; dream eater	   
  19.150 -   0xF3 :TM43     ;; sky attack	   
  19.151 -   0xF4 :TM44     ;; rest		   
  19.152 -   0xF5 :TM45     ;; thunder wave	   
  19.153 -   0xF6 :TM46     ;; psywave	   
  19.154 -   0xF7 :TM47     ;; explosion	   
  19.155 -   0xF8 :TM48     ;; rock slide	   
  19.156 -   0xF9 :TM49     ;; tri attack	   
  19.157 -   0xFA :TM50     ;; substitute	   
  19.158 -   0xFB :TM51     ;; "cut"	   
  19.159 -   0xFC :TM52     ;; "fly"	   
  19.160 -   0xFD :TM53     ;; "surf"	   
  19.161 -   0xFE :TM54     ;; "strength"      
  19.162 -   0xFF :end-of-list-sentinel))
  19.163 -
  19.164 -(def item-name->item-code
  19.165 -  (zipmap (vals item-code->item-name)
  19.166 -          (keys item-code->item-name)))
  19.167 -
  19.168 -(defn inventory [^SaveState state]
  19.169 -  (let [items (item-list state)]
  19.170 -    (map
  19.171 -     (fn [[item-code quantity]]
  19.172 -       [(item-code->item-name
  19.173 -         item-code
  19.174 -         (str ":0x" (.toUpperCase (Integer/toHexString item-code))))
  19.175 -           quantity])
  19.176 -     (partition
  19.177 -      2
  19.178 -      (next (take-while (partial not= 255) items))))))
  19.179 -
  19.180 -(defn print-inventory
  19.181 -  ([] (print-inventory @current-state))
  19.182 -  ([^SaveState state]
  19.183 -     (println
  19.184 -      (let [inv (inventory state)]
  19.185 -        (reduce
  19.186 -         str
  19.187 -         (concat
  19.188 -          ["+-------------------+----------+\n"
  19.189 -           "|##| Item           | Quantity |\n"
  19.190 -           "+--+----------------+----------+\n"]
  19.191 -
  19.192 -          (map
  19.193 -           (fn [index [item-name quantity]]
  19.194 -             (str 
  19.195 -              (format "|%-2d| %-14s | %3d      |\n" index
  19.196 -                      (apply str (rest (str item-name)))
  19.197 -                      quantity)))
  19.198 -           (range 0 (count inv)) inv)
  19.199 -          ["+--+----------------+----------+\n"]))))
  19.200 -     state))
  19.201 -
  19.202 -(defn inventory-codes [inventory]
  19.203 -  (flatten
  19.204 -   (concat [(count inventory)]
  19.205 -           (map (fn [[item-name quantity]]
  19.206 -                  [(item-name->item-code item-name)
  19.207 -                   quantity]) inventory)
  19.208 -           [(item-name->item-code :end-of-list-sentinel)])))
  19.209 -
  19.210 -(defn set-inv-mem [^SaveState state inv-codes]
  19.211 -  (set-state! state)
  19.212 -  (let [mem (memory state)]
  19.213 -    (dorun (map (fn [index val]
  19.214 -                  (aset mem index val))
  19.215 -                (range item-list-start
  19.216 -                       (+ item-list-start (count inv-codes))) inv-codes))
  19.217 -    (write-memory! mem)
  19.218 -    (update-state)))
  19.219 -  
  19.220 -  
  19.221 -(defn set-inventory [^SaveState state new-inventory]
  19.222 -  (set-state! state)
  19.223 -  (let [mem (memory state)
  19.224 -        inv (inventory-codes new-inventory)]
  19.225 -  
  19.226 -    (dorun (map (fn [index val]
  19.227 -                  (aset mem index val))
  19.228 -                (range item-list-start
  19.229 -                       (+ item-list-start (count inv))) inv))
  19.230 -    (write-memory! mem)
  19.231 -    (update-state)))
  19.232 -
  19.233 -(defn give
  19.234 -  ([^SaveState state items]
  19.235 -     (set-inventory state
  19.236 -                    (concat items (inventory state))))
  19.237 -  ([items]
  19.238 -     (give @current-state items)))
  19.239 -
  19.240 -(defn clear-inventory
  19.241 -  ([^SaveState state]
  19.242 -     (set-inventory state []))
  19.243 -  ([] (clear-inventory @current-state)))
  19.244 -
  19.245 -(def gliched-tms
  19.246 -  [[:TM51 1]
  19.247 -   [:TM52 1]
  19.248 -   [:TM53 1]
  19.249 -   [:TM54 1]])
  19.250 -
  19.251 -(def good-items
  19.252 -  [[:bicycle 1]
  19.253 -   [:ultra-ball 15]
  19.254 -   [:pp-up 1]
  19.255 -   [:master-ball 5]
  19.256 -   [:rare-candy 99]
  19.257 -   [:full-restore 25]
  19.258 -   [:max-revive 8]
  19.259 -   [:max-repel 40]
  19.260 -   [:TM25 1]
  19.261 -   [:TM11 1]
  19.262 -   [:TM15 1]
  19.263 -   ])
  19.264 -  
  19.265 -(def some-badges
  19.266 -  [[:cascadebadge 1]
  19.267 -   [:thunderbadge 1]
  19.268 -   [:rainbowbadge 1]
  19.269 -   [:soulbadge 1]    
  19.270 -   ])
  19.271 -  
    20.1 --- a/clojure/com/aurellem/pokemon.clj	Mon Mar 19 20:43:38 2012 -0500
    20.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.3 @@ -1,94 +0,0 @@
    20.4 -(ns com.aurellem.pokemon
    20.5 -  "Here I find out how pokemon are stored in memory."
    20.6 -  (:use (com.aurellem gb-driver vbm
    20.7 -                      rival-name
    20.8 -                      title save-corruption items assembly))
    20.9 -  (:use com.aurellem.experiments.items)
   20.10 -  (:import [com.aurellem.gb_driver SaveState]))
   20.11 -
   20.12 -
   20.13 -(def pidgeot-lvl-36 (mid-game))
   20.14 -
   20.15 -
   20.16 -(def pidgeot-lvl-37 (read-state "pidgeot-lvl-37"))
   20.17 -
   20.18 -
   20.19 -(def pidgeot-lvl-38  (read-state "pidgeot-lvl-38"))
   20.20 -
   20.21 -
   20.22 -(def pidgeot-lvl-39  (read-state "pidgeot-lvl-39"))
   20.23 -
   20.24 -
   20.25 -(def pidgeot-lvl-40  (read-state "pidgeot-lvl-40"))
   20.26 -
   20.27 -
   20.28 -(defn level-analysis []
   20.29 -  (apply common-differences
   20.30 -         (map (comp vec memory)
   20.31 -              [pidgeot-lvl-36
   20.32 -               pidgeot-lvl-37
   20.33 -               pidgeot-lvl-38
   20.34 -               pidgeot-lvl-39
   20.35 -               pidgeot-lvl-40])))
   20.36 -
   20.37 -;; inconclusive -- implies that level is calculated from
   20.38 -;; some other values.
   20.39 -
   20.40 -
   20.41 -(def name-pidgeotto (read-state "name-pidgeotto"))
   20.42 -(def named-A (read-state "named-A"))
   20.43 -(def named-B (read-state "named-B"))
   20.44 -(def named-C (read-state "named-C"))
   20.45 -(def named-D (read-state "named-D"))
   20.46 -(def named-E (read-state "named-E"))
   20.47 -(def named-F (read-state "named-F"))
   20.48 -
   20.49 -(defn name-analysis []
   20.50 -  (apply common-differences
   20.51 -         (map (comp vec memory)
   20.52 -              [named-A
   20.53 -               named-B
   20.54 -               named-C
   20.55 -               named-D
   20.56 -               named-E
   20.57 -               named-F])))
   20.58 -
   20.59 -;; resluted in 3 separate locations that could
   20.60 -;; possibly hold the first letter of the pokemon's name
   20.61 -
   20.62 -0xCF4A
   20.63 -0xD2EB
   20.64 -0xCEED
   20.65 -
   20.66 -;; try changing each of them
   20.67 -
   20.68 -
   20.69 -(defn test-cf4a []
   20.70 -  (continue!
   20.71 -   (set-memory named-A 0xCF4A (character->character-code "Z"))))
   20.72 -;; result -- pidgeotto named "A"
   20.73 -
   20.74 -(defn test-d2eb []
   20.75 -  (continue!
   20.76 -   (set-memory named-A 0xD2EB (character->character-code "Z"))))
   20.77 -;; result -- pidgeotto named "Z"
   20.78 -
   20.79 -(defn test-ceed []
   20.80 -  (continue!
   20.81 -   (set-memory named-A 0xCEED (character->character-code "Z"))))
   20.82 -;; result -- pidgeotto named "A"
   20.83 -
   20.84 -(def sixth-pokemon-name-start 0xD2EB)
   20.85 -
   20.86 -
   20.87 -(defn set-sixth-pokemon-name-first-character
   20.88 -  ([state character]
   20.89 -     (set-memory state sixth-pokemon-name-start
   20.90 -                 (character->character-code character)))
   20.91 -  ([character]
   20.92 -     (set-sixth-pokemon-name-first-character @current-state
   20.93 -                                             character)))
   20.94 -
   20.95 -
   20.96 -
   20.97 -
    21.1 --- a/clojure/com/aurellem/rival_name.clj	Mon Mar 19 20:43:38 2012 -0500
    21.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.3 @@ -1,400 +0,0 @@
    21.4 -(ns com.aurellem.rival-name
    21.5 -  (:use (com.aurellem gb-driver vbm title save-corruption items assembly))
    21.6 -  (:import [com.aurellem.gb_driver SaveState]))
    21.7 -
    21.8 -
    21.9 -(defn talk-to-rival []
   21.10 -  (read-state "talk-to-rival"))
   21.11 -
   21.12 -(def rival-name-start 0xD349)
   21.13 -
   21.14 -(defn set-rival-name [^SaveState state codes]
   21.15 -  (set-state! state)
   21.16 -  (let [mem (memory state)]
   21.17 -    (dorun (map (fn [index val]
   21.18 -                  (aset mem index val))
   21.19 -                (range rival-name-start
   21.20 -                       (+ rival-name-start
   21.21 -                          (count codes))) codes))
   21.22 -    (write-memory! mem)
   21.23 -    (update-state)))
   21.24 -
   21.25 -(defn view-rival-name [name-codes]
   21.26 -  (->
   21.27 -   (set-rival-name (talk-to-rival) name-codes)
   21.28 -   (step [:a])
   21.29 -   (play 50)))
   21.30 -
   21.31 -(defn rival-name-sequence []
   21.32 -  (let [i (atom 1)]
   21.33 -    (fn []
   21.34 -      (let [codes (range @i (+ 5 @i))]
   21.35 -        (println codes)
   21.36 -        (view-rival-name codes)
   21.37 -        (reset! i (+ 5 @i))))))
   21.38 -
   21.39 -(def character-code->character
   21.40 -  {
   21.41 -   0x00   "end-of-name-sentinel"
   21.42 -   0x60   "A-bold"
   21.43 -   0x61   "B-bold"
   21.44 -   0x62   "C-bold"
   21.45 -   0x63   "D-bold"
   21.46 -   0x64   "E-bold"
   21.47 -   0x65   "F-bold"
   21.48 -   0x66   "G-bold"
   21.49 -   0x67   "H-bold"
   21.50 -   0x68   "I-bold"
   21.51 -   0x69   "V-bold"
   21.52 -   0x6A   "S-bold"
   21.53 -   0x6B   "L-bold"
   21.54 -   0x6C   "M-bold"
   21.55 -   0x80   "A"
   21.56 -   0x81   "B"
   21.57 -   0x82   "C"
   21.58 -   0x83   "D"
   21.59 -   0x84   "E"
   21.60 -   0x85   "F"
   21.61 -   0x86   "G"
   21.62 -   0x87   "H"
   21.63 -   0x88   "I"
   21.64 -   0x89   "J"
   21.65 -   0x8A   "K"
   21.66 -   0x8B   "L"
   21.67 -   0x8C   "M"
   21.68 -   0x8D   "N"
   21.69 -   0x8E   "O"
   21.70 -   0x8F   "P"
   21.71 -   0x90   "Q"
   21.72 -   0x91   "R"
   21.73 -   0x92   "S"
   21.74 -   0x93   "T"
   21.75 -   0x94   "U"
   21.76 -   0x95   "V"
   21.77 -   0x96   "W"
   21.78 -   0x97   "X"
   21.79 -   0x98   "Y"
   21.80 -   0x99   "Z"
   21.81 -   0x9A   "("
   21.82 -   0x9B   ")"
   21.83 -   0x9C   ":"
   21.84 -   0x9D   ";"
   21.85 -   0xA0   "a"
   21.86 -   0xA1   "b"
   21.87 -   0xA2   "c"
   21.88 -   0xA3   "d"
   21.89 -   0xA4   "e"
   21.90 -   0xA5   "f"
   21.91 -   0xA6   "g"
   21.92 -   0xA7   "h"
   21.93 -   0xA8   "i"
   21.94 -   0xA9   "j"
   21.95 -   0xAA   "k"
   21.96 -   0xAB   "l"
   21.97 -   0xAC   "m"
   21.98 -   0xAD   "n"
   21.99 -   0xAE   "o"
  21.100 -   0xAF   "p"
  21.101 -   0xB0   "q"
  21.102 -   0xB1   "r"
  21.103 -   0xB2   "s"
  21.104 -   0xB3   "t"
  21.105 -   0xB4   "u"
  21.106 -   0xB5   "v"
  21.107 -   0xB6   "w"
  21.108 -   0xB7   "x"
  21.109 -   0xB8   "y"
  21.110 -   0xB9   "z"
  21.111 -   0xBA   "e-with-grave"
  21.112 -   0xE0   "'"
  21.113 -   0xE1   "PK"
  21.114 -   0xE2   "MN"
  21.115 -   0xE6   "?"
  21.116 -   0xE7   "!"
  21.117 -   0xE8   "."
  21.118 -   0xEF   "male-symbol"
  21.119 -   0xF0   "pokemon-money-symbol"
  21.120 -   0xF1   "."
  21.121 -   0xF2   "/"
  21.122 -   0xF3   ","
  21.123 -   0xF4   "female-symbol"
  21.124 -   0xF6   "0 "
  21.125 -   0xF7   "1"
  21.126 -   0xF8   "2"
  21.127 -   0xF9   "3"
  21.128 -   0xFA   "4"
  21.129 -   0xFB   "5"
  21.130 -   0xFC   "6"
  21.131 -   0xFD   "7"
  21.132 -   0xFE   "8"
  21.133 -   0xFF   "9"
  21.134 -   })
  21.135 -
  21.136 -(def character->character-code
  21.137 -  (zipmap (vals character-code->character)
  21.138 -          (keys character-code->character)))
  21.139 -
  21.140 -
  21.141 -
  21.142 -
  21.143 -
  21.144 -;; 0x00 :  end-of-name-sentinel
  21.145 -;; 0x01 :  
  21.146 -;; 0x02 :  
  21.147 -;; 0x03 :  
  21.148 -;; 0x04 :  
  21.149 -;; 0x05 :  
  21.150 -;; 0x06 :  
  21.151 -;; 0x07 :  
  21.152 -;; 0x08 :  
  21.153 -;; 0x09 :  
  21.154 -;; 0x0A :  
  21.155 -;; 0x0B :  
  21.156 -;; 0x0C :  
  21.157 -;; 0x0D :  
  21.158 -;; 0x0E :  
  21.159 -;; 0x0F :  
  21.160 -;; 0x10 :  
  21.161 -;; 0x11 :  
  21.162 -;; 0x12 :  
  21.163 -;; 0x13 :  
  21.164 -;; 0x14 :  
  21.165 -;; 0x15 :  
  21.166 -;; 0x16 :  
  21.167 -;; 0x17 :  
  21.168 -;; 0x18 :  
  21.169 -;; 0x19 :  
  21.170 -;; 0x1A :  
  21.171 -;; 0x1B :  
  21.172 -;; 0x1C :  
  21.173 -;; 0x1D :  
  21.174 -;; 0x1E :  
  21.175 -;; 0x1F :  
  21.176 -;; 0x20 :  
  21.177 -;; 0x21 :  
  21.178 -;; 0x22 :  
  21.179 -;; 0x23 :  
  21.180 -;; 0x24 :  
  21.181 -;; 0x25 :  
  21.182 -;; 0x26 :  
  21.183 -;; 0x27 :  
  21.184 -;; 0x28 :  
  21.185 -;; 0x29 :  
  21.186 -;; 0x2A :  
  21.187 -;; 0x2B :  
  21.188 -;; 0x2C :  
  21.189 -;; 0x2D :  
  21.190 -;; 0x2E :  
  21.191 -;; 0x2F :  
  21.192 -;; 0x30 :  
  21.193 -;; 0x31 :  
  21.194 -;; 0x32 :  
  21.195 -;; 0x33 :  
  21.196 -;; 0x34 :  
  21.197 -;; 0x35 :  
  21.198 -;; 0x36 :  
  21.199 -;; 0x37 :  
  21.200 -;; 0x38 :  
  21.201 -;; 0x39 :  
  21.202 -;; 0x3A :  
  21.203 -;; 0x3B :  
  21.204 -;; 0x3C :  
  21.205 -;; 0x3D :  
  21.206 -;; 0x3E :  
  21.207 -;; 0x3F :  
  21.208 -;; 0x40 :  
  21.209 -;; 0x41 :  
  21.210 -;; 0x42 :  
  21.211 -;; 0x43 :  
  21.212 -;; 0x44 :  
  21.213 -;; 0x45 :  
  21.214 -;; 0x46 :  
  21.215 -;; 0x47 :  
  21.216 -;; 0x48 :  
  21.217 -;; 0x49 :  
  21.218 -;; 0x4A :  
  21.219 -;; 0x4B :  
  21.220 -;; 0x4C :  
  21.221 -;; 0x4D :  
  21.222 -;; 0x4E :  
  21.223 -;; 0x4F :  
  21.224 -;; 0x50 :  
  21.225 -;; 0x51 :  
  21.226 -;; 0x52 :  
  21.227 -;; 0x53 :  
  21.228 -;; 0x54 :  
  21.229 -;; 0x55 :  
  21.230 -;; 0x56 :  
  21.231 -;; 0x57 :  
  21.232 -;; 0x58 :  
  21.233 -;; 0x59 :  
  21.234 -;; 0x5A :  
  21.235 -;; 0x5B :  
  21.236 -;; 0x5C :  
  21.237 -;; 0x5D :  
  21.238 -;; 0x5E :  
  21.239 -;; 0x5F :  
  21.240 -;; 0x60 :  A (small-bold)
  21.241 -;; 0x61 :  B (small-bold)
  21.242 -;; 0x62 :  C (small-bold)
  21.243 -;; 0x63 :  D (small-bold)
  21.244 -;; 0x64 :  E (small-bold)
  21.245 -;; 0x65 :  F (small-bold)
  21.246 -;; 0x66 :  G (small-bold)
  21.247 -;; 0x67 :  H (small-bold)
  21.248 -;; 0x68 :  I (small-bold)
  21.249 -;; 0x69 :  V (small-bold)
  21.250 -;; 0x6A :  S (small-bold)
  21.251 -;; 0x6B :  L (small-bold)
  21.252 -;; 0x6C :  M (small-bold)
  21.253 -;; 0x6D :  
  21.254 -;; 0x6E :  
  21.255 -;; 0x6F :  
  21.256 -;; 0x70 :  
  21.257 -;; 0x71 :  
  21.258 -;; 0x72 :  
  21.259 -;; 0x73 :  
  21.260 -;; 0x74 :  
  21.261 -;; 0x75 :  
  21.262 -;; 0x76 :  
  21.263 -;; 0x77 :  
  21.264 -;; 0x78 :  
  21.265 -;; 0x79 :  
  21.266 -;; 0x7A :  
  21.267 -;; 0x7B :  
  21.268 -;; 0x7C :  
  21.269 -;; 0x7D :  
  21.270 -;; 0x7E :  
  21.271 -;; 0x7F :  
  21.272 -;; 0x80 :  A
  21.273 -;; 0x81 :  B
  21.274 -;; 0x82 :  C
  21.275 -;; 0x83 :  D
  21.276 -;; 0x84 :  E
  21.277 -;; 0x85 :  F
  21.278 -;; 0x86 :  G
  21.279 -;; 0x87 :  H
  21.280 -;; 0x88 :  I
  21.281 -;; 0x89 :  J
  21.282 -;; 0x8A :  K
  21.283 -;; 0x8B :  L
  21.284 -;; 0x8C :  M
  21.285 -;; 0x8D :  N
  21.286 -;; 0x8E :  O
  21.287 -;; 0x8F :  P
  21.288 -;; 0x90 :  Q
  21.289 -;; 0x91 :  R
  21.290 -;; 0x92 :  S
  21.291 -;; 0x93 :  T
  21.292 -;; 0x94 :  U
  21.293 -;; 0x95 :  V
  21.294 -;; 0x96 :  W
  21.295 -;; 0x97 :  X
  21.296 -;; 0x98 :  Y
  21.297 -;; 0x99 :  Z
  21.298 -;; 0x9A :  (
  21.299 -;; 0x9B :  )
  21.300 -;; 0x9C :  :
  21.301 -;; 0x9D :  ;
  21.302 -;; 0x9E :  
  21.303 -;; 0x9F :  
  21.304 -;; 0xA0 :  a
  21.305 -;; 0xA1 :  b
  21.306 -;; 0xA2 :  c
  21.307 -;; 0xA3 :  d
  21.308 -;; 0xA4 :  e
  21.309 -;; 0xA5 :  f
  21.310 -;; 0xA6 :  g
  21.311 -;; 0xA7 :  h
  21.312 -;; 0xA8 :  i
  21.313 -;; 0xA9 :  j
  21.314 -;; 0xAA :  k
  21.315 -;; 0xAB :  l
  21.316 -;; 0xAC :  m
  21.317 -;; 0xAD :  n
  21.318 -;; 0xAE :  o
  21.319 -;; 0xAF :  p
  21.320 -;; 0xB0 :  q
  21.321 -;; 0xB1 :  r
  21.322 -;; 0xB2 :  s
  21.323 -;; 0xB3 :  t
  21.324 -;; 0xB4 :  u
  21.325 -;; 0xB5 :  v
  21.326 -;; 0xB6 :  w
  21.327 -;; 0xB7 :  x
  21.328 -;; 0xB8 :  y
  21.329 -;; 0xB9 :  z
  21.330 -;; 0xBA :  e-with-grave
  21.331 -;; 0xBB :  
  21.332 -;; 0xBC :  
  21.333 -;; 0xBD :  
  21.334 -;; 0xBE :  
  21.335 -;; 0xBF :  
  21.336 -;; 0xC0 :  
  21.337 -;; 0xC1 :  
  21.338 -;; 0xC2 :  
  21.339 -;; 0xC3 :  
  21.340 -;; 0xC4 :  
  21.341 -;; 0xC5 :  
  21.342 -;; 0xC6 :  
  21.343 -;; 0xC7 :  
  21.344 -;; 0xC8 :  
  21.345 -;; 0xC9 :  
  21.346 -;; 0xCA :  
  21.347 -;; 0xCB :  
  21.348 -;; 0xCC :  
  21.349 -;; 0xCD :  
  21.350 -;; 0xCE :  
  21.351 -;; 0xCF :  
  21.352 -;; 0xD0 :  
  21.353 -;; 0xD1 :  
  21.354 -;; 0xD2 :  
  21.355 -;; 0xD3 :  
  21.356 -;; 0xD4 :  
  21.357 -;; 0xD5 :  
  21.358 -;; 0xD6 :  
  21.359 -;; 0xD7 :  
  21.360 -;; 0xD8 :  
  21.361 -;; 0xD9 :  
  21.362 -;; 0xDA :  
  21.363 -;; 0xDB :  
  21.364 -;; 0xDC :  
  21.365 -;; 0xDD :  
  21.366 -;; 0xDE :  
  21.367 -;; 0xDF :  
  21.368 -;; 0xE0 :  '
  21.369 -;; 0xE1 :  PK
  21.370 -;; 0xE2 :  MN
  21.371 -;; 0xE3 :  
  21.372 -;; 0xE4 :  
  21.373 -;; 0xE5 :  
  21.374 -;; 0xE6 :  ?
  21.375 -;; 0xE7 :  !
  21.376 -;; 0xE8 :  .
  21.377 -;; 0xE9 :  
  21.378 -;; 0xEA :  
  21.379 -;; 0xEB :  
  21.380 -;; 0xEC :  
  21.381 -;; 0xED :  
  21.382 -;; 0xEE :  
  21.383 -;; 0xEF :  male-symbol
  21.384 -;; 0xF0 :  pokemon-money-symbol
  21.385 -;; 0xF1 :  .
  21.386 -;; 0xF2 :  /
  21.387 -;; 0xF3 :  ,
  21.388 -;; 0xF4 :  female-symbol
  21.389 -;; 0xF5 :  
  21.390 -;; 0xF6 :  0 
  21.391 -;; 0xF7 :  1
  21.392 -;; 0xF8 :  2
  21.393 -;; 0xF9 :  3
  21.394 -;; 0xFA :  4
  21.395 -;; 0xFB :  5
  21.396 -;; 0xFC :  6
  21.397 -;; 0xFD :  7
  21.398 -;; 0xFE :  8
  21.399 -;; 0xFF :  9
  21.400 -           
  21.401 -                
  21.402 -
  21.403 -
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/clojure/com/aurellem/run/save_corruption.clj	Mon Mar 19 21:23:46 2012 -0500
    22.3 @@ -0,0 +1,221 @@
    22.4 +(ns com.aurellem.save-corruption
    22.5 +  (:use (com.aurellem gb-driver vbm title)))
    22.6 +
    22.7 +(use 'clojure.repl)
    22.8 +
    22.9 +(defn-memo start-walking [] 
   22.10 +  (->> (finish-title)
   22.11 +       (advance [:b] [:b :r])))
   22.12 +
   22.13 +(def walk (partial advance []))
   22.14 +
   22.15 +(defn-memo walk-to-stairs []
   22.16 +  (->> (start-walking)
   22.17 +       (walk [:u])
   22.18 +       (walk [:u])
   22.19 +       (walk [:u])
   22.20 +       (walk [:u])
   22.21 +       (walk [:u])
   22.22 +       (walk [:r])
   22.23 +       (walk [:r])
   22.24 +       (walk [:r])))
   22.25 +
   22.26 +(defn-memo walk-to-door []
   22.27 +  (->> (walk-to-stairs)
   22.28 +       (walk [:d])
   22.29 +       (walk [:d])
   22.30 +       (walk [:d])
   22.31 +       (walk [:d])
   22.32 +       (walk [:d])
   22.33 +       (walk [:d])
   22.34 +       (walk [:l])
   22.35 +       (walk [:l])
   22.36 +       (walk [:l])
   22.37 +       (walk [:l])))
   22.38 +  
   22.39 +
   22.40 +(defn-memo activate-menu []
   22.41 +  (->> (walk-to-door)
   22.42 +       (advance [:b] [:a :b :start])))
   22.43 +
   22.44 +(defn-memo save-game []
   22.45 +  (->> (activate-menu)
   22.46 +       (advance [] [:d])
   22.47 +       (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]])
   22.48 +       scroll-text))
   22.49 +
   22.50 +(defn-memo corrupt-save []
   22.51 +  (->> (save-game)
   22.52 +       (play-moves
   22.53 +        ;; this section is copied from speedrun-2942
   22.54 +        ;; and corrupts the save so that the end-of-list marker
   22.55 +        ;; for the pokemon roster is destroyed, but the save is still
   22.56 +        ;; playable.
   22.57 +         [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   22.58 +         [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])))
   22.59 +
   22.60 +(defn-memo skip-title-again []
   22.61 +  (->> (corrupt-save)
   22.62 +       (play-moves
   22.63 +        (first (title)))))
   22.64 +
   22.65 +(defn-memo start-game []
   22.66 +  (->> (skip-title-again)
   22.67 +       (advance [] [:start])
   22.68 +       (advance [] [:a])
   22.69 +       (advance [:a] [:a :start])))
   22.70 +
   22.71 +(defn-memo destroy-item-end-of-list-marker []
   22.72 +  (->> (start-game)
   22.73 +       (play-moves
   22.74 +        [
   22.75 +         [:start] [] [] [] [] [] [] [] [] [] [] []
   22.76 +        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
   22.77 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d]
   22.78 +        [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] []
   22.79 +        [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] []
   22.80 +        [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] []
   22.81 +        [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
   22.82 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   22.83 +        [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d]
   22.84 +        [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] []
   22.85 +        [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
   22.86 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   22.87 +        [] [] [] [] [] [] [] [] [] [] []
   22.88 +
   22.89 +        ;; [:b] [] [] [] [] [] [] [] []
   22.90 +        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   22.91 +        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] []
   22.92 +        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] []
   22.93 +        ])))
   22.94 +        
   22.95 +
   22.96 +
   22.97 +(defn warp-to-elite-four
   22.98 +  "This is copied from speedrun-2942 to ensure that everything is good
   22.99 +   up to this point."
  22.100 +  []
  22.101 +  (->> (corrupt-save)
  22.102 +       (play-moves
  22.103 +        [ [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.104 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.105 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.106 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.107 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.108 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.109 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.110 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.111 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.112 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.113 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.114 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.115 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.116 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.117 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.118 +        [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  22.119 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.120 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.121 +        [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] []
  22.122 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.123 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.124 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.125 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.126 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.127 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.128 +        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  22.129 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.130 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.131 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.132 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.133 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.134 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.135 +        [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] []
  22.136 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.137 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a]
  22.138 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.139 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.140 +        [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] []
  22.141 +        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  22.142 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d]
  22.143 +        [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] []
  22.144 +        [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] []
  22.145 +        [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] []
  22.146 +        [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  22.147 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.148 +        [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d]
  22.149 +        [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] []
  22.150 +        [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  22.151 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.152 +        [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] []
  22.153 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.154 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] []
  22.155 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] []
  22.156 +        [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] []
  22.157 +        [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d]
  22.158 +        [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] []
  22.159 +        [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] []
  22.160 +        [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] []
  22.161 +        [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] []
  22.162 +        [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] []
  22.163 +        [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] []
  22.164 +        [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d]
  22.165 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] []
  22.166 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [] []
  22.167 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.168 +        [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] []
  22.169 +        [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] []
  22.170 +        [] [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.171 +        [] [] [] [:select] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.172 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.173 +        [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] []
  22.174 +        [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] []
  22.175 +        [] [] [] [] [] [:d] [] [] [] [] [:b] [] [] [] [] [] [] [] []
  22.176 +        [] [] [] [] [] [] [] [] [:select] [] [] [] [] [] [] [] [] []
  22.177 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] []
  22.178 +        [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] []
  22.179 +        [:d] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] []
  22.180 +        [] [] [] [:d] [] [] [] [] [] [] [] [] [] [] [] [:select] [] []
  22.181 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.182 +        [] [] [] [] [] [] [] [] [] [:a] [] [] [:d] [] [] [:a] [:u] []
  22.183 +        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  22.184 +        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  22.185 +        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  22.186 +        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  22.187 +        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  22.188 +        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  22.189 +        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  22.190 +        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  22.191 +        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [:a] [] [] [] []
  22.192 +        [] [:a] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.193 +        [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  22.194 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] []
  22.195 +        [] [] [] [:b] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  22.196 +        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  22.197 +        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  22.198 +        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [] [] [] [] [] [] [] [] []
  22.199 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.200 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.201 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.202 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.203 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.204 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.205 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.206 +        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  22.207 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.208 +        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  22.209 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  22.210 +        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  22.211 +        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  22.212 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] []
  22.213 +        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  22.214 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] []
  22.215 +        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  22.216 +        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  22.217 +        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] []
  22.218 +        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  22.219 +        [] [] [] [:b]])))
  22.220 +
  22.221 +        
  22.222 +       
  22.223 +
  22.224 +
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/clojure/com/aurellem/run/speedruns.clj	Mon Mar 19 21:23:46 2012 -0500
    23.3 @@ -0,0 +1,17 @@
    23.4 +(ns com.aurellem.speedruns
    23.5 +  (:import java.io.File))
    23.6 +
    23.7 +(def speedrun-2942
    23.8 +  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm"))
    23.9 +
   23.10 +(def speedrun-2913
   23.11 +  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm"))
   23.12 +
   23.13 +(def speedrun-2771
   23.14 +  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm"))
   23.15 +
   23.16 +(def broken-speedrun-1958
   23.17 +  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-1958[bad].vbm"))
   23.18 +
   23.19 +(def broken-speedrun-3256
   23.20 +  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-3256[bad].vbm"))
   23.21 \ No newline at end of file
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/clojure/com/aurellem/run/title.clj	Mon Mar 19 21:23:46 2012 -0500
    24.3 @@ -0,0 +1,118 @@
    24.4 +(ns com.aurellem.title
    24.5 +  (:use (com.aurellem gb-driver vbm)))
    24.6 +
    24.7 +(defn first-difference [base alt summary root]
    24.8 +  (loop [branch-point root
    24.9 +         actions []]
   24.10 +    (let [base-branch (step branch-point base)
   24.11 +          base-val (summary base-branch)
   24.12 +          alt-branch (step branch-point alt)
   24.13 +          alt-val (summary alt-branch)]
   24.14 +      (if (not= base-val alt-val)
   24.15 +        [(conj actions alt) alt-branch]
   24.16 +        (recur base-branch (conj actions base))))))
   24.17 +
   24.18 +(defn advance
   24.19 +  ([base alt summary [commands state]]
   24.20 +     (let [[c s] (first-difference base alt summary state)]
   24.21 +       [(concat commands c) s]))
   24.22 +  ([base alt [commands state]]
   24.23 +     (advance base alt AF [commands state]))
   24.24 +  ([alt [commands state]]
   24.25 +     (advance [] alt [commands state])))
   24.26 +
   24.27 +(def scroll-text (partial advance [:b] [:a :b]))
   24.28 +
   24.29 +(defn start [] [[] (root)])
   24.30 +
   24.31 +(defn-memo title []
   24.32 +  (->> (start)
   24.33 +       (advance [] [:a])
   24.34 +       (advance [] [:start])
   24.35 +       (advance [] [:a])
   24.36 +       (advance [] [:start])))
   24.37 +
   24.38 +(defn-memo oak []
   24.39 +  (->> (title)
   24.40 +       scroll-text
   24.41 +       scroll-text
   24.42 +       scroll-text
   24.43 +       scroll-text
   24.44 +       scroll-text
   24.45 +       scroll-text
   24.46 +       scroll-text
   24.47 +       scroll-text
   24.48 +       scroll-text
   24.49 +       scroll-text
   24.50 +       scroll-text
   24.51 +       scroll-text
   24.52 +       scroll-text
   24.53 +       ))
   24.54 +
   24.55 +(defn-memo name-entry-rlm []
   24.56 +  (->> (oak)
   24.57 +       (advance [] [:a])
   24.58 +       (advance [] [:r] DE)
   24.59 +       (play-moves
   24.60 +        [[]
   24.61 +         [:r] [] [:r] [] [:r] [] [:r] []
   24.62 +         [:r] [] [:r] [] [:r] [] [:d] [:a]  
   24.63 +         [:l] [] [:l] [] [:l] [] [:l] []
   24.64 +         [:l] [] [:l] [:a] [] [:r] [:a]
   24.65 +         [:r] [] [:r] [] [:r] [] [:r] []
   24.66 +         [:r] [] [:d] [] [:d] [] [:d] [:a]
   24.67 +         ])))
   24.68 +
   24.69 +(defn-memo name-entry-ash []
   24.70 +  (->> (oak)
   24.71 +       (advance [] [:d])
   24.72 +       (advance [] [:d])
   24.73 +       (advance [] [:a])))
   24.74 +       
   24.75 +(defn-memo rival-name-entry-gary []
   24.76 +  (->> (name-entry-ash)
   24.77 +       scroll-text
   24.78 +       scroll-text
   24.79 +       scroll-text
   24.80 +       scroll-text
   24.81 +       scroll-text
   24.82 +       (advance [] [:d])
   24.83 +       (advance [] [:d])
   24.84 +       (advance [] [:a])))
   24.85 +
   24.86 +(defn-memo rival-name-entry-blue []
   24.87 +  (->> (name-entry-ash)
   24.88 +       scroll-text
   24.89 +       scroll-text
   24.90 +       scroll-text
   24.91 +       scroll-text
   24.92 +       scroll-text
   24.93 +       (advance [] [:d])
   24.94 +       (advance [] [:a])))
   24.95 +
   24.96 +(defn-memo finish-title []
   24.97 +  (->> (rival-name-entry-blue)
   24.98 +       scroll-text
   24.99 +       scroll-text
  24.100 +       scroll-text
  24.101 +       scroll-text
  24.102 +       scroll-text
  24.103 +       scroll-text
  24.104 +       scroll-text))
  24.105 +
  24.106 +(def title-frames 2323)
  24.107 +
  24.108 +(defn title-checkpoint! []
  24.109 +  (let [[moves state] (finish-title)]
  24.110 +    (assert (= title-frames (:frame state)))
  24.111 +    [(write-moves! moves) (write-state! state)]))
  24.112 +
  24.113 +(defn intro []
  24.114 +  [(read-moves title-frames)
  24.115 +   (read-state title-frames)])
  24.116 +
  24.117 +(defn test-intro []
  24.118 +  (play-vbm (moves->filename title-frames)))
  24.119 +
  24.120 +;; TODO might be able to glue these together more elegantly with monads
  24.121 +
    25.1 --- a/clojure/com/aurellem/save_corruption.clj	Mon Mar 19 20:43:38 2012 -0500
    25.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.3 @@ -1,221 +0,0 @@
    25.4 -(ns com.aurellem.save-corruption
    25.5 -  (:use (com.aurellem gb-driver vbm title)))
    25.6 -
    25.7 -(use 'clojure.repl)
    25.8 -
    25.9 -(defn-memo start-walking [] 
   25.10 -  (->> (finish-title)
   25.11 -       (advance [:b] [:b :r])))
   25.12 -
   25.13 -(def walk (partial advance []))
   25.14 -
   25.15 -(defn-memo walk-to-stairs []
   25.16 -  (->> (start-walking)
   25.17 -       (walk [:u])
   25.18 -       (walk [:u])
   25.19 -       (walk [:u])
   25.20 -       (walk [:u])
   25.21 -       (walk [:u])
   25.22 -       (walk [:r])
   25.23 -       (walk [:r])
   25.24 -       (walk [:r])))
   25.25 -
   25.26 -(defn-memo walk-to-door []
   25.27 -  (->> (walk-to-stairs)
   25.28 -       (walk [:d])
   25.29 -       (walk [:d])
   25.30 -       (walk [:d])
   25.31 -       (walk [:d])
   25.32 -       (walk [:d])
   25.33 -       (walk [:d])
   25.34 -       (walk [:l])
   25.35 -       (walk [:l])
   25.36 -       (walk [:l])
   25.37 -       (walk [:l])))
   25.38 -  
   25.39 -
   25.40 -(defn-memo activate-menu []
   25.41 -  (->> (walk-to-door)
   25.42 -       (advance [:b] [:a :b :start])))
   25.43 -
   25.44 -(defn-memo save-game []
   25.45 -  (->> (activate-menu)
   25.46 -       (advance [] [:d])
   25.47 -       (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]])
   25.48 -       scroll-text))
   25.49 -
   25.50 -(defn-memo corrupt-save []
   25.51 -  (->> (save-game)
   25.52 -       (play-moves
   25.53 -        ;; this section is copied from speedrun-2942
   25.54 -        ;; and corrupts the save so that the end-of-list marker
   25.55 -        ;; for the pokemon roster is destroyed, but the save is still
   25.56 -        ;; playable.
   25.57 -         [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   25.58 -         [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])))
   25.59 -
   25.60 -(defn-memo skip-title-again []
   25.61 -  (->> (corrupt-save)
   25.62 -       (play-moves
   25.63 -        (first (title)))))
   25.64 -
   25.65 -(defn-memo start-game []
   25.66 -  (->> (skip-title-again)
   25.67 -       (advance [] [:start])
   25.68 -       (advance [] [:a])
   25.69 -       (advance [:a] [:a :start])))
   25.70 -
   25.71 -(defn-memo destroy-item-end-of-list-marker []
   25.72 -  (->> (start-game)
   25.73 -       (play-moves
   25.74 -        [
   25.75 -         [:start] [] [] [] [] [] [] [] [] [] [] []
   25.76 -        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
   25.77 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d]
   25.78 -        [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] []
   25.79 -        [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] []
   25.80 -        [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] []
   25.81 -        [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
   25.82 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   25.83 -        [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d]
   25.84 -        [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] []
   25.85 -        [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
   25.86 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   25.87 -        [] [] [] [] [] [] [] [] [] [] []
   25.88 -
   25.89 -        ;; [:b] [] [] [] [] [] [] [] []
   25.90 -        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   25.91 -        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] []
   25.92 -        ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] []
   25.93 -        ])))
   25.94 -        
   25.95 -
   25.96 -
   25.97 -(defn warp-to-elite-four
   25.98 -  "This is copied from speedrun-2942 to ensure that everything is good
   25.99 -   up to this point."
  25.100 -  []
  25.101 -  (->> (corrupt-save)
  25.102 -       (play-moves
  25.103 -        [ [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.104 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.105 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.106 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.107 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.108 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.109 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.110 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.111 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.112 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.113 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.114 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.115 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.116 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.117 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.118 -        [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  25.119 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.120 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.121 -        [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] []
  25.122 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.123 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.124 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.125 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.126 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.127 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.128 -        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  25.129 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.130 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.131 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.132 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.133 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.134 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.135 -        [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] []
  25.136 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.137 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a]
  25.138 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.139 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.140 -        [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] []
  25.141 -        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  25.142 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d]
  25.143 -        [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] []
  25.144 -        [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] []
  25.145 -        [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] []
  25.146 -        [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  25.147 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.148 -        [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d]
  25.149 -        [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] []
  25.150 -        [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  25.151 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.152 -        [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] []
  25.153 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.154 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] []
  25.155 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] []
  25.156 -        [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] []
  25.157 -        [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d]
  25.158 -        [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] []
  25.159 -        [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] []
  25.160 -        [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] []
  25.161 -        [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] []
  25.162 -        [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] []
  25.163 -        [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] []
  25.164 -        [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d]
  25.165 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] []
  25.166 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [] []
  25.167 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.168 -        [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] []
  25.169 -        [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] []
  25.170 -        [] [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.171 -        [] [] [] [:select] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.172 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.173 -        [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] []
  25.174 -        [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] []
  25.175 -        [] [] [] [] [] [:d] [] [] [] [] [:b] [] [] [] [] [] [] [] []
  25.176 -        [] [] [] [] [] [] [] [] [:select] [] [] [] [] [] [] [] [] []
  25.177 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] []
  25.178 -        [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] []
  25.179 -        [:d] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] []
  25.180 -        [] [] [] [:d] [] [] [] [] [] [] [] [] [] [] [] [:select] [] []
  25.181 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.182 -        [] [] [] [] [] [] [] [] [] [:a] [] [] [:d] [] [] [:a] [:u] []
  25.183 -        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  25.184 -        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  25.185 -        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  25.186 -        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  25.187 -        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  25.188 -        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  25.189 -        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u]
  25.190 -        [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] []
  25.191 -        [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [:a] [] [] [] []
  25.192 -        [] [:a] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.193 -        [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] []
  25.194 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] []
  25.195 -        [] [] [] [:b] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  25.196 -        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  25.197 -        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d]
  25.198 -        [:d] [:d] [:d] [:d] [:d] [:d] [:d] [] [] [] [] [] [] [] [] []
  25.199 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.200 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.201 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.202 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.203 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.204 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.205 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.206 -        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  25.207 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.208 -        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  25.209 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
  25.210 -        [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] []
  25.211 -        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  25.212 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] []
  25.213 -        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  25.214 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] []
  25.215 -        [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] []
  25.216 -        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  25.217 -        [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] []
  25.218 -        [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] []
  25.219 -        [] [] [] [:b]])))
  25.220 -
  25.221 -        
  25.222 -       
  25.223 -
  25.224 -
    26.1 --- a/clojure/com/aurellem/speedruns.clj	Mon Mar 19 20:43:38 2012 -0500
    26.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.3 @@ -1,17 +0,0 @@
    26.4 -(ns com.aurellem.speedruns
    26.5 -  (:import java.io.File))
    26.6 -
    26.7 -(def speedrun-2942
    26.8 -  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm"))
    26.9 -
   26.10 -(def speedrun-2913
   26.11 -  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm"))
   26.12 -
   26.13 -(def speedrun-2771
   26.14 -  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm"))
   26.15 -
   26.16 -(def broken-speedrun-1958
   26.17 -  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-1958[bad].vbm"))
   26.18 -
   26.19 -(def broken-speedrun-3256
   26.20 -  (File. "/home/r/proj/pokemon-escape/speedruns/yellow-3256[bad].vbm"))
   26.21 \ No newline at end of file
    27.1 --- a/clojure/com/aurellem/title.clj	Mon Mar 19 20:43:38 2012 -0500
    27.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.3 @@ -1,118 +0,0 @@
    27.4 -(ns com.aurellem.title
    27.5 -  (:use (com.aurellem gb-driver vbm)))
    27.6 -
    27.7 -(defn first-difference [base alt summary root]
    27.8 -  (loop [branch-point root
    27.9 -         actions []]
   27.10 -    (let [base-branch (step branch-point base)
   27.11 -          base-val (summary base-branch)
   27.12 -          alt-branch (step branch-point alt)
   27.13 -          alt-val (summary alt-branch)]
   27.14 -      (if (not= base-val alt-val)
   27.15 -        [(conj actions alt) alt-branch]
   27.16 -        (recur base-branch (conj actions base))))))
   27.17 -
   27.18 -(defn advance
   27.19 -  ([base alt summary [commands state]]
   27.20 -     (let [[c s] (first-difference base alt summary state)]
   27.21 -       [(concat commands c) s]))
   27.22 -  ([base alt [commands state]]
   27.23 -     (advance base alt AF [commands state]))
   27.24 -  ([alt [commands state]]
   27.25 -     (advance [] alt [commands state])))
   27.26 -
   27.27 -(def scroll-text (partial advance [:b] [:a :b]))
   27.28 -
   27.29 -(defn start [] [[] (root)])
   27.30 -
   27.31 -(defn-memo title []
   27.32 -  (->> (start)
   27.33 -       (advance [] [:a])
   27.34 -       (advance [] [:start])
   27.35 -       (advance [] [:a])
   27.36 -       (advance [] [:start])))
   27.37 -
   27.38 -(defn-memo oak []
   27.39 -  (->> (title)
   27.40 -       scroll-text
   27.41 -       scroll-text
   27.42 -       scroll-text
   27.43 -       scroll-text
   27.44 -       scroll-text
   27.45 -       scroll-text
   27.46 -       scroll-text
   27.47 -       scroll-text
   27.48 -       scroll-text
   27.49 -       scroll-text
   27.50 -       scroll-text
   27.51 -       scroll-text
   27.52 -       scroll-text
   27.53 -       ))
   27.54 -
   27.55 -(defn-memo name-entry-rlm []
   27.56 -  (->> (oak)
   27.57 -       (advance [] [:a])
   27.58 -       (advance [] [:r] DE)
   27.59 -       (play-moves
   27.60 -        [[]
   27.61 -         [:r] [] [:r] [] [:r] [] [:r] []
   27.62 -         [:r] [] [:r] [] [:r] [] [:d] [:a]  
   27.63 -         [:l] [] [:l] [] [:l] [] [:l] []
   27.64 -         [:l] [] [:l] [:a] [] [:r] [:a]
   27.65 -         [:r] [] [:r] [] [:r] [] [:r] []
   27.66 -         [:r] [] [:d] [] [:d] [] [:d] [:a]
   27.67 -         ])))
   27.68 -
   27.69 -(defn-memo name-entry-ash []
   27.70 -  (->> (oak)
   27.71 -       (advance [] [:d])
   27.72 -       (advance [] [:d])
   27.73 -       (advance [] [:a])))
   27.74 -       
   27.75 -(defn-memo rival-name-entry-gary []
   27.76 -  (->> (name-entry-ash)
   27.77 -       scroll-text
   27.78 -       scroll-text
   27.79 -       scroll-text
   27.80 -       scroll-text
   27.81 -       scroll-text
   27.82 -       (advance [] [:d])
   27.83 -       (advance [] [:d])
   27.84 -       (advance [] [:a])))
   27.85 -
   27.86 -(defn-memo rival-name-entry-blue []
   27.87 -  (->> (name-entry-ash)
   27.88 -       scroll-text
   27.89 -       scroll-text
   27.90 -       scroll-text
   27.91 -       scroll-text
   27.92 -       scroll-text
   27.93 -       (advance [] [:d])
   27.94 -       (advance [] [:a])))
   27.95 -
   27.96 -(defn-memo finish-title []
   27.97 -  (->> (rival-name-entry-blue)
   27.98 -       scroll-text
   27.99 -       scroll-text
  27.100 -       scroll-text
  27.101 -       scroll-text
  27.102 -       scroll-text
  27.103 -       scroll-text
  27.104 -       scroll-text))
  27.105 -
  27.106 -(def title-frames 2323)
  27.107 -
  27.108 -(defn title-checkpoint! []
  27.109 -  (let [[moves state] (finish-title)]
  27.110 -    (assert (= title-frames (:frame state)))
  27.111 -    [(write-moves! moves) (write-state! state)]))
  27.112 -
  27.113 -(defn intro []
  27.114 -  [(read-moves title-frames)
  27.115 -   (read-state title-frames)])
  27.116 -
  27.117 -(defn test-intro []
  27.118 -  (play-vbm (moves->filename title-frames)))
  27.119 -
  27.120 -;; TODO might be able to glue these together more elegantly with monads
  27.121 -
    28.1 --- a/clojure/com/aurellem/util.clj	Mon Mar 19 20:43:38 2012 -0500
    28.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.3 @@ -1,3 +0,0 @@
    28.4 -(ns com.aurellem.util
    28.5 -  (:use (com.aurellem gb-driver vbm)
    28.6 -  (:import [com.aurellem.gb_driver SaveState])))
    29.1 --- a/clojure/com/aurellem/vbm.clj	Mon Mar 19 20:43:38 2012 -0500
    29.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.3 @@ -1,127 +0,0 @@
    29.4 -(ns com.aurellem.vbm
    29.5 -  (:import java.io.File)
    29.6 -  (:import org.apache.commons.io.FileUtils)
    29.7 -  (:use com.aurellem.gb-driver))
    29.8 -
    29.9 -;;;;;;;;;;;;; read vbm file 
   29.10 -
   29.11 -(def ^:dynamic *moves-cache*
   29.12 -     (File. user-home "proj/pokemon-escape/moves/"))
   29.13 -
   29.14 -(defn buttons [mask]
   29.15 -  (loop [buttons []
   29.16 -         masks (seq (dissoc button-code :listen))]
   29.17 -    (if (empty? masks) buttons
   29.18 -        (let [[button value] (first masks)]
   29.19 -          (if (not= 0x0000 (bit-and value mask))
   29.20 -            (recur (conj buttons button) (rest masks))
   29.21 -            (recur buttons (rest masks)))))))
   29.22 -
   29.23 -(defn vbm-bytes [#^File vbm]
   29.24 -  (let [bytes (FileUtils/readFileToByteArray vbm)
   29.25 -        ints (int-array (count bytes))]
   29.26 -    (areduce bytes idx _ nil
   29.27 -             (aset ints idx
   29.28 -                   (bit-and 0xFF (aget bytes idx))))
   29.29 -    ints))
   29.30 -
   29.31 -(def vbm-header-length 255)
   29.32 -
   29.33 -(defn repair-vbm
   29.34 -  "Two 0's must be inserted after every reset."
   29.35 -  [vbm-masks]
   29.36 -  (loop [fixed []
   29.37 -         pending vbm-masks]
   29.38 -    (if (empty? pending) fixed
   29.39 -        (let [mask (first pending)]
   29.40 -          (if (not= 0x0000 (bit-and mask (button-code :restart)))
   29.41 -            (recur (conj fixed mask 0x0000 0x0000) (next pending))
   29.42 -            (recur (conj fixed mask) (next pending)))))))
   29.43 -
   29.44 -(defn vbm-masks [#^File vbm]
   29.45 -  (repair-vbm
   29.46 -   (map (fn [[a b]]
   29.47 -          (+ (bit-shift-left a 8) b))
   29.48 -        (partition
   29.49 -         2 (drop vbm-header-length (vbm-bytes vbm))))))
   29.50 -
   29.51 -(defn vbm-buttons [#^File vbm]
   29.52 -  (map buttons (vbm-masks vbm)))
   29.53 -
   29.54 -(defn convert-buttons
   29.55 -  "To write a vbm file, we must remove the last two buttons after any
   29.56 -   reset event."
   29.57 -  [buttons]
   29.58 -  (loop [fixed []
   29.59 -         pending buttons]
   29.60 -    (if (empty? pending) fixed
   29.61 -        (let [mask (first pending)]
   29.62 -          (if (contains? (set (first pending)) :reset)
   29.63 -            (recur (conj fixed mask) (drop 3 pending))
   29.64 -            (recur (conj fixed mask) (next pending)))))))
   29.65 -
   29.66 -(defn moves->filename [frame]
   29.67 -  (File. *moves-cache* (format "%07d.vbm" frame)))
   29.68 -
   29.69 -(defn read-moves [frame]
   29.70 -  (let [target (moves->filename frame)]
   29.71 -    (if (.exists target)
   29.72 -      (vbm-buttons target))))
   29.73 -;;;;;;;;;;;;;; write moves to vbm file
   29.74 -
   29.75 -
   29.76 -(def vbm-header
   29.77 -  (byte-array
   29.78 -   (map
   29.79 -    byte
   29.80 -    [86 66 77 26 1 0 0 0 105 74 88 79 89 1 0 0 0 0 0 0 0 1 2 112 0 0 0
   29.81 -     0 0 0 0 0 1 0 0 0 80 79 75 69 77 79 78 32 89 69 76 76 1 -105 124 4
   29.82 -     3 0 0 0 0 0 0 0 0 1 0 0 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.83 -     95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
   29.84 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.85 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.86 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.87 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.88 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.89 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.90 -     95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
   29.91 -     95 95 95 95])))
   29.92 -
   29.93 -(def vbm-trailer
   29.94 -  (byte-array
   29.95 -   (map byte [0])))
   29.96 -
   29.97 -(defn buttons->vbm-bytes [buttons]
   29.98 -  (let [bytes-in-ints
   29.99 -        (map button-mask (convert-buttons buttons))
  29.100 -        high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
  29.101 -                       bytes-in-ints)
  29.102 -        low-bits (map #(bit-and 0xFF %) bytes-in-ints)
  29.103 -        convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
  29.104 -        contents
  29.105 -        (byte-array
  29.106 -         (concat
  29.107 -          vbm-header
  29.108 -          (map convert-byte (interleave high-bits low-bits))
  29.109 -          vbm-trailer))]
  29.110 -    contents))
  29.111 -        
  29.112 -(defn write-moves! [moves]
  29.113 -  (let [target (moves->filename (count moves))]
  29.114 -    (clojure.java.io/copy (buttons->vbm-bytes moves) target)
  29.115 -    target))
  29.116 -
  29.117 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29.118 -
  29.119 -(use 'clojure.java.shell)
  29.120 -
  29.121 -(def vba-linux (File. user-home "bin/vba-linux"))
  29.122 -
  29.123 -(defn play-vbm [#^File vbm]
  29.124 -  (.delete yellow-save-file)
  29.125 -  (if (.exists vbm)
  29.126 -    (sh (.getCanonicalPath vba-linux)
  29.127 -        (str "--playmovie=" (.getCanonicalPath vbm))
  29.128 -        (.getCanonicalPath yellow-rom-image)))
  29.129 -  nil)
  29.130 -