# HG changeset patch # User Robert McIntyre # Date 1332210226 18000 # Node ID 412ca096a9ba94e3e4f525fa6bb7e35971de159d # Parent ec477931f0779cf6324f359852919b1e5f490aa8 major refactoring complete. diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/assembly.clj --- a/clojure/com/aurellem/assembly.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1505 +0,0 @@ -(ns com.aurellem.assembly - (:use (com.aurellem gb-driver vbm title items)) - (:import [com.aurellem.gb_driver SaveState])) - -(defn mid-game [] - (read-state "mid-game")) - -(defn inject-assembly - ([^SaveState state - program-counter registers - assembly-code] - (let [scratch-memory (memory state)] - ;; inject assembly code - (dorun (map (fn [index val] - (aset scratch-memory index val)) - (range program-counter - (+ program-counter (count assembly-code))) - assembly-code)) - (-> state - (write-memory! scratch-memory) - (write-registers! registers) - (PC! program-counter))))) - -(defn inject-item-assembly - ([^SaveState state assembly-code] - (inject-assembly state (inc item-list-start) - (registers state) - assembly-code)) - ([assembly-code] - (inject-item-assembly @current-state assembly-code))) - -(defn info - ([^SaveState state] - (println (format "PC: 0x%04X" (PC state))) - (println "Instruction:" - (format "0x%02X" (aget (memory state) (PC state)))) - state)) - -(defn print-interrupt - [^SaveState state] - (println (format "IE: %d" (IE state))) - state) - -(defn print-listing [state begin end] - (dorun (map - (fn [opcode line] - (println (format "0x%04X: 0x%02X" line opcode))) - (subvec (vec (memory state)) begin end) - (range begin end))) - state) - -(defn run-assembly - ([info-fn assembly n] - (let [final-state - (reduce (fn [state _] - (tick (info-fn state))) - (inject-item-assembly - (mid-game) assembly) - (range n))] - final-state)) - ([assembly n] - (run-assembly info assembly n))) - -(def buttons-port 0xFF00) - -(defn A [state] - (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8)) - -(defn B [state] - (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8)) - -(defn D [state] - (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8)) - -(defn H [state] - (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8)) - -(defn C [state] - (bit-and 0xFF (BC state))) -(defn F [state] - (bit-and 0xFF (AF state))) -(defn E [state] - (bit-and 0xFF (DE state))) -(defn L [state] - (bit-and 0xFF (HL state))) - - - - - -(defn binary-str [num] - (format "%08d" - (Integer/parseInt - (Integer/toBinaryString num) 10))) - -(defn view-register [state name reg-fn] - (println (format "%s: %s" name - (binary-str (reg-fn state)))) - state) - -(defn view-memory [state mem] - (println (format "mem 0x%04X = %s" mem - (binary-str (aget (memory state) mem)))) - state) - -(defn trace [state] - (loop [program-counters [(first (registers @current-state)) ] - opcodes [(aget (memory @current-state) (PC @current-state))]] - (let [frame-boundary? - (com.aurellem.gb.Gb/tick)] - (if frame-boundary? - [program-counters opcodes] - (recur - (conj program-counters - (first (registers @current-state))) - (conj opcodes - (aget (memory @current-state) - (PC @current-state)))))))) - -(defn print-trace [state n] - (let [[program-counters opcodes] (trace state)] - (dorun (map (fn [pc op] (println (format "%04X: 0x%02X" pc op))) - (take n program-counters) - (take n opcodes))))) - -(defn good-trace [] - (-> (mid-game) (tick) (IE! 0) - (set-inv-mem [0x00 0x00 0X00 0x00]) - (PC! item-list-start)(print-interrupt) - (info) (tick) (info) (tick) (info))) - -(defn read-down-button [] - (-> (tick (mid-game)) - (IE! 0) ; disable interrupts - (inject-item-assembly - ;; write 00010000 to 0xFF00 to select joypad - [0x18 ;D31D ; jump over - 0x01 ;D31E ; the next 8 bits - ;D31F - (Integer/parseInt "00100000" 2) ; data section - - 0xFA ;D320 ; load (D31F) into A - 0x1F ;D321 --> - 0xD3 ;D322 --> D31F - - 0xEA ;D323 ; load (A), which is - 0x00 ;D324 --> ; 00010000, into FF00 - 0xFF ;D325 --> FF00 - - 0x18 ;D326 ; this is the place where - 0x01 ;D327 ; we will store whether - 0x00 ;D328 ; "down" is pressed. - - 0xFA ;D329 ; (FF00) -> A - 0x00 ;D32A - 0xFF ;D32B - - 0xCB ;D32C ; Test whether "down" - 0x5F ;D32D ; is pressed. - - 0x28 ;D32E ; if down is pressed, - 0x03 ;D32F ; skip the next section - ; of code. - ;; down-is-not-pressed - 0xC3 ;D330 - 0x1D ;D331 ; return to beginning - 0xD3 ;D332 - - ;; down-is-pressed - 0xEA ;D334 ; write A to D328 if - 0x28 ;D335 ; "down" was pressed - 0xD3 ;D336 - - 0xC3 ;D330 - 0x1D ;D331 ; return to beginning - 0xD3 ;D332 - ]))) - -(defn test-read-down [] - (= (view-memory (step (step (read-down-button) [:d])) 0xD328) - (view-memory (step (step (read-down-button))) 0xD328))) - -(defn count-frames [] - (-> (tick (mid-game)) - (IE! 0) ; disable interrupts - (inject-item-assembly - [0x18 ;D31D ; jump over - 0x02 ;D31E ; the next 2 bytes - 0x00 ;D31F ; frame-count - 0x00 ;D320 ; v-blank-prev - - 0xFA ;D321 - 0x41 ;D322 ; load (FF41) into A - 0xFF ;D323 ; this contains mode flags - - ;; if we're in v-blank, the bit-1 is 0 - ;; and bit-2 is 1 Otherwise, it is not v-blank. - 0xCB ;D324 ; test bit-1 of A - 0x4F ;D325 - - 0xC2 ;D326 ; if bit-1 is not 0 - 0x44 ;D327 ; GOTO not-v-blank - 0xD3 ;D328 - - 0xCB ;D329 ; test bit-0 of A - 0x47 ;D32A - - 0xCA ;D32B ; if bit-0 is not 1 - 0x44 ;D32C ; GOTO not-v-blank - 0xD3 ;D32D - ;;; in v-blank mode - ;; if v-blank-prev was 0, - ;; increment frame-count - - 0xFA ;D32E ; load v-blank-prev to A - 0x20 ;D32F - 0xD3 ;D330 - - 0xCB ;D331 - 0x47 ;D332 ; test bit-0 of A - - 0x20 ;D333 ; skip next section - 0x07 ;D334 ; if v-blank-prev was not zero - - ;; v-blank was 0, increment frame-count - 0xFA ;D335 ; load frame-count into A - 0x1F ;D336 - 0xD3 ;D337 - - 0x3C ;D338 ; inc A - - 0xEA ;D339 ; load A into frame-count - 0x1F ;D33A - 0xD3 ;D33B - - ;; set v-blank-prev to 1 - 0x3E ;D33C ; load 1 into A - 0x01 ;D33D - - 0xEA ;D33E ; load A into v-blank-prev - 0x20 ;D33F - 0xD3 ;D340 - - 0xC3 ;D341 ; return to beginning - 0x1D ;D342 - 0xD3 ;D343 - - ;;; not in v-blank mode - ;; set v-blank-prev to 0 - 0x3E ;D344 ; load 0 into A - 0x00 ;D345 - - 0xEA ;D346 ; load A into v-blank-prev - 0x20 ;D347 - 0xD3 ;D348 - - 0xC3 ;D349 ; return to beginning - 0x1D ;D34A - 0xD3 ;D34B - ]))) - -(defn step-count-frames [] - (-> (read-down-button) - (info) - (tick) ;; skip over data section - (info) - (view-register "Register A" A) - (tick) ;; load-data into A - (view-register "Register A" A) - (info) - (view-memory 0xFF00) - (tick) ;; load A into 0xFF00 - (view-memory 0xFF00) - (info) - (tick) - (info) - (tick) - (info) - (tick) - (info) - (tick) - (info) - (tick) - (info) - (tick) - (print-inventory))) - -(defn test-count-frames [] - (= 255 (aget (memory ((apply comp (repeat 255 step)) - (count-frames))) - 0xD31F))) - -;; specs for main bootstrap program -;; starts in "mode-select" mode -;; Each button press takes place in a single frame. -;; mode-select-mode takes one of the main buttons -;; which selects one of up to eight modes -;; mode 1 activated by the "A" button -;; the next two button presses indicates the start -;; memory location which to which the bootstrap -;; program will write. -;; This is done by using each of the eight buttons to -;; spell out an 8 bit number. The order of buttons is -;; [:d :u :l :r :start :select :b :a] -;; [:a :start :l] --> 00101001 - -;; the next button press determines how many bytes are to be -;; written, starting at the start position. - -;; then, the actual bytes are entered and are written to the -;; start address in sequence. - -(defn input-number-assembly [] - [0x18 ;D31D ; jump over - 0x02 ;D31E ; the next 2 bytes - 0x00 ;D31F ; frame-count - 0x00 ;D320 ; v-blank-prev - - 0xFA ;D321 - 0x41 ;D322 ; load (FF41) into A - 0xFF ;D323 ; this contains mode flags - - ;; if we're in v-blank, the bit-1 is 0 - ;; and bit-2 is 1 Otherwise, it is not v-blank. - 0xCB ;D324 ; test bit-1 of A - 0x4F ;D325 - - 0xC2 ;D326 ; if bit-1 is not 0 - 0x44 ;D327 ; GOTO not-v-blank - 0xD3 ;D328 - - 0xCB ;D329 ; test bit-0 of A - 0x47 ;D32A - - 0xCA ;D32B ; if bit-0 is not 1 - 0x44 ;D32C ; GOTO not-v-blank - 0xD3 ;D32D - - ;;; in v-blank mode - - ;; if v-blank-prev was 0, - ;; increment frame-count - - 0xFA ;D32E ; load v-blank-prev to A - 0x20 ;D32F - 0xD3 ;D330 - - 0xCB ;D331 - 0x47 ;D332 ; test bit-0 of A - - 0x20 ;D333 ; skip next section - 0x07 ;D334 ; if v-blank-prev was not zero - - ;; v-blank was 0, increment frame-count - 0xFA ;D335 ; load frame-count into A - 0x1F ;D336 - 0xD3 ;D337 - - 0x3C ;D338 ; inc A - - 0xEA ;D339 ; load A into frame-count - 0x1F ;D33A - 0xD3 ;D33B - - ;; set v-blank-prev to 1 - 0x3E ;D33C ; load 1 into A - 0x01 ;D33D - - 0xEA ;D33E ; load A into v-blank-prev - 0x20 ;D33F - 0xD3 ;D340 - - 0xC3 ;D341 ; GOTO input handling code - 0x4E ;D342 - 0xD3 ;D343 - - ;;; not in v-blank mode - ;; set v-blank-prev to 0 - 0x3E ;D344 ; load 0 into A - 0x00 ;D345 - - 0xEA ;D346 ; load A into v-blank-prev - 0x20 ;D347 - 0xD3 ;D348 - - 0xC3 ;D349 ; return to beginning - 0x1D ;D34A - 0xD3 ;D34B - - 0x00 ;D34C ; these are here - 0x00 ;D34D ; for glue - - - ;;; calculate input number based on button presses - 0x18 ;D34E ; skip next 3 bytes - 0x03 ;D34F - ;D350 - (Integer/parseInt "00100000" 2) ; select directional pad - ;D351 - (Integer/parseInt "00010000" 2) ; select buttons - 0x00 ;D352 ; input-number - - ;; select directional pad, store low bits in B - - 0xFA ;D353 ; load (D350) into A - 0x50 ;D354 --> - 0xD3 ;D355 --> D31F - - 0xEA ;D356 ; load A, which is - 0x00 ;D357 --> ; 00010000, into FF00 - 0xFF ;D358 --> FF00 - - 0x06 ;D359 - ;D35A - (Integer/parseInt "11110000" 2) ; "11110000" -> B - 0xFA ;D35B ; (FF00) -> A - 0x00 ;D35C - 0xFF ;D35D - - 0xCB ;D35E ; swap nybbles on A - 0x37 ;D35F - 0xA0 ;D360 ; (AND A B) -> A - 0x47 ;D361 ; A -> B - - ;; select buttons store bottom bits in C - - 0xFA ; ; load (D351) into A - 0x51 ; --> - 0xD3 ; --> D31F - - 0xEA ; ; load (A), which is - 0x00 ; --> ; 00001000, into FF00 - 0xFF ; --> FF00 - - 0x0E ; - (Integer/parseInt "00001111" 2) ; "00001111" -> C - - 0xFA ; ; (FF00) -> A - 0x00 ; - 0xFF ; - - 0xA1 ; ; (AND A C) -> A - 0x4F ; ; A -> C - - ;; combine the B and C registers into the input number - 0x79 ; ; C -> A - 0xB0 ; ; (OR A B) -> A - 0x2F ; ; negate A - - 0xEA ; ; store A into input-number - 0x52 ; - 0xD3 ; - - 0xC3 ; ; return to beginning - 0x1D ; - 0xD3 ; - ]) - - -(defn print-pc [state] - (println (format "PC: 0x%04X" (PC state))) - state) - -(defn print-op [state] - (println (format "OP: 0x%02X" (aget (memory state) (PC state)))) - state) - -(defn d-tick - ([state] - (-> state print-pc print-op tick))) - -(defn input-number [] - (-> (tick (mid-game)) - (IE! 0) ; disable interrupts - (inject-item-assembly (input-number-assembly)))) - -(defn test-input-number - "Input freestyle buttons and observe the effects at the repl." - [] - (set-state! (input-number)) - (dotimes [_ 90000] (step (view-memory @current-state 0xD352)))) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -(defn write-memory-assembly* - "Currently, grabs input from the user each frame." - [] - [ - ;; --------- FRAME METRONOME - 0x18 ;; jump ahead to cleanup. first time only. - 0x40 ;; v-blank-prev [D31E] - - 0xFA ;; load modes into A [D31F] - 0x41 - 0xFF - - 0x47 ;; A -> B - 0xCB ;; rotate A - 0x2F - 0x2F ;; invert A - - 0xA0 - 0x47 ;; now B_0 contains (VB==1) - - 0xFA ;; load v-blank-prev - 0x1E - 0xD3 - - 0x2F ;; complement v-blank-prev - - 0xA0 ;; A & B --> A - 0x4F ;; now C_0 contains increment? - - - 0x78 ;; B->A - 0xEA ;; spit A --> vbprev - 0x1E - 0xD3 - - 0xCB ;test C_0 - 0x41 - 0x20 ; JUMP ahead to button input if nonzero - 0x02 - 0x18 ; JUMP back to frame metronome (D31F) - 0xE7 - - ;; -------- GET BUTTON INPUT - - ;; btw, C_0 is now 1 - ;; prepare to select bits - - 0x06 ;; load 0x00 into B - 0x00 ;; to initialize for "OR" loop - - 0x3E ;; load 0x20 into A, to measure dpad - 0x20 - - - 0xE0 ;; load A into [FF00] ;; start of OR loop [D33C] - 0x00 - - 0xF0 ;; load A from [FF00] - 0x00 - - 0xE6 ;; bitmask 00001111 - 0x0F - - 0xB0 ;; A or B --> A - 0xCB - 0x41 ;; test bit 0 of C - 0x28 ;; JUMP forward if 0 - 0x08 - - 0x47 ;; A -> B - 0xCB ;; swap B nybbles - 0x30 - 0x0C ;; increment C - 0x3E ;; load 0x10 into A, to measure btns - 0x10 - 0x18 ;; JUMP back to "load A into [FF00]" [20 steps?] - 0xED - - - ;; ------ TAKE ACTION BASED ON USER INPUT - - ;; "input mode" - ;; mode 0x00 : select mode - ;; mode 0x08 : select bytes-to-write - ;; mode 0x10 : select hi-bit - ;; mode 0x18 : select lo-bit - - ;; "output mode" - ;; mode 0x20 : write bytes - ;; mode 0xFF : jump PC - - - ;; registers - ;; D : mode select - ;; E : count of bytes to write - ;; H : address-high - ;; L : address-low - - ;; now A contains the pressed keys - 0x2F ; complement A, by request. [D34F] - - 0x47 ; A->B ;; now B contains the pressed keys - 0x7B ; E->A ;; now A contains the count. - - 0xCB ; test bit 5 of D (are we in o/p mode?) - 0x6A - 0x28 ; if test == 0, skip this o/p section - 0x13 ; JUMP - - 0xCB ; else, test bit 0 of D (fragile; are we in pc mode?) - 0x42 - 0x28 ; if test == 0, skip the following command - 0x01 - - ;; output mode I: moving the program counter - 0xE9 ; ** move PC to (HL) - - ;; output mode II: writing bytes - 0xFE ; A compare 0. finished writing? - 0x00 - 0x20 ; if we are not finished, skip cleanup - 0x04 ; JUMP - - ;; CLEANUP - ;; btw, A is already zero. - 0xAF ; zero A [D35F] - 0x57 ; A->D; makes D=0. - 0x18 ; end of frame - 0xBC - - ;; ---- end of cleanup - - - ;; continue writing bytes - 0x1D ;; decrement E, the number of bytes to write [D363] - 0x78 ;; B->A; now A contains the pressed keys - 0x77 ;; copy A to (HL) - 0x23 ;; increment HL - 0x18 ;; end frame. [goto D31F] - 0xB6 ;; TODO: set skip length backwards - - - ;; ---- end of o/p section - - ;; i/p mode - ;; adhere to the mode discipline: - ;; D must be one of 0x00 0x08 0x10 0x18. - - 0x3E ;; load the constant 57 into A. [D369] - 0x57 - 0x82 ;; add the mode to A - 0xEA ;; store A into "thing to execute" - 0x74 - 0xD3 - - 0x3E ;; load the constant 8 into A - 0x08 - 0x82 ;; add the mode to A - - 0x57 ;; store the incremented mode into D - 0x78 ;; B->A; now A contains the pressed keys - - 0x00 ;; var: thing to execute [D374] - - 0x18 ;; end frame - 0xA8 - ] - ) - -(defn write-mem-dyl [] - (-> (tick (mid-game)) - (IE! 0) - (inject-item-assembly (write-memory-assembly*)))) - - -(defn dylan* [] - (-> - (write-mem-dyl) - - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - - ;;(view-memory 0xD374) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - ;;(view-memory 0xD374) - (d-tick) - - (view-register "A" A) - (view-register "B" B) - (view-register "C" C)) - -) - - -(defn dylan [] - (-> - (write-mem-dyl) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) ;; first loop - - - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) ;; dpad bits - - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (d-tick) - - - - (view-register "A" A) - (view-register "B" B) - (view-register "C" C) - - )) - - - - -(defn d2 [] - (-> - (write-mem-dyl) - (view-memory 0xD31F) - step step step step step - (view-memory 0xD31F))) - - - - - - - - - - - - - - - - - - - - -(defn write-memory-assembly [] - [ - ;; Main Timing Loop - ;; Constantly check for v-blank and Trigger main state machine on - ;; every transtion from v-blank to non-v-blank. - - 0x18 ; D31D ; Variable declaration - 0x02 ; D31E - 0x00 ; D31F ; frame-count - 0x00 ; D320 ; v-blank-prev - - 0xF0 ; D321 ; load v-blank mode flags into A - 0x41 - 0x00 - - - ;; Branch dependent on v-blank. v-blank happens when the last two - ;; bits in A are "01" - 0xCB ; D324 - 0x4F ; D325 - - 0xC2 ; D326 ; if bit-1 is not 0, then - 0x3E ; D327 ; GOTO non-v-blank. - 0xD3 ; D328 - - 0xCB ; D329 - 0x47 ; D32A - - 0xCA ; D32B ; if bit-0 is not 1, then - 0x3E ; D32C ; GOTO non-v-blank. - 0xD3 ; D32D - - ;; V-Blank - ;; Activate state-machine if this is a transition event. - - 0xFA ; D32E ; load v-bank-prev into A - 0x20 ; D32F - 0xD3 ; D330 - - 0xFE ; D331 ; compare A to 0. >--------\ - 0x00 ; D332 \ - ; | - ;; set v-blank-prev to 1. | - 0x3E ; D333 ; load 1 into A. | - 0x01 ; D334 | - ; | - 0xEA ; D335 ; load A into v-blank-prev | - 0x20 ; D336 | - 0xD3 ; D337 | - ; / - ;; if v-blank-prev was 0, activate state-machine <------/ - 0xCA ; D338 ; if v-blank-prev - 0x46 ; D339 ; was 0, - 0xD3 ; D33A ; GOTO state-machine - - 0xC3 ; D33B - 0x1D ; D33C - 0xD3 ; D33D ; GOTO beginning - ;; END V-blank - - ;; Non-V-Blank - ;; Set v-blank-prev to 0 - 0x3E ; D33E ; load 0 into A - 0x00 ; D33F - - 0xEA ; D340 ; load A into v-blank-prev - 0x20 ; D341 - 0xD3 ; D342 - - 0xC3 ; D343 - 0x1D ; D344 - 0xD3 ; D345 ; GOTO beginning - ;; END Not-V-Blank - - - ;; Main State Machine -- Input Section - ;; This is called once every frame. - ;; It collects input and uses it to drive the - ;; state transitions. - - ;; Increment frame-count - 0xFA ; D346 ; load frame-count into A - 0x1F ; D347 - 0xD3 ; D348 - - 0x3C ; D349 ; inc A - - 0xEA ; D34A - 0x1F ; D34B ; load A into frame-count - 0xD3 ; D34C - - 0x00 ; D34D ; glue :) - - 0x18 ;D34E ; skip next 3 bytes - 0x03 ;D34F - ;D350 - (Integer/parseInt "00100000" 2) ; select directional pad - ;D351 - (Integer/parseInt "00010000" 2) ; select buttons - 0x00 ;D352 ; input-number - - ;; select directional pad; store low bits in B - - 0xFA ;D353 ; load (D350) into A - 0x50 ;D354 --> - 0xD3 ;D355 --> D350 - - 0xE0 ;D356 ; load (A), which is - 0x00 ;D357 --> ; 00010000, into FF00 - 0x00 ;D358 --> FF00 ;; NO-OP - - 0x06 ;D359 - ;D35A - (Integer/parseInt "11110000" 2) ; "11110000" -> B - 0xF0 ;D35B ; (FF00) -> A - 0x00 ;D35C - 0x00 ;D35D ;; NO-OP - - 0xCB ;D35E ; swap nybbles on A - 0x37 ;D35F - 0xA0 ;D360 ; (AND A B) -> A - 0x47 ;D361 ; A -> B - - ;; select buttons; store bottom bits in C - - 0xFA ;D362 ; load (D351) into A - 0x51 ;D363 --> - 0xD3 ;D364 --> D351 - - 0xE0 ;D365 ; load (A), which is - 0x00 ;D366 --> ; 00001000, into FF00 - 0x00 ;D367 --> FF00 ;; NO-OP - - 0x0E ;D368 - ;D369 - (Integer/parseInt "00001111" 2) ; "00001111" -> C - - 0xF0 ;D36A ; (FF00) -> A - 0x00 ;D36B - 0x00 ;D36C - - 0xA1 ;D36D ; (AND A C) -> A - 0x4F ;D36E ; A -> C - - ;; combine the B and C registers into the input number - 0x79 ;D36F ; C -> A - 0xB0 ;D370 ; (OR A B) -> A - 0x2F ;D371 ; negate A - - 0xEA ;D372 ; store A into input-number - 0x52 ;D373 - 0xD3 ;D374 - - 0x00 ;D375 - 0x00 ;D376 - 0x00 ;D377 - 0x00 ;D378 - 0x00 ;D379 - 0x00 ;D37A - 0x00 ;D37B ; these are here because - 0x00 ;D37C ; I messed up :( - 0x00 ;D37D - 0x00 ;D37E - 0x00 ;D37F - - ;; beginning of main state machine - 0x18 ;D380 ; Declaration of variables - 0x05 ;D381 ; 5 variables: - 0x00 ;D382 ; current-mode - 0x00 ;D383 ; bytes-to-write - 0x00 ;D384 ; bytes-written - 0x00 ;D385 ; start-point-high - 0x00 ;D386 ; start-point-low - - - ;; banch on current mode - 0xFA ;D387 ; load current-mode (0xD382) - 0x82 ;D388 ; into A - 0xD3 ;D389 - 0x00 ;D38A - - - ;; GOTO Mode 0 (input-mode) if current-mode is 0 - 0xFE ;D38B - 0x00 ;D38C ; compare A with 0x00 - - 0xCA ;D38D ; goto Mode 0 if A == 0 - 0xA8 ;D38E - 0xD3 ;D38F - - ;; GOTO Mode 1 (set-length) if current-mode is 1 - 0xFE ;D390 - 0x01 ;D391 ; compare A with 0x01 - - 0xCA ;D392 - 0xB1 ;D393 - 0xD3 ;D394 ; goto Mode 1 if A == 1 - - ;; GOTO Mode 2 (set-start-point-high) if current mode is 2 - 0xFE ;D395 - 0x02 ;D396 ; compare A with 0x02 - - 0xCA ;D397 - 0xBF ;D398 - 0xD3 ;D399 ; goto Mode 2 if A == 2 - - ;; GOTO Mode 3 (set-start-point-low) if current mode is 3 - 0xFE ;D39A - 0x03 ;D39B - - 0xCA ;D39C - 0xCD ;D39D - 0xD3 ;D39E ; goto Mode 3 if A == 3 - - ;; GOTO Mode 4 (write-memory) if current mode is 4 - 0xFE ;D39F - 0x04 ;D3A0 - - 0xCA ;D3A1 - 0xDB ;D3A2 - 0xD3 ;D3A3 - - 0x00 ;D3A4 - ;; End of Mode checking, goto beginning - 0xC3 ;D3A5 - 0x1D ;D3A6 - 0xD3 ;D3A7 - - - ;; Mode 0 -- input-mode mode - ;; means that we are waiting for a mode, so set the mode to - ;; whatever is currently in input-number. If nothing is - ;; entered, then the program stays in input-mode mode - - ;; set current-mode to input-number - 0xFA ;D3A8 ; load input-number (0xD352) - 0x52 ;D3A9 ; into A - 0xD3 ;D3AA - - 0xEA ;D3AB ; load A into current-mode - 0x82 ;D3AC ; (0xD382) - 0xD3 ;D3AD - - 0xC3 ;D3AE ; go back to beginning - 0x1D ;D3AF - 0xD3 ;D3B0 - ;; End Mode 0 - - - ;; Mode 1 -- set-length mode - ;; This is the header for writing things to memory. - ;; User specifies the number of bytes to write. - ;; Mode is auto advanced to Mode 2 after this mode - ;; completes. - - ;; Set bytes left to write to input-number; - ;; set current-mode to 0x02. - 0xFA ;D3B1 ; load input-number (0xD352) - 0x52 ;D3B2 ; into A - 0xD3 ;D3B3 - - 0xEA ;D3B4 ; load A into bytes-left-to-write - 0x83 ;D3B5 ; (0xD383) - 0xD3 ;D3B6 - - 0x3E ;D3B7 ; load 0x02 into A. - 0x02 ;D3B8 - - 0xEA ;D3B9 ; load A to current-mode - 0x82 ;D3BA ; advancing from Mode 1 to - 0xD3 ;D3BB ; Mode 2 - - 0xC3 ;D3BC ; go back to beginning - 0x1D ;D3BD - 0xD3 ;D3BE - ;; End Mode 1 - - - ;; Mode 2 -- set start-point-high mode - ;; Middle part of the header for writing things to memory. - ;; User specifies the start location in RAM to which - ;; data will be written. - ;; Mode is auto advanced to Mode 3 after this mode completes. - - ;; Set start-point-high to input-number; - ;; set current mode to 0x03. - 0xFA ;D3BF ; load input-number (0xD352) - 0x52 ;D3C0 ; into A - 0xD3 ;D3C1 - - 0xEA ;D3C2 ; load A into start-point-high - 0x85 ;D3C3 ; (0xD385) - 0xD3 ;D3C4 - - 0x3E ;D3C5 ; load 0x03 into A. - 0x03 ;D3C6 - - 0xEA ;D3C7 ; load A to current-mode, - 0x82 ;D3C8 ; advancing from Mode 2 to - 0xD3 ;D3C9 ; Mode 3. - - 0xC3 ;D3CA ; go back to beginning - 0x1D ;D3CB - 0xD3 ;D3CC - ;;End Mode 2 - - - ;; Mode 3 -- set-start-point-low mode - ;; Final part of header for writing things to memory. - ;; User specifies the low bytes of 16 bit start-point. - - ;; Set start-point-low to input-number; - ;; set current mode to 0x04 - 0xFA ;D3CD ; load input-number into A - 0x52 ;D3CE - 0xD3 ;D3CF - - 0xEA ;D3D0 ; load A into start-point-low - 0x86 ;D3D1 - 0xD3 ;D3D2 - - 0x3E ;D3D3 ; load 0x04 into A. - 0x04 ;D3D4 - - 0xEA ;D3D5 ; load A to current-mode, - 0x82 ;D3D6 ; advancing from Mode 3 to - 0xD3 ;D3D7 ; Mode 4. - - 0xC3 ;D3D8 ; go back to beginning - 0x1D ;D3D9 - 0xD3 ;D3DA - - ;; Mode 4 -- write bytes mode - - ;; This is where RAM manipulation happens. User supplies - ;; bytes every frame, which are written sequentially to - ;; start-point until bytes-to-write have been written. Once - ;; bytes-to-write have been written, the mode is reset to 0. - - ;; compare bytes-written with bytes-to-write. - ;; if they are the same, then reset mode to 0 - - 0xFA ;D3DB ; load bytes-to-write into A - 0x83 ;D3DC - 0xD3 ;D3DD - - 0x47 ;D3DE ; load A into B - - 0xFA ;D3DF ; load bytes-written into A - 0x84 ;D3E0 - 0xD3 ;D3E1 - - 0xB8 ;D3E2 ; compare A with B - - 0xCA ;D3E3 ; if they are equal, go to cleanup - 0x07 ;D3E4 - 0xD4 ;D3E5 - - ;; Write Memory Section - ;; Write the input-number, interpreted as an 8-bit number, - ;; into the current target register, determined by - ;; (+ start-point bytes-written). - ;; Then, increment bytes-written by 1. - - 0xFA ;D3E6 ; load start-point-high into A - 0x85 ;D3E7 - 0xD3 ;D3E8 - - 0x67 ;D3E9 ; load A into H - - 0xFA ;D3EA ; load start-point-low into A - 0x86 ;D3EB - 0xD3 ;D3EC - - 0x6F ;D3ED ; load A into L - - 0xFA ;D3EE ; load bytes-written into A - 0x84 ;D3EF - 0xD3 ;D3F0 - - 0x00 ;D3F1 ; These are here because - 0x00 ;D3F2 ; I screwed up again. - 0x00 ;D3F3 - - 0x85 ;D3F4 ; add L to A; store A in L. - 0x6F ;D3F5 - - 0x30 ;D3F6 ; If the addition overflowed, - 0x01 ;D3F7 - 0x24 ;D3F8 ; increment H. - - ;; Now, HL points to the correct place in memory - - 0xFA ;D3F9 ; load input-number into A - 0x52 ;D3FA - 0xD3 ;D3FB - - 0x77 ;D3FC ; load A into (HL) - - 0xFA ;D3FD ; load bytes-written into A - 0x84 ;D3FE - 0xD3 ;D3FF - - 0x3C ;D400 ; increment A - - 0xEA ;D401 ; load A into bytes-written - 0x84 ;D402 - 0xD3 ;D403 - - 0xC3 ;D404 ; go back to beginning. - 0x1D ;D405 - 0xD3 ;D406 - ;; End Write Memory Section - - ;; Mode 4 Cleanup Section - ;; reset bytes-written to 0 - ;; set mode to 0 - 0x3E ;D407 ; load 0 into A - 0x00 ;D408 - - 0xEA ;D409 ; load A into bytes-written - 0x84 ;D40A - 0xD3 ;D40B - - 0xEA ;D40C ; load A into current-mode - 0x82 ;D40D - 0xD3 ;D40E - - 0xC3 ;D40F ; go back to beginning - 0x1D ;D410 - 0xD3 ;D411 - - ;; End Mode 4 - - ]) - - - -(def frame-count 0xD31F) -(def input 0xD352) -(def current-mode 0xD382) -(def bytes-to-write 0xD383) -(def bytes-written 0xD384) -(def start-point-high 0xD385) -(def start-point-low 0xD386) - - - -(defn write-memory [] - (-> (tick (mid-game)) - (IE! 0) ; disable interrupts - (inject-item-assembly (write-memory-assembly)))) - -(defn test-write-memory [] - (set-state! (write-memory)) - (dorun - (dotimes [_ 5000] - (view-memory (step @current-state) current-mode)))) - -(def bytes-to-write 0xD383) -(def start-point 0xD384) - -(defn print-blank-assembly - [start end] - (dorun - (map - #(println (format "0x00 ;%04X " %)) - (range start end)))) - -(defn test-mode-2 [] - (-> - (write-memory) - (view-memory frame-count) - (step) - (step [:a]) - (step [:b]) - (step [:start]) - (step []) - (view-memory frame-count))) - - - -(defn dylan-test-mode - ([] (dylan-test-mode (write-mem-dyl))) - ([target-state] - (let [ - v-blank-prev 54046 - btn-register 65280 - eggs 0xD374 - ] - - (-> - target-state - - (tick) - (tick) - (tick) - (tick);; jumps back to beginning - - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - - - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) ;; just complemented A - - (tick) - (DE! 0x1800) - (AF! 0x7700) ;; change inputs @ A - (tick) - (tick) - (tick) - (tick) - (tick) - - ;;(view-memory eggs) - (tick) - (tick) - ;;(view-memory eggs) - (tick) - (tick) - (tick) - (tick) - (tick) - (tick) - (d-tick) - - - ;;(view-memory btn-register) - (view-register "A" A) - (view-register "B" B) - - ;;(view-register "C" C) - (view-register "D" D) - (view-register "E" E) - (view-register "H" H) - (view-register "L" L) - )))) - - - -(defn drive-dylan [] - (-> (write-mem-dyl) - (#(do (println "memory from 0xC00F to 0xC01F:" - (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) - (step []) - (step []) - (step []) - (step [:start]) - (step [:select]) - (step [:u :d]) - (step [:a :b :start :select]) - (step [:a]) - (step [:b]) - (step [:a :b]) - (step [:select]) - (step []) - (step []) - (step []) - (#(do (println "memory from 0xC00F to 0xC01F:" - (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) - )) - -(defn test-mode-4 - ([] (test-mode-4 (write-memory))) - ([target-state] - (-> - target-state - (#(do (println "memory from 0xC00F to 0xC01F:" - (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) - (view-memory current-mode) - (step []) - (step []) - (step []) - (#(do (println "after three steps") %)) - (view-memory current-mode) - - ;; Activate memory writing mode - - (#(do (println "step with [:a]") %)) - (step [:a]) - (view-memory current-mode) - (view-memory bytes-to-write) - (view-memory start-point-high) - (view-memory start-point-low) - - ;; Specify four bytes to be written - - (#(do (println "step with [:select]")%)) - (step [:select]) - (view-memory current-mode) - (view-memory bytes-to-write) - (view-memory start-point-high) - (view-memory start-point-low) - - ;; Specify target memory address as 0xC00F - - (#(do (println "step with [:u :d]")%)) - (step [:u :d]) - (view-memory current-mode) - (view-memory bytes-to-write) - (view-memory start-point-high) - (view-memory start-point-low) - - (#(do (println "step with [:a :b :start :select]")%)) - (step [:a :b :start :select]) - (view-memory current-mode) - (view-memory bytes-to-write) - (view-memory start-point-high) - (view-memory start-point-low) - - ;; Start reprogramming memory - - (#(do (println "step with [:a]")%)) - (step [:a]) - (view-memory current-mode) - (view-memory bytes-written) - - (#(do (println "step with [:b]")%)) - (step [:b]) - (view-memory current-mode) - (view-memory bytes-written) - - (#(do (println "step with [:a :b]")%)) - (step [:a :b]) - (view-memory current-mode) - (view-memory bytes-written) - - (#(do (println "step with [:select]")%)) - (step [:select]) - (view-memory current-mode) - (view-memory bytes-written) - - ;; Reprogramming done, program ready for more commands. - - (#(do (println "step with []")%)) - (step []) - (view-memory current-mode) - (view-memory bytes-written) - - (#(do (println "memory from 0xC00F to 0xC01F:" - (subvec (vec (memory %)) 0xC00F 0xC01F)) %))))) - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/cruft/gb_driver.clj --- a/clojure/com/aurellem/cruft/gb_driver.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -(ns com.aurellem.gb-driver - (:import com.aurellem.gb.Gb) - (:import java.io.File) - (:import org.apache.commons.io.FileUtils) - (:import (java.nio IntBuffer ByteOrder))) - -(Gb/loadVBA) - -(def ^:dynamic *max-history* 2e4) - -(def ^:dynamic *backup-saves-to-disk* true) - -(def ^:dynamic *save-history* true) - -(def ^:dynamic *save-state-cache* - (File. "/home/r/proj/pokemon-escape/save-states/")) - -(def yellow-rom-image - (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) - -(def yellow-save-file - (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) - -(def current-frame (atom 0)) - -(defn vba-init [] - (reset! current-frame 0) - (.delete yellow-save-file) - (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) - -(defn shutdown [] (Gb/shutdown)) - -(defn reset [] (shutdown) (vba-init)) - -(defn cpu-data [size arr-fn] - (let [store (int-array size)] - (fn [] (arr-fn store) store))) - -(def ram - (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) - -(def rom - (cpu-data (Gb/getROMSize) #(Gb/getROM %))) - -(def working-ram - (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) - -(def video-ram - (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) - -(def registers - (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) - -(def button-code - {;; main buttons - :a 0x0001 - :b 0x0002 - - ;; directional pad - :r 0x0010 - :l 0x0020 - :u 0x0040 - :d 0x0080 - - ;; meta buttons - :select 0x0004 - :start 0x0008 - - ;; hard reset -- not really a button - :reset 0x0800}) - -(defn button-mask [buttons] - (reduce bit-or 0x0000 (map button-code buttons))) - -(defn buttons [mask] - (loop [buttons [] - masks (seq button-code)] - (if (empty? masks) buttons - (let [[button value] (first masks)] - (if (not= 0x0000 (bit-and value mask)) - (recur (conj buttons button) (rest masks)) - (recur buttons (rest masks))))))) - -(defrecord SaveState [frame save-data]) - -(defn frame [] @current-frame) - -(defn save-state [] - (SaveState. (frame) (Gb/saveState))) - -(defn load-state [#^SaveState save] - (reset! current-frame (:frame save)) - (Gb/loadState (:save-data save))) - -(def empty-history (sorted-map)) - -(def history (atom empty-history)) - -(defn frame->disk-save [frame] - (File. *save-state-cache* - (format "%07d.sav" frame))) - -(defn get-save-from-disk [frame] - (let [save (frame->disk-save frame)] - (if (.exists save) - (let [buf (Gb/saveBuffer) - bytes (FileUtils/readFileToByteArray save)] - (.put buf bytes) - (.flip buf) - (SaveState. frame buf))))) - -(defn store-save-to-disk [^SaveState save] - (let [buf (:save-data save) - bytes (byte-array (.limit buf)) - dest (frame->disk-save (:frame save))] - (.get buf bytes) - (FileUtils/writeByteArrayToFile dest bytes) - (.rewind buf) dest)) - -(defn find-save-state [frame] - (let [save (@history frame)] - (if (not (nil? save)) save - (get-save-from-disk frame)))) - -(defn goto [frame] - (let [save (find-save-state frame)] - (if (nil? save) - (println frame "is not in history") - (do - (reset! current-frame frame) - (load-state save))))) - -(defn clear-history [] (reset! history empty-history)) - -(defn rewind - ([] (rewind 1)) - ([n] (goto (- @current-frame n)))) - -(defn backup-state - ([] (backup-state (frame))) - ([frame] - (let [save (save-state)] - (swap! history #(assoc % frame save)) - ;;(store-save-to-disk save) - (if (> (count @history) *max-history*) - (swap! history #(dissoc % (first (first %)))))))) - -(defn advance [] - (if *save-history* - (backup-state @current-frame)) - (swap! current-frame inc)) - -(defn step - ([] (advance) (Gb/step)) - ([mask-or-buttons] - (advance) - (if (number? mask-or-buttons) - (Gb/step mask-or-buttons) - (Gb/step (button-mask mask-or-buttons))))) - -(defn play-moves - ([start moves] - (goto start) - (dorun (map step moves)) - (backup-state) - (frame)) - ([moves] - (dorun (map step moves)) - (backup-state) - (frame))) - -(defn play - ([] (play Integer/MAX_VALUE)) - ([n] (dorun (dotimes [_ n] (step))))) - -(defmacro without-saves [& forms] - `(binding [*save-history* false] - ~@forms)) - - -(require '(clojure [zip :as zip])) - - - - -(defn tree->str [original] - (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] - (if (zip/end? loc) s - (let [d (count (zip/path loc)) - rep - (str - s - (if (and (zip/up loc) - (> (count (-> loc zip/up zip/rights)) 0)) - "|" "") - (apply str (repeat (dec d) " ")) - (if (= (count (zip/rights loc)) 0) - "`-- " - "|-- ") - (zip/node loc) - "\n")] - (recur rep (zip/next loc)))))) - - - - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/cruft/title.clj --- a/clojure/com/aurellem/cruft/title.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,141 +0,0 @@ -(ns com.aurellem.title - (:use (com.aurellem gb-driver vbm))) - -(defn delayed-key - ([key delay total] - (concat (repeat delay []) [key] (repeat (- total delay 1) []))) - ([key total] - (delayed-key key (dec total) total))) - -(defn no-action [length] - (repeat length [])) - -(defn start-summary [] - (nth (registers) 2)) - -(defn common-initial-elements [baseline moves] - (loop [common 0 b baseline m moves] - (if (empty? m) common - (if (= (first b) (first m)) - (recur (inc common) (rest b) (rest m)) - common)))) - -(defn earliest-press - [start-frame - end-frame - key - summary-fn] - (let [action-length (- end-frame start-frame) - baseline (no-action action-length)] - (print "establishing baseline...") - (play-moves start-frame baseline) - (let [bad-value (summary-fn)] - (println bad-value) - (loop [n 0] - (let [moves (delayed-key key n action-length) - header-length - (common-initial-elements moves baseline)] - (print "length" (inc n) "...") - (without-saves - (play-moves - (+ start-frame header-length) - (drop header-length moves))) - (let [result (summary-fn)] - (println result) - (if (not= result bad-value) - (let [keys (delayed-key key (inc n))] - (play-moves start-frame keys) - keys) - (recur (inc n))))))))) - - -(defn search-first - [start-frame - baseline - gen-move-fn - summary-fn] - (print "establishing baseline...") - (play-moves start-frame baseline) - (let [bad-value (summary-fn)] - (println bad-value) - (loop [n 0] - (let [trial-moves (gen-move-fn n) - header-length - (common-initial-elements trial-moves baseline)] - (print "length" (inc n) "...") - (without-saves - (play-moves - (+ start-frame header-length) - (drop header-length trial-moves))) - (let [result (summary-fn)] - (println result) - (if (not= result bad-value) - (let [keys (take (inc n) trial-moves)] - (play-moves start-frame keys) - keys) - (recur (inc n)))))))) - -(defn title-search - [start-frame - end-frame - key - summary-fn] - (let [action-length (- end-frame start-frame)] - (search-first - start-frame - (no-action action-length) - (fn [n] (delayed-key key n action-length)) - summary-fn))) - -(defn gen-title [] - (let [start0 (no-action 300)] - (play-moves 0 start0) - (let [start->first-press - (title-search (frame) (+ 50 (frame)) [:a] start-summary) - first-press->second-press - (title-search (frame) (+ 100 (frame)) [:start] start-summary) - second-press->third-press - (title-search (frame) (+ 151 (frame)) [:a] start-summary) - new-game - (title-search (frame) (+ 151 (frame)) [:a] start-summary)] - (concat - start0 - start->first-press - first-press->second-press - second-press->third-press - new-game)))) - -(def title - [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [ :a]]) - - -(require '(clojure [zip :as zip])) \ No newline at end of file diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/dylans-code --- a/clojure/com/aurellem/dylans-code Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ - -(defn count-frames* [] - (-> (tick (mid-game)) - (IE! 0) ; disable interrupts - (inject-item-assembly - ;; write 00010000 to 0xFF00 to select joypad - [0x18 ;D31D ; jump over - 0x02 ;D31E ; the next 2 bytes - 0x00 ;D31F ; frame-count - 0x00 ;D320 ; v-blank-prev - - - 0xFA ;D321 - 0x41 ;D322 ; load (FF41) into A - 0xFF ;D323 ; this contains mode flags - - 0x47 ;; copy A -> B - - 0xCB - 0x3F ;; shift A right - 0x2F ;; complement A - - 0xA0 ;; A & B -> A. - 0x47 ;; copy A -> B. Now the first bit of B is (VB == 1) - - 0xFA - 0x20 - 0xD3 ;; load v-blank-prev into A - - 0xA0 ;; A & B -> A. - 0x4F ;; copy A to C. Now C contains increment-counter? - - 0xFA - 0x1F - 0xD3 ;; load frame-count into A - - 0x81 ;; add increment-counter? to frame-count - 0xEA ;; store A into frame-count - 0x1F - 0xD3 - - 0x3E ;; load 1 into A - 0x01 - 0xA0 ;; A & B -> A. Now A is (VB==1) - 0xEA ;; store A into v-blank-prev - 0x20 - 0xD3 - - 0xC3 ;D348 ; return to beginning - 0x1D ;D349 - 0xD3 ;D34A - - - ]))) \ No newline at end of file diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/exp/assembly.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/exp/assembly.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,128 @@ +(ns com.aurellem.exp.assembly + (:use (com.aurellem.gb gb-driver vbm title items)) + (:import [com.aurellem.gb.gb_driver SaveState])) + + +(defn run-item-program + "This is my first assembly/item program! + it just increments BC by one. + + The code places a 3 'great balls' at the beginning of the + inventory, then directly sets the program counter to start + executing at the position of the 'great balls' in memory. + + Since a 'great ball' is represented in memory as 0x03, which + corresponts to the opcode which increments BC by one, that is + what happens. Then the program counter to the 0x03 quantity entry + and BC is incremented again. + + Obviously, the game crashes more or less immediately after the + program counter advances past the 'great balls' into the next items + in the inventory, thus I call shutdown! before anything bad happens." + [] + (set-inventory (read-state "mid-game") [[:great-ball 3]]) + (print-inventory) + (println "3 ticks") (tick) (tick) (tick) + (println "PC before:" (PC)) + (println "BC before:" (BC)) + (PC! (inc item-list-start)) + (println "PC after setting:" (PC)) + (println "data at PC:" (aget (memory) (PC))) + (println "one tick") + (tick) + (println "PC after one tick:" (PC)) + (println "BC after one tick:" (BC)) + (tick) + (println "PC after two ticks:" (PC)) + (println "BC after two ticks:" (BC)) + + (shutdown!)) + + + + +(defn test-opcodes-1 + [] + (let [final-state + (-> + (read-state "mid-game") + (set-inv-mem + [20 0x02 0x00 0x00 0x02 0x00 0x00 + 0x00 0x0 0xFF]) + (print-inventory) + ;;((fn [_] (println "3 ticks") _)) + (tick) (tick) (tick) + + ;;(println "PC before:" (PC)) + ;;(println "BC before:" (BC)) + ;;(println "AF:" (AF)) + (PC! (inc item-list-start)) + (BC! (+ 1 item-list-start)) + ;;(println "PC after setting:" (PC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + + ;;(println "one tick") + (tick) + ;;(println "PC after one tick:" (PC)) + ;;(println "BC after one tick:" (BC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + (tick) + (AF! 0xFFFF) + ;;(println "PC after two ticks:" (PC)) + ;;(println "BC after two ticks:" (BC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + (tick) + ;;(println "PC after three ticks:" (PC)) + ;;(println "BC after three ticks:" (BC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + (tick) + ;;(println "PC after four ticks:" (PC)) + ;;(println "BC after four ticks:" (BC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + (tick) + ;;(println "PC after five ticks:" (PC)) + ;;(println "BC after five ticks:" (BC)) + ;;(println "data at PC:" (aget (memory) (PC))) + ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) + (print-inventory) + )] + + (shutdown!) + final-state)) + + + +(defn test-opcodes-2 + [] + (set-inv-mem (read-state "mid-game") + [20 0x08 0x1D 0xD3 0x00 0x00 0x00 + 0x00 0x0 0xFF]) + (print-inventory) + (println "3 ticks") (tick) (tick) (tick) + (println "PC before:" (PC)) + (println "SP:" (SP)) + (PC! (inc item-list-start)) + (println "PC after setting:" (PC)) + (println "SP:" (Integer/toBinaryString (SP))) + (println "data at PC:" (aget (memory) (PC))) + (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D))) + (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E))) + (println "one tick") + (tick) + (println "PC after one tick:" (PC)) + (println "data at PC:" (aget (memory) (PC))) + (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D))) + (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E))) + (tick) (tick) (tick) + (println "PC aftter four tick:" (PC)) + (println "data at PC:" (aget (memory) (PC))) + (println "data at 0xD31D:" (aget (memory) 0xD31D)) + + (print-inventory) + (shutdown!)) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/exp/item_bridge.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/exp/item_bridge.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,65 @@ +(ns com.aurellem.item-bridge + (:use (com.aurellem gb-driver vbm title save-corruption items assembly)) + (:import [com.aurellem.gb_driver SaveState])) + + +(defn corrupt-item-state [] + (second (destroy-item-end-of-list-marker))) + +(defn corrupt-item-state [] + (read-state "corrupt-items")) + + +(defn view-memory-range [state start end] + (dorun + (map (fn [loc val] + (println (format "%04X : %02X" loc val))) + + (range start end) (subvec (vec (memory state)) start end))) + state) + +(defn almost-broken + "if one more memory location is turned into 0x03, the game crashes." + [n] + (view-memory-range + (set-inv-mem (mid-game) + (concat [0xFF] (repeat 64 0x03) + (subvec (vec (memory (mid-game))) + (+ item-list-start 65) + (+ item-list-start 65 n)) + (repeat (- 255 65 n) 0x03) + )) + + item-list-start (+ item-list-start 255))) + +(defn actually-broken + "if one more memory location is turned into 0x03, the game crashes." + [] + (set-memory (mid-game) 0xD35D 0x03)) + + +;; (almost-broken 20) more or less works + +(defn capture-program-counter + "records the program counter for each tick" + [^SaveState state ticks] + (let [i (atom 0)] + (reduce (fn [[program-counters state] _] + (println (swap! i inc)) + [(conj program-counters (PC state)) + (tick state)]) + [[] state] + (range ticks)))) + + +(defn capture-program-counter + [^SaveState state ticks] + (set-state! state) + (loop [i 0 + pcs []] + (if (= i ticks) + pcs + (do + (com.aurellem.gb.Gb/tick) + (recur (inc i) + (conj pcs (first (registers)))))))) diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/exp/items.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/exp/items.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,401 @@ +(ns com.aurellem.exp.items + (:use (com.aurellem.gb gb-driver vbm items)) + (:import [com.aurellem.gb.gb_driver SaveState])) + +;; try just buying five potions in sequence and see what changes +;; each time. + +;; trying to find how items are represented in memory + +(def zero-potions (read-state "zero-potions")) + +(def one-potion (read-state "one-potion")) + +(def two-potions (read-state "two-potions")) + +(def three-potions (read-state "three-potions")) + +(def four-potions (read-state "four-potions")) + +(def five-potions (read-state "five-potions")) + + + ;; result +(defn item-canidates [] + (apply common-differences + (map (comp vec memory) + [zero-potions one-potion two-potions three-potions + four-potions five-potions]))) + + (comment [55875 (37 15 49 27 14 44)] + [55876 (30 1 49 56 55 23)] + [49158 (154 191 78 135 70 73)] + [54087 (49 40 37 34 25 22)] + [49160 (7 24 59 243 50 217)] + [49704 (31 14 72 33 84 27)] + [49162 (126 159 183 110 176 179)] + [39984 (0 254 251 248 127 252)] + [49904 (29 72 64 78 1 95)] + [65491 (222 127 149 132 226 38)] + [65492 (44 20 89 11 253 163)] + [49335 (52 15 6 14 3 17)] + [49720 (78 152 96 60 83 103)] + [65304 (19 89 214 33 18 113)] + [53561 (132 185 145 162 159 183)] + [54046 (0 1 2 3 4 5)]) + +;;; hmmmmmm...... I guess that the potion quantities are at 54046, +;;;huh? + + + +(defn get-mem [] + (subvec (vec (memory @current-state)) 54040 (+ 54046 100))) + + +;; potion -- 99 +[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] + +;; potion -- 95 +[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] + +;; potion -- 95 +;; pokeball -- 1 +[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] + +;; potion -- 95 +;; pokeball -- 10 +[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] + + +;; pokeball -- 10 +;; potion -- 95 +[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] + +;; pokeball -- 10 +;; potion -- 95 +;; antidote -- 1 + +;;prediction +;;[0 16 0 0 3 4 10 20 95 ?? 1 255 0 0 0 0 0 ....] + [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] + + + +;; now it's time to learn the item codes + +(def inventory-begin + (read-state "inventory-begin")) + +(defn show-item + "Run a saved pokemon with the first item replaced by the item named + by n." + [n] + (set-state! inventory-begin) + (let [mem (memory)] + (aset mem 54044 1) + (aset mem 54045 n) + (aset mem 54046 1) + (aset mem 54047 255) + (write-memory! mem)) + (step) + (->> [[] @current-state] + (play-moves + [[:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] []]))) + + +(defn get-item-names [] + (dorun (map (fn [n] (println n) + (show-item n) + (Thread/sleep 5000)) + (range 0x00 0xFF)))) + +;; results (took about 10 minutes to generate) + +;; 0 garbage +;; 1 master-ball +;; 2 ultra-ball +;; 3 great-ball +;; 4 poke-ball +;; 5 town-map +;; 6 bicycle +;; 7 ????? +;; 8 safari-ball +;; 9 pokedex +;; 10 moon-stone +;; 11 antidote +;; 12 burn-heal +;; 13 ice-heal +;; 14 awakening +;; 15 parlyz-heal +;; 16 full-restore +;; 17 max-potion +;; 18 hyper-potion +;; 19 super-potion +;; 20 potion +;; 21 boulderbadge +;; 22 cascadebadge +;; 23 thunderbadge +;; 24 rainbowbadge +;; 25 soulbadge +;; 26 marshbadge +;; 27 volcanobadge +;; 28 earthbadge +;; 29 escape-rope +;; 30 repel +;; 31 old amber +;; 32 fire-stone +;; 33 thunderstone +;; 34 water-stone +;; 35 hp-up +;; 36 protein +;; 37 iron +;; 38 carbos +;; 39 calcium +;; 40 rare-candy +;; 41 dome-fossil +;; 42 helix-fossil +;; 43 secret-key +;; 44 ????? +;; 45 bike-voucher +;; 46 x-accuracy +;; 47 leaf-stone +;; 48 card-key +;; 49 nugget +;; 50 pp-up +;; 51 poke-doll +;; 52 full-heal +;; 53 revive +;; 54 max-revive +;; 55 guard-spec. +;; 56 super-repel +;; 57 max-repel +;; 58 dire-hit +;; 59 coin +;; 60 fresh-water +;; 61 soda-pop +;; 62 lemonade +;; 63 s.s.ticket +;; 64 gold-teeth +;; 65 x-attach +;; 66 x-defend +;; 67 x-speed +;; 68 x-special +;; 69 coin-case +;; 70 oak's-parcel +;; 71 itemfinder +;; 72 silph-scope +;; 73 poke-flute +;; 74 lift-key +;; 75 exp.all +;; 76 old-rod +;; 77 good-rod +;; 78 super-rod +;; 79 pp-up +;; 80 ether +;; 81 max-ether +;; 82 elixer +;; 83 max-elixer +;; 84 B2F +;; 85 B1F +;; 86 1F +;; 87 2F +;; 88 3F +;; 89 4F +;; 90 5F +;; 91 6F +;; 92 7F +;; 93 8F +;; 94 9F +;; 95 10F +;; 96 11F +;; 97 B4F +;; 98 garbage +;; 99 garbage +;; 100 garbage +;; 101 garbage +;; 102 garbage +;; 103 garbage +;; 104 garbage +;; 105 garbage +;; 106 garbage +;; 107 garbage +;; 108 garbage +;; 109 garbage +;; 110 garbage +;; 111 garbage +;; 112 garbage +;; 113 garbage +;; 114 garbage +;; 115 garbage +;; 116 garbage +;; 117 garbage +;; 118 garbage +;; 119 4 +;; 120 garbage +;; 121 garbage +;; 122 slow +;; 123 garbage +;; 124 garbage +;; 125 garbage +;; 126 garbage +;; 127 garbage +;; 128 garbage +;; 129 garbage +;; 130 garbage +;; 131 slow +;; 132 slow +;; 133 garbage +;; 134 slow +;; 135 garbage +;; 136 garbage +;; 137 slow +;; 138 garbage +;; 139 garbage +;; 140 garbage +;; 141 slow +;; 142 garbage +;; 143 garbage +;; 144 garbage +;; 145 garbage +;; 146 garbage +;; 147 garbage +;; 148 garbage +;; 149 garbage +;; 150 slow +;; 151 garbage +;; 152 Q +;; 153 garbage +;; 154 garbage +;; 155 garbage +;; 156 garbage +;; 157 garbage +;; 158 garbage +;; 159 garbage +;; 160 garbage (alaphabet) +;; 161 garbage +;; 162 garbage +;; 163 garbage +;; 164 rival's +;; 165 name? +;; 166 nickname? +;; 167 slow +;; 168 garbage +;; 169 slow +;; 170 garbage +;; 171 garbage +;; 172 garbage +;; 173 garbage +;; 174 garbage +;; 175 yellow +;; 176 ash +;; 177 jack +;; 178 new-name +;; 179 blue +;; 180 gary +;; 181 john +;; 182 garbage +;; 183 garbage +;; 184 garbage +;; 185 garbage +;; 186 slow +;; 187 garbage +;; 188 garbage +;; 189 garbage +;; 190 garbage +;; 191 garbage +;; 192 garbage +;; 193 garbage +;; 194 garbage +;; 195 slow +;; 196 HM01 +;; 197 HM02 +;; 198 HM03 +;; 199 HM04 +;; 200 HM05 +;; 201 TM01 +;; 202 TM02 +;; 203 TM03 +;; 204 TM04 +;; 205 TM05 +;; 206 TM06 +;; 207 TM07 +;; 208 TM08 +;; 209 TM09 +;; 210 TM10 +;; 211 TM11 +;; 212 TM12 +;; 213 TM13 +;; 214 TM13 +;; 215 TM15 +;; 216 TM16 +;; 217 TM17 +;; 218 TM18 +;; 219 TM19 +;; 220 TM20 +;; 221 TM21 +;; 222 TM22 +;; 223 TM23 +;; 224 TM24 +;; 225 TM25 +;; 226 TM26 +;; 227 TM27 +;; 228 TM28 +;; 229 TM29 +;; 230 TM30 +;; 231 TM31 +;; 232 TM32 +;; 233 TM33 +;; 234 TM34 +;; 235 TM35 +;; 236 TM36 +;; 237 TM37 +;; 238 TM38 +;; 239 TM39 +;; 240 TM40 +;; 241 TM41 +;; 242 TM42 +;; 243 TM43 +;; 244 TM44 +;; 245 TM45 +;; 246 TM46 +;; 247 TM47 +;; 248 TM48 +;; 249 TM49 +;; 250 TM50 +;; 251 TM51 +;; 252 TM52 +;; 253 TM53 +;; 254 TM54 +;; 255 end-of-list-sentinel + + + +(def gliched-tms + [[:TM51 1] + [:TM52 1] + [:TM53 1] + [:TM54 1]]) + +(def good-items + [[:bicycle 1] + [:ultra-ball 15] + [:pp-up 1] + [:master-ball 5] + [:rare-candy 99] + [:full-restore 25] + [:max-revive 8] + [:max-repel 40] + [:TM25 1] + [:TM11 1] + [:TM15 1] + ]) + +(def some-badges + [[:cascadebadge 1] + [:thunderbadge 1] + [:rainbowbadge 1] + [:soulbadge 1] + ]) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/exp/pokemon.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/exp/pokemon.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,92 @@ +(ns com.aurellem.exp.pokemon + "Here I find out how pokemon are stored in memory." + (:use (com.aurellem.gb gb-driver items assembly util + characters)) + (:import [com.aurellem.gb.gb_driver SaveState])) + + +(def pidgeot-lvl-36 (mid-game)) + + +(def pidgeot-lvl-37 (read-state "pidgeot-lvl-37")) + + +(def pidgeot-lvl-38 (read-state "pidgeot-lvl-38")) + + +(def pidgeot-lvl-39 (read-state "pidgeot-lvl-39")) + + +(def pidgeot-lvl-40 (read-state "pidgeot-lvl-40")) + + +(defn level-analysis [] + (apply common-differences + (map (comp vec memory) + [pidgeot-lvl-36 + pidgeot-lvl-37 + pidgeot-lvl-38 + pidgeot-lvl-39 + pidgeot-lvl-40]))) + +;; inconclusive -- implies that level is calculated from +;; some other values. + + +(def name-pidgeotto (read-state "name-pidgeotto")) +(def named-A (read-state "named-A")) +(def named-B (read-state "named-B")) +(def named-C (read-state "named-C")) +(def named-D (read-state "named-D")) +(def named-E (read-state "named-E")) +(def named-F (read-state "named-F")) + +(defn name-analysis [] + (apply common-differences + (map (comp vec memory) + [named-A + named-B + named-C + named-D + named-E + named-F]))) + +;; resluted in 3 separate locations that could +;; possibly hold the first letter of the pokemon's name + +0xCF4A +0xD2EB +0xCEED + +;; try changing each of them + + +(defn test-cf4a [] + (continue! + (set-memory named-A 0xCF4A (character->character-code "Z")))) +;; result -- pidgeotto named "A" + +(defn test-d2eb [] + (continue! + (set-memory named-A 0xD2EB (character->character-code "Z")))) +;; result -- pidgeotto named "Z" + +(defn test-ceed [] + (continue! + (set-memory named-A 0xCEED (character->character-code "Z")))) +;; result -- pidgeotto named "A" + +(def sixth-pokemon-name-start 0xD2EB) + + +(defn set-sixth-pokemon-name-first-character + ([state character] + (set-memory state sixth-pokemon-name-start + (character->character-code character))) + ([character] + (set-sixth-pokemon-name-first-character @current-state + character))) + + + + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/exp/rival_name.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/exp/rival_name.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,301 @@ +(ns com.aurellem.exp.rival-name + (:use (com.aurellem.gb gb-driver)) + (:import [com.aurellem.gb.gb_driver SaveState])) + +(defn talk-to-rival [] + (read-state "talk-to-rival")) + + +;; determined by naming rival "ZZZZZZZ" and noticing the +;; pattern in the memory past the item list. + +(def rival-name-start 0xD349) + +(defn set-rival-name [^SaveState state codes] + (set-state! state) + (let [mem (memory state)] + (dorun (map (fn [index val] + (aset mem index val)) + (range rival-name-start + (+ rival-name-start + (count codes))) codes)) + (write-memory! mem) + (update-state))) + +(defn view-rival-name [name-codes] + (-> + (set-rival-name (talk-to-rival) name-codes) + (step [:a]) + (play 50))) + +(defn rival-name-sequence [] + (let [i (atom 1)] + (fn [] + (let [codes (range @i (+ 5 @i))] + (println codes) + (view-rival-name codes) + (reset! i (+ 5 @i)))))) + + +;; results: + +;; 0x00 : end-of-name-sentinel +;; 0x01 : +;; 0x02 : +;; 0x03 : +;; 0x04 : +;; 0x05 : +;; 0x06 : +;; 0x07 : +;; 0x08 : +;; 0x09 : +;; 0x0A : +;; 0x0B : +;; 0x0C : +;; 0x0D : +;; 0x0E : +;; 0x0F : +;; 0x10 : +;; 0x11 : +;; 0x12 : +;; 0x13 : +;; 0x14 : +;; 0x15 : +;; 0x16 : +;; 0x17 : +;; 0x18 : +;; 0x19 : +;; 0x1A : +;; 0x1B : +;; 0x1C : +;; 0x1D : +;; 0x1E : +;; 0x1F : +;; 0x20 : +;; 0x21 : +;; 0x22 : +;; 0x23 : +;; 0x24 : +;; 0x25 : +;; 0x26 : +;; 0x27 : +;; 0x28 : +;; 0x29 : +;; 0x2A : +;; 0x2B : +;; 0x2C : +;; 0x2D : +;; 0x2E : +;; 0x2F : +;; 0x30 : +;; 0x31 : +;; 0x32 : +;; 0x33 : +;; 0x34 : +;; 0x35 : +;; 0x36 : +;; 0x37 : +;; 0x38 : +;; 0x39 : +;; 0x3A : +;; 0x3B : +;; 0x3C : +;; 0x3D : +;; 0x3E : +;; 0x3F : +;; 0x40 : +;; 0x41 : +;; 0x42 : +;; 0x43 : +;; 0x44 : +;; 0x45 : +;; 0x46 : +;; 0x47 : +;; 0x48 : +;; 0x49 : +;; 0x4A : +;; 0x4B : +;; 0x4C : +;; 0x4D : +;; 0x4E : +;; 0x4F : +;; 0x50 : +;; 0x51 : +;; 0x52 : +;; 0x53 : +;; 0x54 : +;; 0x55 : +;; 0x56 : +;; 0x57 : +;; 0x58 : +;; 0x59 : +;; 0x5A : +;; 0x5B : +;; 0x5C : +;; 0x5D : +;; 0x5E : +;; 0x5F : +;; 0x60 : A (small-bold) +;; 0x61 : B (small-bold) +;; 0x62 : C (small-bold) +;; 0x63 : D (small-bold) +;; 0x64 : E (small-bold) +;; 0x65 : F (small-bold) +;; 0x66 : G (small-bold) +;; 0x67 : H (small-bold) +;; 0x68 : I (small-bold) +;; 0x69 : V (small-bold) +;; 0x6A : S (small-bold) +;; 0x6B : L (small-bold) +;; 0x6C : M (small-bold) +;; 0x6D : +;; 0x6E : +;; 0x6F : +;; 0x70 : +;; 0x71 : +;; 0x72 : +;; 0x73 : +;; 0x74 : +;; 0x75 : +;; 0x76 : +;; 0x77 : +;; 0x78 : +;; 0x79 : +;; 0x7A : +;; 0x7B : +;; 0x7C : +;; 0x7D : +;; 0x7E : +;; 0x7F : +;; 0x80 : A +;; 0x81 : B +;; 0x82 : C +;; 0x83 : D +;; 0x84 : E +;; 0x85 : F +;; 0x86 : G +;; 0x87 : H +;; 0x88 : I +;; 0x89 : J +;; 0x8A : K +;; 0x8B : L +;; 0x8C : M +;; 0x8D : N +;; 0x8E : O +;; 0x8F : P +;; 0x90 : Q +;; 0x91 : R +;; 0x92 : S +;; 0x93 : T +;; 0x94 : U +;; 0x95 : V +;; 0x96 : W +;; 0x97 : X +;; 0x98 : Y +;; 0x99 : Z +;; 0x9A : ( +;; 0x9B : ) +;; 0x9C : : +;; 0x9D : ; +;; 0x9E : +;; 0x9F : +;; 0xA0 : a +;; 0xA1 : b +;; 0xA2 : c +;; 0xA3 : d +;; 0xA4 : e +;; 0xA5 : f +;; 0xA6 : g +;; 0xA7 : h +;; 0xA8 : i +;; 0xA9 : j +;; 0xAA : k +;; 0xAB : l +;; 0xAC : m +;; 0xAD : n +;; 0xAE : o +;; 0xAF : p +;; 0xB0 : q +;; 0xB1 : r +;; 0xB2 : s +;; 0xB3 : t +;; 0xB4 : u +;; 0xB5 : v +;; 0xB6 : w +;; 0xB7 : x +;; 0xB8 : y +;; 0xB9 : z +;; 0xBA : e-with-grave +;; 0xBB : +;; 0xBC : +;; 0xBD : +;; 0xBE : +;; 0xBF : +;; 0xC0 : +;; 0xC1 : +;; 0xC2 : +;; 0xC3 : +;; 0xC4 : +;; 0xC5 : +;; 0xC6 : +;; 0xC7 : +;; 0xC8 : +;; 0xC9 : +;; 0xCA : +;; 0xCB : +;; 0xCC : +;; 0xCD : +;; 0xCE : +;; 0xCF : +;; 0xD0 : +;; 0xD1 : +;; 0xD2 : +;; 0xD3 : +;; 0xD4 : +;; 0xD5 : +;; 0xD6 : +;; 0xD7 : +;; 0xD8 : +;; 0xD9 : +;; 0xDA : +;; 0xDB : +;; 0xDC : +;; 0xDD : +;; 0xDE : +;; 0xDF : +;; 0xE0 : ' +;; 0xE1 : PK +;; 0xE2 : MN +;; 0xE3 : +;; 0xE4 : +;; 0xE5 : +;; 0xE6 : ? +;; 0xE7 : ! +;; 0xE8 : . +;; 0xE9 : +;; 0xEA : +;; 0xEB : +;; 0xEC : +;; 0xED : +;; 0xEE : +;; 0xEF : male-symbol +;; 0xF0 : pokemon-money-symbol +;; 0xF1 : . +;; 0xF2 : / +;; 0xF3 : , +;; 0xF4 : female-symbol +;; 0xF5 : +;; 0xF6 : 0 +;; 0xF7 : 1 +;; 0xF8 : 2 +;; 0xF9 : 3 +;; 0xFA : 4 +;; 0xFB : 5 +;; 0xFC : 6 +;; 0xFD : 7 +;; 0xFE : 8 +;; 0xFF : 9 + + + + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/experiments/items.clj --- a/clojure/com/aurellem/experiments/items.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,503 +0,0 @@ -(ns com.aurellem.experiments.items - (:use (com.aurellem gb-driver vbm title items)) - (:import [com.aurellem.gb_driver SaveState])) - -;; try just buying five potions in sequence and see what changes -;; each time. - -(defn common-differences [& seqs] - (let [backbone (range (count (first seqs)))] - (filter - (comp (partial apply distinct?) second) - (zipmap backbone - (apply (partial map list) seqs))))) - -;; trying to find how items are represented in memory - -(def zero-potions (read-state "zero-potions")) - -(def one-potion (read-state "one-potion")) - -(def two-potions (read-state "two-potions")) - -(def three-potions (read-state "three-potions")) - -(def four-potions (read-state "four-potions")) - -(def five-potions (read-state "five-potions")) - - - ;; result -(defn canidates [] - (apply common-differences - (map (comp vec memory) - [zero-potions one-potion two-potions three-potions - four-potions five-potions]))) - - (comment [55875 (37 15 49 27 14 44)] - [55876 (30 1 49 56 55 23)] - [49158 (154 191 78 135 70 73)] - [54087 (49 40 37 34 25 22)] - [49160 (7 24 59 243 50 217)] - [49704 (31 14 72 33 84 27)] - [49162 (126 159 183 110 176 179)] - [39984 (0 254 251 248 127 252)] - [49904 (29 72 64 78 1 95)] - [65491 (222 127 149 132 226 38)] - [65492 (44 20 89 11 253 163)] - [49335 (52 15 6 14 3 17)] - [49720 (78 152 96 60 83 103)] - [65304 (19 89 214 33 18 113)] - [53561 (132 185 145 162 159 183)] - [54046 (0 1 2 3 4 5)]) - -;;; hmmmmmm...... I guess that the potion quantities are at 54046, -;;;huh? - - - -(defn get-mem [] - (subvec (vec (memory @current-state)) 54040 (+ 54046 100))) - - -;; potion -- 99 -[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] - -;; potion -- 95 -[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] - -;; potion -- 95 -;; pokeball -- 1 -[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] - -;; potion -- 95 -;; pokeball -- 10 -[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] - - -;; pokeball -- 10 -;; potion -- 95 -[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] - -;; pokeball -- 10 -;; potion -- 95 -;; antidote -- 1 - -;;prediction -;;[0 16 0 0 3 4 10 20 95 ?? 1 255 0 0 0 0 0 ....] - [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] - - - -;; now it's time to learn the item codes - -(def inventory-begin - (read-state "inventory-begin")) - -(defn show-item - "Run a saved pokemon with the first item replaced by the item named - by n." - [n] - (set-state! inventory-begin) - (let [mem (memory)] - (aset mem 54044 1) - (aset mem 54045 n) - (aset mem 54046 1) - (aset mem 54047 255) - (write-memory! mem)) - (step) - (->> [[] @current-state] - (play-moves - [[:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] []]))) - - -(defn get-item-names [] - (dorun (map (fn [n] (println n) - (show-item n) - (Thread/sleep 5000)) - (range 0x00 0xFF)))) - -;; results (took about 10 minutes to generate) - -;; 0 garbage -;; 1 master-ball -;; 2 ultra-ball -;; 3 great-ball -;; 4 poke-ball -;; 5 town-map -;; 6 bicycle -;; 7 ????? -;; 8 safari-ball -;; 9 pokedex -;; 10 moon-stone -;; 11 antidote -;; 12 burn-heal -;; 13 ice-heal -;; 14 awakening -;; 15 parlyz-heal -;; 16 full-restore -;; 17 max-potion -;; 18 hyper-potion -;; 19 super-potion -;; 20 potion -;; 21 boulderbadge -;; 22 cascadebadge -;; 23 thunderbadge -;; 24 rainbowbadge -;; 25 soulbadge -;; 26 marshbadge -;; 27 volcanobadge -;; 28 earthbadge -;; 29 escape-rope -;; 30 repel -;; 31 old amber -;; 32 fire-stone -;; 33 thunderstone -;; 34 water-stone -;; 35 hp-up -;; 36 protein -;; 37 iron -;; 38 carbos -;; 39 calcium -;; 40 rare-candy -;; 41 dome-fossil -;; 42 helix-fossil -;; 43 secret-key -;; 44 ????? -;; 45 bike-voucher -;; 46 x-accuracy -;; 47 leaf-stone -;; 48 card-key -;; 49 nugget -;; 50 pp-up -;; 51 poke-doll -;; 52 full-heal -;; 53 revive -;; 54 max-revive -;; 55 guard-spec. -;; 56 super-repel -;; 57 max-repel -;; 58 dire-hit -;; 59 coin -;; 60 fresh-water -;; 61 soda-pop -;; 62 lemonade -;; 63 s.s.ticket -;; 64 gold-teeth -;; 65 x-attach -;; 66 x-defend -;; 67 x-speed -;; 68 x-special -;; 69 coin-case -;; 70 oak's-parcel -;; 71 itemfinder -;; 72 silph-scope -;; 73 poke-flute -;; 74 lift-key -;; 75 exp.all -;; 76 old-rod -;; 77 good-rod -;; 78 super-rod -;; 79 pp-up -;; 80 ether -;; 81 max-ether -;; 82 elixer -;; 83 max-elixer -;; 84 B2F -;; 85 B1F -;; 86 1F -;; 87 2F -;; 88 3F -;; 89 4F -;; 90 5F -;; 91 6F -;; 92 7F -;; 93 8F -;; 94 9F -;; 95 10F -;; 96 11F -;; 97 B4F -;; 98 garbage -;; 99 garbage -;; 100 garbage -;; 101 garbage -;; 102 garbage -;; 103 garbage -;; 104 garbage -;; 105 garbage -;; 106 garbage -;; 107 garbage -;; 108 garbage -;; 109 garbage -;; 110 garbage -;; 111 garbage -;; 112 garbage -;; 113 garbage -;; 114 garbage -;; 115 garbage -;; 116 garbage -;; 117 garbage -;; 118 garbage -;; 119 4 -;; 120 garbage -;; 121 garbage -;; 122 slow -;; 123 garbage -;; 124 garbage -;; 125 garbage -;; 126 garbage -;; 127 garbage -;; 128 garbage -;; 129 garbage -;; 130 garbage -;; 131 slow -;; 132 slow -;; 133 garbage -;; 134 slow -;; 135 garbage -;; 136 garbage -;; 137 slow -;; 138 garbage -;; 139 garbage -;; 140 garbage -;; 141 slow -;; 142 garbage -;; 143 garbage -;; 144 garbage -;; 145 garbage -;; 146 garbage -;; 147 garbage -;; 148 garbage -;; 149 garbage -;; 150 slow -;; 151 garbage -;; 152 Q -;; 153 garbage -;; 154 garbage -;; 155 garbage -;; 156 garbage -;; 157 garbage -;; 158 garbage -;; 159 garbage -;; 160 garbage (alaphabet) -;; 161 garbage -;; 162 garbage -;; 163 garbage -;; 164 rival's -;; 165 name? -;; 166 nickname? -;; 167 slow -;; 168 garbage -;; 169 slow -;; 170 garbage -;; 171 garbage -;; 172 garbage -;; 173 garbage -;; 174 garbage -;; 175 yellow -;; 176 ash -;; 177 jack -;; 178 new-name -;; 179 blue -;; 180 gary -;; 181 john -;; 182 garbage -;; 183 garbage -;; 184 garbage -;; 185 garbage -;; 186 slow -;; 187 garbage -;; 188 garbage -;; 189 garbage -;; 190 garbage -;; 191 garbage -;; 192 garbage -;; 193 garbage -;; 194 garbage -;; 195 slow -;; 196 HM01 -;; 197 HM02 -;; 198 HM03 -;; 199 HM04 -;; 200 HM05 -;; 201 TM01 -;; 202 TM02 -;; 203 TM03 -;; 204 TM04 -;; 205 TM05 -;; 206 TM06 -;; 207 TM07 -;; 208 TM08 -;; 209 TM09 -;; 210 TM10 -;; 211 TM11 -;; 212 TM12 -;; 213 TM13 -;; 214 TM13 -;; 215 TM15 -;; 216 TM16 -;; 217 TM17 -;; 218 TM18 -;; 219 TM19 -;; 220 TM20 -;; 221 TM21 -;; 222 TM22 -;; 223 TM23 -;; 224 TM24 -;; 225 TM25 -;; 226 TM26 -;; 227 TM27 -;; 228 TM28 -;; 229 TM29 -;; 230 TM30 -;; 231 TM31 -;; 232 TM32 -;; 233 TM33 -;; 234 TM34 -;; 235 TM35 -;; 236 TM36 -;; 237 TM37 -;; 238 TM38 -;; 239 TM39 -;; 240 TM40 -;; 241 TM41 -;; 242 TM42 -;; 243 TM43 -;; 244 TM44 -;; 245 TM45 -;; 246 TM46 -;; 247 TM47 -;; 248 TM48 -;; 249 TM49 -;; 250 TM50 -;; 251 TM51 -;; 252 TM52 -;; 253 TM53 -;; 254 TM54 -;; 255 end-of-list-sentinel - - - -(defn run-item-program - "This is my first assembly/item program! - it just increments BC by one. - - The code places a 3 'great balls' at the beginning of the - inventory, then directly sets the program counter to start - executing at the position of the 'great balls' in memory. - - Since a 'great ball' is represented in memory as 0x03, which - corresponts to the opcode which increments BC by one, that is - what happens. Then the program counter to the 0x03 quantity entry - and BC is incremented again. - - Obviously, the game crashes more or less immediately after the - program counter advances past the 'great balls' into the next items - in the inventory, thus I call shutdown! before anything bad happens." - [] - (set-inventory (read-state "mid-game") [[:great-ball 3]]) - (print-inventory) - (println "3 ticks") (tick) (tick) (tick) - (println "PC before:" (PC)) - (println "BC before:" (BC)) - (PC! (inc item-list-start)) - (println "PC after setting:" (PC)) - (println "data at PC:" (aget (memory) (PC))) - (println "one tick") - (tick) - (println "PC after one tick:" (PC)) - (println "BC after one tick:" (BC)) - (tick) - (println "PC after two ticks:" (PC)) - (println "BC after two ticks:" (BC)) - - (shutdown!)) - - - - -(defn test-opcodes-1 - [] - (let [final-state - (-> - (read-state "mid-game") - (set-inv-mem - [20 0x02 0x00 0x00 0x02 0x00 0x00 - 0x00 0x0 0xFF]) - (print-inventory) - ;;((fn [_] (println "3 ticks") _)) - (tick) (tick) (tick) - - ;;(println "PC before:" (PC)) - ;;(println "BC before:" (BC)) - ;;(println "AF:" (AF)) - (PC! (inc item-list-start)) - (BC! (+ 1 item-list-start)) - ;;(println "PC after setting:" (PC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - - ;;(println "one tick") - (tick) - ;;(println "PC after one tick:" (PC)) - ;;(println "BC after one tick:" (BC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - (tick) - (AF! 0xFFFF) - ;;(println "PC after two ticks:" (PC)) - ;;(println "BC after two ticks:" (BC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - (tick) - ;;(println "PC after three ticks:" (PC)) - ;;(println "BC after three ticks:" (BC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - (tick) - ;;(println "PC after four ticks:" (PC)) - ;;(println "BC after four ticks:" (BC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - (tick) - ;;(println "PC after five ticks:" (PC)) - ;;(println "BC after five ticks:" (BC)) - ;;(println "data at PC:" (aget (memory) (PC))) - ;;(println "data at " (BC) "(BC):" (aget (memory) (BC))) - (print-inventory) - )] - - (shutdown!) - final-state)) - - - -(defn test-opcodes-2 - [] - (set-inv-mem (read-state "mid-game") - [20 0x08 0x1D 0xD3 0x00 0x00 0x00 - 0x00 0x0 0xFF]) - (print-inventory) - (println "3 ticks") (tick) (tick) (tick) - (println "PC before:" (PC)) - (println "SP:" (SP)) - (PC! (inc item-list-start)) - (println "PC after setting:" (PC)) - (println "SP:" (Integer/toBinaryString (SP))) - (println "data at PC:" (aget (memory) (PC))) - (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D))) - (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E))) - (println "one tick") - (tick) - (println "PC after one tick:" (PC)) - (println "data at PC:" (aget (memory) (PC))) - (println "data at 0xD31D:" (Integer/toBinaryString (aget (memory) 0xD31D))) - (println "data at 0xD31E:" (Integer/toBinaryString (aget (memory) 0xD31E))) - (tick) (tick) (tick) - (println "PC aftter four tick:" (PC)) - (println "data at PC:" (aget (memory) (PC))) - (println "data at 0xD31D:" (aget (memory) 0xD31D)) - - (print-inventory) - (shutdown!)) diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/assembly.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/assembly.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,1431 @@ +(ns com.aurellem.gb.assembly + (:use (com.aurellem.gb gb-driver vbm util items)) + (:import [com.aurellem.gb.gb_driver SaveState])) + +(defn inject-assembly + ([^SaveState state + program-counter registers + assembly-code] + (let [scratch-memory (memory state)] + ;; inject assembly code + (dorun (map (fn [index val] + (aset scratch-memory index val)) + (range program-counter + (+ program-counter (count assembly-code))) + assembly-code)) + (-> state + (write-memory! scratch-memory) + (write-registers! registers) + (PC! program-counter))))) + +(defn inject-item-assembly + ([^SaveState state assembly-code] + (inject-assembly state (inc item-list-start) + (registers state) + assembly-code)) + ([assembly-code] + (inject-item-assembly @current-state assembly-code))) + +(defn run-assembly + ([info-fn assembly n] + (let [final-state + (reduce (fn [state _] + (tick (info-fn state))) + (inject-item-assembly + (mid-game) assembly) + (range n))] + final-state)) + ([assembly n] + (run-assembly d-tick assembly n))) + +(def buttons-port 0xFF00) + +(defn trace [state] + (loop [program-counters [(first (registers @current-state)) ] + opcodes [(aget (memory @current-state) (PC @current-state))]] + (let [frame-boundary? + (com.aurellem.gb.Gb/tick)] + (if frame-boundary? + [program-counters opcodes] + (recur + (conj program-counters + (first (registers @current-state))) + (conj opcodes + (aget (memory @current-state) + (PC @current-state)))))))) + +(defn print-trace [state n] + (let [[program-counters opcodes] (trace state)] + (dorun (map (fn [pc op] (println (format "%04X: 0x%02X" pc op))) + (take n program-counters) + (take n opcodes))))) + +(defn good-trace [] + (-> (mid-game) (tick) (IE! 0) + (set-inv-mem [0x00 0x00 0X00 0x00]) + (PC! item-list-start)(print-interrupt) + (d-tick) (tick) (d-tick) (tick) (d-tick))) + +(defn read-down-button [] + (-> (tick (mid-game)) + (IE! 0) ; disable interrupts + (inject-item-assembly + ;; write 00010000 to 0xFF00 to select joypad + [0x18 ;D31D ; jump over + 0x01 ;D31E ; the next 8 bits + ;D31F + (Integer/parseInt "00100000" 2) ; data section + + 0xFA ;D320 ; load (D31F) into A + 0x1F ;D321 --> + 0xD3 ;D322 --> D31F + + 0xEA ;D323 ; load (A), which is + 0x00 ;D324 --> ; 00010000, into FF00 + 0xFF ;D325 --> FF00 + + 0x18 ;D326 ; this is the place where + 0x01 ;D327 ; we will store whether + 0x00 ;D328 ; "down" is pressed. + + 0xFA ;D329 ; (FF00) -> A + 0x00 ;D32A + 0xFF ;D32B + + 0xCB ;D32C ; Test whether "down" + 0x5F ;D32D ; is pressed. + + 0x28 ;D32E ; if down is pressed, + 0x03 ;D32F ; skip the next section + ; of code. + ;; down-is-not-pressed + 0xC3 ;D330 + 0x1D ;D331 ; return to beginning + 0xD3 ;D332 + + ;; down-is-pressed + 0xEA ;D334 ; write A to D328 if + 0x28 ;D335 ; "down" was pressed + 0xD3 ;D336 + + 0xC3 ;D330 + 0x1D ;D331 ; return to beginning + 0xD3 ;D332 + ]))) + +(defn test-read-down [] + (= (view-memory (step (step (read-down-button) [:d])) 0xD328) + (view-memory (step (step (read-down-button))) 0xD328))) + +(defn count-frames [] + (-> (tick (mid-game)) + (IE! 0) ; disable interrupts + (inject-item-assembly + [0x18 ;D31D ; jump over + 0x02 ;D31E ; the next 2 bytes + 0x00 ;D31F ; frame-count + 0x00 ;D320 ; v-blank-prev + + 0xFA ;D321 + 0x41 ;D322 ; load (FF41) into A + 0xFF ;D323 ; this contains mode flags + + ;; if we're in v-blank, the bit-1 is 0 + ;; and bit-2 is 1 Otherwise, it is not v-blank. + 0xCB ;D324 ; test bit-1 of A + 0x4F ;D325 + + 0xC2 ;D326 ; if bit-1 is not 0 + 0x44 ;D327 ; GOTO not-v-blank + 0xD3 ;D328 + + 0xCB ;D329 ; test bit-0 of A + 0x47 ;D32A + + 0xCA ;D32B ; if bit-0 is not 1 + 0x44 ;D32C ; GOTO not-v-blank + 0xD3 ;D32D + ;;; in v-blank mode + ;; if v-blank-prev was 0, + ;; increment frame-count + + 0xFA ;D32E ; load v-blank-prev to A + 0x20 ;D32F + 0xD3 ;D330 + + 0xCB ;D331 + 0x47 ;D332 ; test bit-0 of A + + 0x20 ;D333 ; skip next section + 0x07 ;D334 ; if v-blank-prev was not zero + + ;; v-blank was 0, increment frame-count + 0xFA ;D335 ; load frame-count into A + 0x1F ;D336 + 0xD3 ;D337 + + 0x3C ;D338 ; inc A + + 0xEA ;D339 ; load A into frame-count + 0x1F ;D33A + 0xD3 ;D33B + + ;; set v-blank-prev to 1 + 0x3E ;D33C ; load 1 into A + 0x01 ;D33D + + 0xEA ;D33E ; load A into v-blank-prev + 0x20 ;D33F + 0xD3 ;D340 + + 0xC3 ;D341 ; return to beginning + 0x1D ;D342 + 0xD3 ;D343 + + ;;; not in v-blank mode + ;; set v-blank-prev to 0 + 0x3E ;D344 ; load 0 into A + 0x00 ;D345 + + 0xEA ;D346 ; load A into v-blank-prev + 0x20 ;D347 + 0xD3 ;D348 + + 0xC3 ;D349 ; return to beginning + 0x1D ;D34A + 0xD3 ;D34B + ]))) + +(defn step-count-frames [] + (-> (read-down-button) + (d-tick) + (tick) ;; skip over data section + (d-tick) + (view-register "Register A" A) + (tick) ;; load-data into A + (view-register "Register A" A) + (d-tick) + (view-memory 0xFF00) + (tick) ;; load A into 0xFF00 + (view-memory 0xFF00) + (d-tick) + (tick) + (d-tick) + (tick) + (d-tick) + (tick) + (d-tick) + (tick) + (d-tick) + (tick) + (d-tick) + (tick) + (print-inventory))) + +(defn test-count-frames [] + (= 255 (aget (memory ((apply comp (repeat 255 step)) + (count-frames))) + 0xD31F))) + +;; specs for main bootstrap program +;; starts in "mode-select" mode +;; Each button press takes place in a single frame. +;; mode-select-mode takes one of the main buttons +;; which selects one of up to eight modes +;; mode 1 activated by the "A" button +;; the next two button presses indicates the start +;; memory location which to which the bootstrap +;; program will write. +;; This is done by using each of the eight buttons to +;; spell out an 8 bit number. The order of buttons is +;; [:d :u :l :r :start :select :b :a] +;; [:a :start :l] --> 00101001 + +;; the next button press determines how many bytes are to be +;; written, starting at the start position. + +;; then, the actual bytes are entered and are written to the +;; start address in sequence. + +(defn input-number-assembly [] + [0x18 ;D31D ; jump over + 0x02 ;D31E ; the next 2 bytes + 0x00 ;D31F ; frame-count + 0x00 ;D320 ; v-blank-prev + + 0xFA ;D321 + 0x41 ;D322 ; load (FF41) into A + 0xFF ;D323 ; this contains mode flags + + ;; if we're in v-blank, the bit-1 is 0 + ;; and bit-2 is 1 Otherwise, it is not v-blank. + 0xCB ;D324 ; test bit-1 of A + 0x4F ;D325 + + 0xC2 ;D326 ; if bit-1 is not 0 + 0x44 ;D327 ; GOTO not-v-blank + 0xD3 ;D328 + + 0xCB ;D329 ; test bit-0 of A + 0x47 ;D32A + + 0xCA ;D32B ; if bit-0 is not 1 + 0x44 ;D32C ; GOTO not-v-blank + 0xD3 ;D32D + + ;;; in v-blank mode + + ;; if v-blank-prev was 0, + ;; increment frame-count + + 0xFA ;D32E ; load v-blank-prev to A + 0x20 ;D32F + 0xD3 ;D330 + + 0xCB ;D331 + 0x47 ;D332 ; test bit-0 of A + + 0x20 ;D333 ; skip next section + 0x07 ;D334 ; if v-blank-prev was not zero + + ;; v-blank was 0, increment frame-count + 0xFA ;D335 ; load frame-count into A + 0x1F ;D336 + 0xD3 ;D337 + + 0x3C ;D338 ; inc A + + 0xEA ;D339 ; load A into frame-count + 0x1F ;D33A + 0xD3 ;D33B + + ;; set v-blank-prev to 1 + 0x3E ;D33C ; load 1 into A + 0x01 ;D33D + + 0xEA ;D33E ; load A into v-blank-prev + 0x20 ;D33F + 0xD3 ;D340 + + 0xC3 ;D341 ; GOTO input handling code + 0x4E ;D342 + 0xD3 ;D343 + + ;;; not in v-blank mode + ;; set v-blank-prev to 0 + 0x3E ;D344 ; load 0 into A + 0x00 ;D345 + + 0xEA ;D346 ; load A into v-blank-prev + 0x20 ;D347 + 0xD3 ;D348 + + 0xC3 ;D349 ; return to beginning + 0x1D ;D34A + 0xD3 ;D34B + + 0x00 ;D34C ; these are here + 0x00 ;D34D ; for glue + + + ;;; calculate input number based on button presses + 0x18 ;D34E ; skip next 3 bytes + 0x03 ;D34F + ;D350 + (Integer/parseInt "00100000" 2) ; select directional pad + ;D351 + (Integer/parseInt "00010000" 2) ; select buttons + 0x00 ;D352 ; input-number + + ;; select directional pad, store low bits in B + + 0xFA ;D353 ; load (D350) into A + 0x50 ;D354 --> + 0xD3 ;D355 --> D31F + + 0xEA ;D356 ; load A, which is + 0x00 ;D357 --> ; 00010000, into FF00 + 0xFF ;D358 --> FF00 + + 0x06 ;D359 + ;D35A + (Integer/parseInt "11110000" 2) ; "11110000" -> B + 0xFA ;D35B ; (FF00) -> A + 0x00 ;D35C + 0xFF ;D35D + + 0xCB ;D35E ; swap nybbles on A + 0x37 ;D35F + 0xA0 ;D360 ; (AND A B) -> A + 0x47 ;D361 ; A -> B + + ;; select buttons store bottom bits in C + + 0xFA ; ; load (D351) into A + 0x51 ; --> + 0xD3 ; --> D31F + + 0xEA ; ; load (A), which is + 0x00 ; --> ; 00001000, into FF00 + 0xFF ; --> FF00 + + 0x0E ; + (Integer/parseInt "00001111" 2) ; "00001111" -> C + + 0xFA ; ; (FF00) -> A + 0x00 ; + 0xFF ; + + 0xA1 ; ; (AND A C) -> A + 0x4F ; ; A -> C + + ;; combine the B and C registers into the input number + 0x79 ; ; C -> A + 0xB0 ; ; (OR A B) -> A + 0x2F ; ; negate A + + 0xEA ; ; store A into input-number + 0x52 ; + 0xD3 ; + + 0xC3 ; ; return to beginning + 0x1D ; + 0xD3 ; + ]) + + + +(defn input-number [] + (-> (tick (mid-game)) + (IE! 0) ; disable interrupts + (inject-item-assembly (input-number-assembly)))) + +(defn test-input-number + "Input freestyle buttons and observe the effects at the repl." + [] + (set-state! (input-number)) + (dotimes [_ 90000] (step (view-memory @current-state 0xD352)))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +(defn write-memory-assembly* + "Currently, grabs input from the user each frame." + [] + [ + ;; --------- FRAME METRONOME + 0x18 ;; jump ahead to cleanup. first time only. + 0x40 ;; v-blank-prev [D31E] + + 0xFA ;; load modes into A [D31F] + 0x41 + 0xFF + + 0x47 ;; A -> B + 0xCB ;; rotate A + 0x2F + 0x2F ;; invert A + + 0xA0 + 0x47 ;; now B_0 contains (VB==1) + + 0xFA ;; load v-blank-prev + 0x1E + 0xD3 + + 0x2F ;; complement v-blank-prev + + 0xA0 ;; A & B --> A + 0x4F ;; now C_0 contains increment? + + + 0x78 ;; B->A + 0xEA ;; spit A --> vbprev + 0x1E + 0xD3 + + 0xCB ;test C_0 + 0x41 + 0x20 ; JUMP ahead to button input if nonzero + 0x02 + 0x18 ; JUMP back to frame metronome (D31F) + 0xE7 + + ;; -------- GET BUTTON INPUT + + ;; btw, C_0 is now 1 + ;; prepare to select bits + + 0x06 ;; load 0x00 into B + 0x00 ;; to initialize for "OR" loop + + 0x3E ;; load 0x20 into A, to measure dpad + 0x20 + + + 0xE0 ;; load A into [FF00] ;; start of OR loop [D33C] + 0x00 + + 0xF0 ;; load A from [FF00] + 0x00 + + 0xE6 ;; bitmask 00001111 + 0x0F + + 0xB0 ;; A or B --> A + 0xCB + 0x41 ;; test bit 0 of C + 0x28 ;; JUMP forward if 0 + 0x08 + + 0x47 ;; A -> B + 0xCB ;; swap B nybbles + 0x30 + 0x0C ;; increment C + 0x3E ;; load 0x10 into A, to measure btns + 0x10 + 0x18 ;; JUMP back to "load A into [FF00]" [20 steps?] + 0xED + + + ;; ------ TAKE ACTION BASED ON USER INPUT + + ;; "input mode" + ;; mode 0x00 : select mode + ;; mode 0x08 : select bytes-to-write + ;; mode 0x10 : select hi-bit + ;; mode 0x18 : select lo-bit + + ;; "output mode" + ;; mode 0x20 : write bytes + ;; mode 0xFF : jump PC + + + ;; registers + ;; D : mode select + ;; E : count of bytes to write + ;; H : address-high + ;; L : address-low + + ;; now A contains the pressed keys + 0x2F ; complement A, by request. [D34F] + + 0x47 ; A->B ;; now B contains the pressed keys + 0x7B ; E->A ;; now A contains the count. + + 0xCB ; test bit 5 of D (are we in o/p mode?) + 0x6A + 0x28 ; if test == 0, skip this o/p section + 0x13 ; JUMP + + 0xCB ; else, test bit 0 of D (fragile; are we in pc mode?) + 0x42 + 0x28 ; if test == 0, skip the following command + 0x01 + + ;; output mode I: moving the program counter + 0xE9 ; ** move PC to (HL) + + ;; output mode II: writing bytes + 0xFE ; A compare 0. finished writing? + 0x00 + 0x20 ; if we are not finished, skip cleanup + 0x04 ; JUMP + + ;; CLEANUP + ;; btw, A is already zero. + 0xAF ; zero A [D35F] + 0x57 ; A->D; makes D=0. + 0x18 ; end of frame + 0xBC + + ;; ---- end of cleanup + + + ;; continue writing bytes + 0x1D ;; decrement E, the number of bytes to write [D363] + 0x78 ;; B->A; now A contains the pressed keys + 0x77 ;; copy A to (HL) + 0x23 ;; increment HL + 0x18 ;; end frame. [goto D31F] + 0xB6 ;; TODO: set skip length backwards + + + ;; ---- end of o/p section + + ;; i/p mode + ;; adhere to the mode discipline: + ;; D must be one of 0x00 0x08 0x10 0x18. + + 0x3E ;; load the constant 57 into A. [D369] + 0x57 + 0x82 ;; add the mode to A + 0xEA ;; store A into "thing to execute" + 0x74 + 0xD3 + + 0x3E ;; load the constant 8 into A + 0x08 + 0x82 ;; add the mode to A + + 0x57 ;; store the incremented mode into D + 0x78 ;; B->A; now A contains the pressed keys + + 0x00 ;; var: thing to execute [D374] + + 0x18 ;; end frame + 0xA8 + ] + ) + +(defn write-mem-dyl [] + (-> (tick (mid-game)) + (IE! 0) + (inject-item-assembly (write-memory-assembly*)))) + + +(defn dylan* [] + (-> + (write-mem-dyl) + + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + + ;;(view-memory 0xD374) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + ;;(view-memory 0xD374) + (d-tick) + + (view-register "A" A) + (view-register "B" B) + (view-register "C" C)) + +) + + +(defn dylan [] + (-> + (write-mem-dyl) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) ;; first loop + + + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) ;; dpad bits + + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (d-tick) + + + + (view-register "A" A) + (view-register "B" B) + (view-register "C" C) + + )) + + + + +(defn d2 [] + (-> + (write-mem-dyl) + (view-memory 0xD31F) + step step step step step + (view-memory 0xD31F))) + + + + + + + + + + + + + + + + + + + + +(defn write-memory-assembly [] + [ + ;; Main Timing Loop + ;; Constantly check for v-blank and Trigger main state machine on + ;; every transtion from v-blank to non-v-blank. + + 0x18 ; D31D ; Variable declaration + 0x02 ; D31E + 0x00 ; D31F ; frame-count + 0x00 ; D320 ; v-blank-prev + + 0xF0 ; D321 ; load v-blank mode flags into A + 0x41 + 0x00 + + + ;; Branch dependent on v-blank. v-blank happens when the last two + ;; bits in A are "01" + 0xCB ; D324 + 0x4F ; D325 + + 0xC2 ; D326 ; if bit-1 is not 0, then + 0x3E ; D327 ; GOTO non-v-blank. + 0xD3 ; D328 + + 0xCB ; D329 + 0x47 ; D32A + + 0xCA ; D32B ; if bit-0 is not 1, then + 0x3E ; D32C ; GOTO non-v-blank. + 0xD3 ; D32D + + ;; V-Blank + ;; Activate state-machine if this is a transition event. + + 0xFA ; D32E ; load v-bank-prev into A + 0x20 ; D32F + 0xD3 ; D330 + + 0xFE ; D331 ; compare A to 0. >--------\ + 0x00 ; D332 \ + ; | + ;; set v-blank-prev to 1. | + 0x3E ; D333 ; load 1 into A. | + 0x01 ; D334 | + ; | + 0xEA ; D335 ; load A into v-blank-prev | + 0x20 ; D336 | + 0xD3 ; D337 | + ; / + ;; if v-blank-prev was 0, activate state-machine <------/ + 0xCA ; D338 ; if v-blank-prev + 0x46 ; D339 ; was 0, + 0xD3 ; D33A ; GOTO state-machine + + 0xC3 ; D33B + 0x1D ; D33C + 0xD3 ; D33D ; GOTO beginning + ;; END V-blank + + ;; Non-V-Blank + ;; Set v-blank-prev to 0 + 0x3E ; D33E ; load 0 into A + 0x00 ; D33F + + 0xEA ; D340 ; load A into v-blank-prev + 0x20 ; D341 + 0xD3 ; D342 + + 0xC3 ; D343 + 0x1D ; D344 + 0xD3 ; D345 ; GOTO beginning + ;; END Not-V-Blank + + + ;; Main State Machine -- Input Section + ;; This is called once every frame. + ;; It collects input and uses it to drive the + ;; state transitions. + + ;; Increment frame-count + 0xFA ; D346 ; load frame-count into A + 0x1F ; D347 + 0xD3 ; D348 + + 0x3C ; D349 ; inc A + + 0xEA ; D34A + 0x1F ; D34B ; load A into frame-count + 0xD3 ; D34C + + 0x00 ; D34D ; glue :) + + 0x18 ;D34E ; skip next 3 bytes + 0x03 ;D34F + ;D350 + (Integer/parseInt "00100000" 2) ; select directional pad + ;D351 + (Integer/parseInt "00010000" 2) ; select buttons + 0x00 ;D352 ; input-number + + ;; select directional pad; store low bits in B + + 0xFA ;D353 ; load (D350) into A + 0x50 ;D354 --> + 0xD3 ;D355 --> D350 + + 0xE0 ;D356 ; load (A), which is + 0x00 ;D357 --> ; 00010000, into FF00 + 0x00 ;D358 --> FF00 ;; NO-OP + + 0x06 ;D359 + ;D35A + (Integer/parseInt "11110000" 2) ; "11110000" -> B + 0xF0 ;D35B ; (FF00) -> A + 0x00 ;D35C + 0x00 ;D35D ;; NO-OP + + 0xCB ;D35E ; swap nybbles on A + 0x37 ;D35F + 0xA0 ;D360 ; (AND A B) -> A + 0x47 ;D361 ; A -> B + + ;; select buttons; store bottom bits in C + + 0xFA ;D362 ; load (D351) into A + 0x51 ;D363 --> + 0xD3 ;D364 --> D351 + + 0xE0 ;D365 ; load (A), which is + 0x00 ;D366 --> ; 00001000, into FF00 + 0x00 ;D367 --> FF00 ;; NO-OP + + 0x0E ;D368 + ;D369 + (Integer/parseInt "00001111" 2) ; "00001111" -> C + + 0xF0 ;D36A ; (FF00) -> A + 0x00 ;D36B + 0x00 ;D36C + + 0xA1 ;D36D ; (AND A C) -> A + 0x4F ;D36E ; A -> C + + ;; combine the B and C registers into the input number + 0x79 ;D36F ; C -> A + 0xB0 ;D370 ; (OR A B) -> A + 0x2F ;D371 ; negate A + + 0xEA ;D372 ; store A into input-number + 0x52 ;D373 + 0xD3 ;D374 + + 0x00 ;D375 + 0x00 ;D376 + 0x00 ;D377 + 0x00 ;D378 + 0x00 ;D379 + 0x00 ;D37A + 0x00 ;D37B ; these are here because + 0x00 ;D37C ; I messed up :( + 0x00 ;D37D + 0x00 ;D37E + 0x00 ;D37F + + ;; beginning of main state machine + 0x18 ;D380 ; Declaration of variables + 0x05 ;D381 ; 5 variables: + 0x00 ;D382 ; current-mode + 0x00 ;D383 ; bytes-to-write + 0x00 ;D384 ; bytes-written + 0x00 ;D385 ; start-point-high + 0x00 ;D386 ; start-point-low + + + ;; banch on current mode + 0xFA ;D387 ; load current-mode (0xD382) + 0x82 ;D388 ; into A + 0xD3 ;D389 + 0x00 ;D38A + + + ;; GOTO Mode 0 (input-mode) if current-mode is 0 + 0xFE ;D38B + 0x00 ;D38C ; compare A with 0x00 + + 0xCA ;D38D ; goto Mode 0 if A == 0 + 0xA8 ;D38E + 0xD3 ;D38F + + ;; GOTO Mode 1 (set-length) if current-mode is 1 + 0xFE ;D390 + 0x01 ;D391 ; compare A with 0x01 + + 0xCA ;D392 + 0xB1 ;D393 + 0xD3 ;D394 ; goto Mode 1 if A == 1 + + ;; GOTO Mode 2 (set-start-point-high) if current mode is 2 + 0xFE ;D395 + 0x02 ;D396 ; compare A with 0x02 + + 0xCA ;D397 + 0xBF ;D398 + 0xD3 ;D399 ; goto Mode 2 if A == 2 + + ;; GOTO Mode 3 (set-start-point-low) if current mode is 3 + 0xFE ;D39A + 0x03 ;D39B + + 0xCA ;D39C + 0xCD ;D39D + 0xD3 ;D39E ; goto Mode 3 if A == 3 + + ;; GOTO Mode 4 (write-memory) if current mode is 4 + 0xFE ;D39F + 0x04 ;D3A0 + + 0xCA ;D3A1 + 0xDB ;D3A2 + 0xD3 ;D3A3 + + 0x00 ;D3A4 + ;; End of Mode checking, goto beginning + 0xC3 ;D3A5 + 0x1D ;D3A6 + 0xD3 ;D3A7 + + + ;; Mode 0 -- input-mode mode + ;; means that we are waiting for a mode, so set the mode to + ;; whatever is currently in input-number. If nothing is + ;; entered, then the program stays in input-mode mode + + ;; set current-mode to input-number + 0xFA ;D3A8 ; load input-number (0xD352) + 0x52 ;D3A9 ; into A + 0xD3 ;D3AA + + 0xEA ;D3AB ; load A into current-mode + 0x82 ;D3AC ; (0xD382) + 0xD3 ;D3AD + + 0xC3 ;D3AE ; go back to beginning + 0x1D ;D3AF + 0xD3 ;D3B0 + ;; End Mode 0 + + + ;; Mode 1 -- set-length mode + ;; This is the header for writing things to memory. + ;; User specifies the number of bytes to write. + ;; Mode is auto advanced to Mode 2 after this mode + ;; completes. + + ;; Set bytes left to write to input-number; + ;; set current-mode to 0x02. + 0xFA ;D3B1 ; load input-number (0xD352) + 0x52 ;D3B2 ; into A + 0xD3 ;D3B3 + + 0xEA ;D3B4 ; load A into bytes-left-to-write + 0x83 ;D3B5 ; (0xD383) + 0xD3 ;D3B6 + + 0x3E ;D3B7 ; load 0x02 into A. + 0x02 ;D3B8 + + 0xEA ;D3B9 ; load A to current-mode + 0x82 ;D3BA ; advancing from Mode 1 to + 0xD3 ;D3BB ; Mode 2 + + 0xC3 ;D3BC ; go back to beginning + 0x1D ;D3BD + 0xD3 ;D3BE + ;; End Mode 1 + + + ;; Mode 2 -- set start-point-high mode + ;; Middle part of the header for writing things to memory. + ;; User specifies the start location in RAM to which + ;; data will be written. + ;; Mode is auto advanced to Mode 3 after this mode completes. + + ;; Set start-point-high to input-number; + ;; set current mode to 0x03. + 0xFA ;D3BF ; load input-number (0xD352) + 0x52 ;D3C0 ; into A + 0xD3 ;D3C1 + + 0xEA ;D3C2 ; load A into start-point-high + 0x85 ;D3C3 ; (0xD385) + 0xD3 ;D3C4 + + 0x3E ;D3C5 ; load 0x03 into A. + 0x03 ;D3C6 + + 0xEA ;D3C7 ; load A to current-mode, + 0x82 ;D3C8 ; advancing from Mode 2 to + 0xD3 ;D3C9 ; Mode 3. + + 0xC3 ;D3CA ; go back to beginning + 0x1D ;D3CB + 0xD3 ;D3CC + ;;End Mode 2 + + + ;; Mode 3 -- set-start-point-low mode + ;; Final part of header for writing things to memory. + ;; User specifies the low bytes of 16 bit start-point. + + ;; Set start-point-low to input-number; + ;; set current mode to 0x04 + 0xFA ;D3CD ; load input-number into A + 0x52 ;D3CE + 0xD3 ;D3CF + + 0xEA ;D3D0 ; load A into start-point-low + 0x86 ;D3D1 + 0xD3 ;D3D2 + + 0x3E ;D3D3 ; load 0x04 into A. + 0x04 ;D3D4 + + 0xEA ;D3D5 ; load A to current-mode, + 0x82 ;D3D6 ; advancing from Mode 3 to + 0xD3 ;D3D7 ; Mode 4. + + 0xC3 ;D3D8 ; go back to beginning + 0x1D ;D3D9 + 0xD3 ;D3DA + + ;; Mode 4 -- write bytes mode + + ;; This is where RAM manipulation happens. User supplies + ;; bytes every frame, which are written sequentially to + ;; start-point until bytes-to-write have been written. Once + ;; bytes-to-write have been written, the mode is reset to 0. + + ;; compare bytes-written with bytes-to-write. + ;; if they are the same, then reset mode to 0 + + 0xFA ;D3DB ; load bytes-to-write into A + 0x83 ;D3DC + 0xD3 ;D3DD + + 0x47 ;D3DE ; load A into B + + 0xFA ;D3DF ; load bytes-written into A + 0x84 ;D3E0 + 0xD3 ;D3E1 + + 0xB8 ;D3E2 ; compare A with B + + 0xCA ;D3E3 ; if they are equal, go to cleanup + 0x07 ;D3E4 + 0xD4 ;D3E5 + + ;; Write Memory Section + ;; Write the input-number, interpreted as an 8-bit number, + ;; into the current target register, determined by + ;; (+ start-point bytes-written). + ;; Then, increment bytes-written by 1. + + 0xFA ;D3E6 ; load start-point-high into A + 0x85 ;D3E7 + 0xD3 ;D3E8 + + 0x67 ;D3E9 ; load A into H + + 0xFA ;D3EA ; load start-point-low into A + 0x86 ;D3EB + 0xD3 ;D3EC + + 0x6F ;D3ED ; load A into L + + 0xFA ;D3EE ; load bytes-written into A + 0x84 ;D3EF + 0xD3 ;D3F0 + + 0x00 ;D3F1 ; These are here because + 0x00 ;D3F2 ; I screwed up again. + 0x00 ;D3F3 + + 0x85 ;D3F4 ; add L to A; store A in L. + 0x6F ;D3F5 + + 0x30 ;D3F6 ; If the addition overflowed, + 0x01 ;D3F7 + 0x24 ;D3F8 ; increment H. + + ;; Now, HL points to the correct place in memory + + 0xFA ;D3F9 ; load input-number into A + 0x52 ;D3FA + 0xD3 ;D3FB + + 0x77 ;D3FC ; load A into (HL) + + 0xFA ;D3FD ; load bytes-written into A + 0x84 ;D3FE + 0xD3 ;D3FF + + 0x3C ;D400 ; increment A + + 0xEA ;D401 ; load A into bytes-written + 0x84 ;D402 + 0xD3 ;D403 + + 0xC3 ;D404 ; go back to beginning. + 0x1D ;D405 + 0xD3 ;D406 + ;; End Write Memory Section + + ;; Mode 4 Cleanup Section + ;; reset bytes-written to 0 + ;; set mode to 0 + 0x3E ;D407 ; load 0 into A + 0x00 ;D408 + + 0xEA ;D409 ; load A into bytes-written + 0x84 ;D40A + 0xD3 ;D40B + + 0xEA ;D40C ; load A into current-mode + 0x82 ;D40D + 0xD3 ;D40E + + 0xC3 ;D40F ; go back to beginning + 0x1D ;D410 + 0xD3 ;D411 + + ;; End Mode 4 + + ]) + + + +(def frame-count 0xD31F) +(def input 0xD352) +(def current-mode 0xD382) +(def bytes-to-write 0xD383) +(def bytes-written 0xD384) +(def start-point-high 0xD385) +(def start-point-low 0xD386) + + + +(defn write-memory [] + (-> (tick (mid-game)) + (IE! 0) ; disable interrupts + (inject-item-assembly (write-memory-assembly)))) + +(defn test-write-memory [] + (set-state! (write-memory)) + (dorun + (dotimes [_ 5000] + (view-memory (step @current-state) current-mode)))) + +(def bytes-to-write 0xD383) +(def start-point 0xD384) + +(defn print-blank-assembly + [start end] + (dorun + (map + #(println (format "0x00 ;%04X " %)) + (range start end)))) + +(defn test-mode-2 [] + (-> + (write-memory) + (view-memory frame-count) + (step) + (step [:a]) + (step [:b]) + (step [:start]) + (step []) + (view-memory frame-count))) + + + +(defn dylan-test-mode + ([] (dylan-test-mode (write-mem-dyl))) + ([target-state] + (let [ + v-blank-prev 54046 + btn-register 65280 + eggs 0xD374 + ] + + (-> + target-state + + (tick) + (tick) + (tick) + (tick);; jumps back to beginning + + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + + + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) ;; just complemented A + + (tick) + (DE! 0x1800) + (AF! 0x7700) ;; change inputs @ A + (tick) + (tick) + (tick) + (tick) + (tick) + + ;;(view-memory eggs) + (tick) + (tick) + ;;(view-memory eggs) + (tick) + (tick) + (tick) + (tick) + (tick) + (tick) + (d-tick) + + + ;;(view-memory btn-register) + (view-register "A" A) + (view-register "B" B) + + ;;(view-register "C" C) + (view-register "D" D) + (view-register "E" E) + (view-register "H" H) + (view-register "L" L) + )))) + + + +(defn drive-dylan [] + (-> (write-mem-dyl) + (#(do (println "memory from 0xC00F to 0xC01F:" + (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) + (step []) + (step []) + (step []) + (step [:start]) + (step [:select]) + (step [:u :d]) + (step [:a :b :start :select]) + (step [:a]) + (step [:b]) + (step [:a :b]) + (step [:select]) + (step []) + (step []) + (step []) + (#(do (println "memory from 0xC00F to 0xC01F:" + (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) + )) + +(defn test-mode-4 + ([] (test-mode-4 (write-memory))) + ([target-state] + (-> + target-state + (#(do (println "memory from 0xC00F to 0xC01F:" + (subvec (vec (memory %)) 0xC00F 0xC01F)) %)) + (view-memory current-mode) + (step []) + (step []) + (step []) + (#(do (println "after three steps") %)) + (view-memory current-mode) + + ;; Activate memory writing mode + + (#(do (println "step with [:a]") %)) + (step [:a]) + (view-memory current-mode) + (view-memory bytes-to-write) + (view-memory start-point-high) + (view-memory start-point-low) + + ;; Specify four bytes to be written + + (#(do (println "step with [:select]")%)) + (step [:select]) + (view-memory current-mode) + (view-memory bytes-to-write) + (view-memory start-point-high) + (view-memory start-point-low) + + ;; Specify target memory address as 0xC00F + + (#(do (println "step with [:u :d]")%)) + (step [:u :d]) + (view-memory current-mode) + (view-memory bytes-to-write) + (view-memory start-point-high) + (view-memory start-point-low) + + (#(do (println "step with [:a :b :start :select]")%)) + (step [:a :b :start :select]) + (view-memory current-mode) + (view-memory bytes-to-write) + (view-memory start-point-high) + (view-memory start-point-low) + + ;; Start reprogramming memory + + (#(do (println "step with [:a]")%)) + (step [:a]) + (view-memory current-mode) + (view-memory bytes-written) + + (#(do (println "step with [:b]")%)) + (step [:b]) + (view-memory current-mode) + (view-memory bytes-written) + + (#(do (println "step with [:a :b]")%)) + (step [:a :b]) + (view-memory current-mode) + (view-memory bytes-written) + + (#(do (println "step with [:select]")%)) + (step [:select]) + (view-memory current-mode) + (view-memory bytes-written) + + ;; Reprogramming done, program ready for more commands. + + (#(do (println "step with []")%)) + (step []) + (view-memory current-mode) + (view-memory bytes-written) + + (#(do (println "memory from 0xC00F to 0xC01F:" + (subvec (vec (memory %)) 0xC00F 0xC01F)) %))))) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/characters.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/characters.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,116 @@ +(ns com.aurellem.gb.characters + (:use (com.aurellem.gb gb-driver)) + (:import [com.aurellem.gb.gb_driver SaveState])) + +(def character-code->character + { + 0x00 "end-of-name-sentinel" + 0x60 "A-bold" + 0x61 "B-bold" + 0x62 "C-bold" + 0x63 "D-bold" + 0x64 "E-bold" + 0x65 "F-bold" + 0x66 "G-bold" + 0x67 "H-bold" + 0x68 "I-bold" + 0x69 "V-bold" + 0x6A "S-bold" + 0x6B "L-bold" + 0x6C "M-bold" + 0x80 "A" + 0x81 "B" + 0x82 "C" + 0x83 "D" + 0x84 "E" + 0x85 "F" + 0x86 "G" + 0x87 "H" + 0x88 "I" + 0x89 "J" + 0x8A "K" + 0x8B "L" + 0x8C "M" + 0x8D "N" + 0x8E "O" + 0x8F "P" + 0x90 "Q" + 0x91 "R" + 0x92 "S" + 0x93 "T" + 0x94 "U" + 0x95 "V" + 0x96 "W" + 0x97 "X" + 0x98 "Y" + 0x99 "Z" + 0x9A "(" + 0x9B ")" + 0x9C ":" + 0x9D ";" + 0xA0 "a" + 0xA1 "b" + 0xA2 "c" + 0xA3 "d" + 0xA4 "e" + 0xA5 "f" + 0xA6 "g" + 0xA7 "h" + 0xA8 "i" + 0xA9 "j" + 0xAA "k" + 0xAB "l" + 0xAC "m" + 0xAD "n" + 0xAE "o" + 0xAF "p" + 0xB0 "q" + 0xB1 "r" + 0xB2 "s" + 0xB3 "t" + 0xB4 "u" + 0xB5 "v" + 0xB6 "w" + 0xB7 "x" + 0xB8 "y" + 0xB9 "z" + 0xBA "e-with-grave" + 0xE0 "'" + 0xE1 "PK" + 0xE2 "MN" + 0xE6 "?" + 0xE7 "!" + 0xE8 "." + 0xEF "male-symbol" + 0xF0 "pokemon-money-symbol" + 0xF1 "." + 0xF2 "/" + 0xF3 "," + 0xF4 "female-symbol" + 0xF6 "0 " + 0xF7 "1" + 0xF8 "2" + 0xF9 "3" + 0xFA "4" + 0xFB "5" + 0xFC "6" + 0xFD "7" + 0xFE "8" + 0xFF "9" + }) + +(def character->character-code + (zipmap (vals character-code->character) + (keys character-code->character))) + +(defn str->character-codes [s] + (map character->character-code (map str s))) + +(defn character-codes->str [codes] + (apply str + (map #(character-code->character + % + (format "[0x%02X]" %)) + codes))) + + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/gb_driver.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/gb_driver.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,261 @@ +(ns com.aurellem.gb.gb-driver + (:import com.aurellem.gb.Gb) + (:import java.io.File) + (:import org.apache.commons.io.FileUtils) + (:import (java.nio IntBuffer ByteOrder))) + +;; Savestates +(defrecord SaveState [data]) + +(def user-home (File. (System/getProperty "user.home"))) + +(def ^:dynamic *save-state-cache* + (File. user-home "proj/vba-clojure/save-states/")) + +(def current-state (atom nil)) + +(defn state-cache-file [name] + (File. *save-state-cache* (str name ".sav"))) + +(defn write-state! + ([^SaveState name] + (write-state! @current-state name)) + ([^SaveState save ^String name] + (let [buffer (:data save) + bytes (byte-array (.limit buffer)) + dest (state-cache-file name)] + (.get buffer bytes) + (FileUtils/writeByteArrayToFile dest bytes) + (.rewind buffer) + dest))) + +(defn read-state [name] + (let [save (state-cache-file name)] + (if (.exists save) + (let [buffer (Gb/saveBuffer) + bytes (FileUtils/readFileToByteArray save)] + (.put buffer bytes) + (.flip buffer) + (SaveState. buffer))))) +;;;;;;;;;;;;;;;; + +;; Gameboy management +(Gb/loadVBA) + +(def yellow-rom-image + (File. user-home "proj/pokemon-escape/roms/yellow.gbc")) + +(def yellow-save-file + (File. user-home "proj/pokemon-escape/roms/yellow.sav")) + +(def on? (atom nil)) + +(defn shutdown! [] (Gb/shutdown) (reset! on? false)) + +(defn restart! [] + (shutdown!) + (.delete yellow-save-file) + (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) + (reset! on? true)) + +;;; The first state! +(defn gen-root! [] + (restart!) + (let [state (SaveState. (Gb/saveState))] + (write-state! state "root" ) state)) + +(defn root [] + (if (.exists (state-cache-file "root")) + (read-state "root") + (gen-root!))) + +;;;; Press Buttons + +(def button-code + {;; main buttons + :a 0x0001 + :b 0x0002 + + ;; directional pad + :r 0x0010 + :l 0x0020 + :u 0x0040 + :d 0x0080 + + ;; meta buttons + :select 0x0004 + :start 0x0008 + + ;; pseudo-buttons + :restart 0x0800 ; hard reset + :listen -1 ; listen for user input + }) + +(defn button-mask [buttons] + (reduce bit-or 0x0000 (map button-code buttons))) + +(defn set-state! [^SaveState state] + (assert (:data state) "Not a valid state!") + (if (not @on?) (restart!)) + (if (not= state @current-state) + (do + (Gb/loadState (:data state)) + (reset! current-state state)))) + +(defn update-state [] + (reset! current-state + (SaveState. (Gb/saveState)))) + +(defn step + ([^SaveState state buttons] + (set-state! state) + (Gb/step (button-mask buttons)) + (reset! current-state + (SaveState. (Gb/saveState)))) + ([^SaveState state] + (step state [:listen])) + ([] (step (if @current-state @current-state (root))))) + +(defn tick + ([] (tick @current-state)) + ([^SaveState state] + (set-state! state) + (Gb/tick) + (update-state))) + +(defn play + ([^SaveState state n] + (try + (set-state! state) + (dorun (dotimes [_ n] + (Thread/sleep 1) + (Gb/step))) + (finally + (update-state)))) + ([n] + (play @current-state n))) + +(defn continue! + ([state] + (play state Integer/MAX_VALUE)) + ([] + (continue! @current-state))) + +(defn play-moves + ([moves [prev state]] + (set-state! state) + (dorun (map (fn [move] (step @current-state move)) moves)) + [(concat prev moves) @current-state])) + +;;;;;;;;;;; + + +;;;;;;;;;;;;;;; CPU data + +(defn cpu-data [size arr-fn] + (let [store (int-array size)] + (fn get-data + ([] (get-data @current-state)) + ([state] + (set-state! state) (arr-fn store) store)))) + +(defn write-cpu-data [size store-fn] + (fn store-data + ([state new-data] + (set-state! state) + (let [store (int-array new-data)] + (assert (= size (count new-data))) + (store-fn store) + (update-state))) + ([new-data] + (store-data @current-state new-data)))) + + +(def memory + (cpu-data Gb/GB_MEMORY #(Gb/getMemory %))) + +(def ram + (cpu-data Gb/RAM_SIZE #(Gb/getRAM %))) + +(def rom + (cpu-data Gb/ROM_SIZE #(Gb/getROM %))) + +(def working-ram + (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) + +(def video-ram + (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) + +(def registers + (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) + +(def write-memory! + (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %))) + +(def write-registers! + (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %))) + +;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro gen-get-set-register [name index] + (let [name-bang (symbol (str name "!"))] + `(do + (defn ~name + ~(str "Retrieve the " name " register from state, or " + "from @current-state if state is absent.") + ([state#] + (nth (registers state#) ~index)) + ([] + (~name @current-state))) + (defn ~name-bang + ~(str "Set the " name " register for state, or " + "for @current-state if state is absent.") + ([state# new-register#] + (set-state! state#) + (let [registers# (registers state#)] + (aset registers# ~index new-register#) + (Gb/writeRegisters registers#) + (update-state))) + ([new-register#] + (~name-bang @current-state new-register#)))))) + +;; 16 bit registers +(gen-get-set-register PC 0) +(gen-get-set-register SP 1) +(gen-get-set-register AF 2) +(gen-get-set-register BC 3) +(gen-get-set-register DE 4) +(gen-get-set-register HL 5) +(gen-get-set-register IFF 6) + +;; 8 bit registers +(gen-get-set-register DIV 7) +(gen-get-set-register TIMA 8) +(gen-get-set-register TMA 9) +(gen-get-set-register IF 11) +(gen-get-set-register LCDC 12) +(gen-get-set-register STAT 13) +(gen-get-set-register SCY 14) +(gen-get-set-register SCX 15) +(gen-get-set-register LY 16) +(gen-get-set-register DMA 18) +(gen-get-set-register WY 19) +(gen-get-set-register WX 20) +(gen-get-set-register VBK 21) +(gen-get-set-register HDMA1 22) +(gen-get-set-register HDMA2 23) +(gen-get-set-register HDMA3 24) +(gen-get-set-register HDMA4 25) +(gen-get-set-register HDMA5 26) +(gen-get-set-register SVBK 27) +(gen-get-set-register IE 28) + +;;;;;;;;;;;;;;; + +(defmacro defn-memo + [& forms] + (let [fun-name (first forms)] + `(do + (defn ~@forms) + (alter-var-root (var ~fun-name) memoize)))) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/items.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/items.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,226 @@ +(ns com.aurellem.gb.items + (:use (com.aurellem.gb gb-driver util)) + ;; this is bullshit + (:import [com.aurellem.gb.gb_driver SaveState])) + +(defn game-name [] + (map char (subvec (vec (memory)) 0x134 0x142))) + +(def item-list-start 0xD31C) + +(defn item-list [^SaveState state] + (subvec + (vec (memory state)) + item-list-start + (+ item-list-start 150))) + +(def item-code->item-name + (hash-map + 0x01 :master-ball + 0x02 :ultra-ball + 0x03 :great-ball + 0x04 :poke-ball + 0x05 :town-map + 0x06 :bicycle + 0x08 :safari-ball + 0x09 :pokedex + 0x0A :moon-stone + 0x0B :antidote + 0x0C :burn-heal + 0x0D :ice-heal + 0x0E :awakening + 0x0F :parlyz-heal + 0x10 :full-restore + 0x11 :max-potion + 0x12 :hyper-potion + 0x13 :super-potion + 0x14 :potion + 0x15 :boulderbadge + 0x16 :cascadebadge + 0x17 :thunderbadge + 0x18 :rainbowbadge + 0x19 :soulbadge + 0x1A :marshbadge + 0x1B :volcanobadge + 0x1C :earthbadge + 0x1D :escape-rope + 0x1E :repel + 0x1F :old-amber + 0x20 :fire-stone + 0x21 :thunderstone + 0x22 :water-stone + 0x23 :hp-up + 0x24 :protein + 0x25 :iron + 0x26 :carbos + 0x27 :calcium + 0x28 :rare-candy + 0x29 :dome-fossil + 0x2A :helix-fossil + 0x2B :secret-key + 0x2D :bike-voucher + 0x2E :x-accuracy + 0x2F :leaf-stone + 0x30 :card-key + 0x31 :nugget + 0x32 :pp-up + 0x33 :poke-doll + 0x34 :full-heal + 0x35 :revive + 0x36 :max-revive + 0x37 :guard-spec + 0x38 :super-repel + 0x39 :max-repel + 0x3A :dire-hit + 0x3B :coin + 0x3C :fresh-water + 0x3D :soda-pop + 0x3E :lemonade + 0x3F :s.s.ticket + 0x40 :gold-teeth + 0x41 :x-attach + 0x42 :x-defend + 0x43 :x-speed + 0x44 :x-special + 0x45 :coin-case + 0x46 :oaks-parcel + 0x47 :itemfinder + 0x48 :silph-scope + 0x49 :poke-flute + 0x4A :lift-key + 0x4B :exp.all + 0x4C :old-rod + 0x4D :good-rod + 0x4E :super-rod + 0x4F :pp-up + 0x50 :ether + 0x51 :max-ether + 0x52 :elixer + 0x53 :max-elixer + 0xC4 :HM01 ;; cut + 0xC5 :HM02 ;; fly + 0xC6 :HM03 ;; surf + 0xC7 :HM04 ;; strength + 0xC8 :HM05 ;; flash + 0xC9 :TM01 ;; mega punch + 0xCA :TM02 ;; razor wind + 0xCB :TM03 ;; swords dance + 0xCC :TM04 ;; whirlwind + 0xCD :TM05 ;; mega kick + 0xCE :TM06 ;; toxic + 0xCF :TM07 ;; horn drill + 0xD0 :TM08 ;; body slam + 0xD1 :TM09 ;; take down + 0xD2 :TM10 ;; double-edge + 0xD3 :TM11 ;; bubblebeam + 0xD4 :TM12 ;; water gun + 0xD5 :TM13 ;; ice beam + 0xD6 :TM14 ;; blizzard + 0xD7 :TM15 ;; hyper beam + 0xD8 :TM16 ;; pay day + 0xD9 :TM17 ;; submission + 0xDA :TM18 ;; counter + 0xDB :TM19 ;; seismic toss + 0xDC :TM20 ;; rage + 0xDD :TM21 ;; mega drain + 0xDE :TM22 ;; solarbeam + 0xDF :TM23 ;; dragon rage + 0xE0 :TM24 ;; thunderbolt + 0xE1 :TM25 ;; thunder + 0xE2 :TM26 ;; earthquake + 0xE3 :TM27 ;; fissure + 0xE4 :TM28 ;; dig + 0xE5 :TM29 ;; psychic + 0xE6 :TM30 ;; teleport + 0xE7 :TM31 ;; mimic + 0xE8 :TM32 ;; double team + 0xE9 :TM33 ;; reflect + 0xEA :TM34 ;; bide + 0xEB :TM35 ;; metronome + 0xEC :TM36 ;; self destruct + 0xED :TM37 ;; eggbomb + 0xEE :TM38 ;; fire blast + 0xEF :TM39 ;; swift + 0xF0 :TM40 ;; skull bash + 0xF1 :TM41 ;; softboiled + 0xF2 :TM42 ;; dream eater + 0xF3 :TM43 ;; sky attack + 0xF4 :TM44 ;; rest + 0xF5 :TM45 ;; thunder wave + 0xF6 :TM46 ;; psywave + 0xF7 :TM47 ;; explosion + 0xF8 :TM48 ;; rock slide + 0xF9 :TM49 ;; tri attack + 0xFA :TM50 ;; substitute + 0xFB :TM51 ;; "cut" + 0xFC :TM52 ;; "fly" + 0xFD :TM53 ;; "surf" + 0xFE :TM54 ;; "strength" + 0xFF :end-of-list-sentinel)) + +(def item-name->item-code + (zipmap (vals item-code->item-name) + (keys item-code->item-name))) + +(defn inventory [^SaveState state] + (let [items (item-list state)] + (map + (fn [[item-code quantity]] + [(item-code->item-name + item-code + (str ":0x" (.toUpperCase (Integer/toHexString item-code)))) + quantity]) + (partition + 2 + (next (take-while (partial not= 255) items)))))) + +(defn print-inventory + ([] (print-inventory @current-state)) + ([^SaveState state] + (println + (let [inv (inventory state)] + (reduce + str + (concat + ["+-------------------+----------+\n" + "|##| Item | Quantity |\n" + "+--+----------------+----------+\n"] + + (map + (fn [index [item-name quantity]] + (str + (format "|%-2d| %-14s | %3d |\n" index + (apply str (rest (str item-name))) + quantity))) + (range 0 (count inv)) inv) + ["+--+----------------+----------+\n"])))) + state)) + +(defn inventory-codes [inventory] + (flatten + (concat [(count inventory)] + (map (fn [[item-name quantity]] + [(item-name->item-code item-name) + quantity]) inventory) + [(item-name->item-code :end-of-list-sentinel)]))) + +(defn set-inv-mem [^SaveState state inv-codes] + (set-memory-range state item-list-start + inv-codes)) + + +(defn set-inventory [^SaveState state new-inventory] + (set-inv-mem state (inventory-codes new-inventory))) + +(defn give + ([^SaveState state items] + (set-inventory state + (concat items (inventory state)))) + ([items] + (give @current-state items))) + +(defn clear-inventory + ([^SaveState state] + (set-inventory state [])) + ([] (clear-inventory @current-state))) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/util.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/util.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,100 @@ +(ns com.aurellem.gb.util + (:use (com.aurellem.gb gb-driver vbm)) + (:import [com.aurellem.gb.gb_driver SaveState])) + + +(defn A [state] + (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8)) + +(defn B [state] + (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8)) + +(defn D [state] + (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8)) + +(defn H [state] + (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8)) + +(defn C [state] + (bit-and 0xFF (BC state))) +(defn F [state] + (bit-and 0xFF (AF state))) +(defn E [state] + (bit-and 0xFF (DE state))) +(defn L [state] + (bit-and 0xFF (HL state))) + +(defn binary-str [num] + (format "%08d" + (Integer/parseInt + (Integer/toBinaryString num) 10))) + +(defn view-register [state name reg-fn] + (println (format "%s: %s" name + (binary-str (reg-fn state)))) + state) + +(defn view-memory [state mem] + (println (format "mem 0x%04X = %s" mem + (binary-str (aget (memory state) mem)))) + state) + +(defn print-listing [state begin end] + (dorun (map + (fn [opcode line] + (println (format "0x%04X: 0x%02X" line opcode))) + (subvec (vec (memory state)) begin end) + (range begin end))) + state) + +(defn print-pc [state] + (println (format "PC: 0x%04X" (PC state))) + state) + +(defn print-op [state] + (println (format "OP: 0x%02X" (aget (memory state) (PC state)))) + state) + +(defn d-tick + ([state] + (-> state print-pc print-op tick))) + +(defn print-interrupt + [^SaveState state] + (println (format "IE: %d" (IE state))) + state) + +(defn set-memory + ([state location value] + (set-state! state) + (let [mem (memory state)] + (aset mem location value) + (write-memory! mem) + (update-state))) + ([location value] + (set-memory @current-state location value))) + +(defn set-memory-range + ([state start values] + (set-state! state) + (let [mem (memory state)] + + (dorun (map (fn [index val] + (aset mem index val)) + (range start + (+ start (count values))) values)) + (write-memory! mem) + (update-state))) + ([start values] + (set-memory-range + @current-state start values))) + +(defn common-differences [& seqs] + (let [backbone (range (count (first seqs)))] + (filter + (comp (partial apply distinct?) second) + (zipmap backbone + (apply (partial map list) seqs))))) + +(defn mid-game [] + (read-state "mid-game")) diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb/vbm.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/gb/vbm.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,127 @@ +(ns com.aurellem.gb.vbm + (:import java.io.File) + (:import org.apache.commons.io.FileUtils) + (:use com.aurellem.gb.gb-driver)) + +;;;;;;;;;;;;; read vbm file + +(def ^:dynamic *moves-cache* + (File. user-home "proj/pokemon-escape/moves/")) + +(defn buttons [mask] + (loop [buttons [] + masks (seq (dissoc button-code :listen))] + (if (empty? masks) buttons + (let [[button value] (first masks)] + (if (not= 0x0000 (bit-and value mask)) + (recur (conj buttons button) (rest masks)) + (recur buttons (rest masks))))))) + +(defn vbm-bytes [#^File vbm] + (let [bytes (FileUtils/readFileToByteArray vbm) + ints (int-array (count bytes))] + (areduce bytes idx _ nil + (aset ints idx + (bit-and 0xFF (aget bytes idx)))) + ints)) + +(def vbm-header-length 255) + +(defn repair-vbm + "Two 0's must be inserted after every reset." + [vbm-masks] + (loop [fixed [] + pending vbm-masks] + (if (empty? pending) fixed + (let [mask (first pending)] + (if (not= 0x0000 (bit-and mask (button-code :restart))) + (recur (conj fixed mask 0x0000 0x0000) (next pending)) + (recur (conj fixed mask) (next pending))))))) + +(defn vbm-masks [#^File vbm] + (repair-vbm + (map (fn [[a b]] + (+ (bit-shift-left a 8) b)) + (partition + 2 (drop vbm-header-length (vbm-bytes vbm)))))) + +(defn vbm-buttons [#^File vbm] + (map buttons (vbm-masks vbm))) + +(defn convert-buttons + "To write a vbm file, we must remove the last two buttons after any + reset event." + [buttons] + (loop [fixed [] + pending buttons] + (if (empty? pending) fixed + (let [mask (first pending)] + (if (contains? (set (first pending)) :reset) + (recur (conj fixed mask) (drop 3 pending)) + (recur (conj fixed mask) (next pending))))))) + +(defn moves->filename [frame] + (File. *moves-cache* (format "%07d.vbm" frame))) + +(defn read-moves [frame] + (let [target (moves->filename frame)] + (if (.exists target) + (vbm-buttons target)))) +;;;;;;;;;;;;;; write moves to vbm file + + +(def vbm-header + (byte-array + (map + byte + [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 + 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 + 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 + 95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 + 95 95 95 95]))) + +(def vbm-trailer + (byte-array + (map byte [0]))) + +(defn buttons->vbm-bytes [buttons] + (let [bytes-in-ints + (map button-mask (convert-buttons buttons)) + high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8) + bytes-in-ints) + low-bits (map #(bit-and 0xFF %) bytes-in-ints) + convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i))) + contents + (byte-array + (concat + vbm-header + (map convert-byte (interleave high-bits low-bits)) + vbm-trailer))] + contents)) + +(defn write-moves! [moves] + (let [target (moves->filename (count moves))] + (clojure.java.io/copy (buttons->vbm-bytes moves) target) + target)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use 'clojure.java.shell) + +(def vba-linux (File. user-home "bin/vba-linux")) + +(defn play-vbm [#^File vbm] + (.delete yellow-save-file) + (if (.exists vbm) + (sh (.getCanonicalPath vba-linux) + (str "--playmovie=" (.getCanonicalPath vbm)) + (.getCanonicalPath yellow-rom-image))) + nil) + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/gb_driver.clj --- a/clojure/com/aurellem/gb_driver.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -(ns com.aurellem.gb-driver - (:import com.aurellem.gb.Gb) - (:import java.io.File) - (:import org.apache.commons.io.FileUtils) - (:import (java.nio IntBuffer ByteOrder))) - -;; Savestates -(defrecord SaveState [data]) - -(def user-home (File. (System/getProperty "user.home"))) - -(def ^:dynamic *save-state-cache* - (File. user-home "proj/vba-clojure/save-states/")) - -(def current-state (atom nil)) - -(defn state-cache-file [name] - (File. *save-state-cache* (str name ".sav"))) - -(defn write-state! - ([^SaveState name] - (write-state! @current-state name)) - ([^SaveState save ^String name] - (let [buffer (:data save) - bytes (byte-array (.limit buffer)) - dest (state-cache-file name)] - (.get buffer bytes) - (FileUtils/writeByteArrayToFile dest bytes) - (.rewind buffer) - dest))) - -(defn read-state [name] - (let [save (state-cache-file name)] - (if (.exists save) - (let [buffer (Gb/saveBuffer) - bytes (FileUtils/readFileToByteArray save)] - (.put buffer bytes) - (.flip buffer) - (SaveState. buffer))))) -;;;;;;;;;;;;;;;; - -;; Gameboy management -(Gb/loadVBA) - -(def yellow-rom-image - (File. user-home "proj/pokemon-escape/roms/yellow.gbc")) - -(def yellow-save-file - (File. user-home "proj/pokemon-escape/roms/yellow.sav")) - -(def on? (atom nil)) - -(defn shutdown! [] (Gb/shutdown) (reset! on? false)) - -(defn restart! [] - (shutdown!) - (.delete yellow-save-file) - (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) - (reset! on? true)) - -;;; The first state! -(defn gen-root! [] - (restart!) - (let [state (SaveState. (Gb/saveState))] - (write-state! state "root" ) state)) - -(defn root [] - (if (.exists (state-cache-file "root")) - (read-state "root") - (gen-root!))) - -;;;; Press Buttons - -(def button-code - {;; main buttons - :a 0x0001 - :b 0x0002 - - ;; directional pad - :r 0x0010 - :l 0x0020 - :u 0x0040 - :d 0x0080 - - ;; meta buttons - :select 0x0004 - :start 0x0008 - - ;; pseudo-buttons - :restart 0x0800 ; hard reset - :listen -1 ; listen for user input - }) - -(defn button-mask [buttons] - (reduce bit-or 0x0000 (map button-code buttons))) - -(defn set-state! [^SaveState state] - (assert (:data state) "Not a valid state!") - (if (not @on?) (restart!)) - (if (not= state @current-state) - (do - (Gb/loadState (:data state)) - (reset! current-state state)))) - -(defn update-state [] - (reset! current-state - (SaveState. (Gb/saveState)))) - -(defn step - ([^SaveState state buttons] - (set-state! state) - (Gb/step (button-mask buttons)) - (reset! current-state - (SaveState. (Gb/saveState)))) - ([^SaveState state] - (step state [:listen])) - ([] (step (if @current-state @current-state (root))))) - -(defn tick - ([] (tick @current-state)) - ([^SaveState state] - (set-state! state) - (Gb/tick) - (update-state))) - -(defn play - ([^SaveState state n] - (try - (set-state! state) - (dorun (dotimes [_ n] - (Thread/sleep 1) - (Gb/step))) - (finally - (update-state)))) - ([n] - (play @current-state n))) - -(defn continue! - ([state] - (play state Integer/MAX_VALUE)) - ([] - (continue! @current-state))) - -(defn play-moves - ([moves [prev state]] - (set-state! state) - (dorun (map (fn [move] (step @current-state move)) moves)) - [(concat prev moves) @current-state])) - -;;;;;;;;;;; - - -;;;;;;;;;;;;;;; CPU data - -(defn cpu-data [size arr-fn] - (let [store (int-array size)] - (fn get-data - ([] (get-data @current-state)) - ([state] - (set-state! state) (arr-fn store) store)))) - -(defn write-cpu-data [size store-fn] - (fn store-data - ([state new-data] - (set-state! state) - (let [store (int-array new-data)] - (assert (= size (count new-data))) - (store-fn store) - (update-state))) - ([new-data] - (store-data @current-state new-data)))) - - -(def memory - (cpu-data Gb/GB_MEMORY #(Gb/getMemory %))) - -(def ram - (cpu-data Gb/RAM_SIZE #(Gb/getRAM %))) - -(def rom - (cpu-data Gb/ROM_SIZE #(Gb/getROM %))) - -(def working-ram - (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) - -(def video-ram - (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) - -(def registers - (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) - -(def write-memory! - (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %))) - -(def write-registers! - (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %))) - -;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro gen-get-set-register [name index] - (let [name-bang (symbol (str name "!"))] - `(do - (defn ~name - ~(str "Retrieve the " name " register from state, or " - "from @current-state if state is absent.") - ([state#] - (nth (registers state#) ~index)) - ([] - (~name @current-state))) - (defn ~name-bang - ~(str "Set the " name " register for state, or " - "for @current-state if state is absent.") - ([state# new-register#] - (set-state! state#) - (let [registers# (registers state#)] - (aset registers# ~index new-register#) - (Gb/writeRegisters registers#) - (update-state))) - ([new-register#] - (~name-bang @current-state new-register#)))))) - -;; 16 bit registers -(gen-get-set-register PC 0) -(gen-get-set-register SP 1) -(gen-get-set-register AF 2) -(gen-get-set-register BC 3) -(gen-get-set-register DE 4) -(gen-get-set-register HL 5) -(gen-get-set-register IFF 6) - -;; 8 bit registers -(gen-get-set-register DIV 7) -(gen-get-set-register TIMA 8) -(gen-get-set-register TMA 9) -(gen-get-set-register IF 11) -(gen-get-set-register LCDC 12) -(gen-get-set-register STAT 13) -(gen-get-set-register SCY 14) -(gen-get-set-register SCX 15) -(gen-get-set-register LY 16) -(gen-get-set-register DMA 18) -(gen-get-set-register WY 19) -(gen-get-set-register WX 20) -(gen-get-set-register VBK 21) -(gen-get-set-register HDMA1 22) -(gen-get-set-register HDMA2 23) -(gen-get-set-register HDMA3 24) -(gen-get-set-register HDMA4 25) -(gen-get-set-register HDMA5 26) -(gen-get-set-register SVBK 27) -(gen-get-set-register IE 28) - -(defn set-memory [state location value] - (set-state! state) - (let [mem (memory state)] - (aset mem location value) - (write-memory! mem) - (update-state))) - -;;;;;;;;;;;;;;; - -(defmacro defn-memo - [& forms] - (let [fun-name (first forms)] - `(do - (defn ~@forms) - (alter-var-root (var ~fun-name) memoize)))) - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/item_bridge.clj --- a/clojure/com/aurellem/item_bridge.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -(ns com.aurellem.item-bridge - (:use (com.aurellem gb-driver vbm title save-corruption items assembly)) - (:import [com.aurellem.gb_driver SaveState])) - - -(defn corrupt-item-state [] - (second (destroy-item-end-of-list-marker))) - -(defn corrupt-item-state [] - (read-state "corrupt-items")) - - -(defn view-memory-range [state start end] - (dorun - (map (fn [loc val] - (println (format "%04X : %02X" loc val))) - - (range start end) (subvec (vec (memory state)) start end))) - state) - -(defn almost-broken - "if one more memory location is turned into 0x03, the game crashes." - [n] - (view-memory-range - (set-inv-mem (mid-game) - (concat [0xFF] (repeat 64 0x03) - (subvec (vec (memory (mid-game))) - (+ item-list-start 65) - (+ item-list-start 65 n)) - (repeat (- 255 65 n) 0x03) - )) - - item-list-start (+ item-list-start 255))) - -(defn actually-broken - "if one more memory location is turned into 0x03, the game crashes." - [] - (set-memory (mid-game) 0xD35D 0x03)) - - -;; (almost-broken 20) more or less works - -(defn capture-program-counter - "records the program counter for each tick" - [^SaveState state ticks] - (let [i (atom 0)] - (reduce (fn [[program-counters state] _] - (println (swap! i inc)) - [(conj program-counters (PC state)) - (tick state)]) - [[] state] - (range ticks)))) - - -(defn capture-program-counter - [^SaveState state ticks] - (set-state! state) - (loop [i 0 - pcs []] - (if (= i ticks) - pcs - (do - (com.aurellem.gb.Gb/tick) - (recur (inc i) - (conj pcs (first (registers)))))))) diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/items.clj --- a/clojure/com/aurellem/items.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -(ns com.aurellem.items - (:use (com.aurellem gb-driver vbm title)) - ;; this is bullshit - (:import [com.aurellem.gb_driver SaveState])) - -(defn game-name [] - (map char (subvec (vec (memory)) 0x134 0x142))) - -(def item-list-start 0xD31C) - -(defn item-list [^SaveState state] - (subvec - (vec (memory state)) - item-list-start - (+ item-list-start 150))) - -(def item-code->item-name - (hash-map - 0x01 :master-ball - 0x02 :ultra-ball - 0x03 :great-ball - 0x04 :poke-ball - 0x05 :town-map - 0x06 :bicycle - 0x08 :safari-ball - 0x09 :pokedex - 0x0A :moon-stone - 0x0B :antidote - 0x0C :burn-heal - 0x0D :ice-heal - 0x0E :awakening - 0x0F :parlyz-heal - 0x10 :full-restore - 0x11 :max-potion - 0x12 :hyper-potion - 0x13 :super-potion - 0x14 :potion - 0x15 :boulderbadge - 0x16 :cascadebadge - 0x17 :thunderbadge - 0x18 :rainbowbadge - 0x19 :soulbadge - 0x1A :marshbadge - 0x1B :volcanobadge - 0x1C :earthbadge - 0x1D :escape-rope - 0x1E :repel - 0x1F :old-amber - 0x20 :fire-stone - 0x21 :thunderstone - 0x22 :water-stone - 0x23 :hp-up - 0x24 :protein - 0x25 :iron - 0x26 :carbos - 0x27 :calcium - 0x28 :rare-candy - 0x29 :dome-fossil - 0x2A :helix-fossil - 0x2B :secret-key - 0x2D :bike-voucher - 0x2E :x-accuracy - 0x2F :leaf-stone - 0x30 :card-key - 0x31 :nugget - 0x32 :pp-up - 0x33 :poke-doll - 0x34 :full-heal - 0x35 :revive - 0x36 :max-revive - 0x37 :guard-spec - 0x38 :super-repel - 0x39 :max-repel - 0x3A :dire-hit - 0x3B :coin - 0x3C :fresh-water - 0x3D :soda-pop - 0x3E :lemonade - 0x3F :s.s.ticket - 0x40 :gold-teeth - 0x41 :x-attach - 0x42 :x-defend - 0x43 :x-speed - 0x44 :x-special - 0x45 :coin-case - 0x46 :oaks-parcel - 0x47 :itemfinder - 0x48 :silph-scope - 0x49 :poke-flute - 0x4A :lift-key - 0x4B :exp.all - 0x4C :old-rod - 0x4D :good-rod - 0x4E :super-rod - 0x4F :pp-up - 0x50 :ether - 0x51 :max-ether - 0x52 :elixer - 0x53 :max-elixer - 0xC4 :HM01 ;; cut - 0xC5 :HM02 ;; fly - 0xC6 :HM03 ;; surf - 0xC7 :HM04 ;; strength - 0xC8 :HM05 ;; flash - 0xC9 :TM01 ;; mega punch - 0xCA :TM02 ;; razor wind - 0xCB :TM03 ;; swords dance - 0xCC :TM04 ;; whirlwind - 0xCD :TM05 ;; mega kick - 0xCE :TM06 ;; toxic - 0xCF :TM07 ;; horn drill - 0xD0 :TM08 ;; body slam - 0xD1 :TM09 ;; take down - 0xD2 :TM10 ;; double-edge - 0xD3 :TM11 ;; bubblebeam - 0xD4 :TM12 ;; water gun - 0xD5 :TM13 ;; ice beam - 0xD6 :TM14 ;; blizzard - 0xD7 :TM15 ;; hyper beam - 0xD8 :TM16 ;; pay day - 0xD9 :TM17 ;; submission - 0xDA :TM18 ;; counter - 0xDB :TM19 ;; seismic toss - 0xDC :TM20 ;; rage - 0xDD :TM21 ;; mega drain - 0xDE :TM22 ;; solarbeam - 0xDF :TM23 ;; dragon rage - 0xE0 :TM24 ;; thunderbolt - 0xE1 :TM25 ;; thunder - 0xE2 :TM26 ;; earthquake - 0xE3 :TM27 ;; fissure - 0xE4 :TM28 ;; dig - 0xE5 :TM29 ;; psychic - 0xE6 :TM30 ;; teleport - 0xE7 :TM31 ;; mimic - 0xE8 :TM32 ;; double team - 0xE9 :TM33 ;; reflect - 0xEA :TM34 ;; bide - 0xEB :TM35 ;; metronome - 0xEC :TM36 ;; self destruct - 0xED :TM37 ;; eggbomb - 0xEE :TM38 ;; fire blast - 0xEF :TM39 ;; swift - 0xF0 :TM40 ;; skull bash - 0xF1 :TM41 ;; softboiled - 0xF2 :TM42 ;; dream eater - 0xF3 :TM43 ;; sky attack - 0xF4 :TM44 ;; rest - 0xF5 :TM45 ;; thunder wave - 0xF6 :TM46 ;; psywave - 0xF7 :TM47 ;; explosion - 0xF8 :TM48 ;; rock slide - 0xF9 :TM49 ;; tri attack - 0xFA :TM50 ;; substitute - 0xFB :TM51 ;; "cut" - 0xFC :TM52 ;; "fly" - 0xFD :TM53 ;; "surf" - 0xFE :TM54 ;; "strength" - 0xFF :end-of-list-sentinel)) - -(def item-name->item-code - (zipmap (vals item-code->item-name) - (keys item-code->item-name))) - -(defn inventory [^SaveState state] - (let [items (item-list state)] - (map - (fn [[item-code quantity]] - [(item-code->item-name - item-code - (str ":0x" (.toUpperCase (Integer/toHexString item-code)))) - quantity]) - (partition - 2 - (next (take-while (partial not= 255) items)))))) - -(defn print-inventory - ([] (print-inventory @current-state)) - ([^SaveState state] - (println - (let [inv (inventory state)] - (reduce - str - (concat - ["+-------------------+----------+\n" - "|##| Item | Quantity |\n" - "+--+----------------+----------+\n"] - - (map - (fn [index [item-name quantity]] - (str - (format "|%-2d| %-14s | %3d |\n" index - (apply str (rest (str item-name))) - quantity))) - (range 0 (count inv)) inv) - ["+--+----------------+----------+\n"])))) - state)) - -(defn inventory-codes [inventory] - (flatten - (concat [(count inventory)] - (map (fn [[item-name quantity]] - [(item-name->item-code item-name) - quantity]) inventory) - [(item-name->item-code :end-of-list-sentinel)]))) - -(defn set-inv-mem [^SaveState state inv-codes] - (set-state! state) - (let [mem (memory state)] - (dorun (map (fn [index val] - (aset mem index val)) - (range item-list-start - (+ item-list-start (count inv-codes))) inv-codes)) - (write-memory! mem) - (update-state))) - - -(defn set-inventory [^SaveState state new-inventory] - (set-state! state) - (let [mem (memory state) - inv (inventory-codes new-inventory)] - - (dorun (map (fn [index val] - (aset mem index val)) - (range item-list-start - (+ item-list-start (count inv))) inv)) - (write-memory! mem) - (update-state))) - -(defn give - ([^SaveState state items] - (set-inventory state - (concat items (inventory state)))) - ([items] - (give @current-state items))) - -(defn clear-inventory - ([^SaveState state] - (set-inventory state [])) - ([] (clear-inventory @current-state))) - -(def gliched-tms - [[:TM51 1] - [:TM52 1] - [:TM53 1] - [:TM54 1]]) - -(def good-items - [[:bicycle 1] - [:ultra-ball 15] - [:pp-up 1] - [:master-ball 5] - [:rare-candy 99] - [:full-restore 25] - [:max-revive 8] - [:max-repel 40] - [:TM25 1] - [:TM11 1] - [:TM15 1] - ]) - -(def some-badges - [[:cascadebadge 1] - [:thunderbadge 1] - [:rainbowbadge 1] - [:soulbadge 1] - ]) - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/pokemon.clj --- a/clojure/com/aurellem/pokemon.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -(ns com.aurellem.pokemon - "Here I find out how pokemon are stored in memory." - (:use (com.aurellem gb-driver vbm - rival-name - title save-corruption items assembly)) - (:use com.aurellem.experiments.items) - (:import [com.aurellem.gb_driver SaveState])) - - -(def pidgeot-lvl-36 (mid-game)) - - -(def pidgeot-lvl-37 (read-state "pidgeot-lvl-37")) - - -(def pidgeot-lvl-38 (read-state "pidgeot-lvl-38")) - - -(def pidgeot-lvl-39 (read-state "pidgeot-lvl-39")) - - -(def pidgeot-lvl-40 (read-state "pidgeot-lvl-40")) - - -(defn level-analysis [] - (apply common-differences - (map (comp vec memory) - [pidgeot-lvl-36 - pidgeot-lvl-37 - pidgeot-lvl-38 - pidgeot-lvl-39 - pidgeot-lvl-40]))) - -;; inconclusive -- implies that level is calculated from -;; some other values. - - -(def name-pidgeotto (read-state "name-pidgeotto")) -(def named-A (read-state "named-A")) -(def named-B (read-state "named-B")) -(def named-C (read-state "named-C")) -(def named-D (read-state "named-D")) -(def named-E (read-state "named-E")) -(def named-F (read-state "named-F")) - -(defn name-analysis [] - (apply common-differences - (map (comp vec memory) - [named-A - named-B - named-C - named-D - named-E - named-F]))) - -;; resluted in 3 separate locations that could -;; possibly hold the first letter of the pokemon's name - -0xCF4A -0xD2EB -0xCEED - -;; try changing each of them - - -(defn test-cf4a [] - (continue! - (set-memory named-A 0xCF4A (character->character-code "Z")))) -;; result -- pidgeotto named "A" - -(defn test-d2eb [] - (continue! - (set-memory named-A 0xD2EB (character->character-code "Z")))) -;; result -- pidgeotto named "Z" - -(defn test-ceed [] - (continue! - (set-memory named-A 0xCEED (character->character-code "Z")))) -;; result -- pidgeotto named "A" - -(def sixth-pokemon-name-start 0xD2EB) - - -(defn set-sixth-pokemon-name-first-character - ([state character] - (set-memory state sixth-pokemon-name-start - (character->character-code character))) - ([character] - (set-sixth-pokemon-name-first-character @current-state - character))) - - - - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/rival_name.clj --- a/clojure/com/aurellem/rival_name.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,400 +0,0 @@ -(ns com.aurellem.rival-name - (:use (com.aurellem gb-driver vbm title save-corruption items assembly)) - (:import [com.aurellem.gb_driver SaveState])) - - -(defn talk-to-rival [] - (read-state "talk-to-rival")) - -(def rival-name-start 0xD349) - -(defn set-rival-name [^SaveState state codes] - (set-state! state) - (let [mem (memory state)] - (dorun (map (fn [index val] - (aset mem index val)) - (range rival-name-start - (+ rival-name-start - (count codes))) codes)) - (write-memory! mem) - (update-state))) - -(defn view-rival-name [name-codes] - (-> - (set-rival-name (talk-to-rival) name-codes) - (step [:a]) - (play 50))) - -(defn rival-name-sequence [] - (let [i (atom 1)] - (fn [] - (let [codes (range @i (+ 5 @i))] - (println codes) - (view-rival-name codes) - (reset! i (+ 5 @i)))))) - -(def character-code->character - { - 0x00 "end-of-name-sentinel" - 0x60 "A-bold" - 0x61 "B-bold" - 0x62 "C-bold" - 0x63 "D-bold" - 0x64 "E-bold" - 0x65 "F-bold" - 0x66 "G-bold" - 0x67 "H-bold" - 0x68 "I-bold" - 0x69 "V-bold" - 0x6A "S-bold" - 0x6B "L-bold" - 0x6C "M-bold" - 0x80 "A" - 0x81 "B" - 0x82 "C" - 0x83 "D" - 0x84 "E" - 0x85 "F" - 0x86 "G" - 0x87 "H" - 0x88 "I" - 0x89 "J" - 0x8A "K" - 0x8B "L" - 0x8C "M" - 0x8D "N" - 0x8E "O" - 0x8F "P" - 0x90 "Q" - 0x91 "R" - 0x92 "S" - 0x93 "T" - 0x94 "U" - 0x95 "V" - 0x96 "W" - 0x97 "X" - 0x98 "Y" - 0x99 "Z" - 0x9A "(" - 0x9B ")" - 0x9C ":" - 0x9D ";" - 0xA0 "a" - 0xA1 "b" - 0xA2 "c" - 0xA3 "d" - 0xA4 "e" - 0xA5 "f" - 0xA6 "g" - 0xA7 "h" - 0xA8 "i" - 0xA9 "j" - 0xAA "k" - 0xAB "l" - 0xAC "m" - 0xAD "n" - 0xAE "o" - 0xAF "p" - 0xB0 "q" - 0xB1 "r" - 0xB2 "s" - 0xB3 "t" - 0xB4 "u" - 0xB5 "v" - 0xB6 "w" - 0xB7 "x" - 0xB8 "y" - 0xB9 "z" - 0xBA "e-with-grave" - 0xE0 "'" - 0xE1 "PK" - 0xE2 "MN" - 0xE6 "?" - 0xE7 "!" - 0xE8 "." - 0xEF "male-symbol" - 0xF0 "pokemon-money-symbol" - 0xF1 "." - 0xF2 "/" - 0xF3 "," - 0xF4 "female-symbol" - 0xF6 "0 " - 0xF7 "1" - 0xF8 "2" - 0xF9 "3" - 0xFA "4" - 0xFB "5" - 0xFC "6" - 0xFD "7" - 0xFE "8" - 0xFF "9" - }) - -(def character->character-code - (zipmap (vals character-code->character) - (keys character-code->character))) - - - - - -;; 0x00 : end-of-name-sentinel -;; 0x01 : -;; 0x02 : -;; 0x03 : -;; 0x04 : -;; 0x05 : -;; 0x06 : -;; 0x07 : -;; 0x08 : -;; 0x09 : -;; 0x0A : -;; 0x0B : -;; 0x0C : -;; 0x0D : -;; 0x0E : -;; 0x0F : -;; 0x10 : -;; 0x11 : -;; 0x12 : -;; 0x13 : -;; 0x14 : -;; 0x15 : -;; 0x16 : -;; 0x17 : -;; 0x18 : -;; 0x19 : -;; 0x1A : -;; 0x1B : -;; 0x1C : -;; 0x1D : -;; 0x1E : -;; 0x1F : -;; 0x20 : -;; 0x21 : -;; 0x22 : -;; 0x23 : -;; 0x24 : -;; 0x25 : -;; 0x26 : -;; 0x27 : -;; 0x28 : -;; 0x29 : -;; 0x2A : -;; 0x2B : -;; 0x2C : -;; 0x2D : -;; 0x2E : -;; 0x2F : -;; 0x30 : -;; 0x31 : -;; 0x32 : -;; 0x33 : -;; 0x34 : -;; 0x35 : -;; 0x36 : -;; 0x37 : -;; 0x38 : -;; 0x39 : -;; 0x3A : -;; 0x3B : -;; 0x3C : -;; 0x3D : -;; 0x3E : -;; 0x3F : -;; 0x40 : -;; 0x41 : -;; 0x42 : -;; 0x43 : -;; 0x44 : -;; 0x45 : -;; 0x46 : -;; 0x47 : -;; 0x48 : -;; 0x49 : -;; 0x4A : -;; 0x4B : -;; 0x4C : -;; 0x4D : -;; 0x4E : -;; 0x4F : -;; 0x50 : -;; 0x51 : -;; 0x52 : -;; 0x53 : -;; 0x54 : -;; 0x55 : -;; 0x56 : -;; 0x57 : -;; 0x58 : -;; 0x59 : -;; 0x5A : -;; 0x5B : -;; 0x5C : -;; 0x5D : -;; 0x5E : -;; 0x5F : -;; 0x60 : A (small-bold) -;; 0x61 : B (small-bold) -;; 0x62 : C (small-bold) -;; 0x63 : D (small-bold) -;; 0x64 : E (small-bold) -;; 0x65 : F (small-bold) -;; 0x66 : G (small-bold) -;; 0x67 : H (small-bold) -;; 0x68 : I (small-bold) -;; 0x69 : V (small-bold) -;; 0x6A : S (small-bold) -;; 0x6B : L (small-bold) -;; 0x6C : M (small-bold) -;; 0x6D : -;; 0x6E : -;; 0x6F : -;; 0x70 : -;; 0x71 : -;; 0x72 : -;; 0x73 : -;; 0x74 : -;; 0x75 : -;; 0x76 : -;; 0x77 : -;; 0x78 : -;; 0x79 : -;; 0x7A : -;; 0x7B : -;; 0x7C : -;; 0x7D : -;; 0x7E : -;; 0x7F : -;; 0x80 : A -;; 0x81 : B -;; 0x82 : C -;; 0x83 : D -;; 0x84 : E -;; 0x85 : F -;; 0x86 : G -;; 0x87 : H -;; 0x88 : I -;; 0x89 : J -;; 0x8A : K -;; 0x8B : L -;; 0x8C : M -;; 0x8D : N -;; 0x8E : O -;; 0x8F : P -;; 0x90 : Q -;; 0x91 : R -;; 0x92 : S -;; 0x93 : T -;; 0x94 : U -;; 0x95 : V -;; 0x96 : W -;; 0x97 : X -;; 0x98 : Y -;; 0x99 : Z -;; 0x9A : ( -;; 0x9B : ) -;; 0x9C : : -;; 0x9D : ; -;; 0x9E : -;; 0x9F : -;; 0xA0 : a -;; 0xA1 : b -;; 0xA2 : c -;; 0xA3 : d -;; 0xA4 : e -;; 0xA5 : f -;; 0xA6 : g -;; 0xA7 : h -;; 0xA8 : i -;; 0xA9 : j -;; 0xAA : k -;; 0xAB : l -;; 0xAC : m -;; 0xAD : n -;; 0xAE : o -;; 0xAF : p -;; 0xB0 : q -;; 0xB1 : r -;; 0xB2 : s -;; 0xB3 : t -;; 0xB4 : u -;; 0xB5 : v -;; 0xB6 : w -;; 0xB7 : x -;; 0xB8 : y -;; 0xB9 : z -;; 0xBA : e-with-grave -;; 0xBB : -;; 0xBC : -;; 0xBD : -;; 0xBE : -;; 0xBF : -;; 0xC0 : -;; 0xC1 : -;; 0xC2 : -;; 0xC3 : -;; 0xC4 : -;; 0xC5 : -;; 0xC6 : -;; 0xC7 : -;; 0xC8 : -;; 0xC9 : -;; 0xCA : -;; 0xCB : -;; 0xCC : -;; 0xCD : -;; 0xCE : -;; 0xCF : -;; 0xD0 : -;; 0xD1 : -;; 0xD2 : -;; 0xD3 : -;; 0xD4 : -;; 0xD5 : -;; 0xD6 : -;; 0xD7 : -;; 0xD8 : -;; 0xD9 : -;; 0xDA : -;; 0xDB : -;; 0xDC : -;; 0xDD : -;; 0xDE : -;; 0xDF : -;; 0xE0 : ' -;; 0xE1 : PK -;; 0xE2 : MN -;; 0xE3 : -;; 0xE4 : -;; 0xE5 : -;; 0xE6 : ? -;; 0xE7 : ! -;; 0xE8 : . -;; 0xE9 : -;; 0xEA : -;; 0xEB : -;; 0xEC : -;; 0xED : -;; 0xEE : -;; 0xEF : male-symbol -;; 0xF0 : pokemon-money-symbol -;; 0xF1 : . -;; 0xF2 : / -;; 0xF3 : , -;; 0xF4 : female-symbol -;; 0xF5 : -;; 0xF6 : 0 -;; 0xF7 : 1 -;; 0xF8 : 2 -;; 0xF9 : 3 -;; 0xFA : 4 -;; 0xFB : 5 -;; 0xFC : 6 -;; 0xFD : 7 -;; 0xFE : 8 -;; 0xFF : 9 - - - - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/run/save_corruption.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/run/save_corruption.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,221 @@ +(ns com.aurellem.save-corruption + (:use (com.aurellem gb-driver vbm title))) + +(use 'clojure.repl) + +(defn-memo start-walking [] + (->> (finish-title) + (advance [:b] [:b :r]))) + +(def walk (partial advance [])) + +(defn-memo walk-to-stairs [] + (->> (start-walking) + (walk [:u]) + (walk [:u]) + (walk [:u]) + (walk [:u]) + (walk [:u]) + (walk [:r]) + (walk [:r]) + (walk [:r]))) + +(defn-memo walk-to-door [] + (->> (walk-to-stairs) + (walk [:d]) + (walk [:d]) + (walk [:d]) + (walk [:d]) + (walk [:d]) + (walk [:d]) + (walk [:l]) + (walk [:l]) + (walk [:l]) + (walk [:l]))) + + +(defn-memo activate-menu [] + (->> (walk-to-door) + (advance [:b] [:a :b :start]))) + +(defn-memo save-game [] + (->> (activate-menu) + (advance [] [:d]) + (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]]) + scroll-text)) + +(defn-memo corrupt-save [] + (->> (save-game) + (play-moves + ;; this section is copied from speedrun-2942 + ;; and corrupts the save so that the end-of-list marker + ;; for the pokemon roster is destroyed, but the save is still + ;; playable. + [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [:select] [:restart]]))) + +(defn-memo skip-title-again [] + (->> (corrupt-save) + (play-moves + (first (title))))) + +(defn-memo start-game [] + (->> (skip-title-again) + (advance [] [:start]) + (advance [] [:a]) + (advance [:a] [:a :start]))) + +(defn-memo destroy-item-end-of-list-marker [] + (->> (start-game) + (play-moves + [ + [:start] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] + [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] [] + [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] + [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] + [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d] + [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] [] + [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] + + ;; [:b] [] [] [] [] [] [] [] [] + ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] [] + ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] + ]))) + + + +(defn warp-to-elite-four + "This is copied from speedrun-2942 to ensure that everything is good + up to this point." + [] + (->> (corrupt-save) + (play-moves + [ [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] + [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] [] + [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] + [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] + [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d] + [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] [] + [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] + [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] + [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] + [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] + [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] + [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] + [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] + [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] + [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] + [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] + [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [] + [] [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [:select] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] + [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [:d] [] [] [] [] [:b] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [:select] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [] + [:d] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] + [] [] [] [:d] [] [] [] [] [] [] [] [] [] [] [] [:select] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [:a] [] [] [:d] [] [] [:a] [:u] [] + [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] + [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] + [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] + [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] + [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] + [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] + [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] + [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] + [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [:a] [] [] [] [] + [] [:a] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] + [] [] [] [:b] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] + [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] + [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] + [:d] [:d] [:d] [:d] [:d] [:d] [:d] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] + [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] + [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] + [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [:b]]))) + + + + + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/run/speedruns.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/run/speedruns.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,17 @@ +(ns com.aurellem.speedruns + (:import java.io.File)) + +(def speedrun-2942 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) + +(def speedrun-2913 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) + +(def speedrun-2771 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) + +(def broken-speedrun-1958 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-1958[bad].vbm")) + +(def broken-speedrun-3256 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-3256[bad].vbm")) \ No newline at end of file diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/run/title.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/run/title.clj Mon Mar 19 21:23:46 2012 -0500 @@ -0,0 +1,118 @@ +(ns com.aurellem.title + (:use (com.aurellem gb-driver vbm))) + +(defn first-difference [base alt summary root] + (loop [branch-point root + actions []] + (let [base-branch (step branch-point base) + base-val (summary base-branch) + alt-branch (step branch-point alt) + alt-val (summary alt-branch)] + (if (not= base-val alt-val) + [(conj actions alt) alt-branch] + (recur base-branch (conj actions base)))))) + +(defn advance + ([base alt summary [commands state]] + (let [[c s] (first-difference base alt summary state)] + [(concat commands c) s])) + ([base alt [commands state]] + (advance base alt AF [commands state])) + ([alt [commands state]] + (advance [] alt [commands state]))) + +(def scroll-text (partial advance [:b] [:a :b])) + +(defn start [] [[] (root)]) + +(defn-memo title [] + (->> (start) + (advance [] [:a]) + (advance [] [:start]) + (advance [] [:a]) + (advance [] [:start]))) + +(defn-memo oak [] + (->> (title) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + )) + +(defn-memo name-entry-rlm [] + (->> (oak) + (advance [] [:a]) + (advance [] [:r] DE) + (play-moves + [[] + [:r] [] [:r] [] [:r] [] [:r] [] + [:r] [] [:r] [] [:r] [] [:d] [:a] + [:l] [] [:l] [] [:l] [] [:l] [] + [:l] [] [:l] [:a] [] [:r] [:a] + [:r] [] [:r] [] [:r] [] [:r] [] + [:r] [] [:d] [] [:d] [] [:d] [:a] + ]))) + +(defn-memo name-entry-ash [] + (->> (oak) + (advance [] [:d]) + (advance [] [:d]) + (advance [] [:a]))) + +(defn-memo rival-name-entry-gary [] + (->> (name-entry-ash) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + (advance [] [:d]) + (advance [] [:d]) + (advance [] [:a]))) + +(defn-memo rival-name-entry-blue [] + (->> (name-entry-ash) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + (advance [] [:d]) + (advance [] [:a]))) + +(defn-memo finish-title [] + (->> (rival-name-entry-blue) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text)) + +(def title-frames 2323) + +(defn title-checkpoint! [] + (let [[moves state] (finish-title)] + (assert (= title-frames (:frame state))) + [(write-moves! moves) (write-state! state)])) + +(defn intro [] + [(read-moves title-frames) + (read-state title-frames)]) + +(defn test-intro [] + (play-vbm (moves->filename title-frames))) + +;; TODO might be able to glue these together more elegantly with monads + diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/save_corruption.clj --- a/clojure/com/aurellem/save_corruption.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,221 +0,0 @@ -(ns com.aurellem.save-corruption - (:use (com.aurellem gb-driver vbm title))) - -(use 'clojure.repl) - -(defn-memo start-walking [] - (->> (finish-title) - (advance [:b] [:b :r]))) - -(def walk (partial advance [])) - -(defn-memo walk-to-stairs [] - (->> (start-walking) - (walk [:u]) - (walk [:u]) - (walk [:u]) - (walk [:u]) - (walk [:u]) - (walk [:r]) - (walk [:r]) - (walk [:r]))) - -(defn-memo walk-to-door [] - (->> (walk-to-stairs) - (walk [:d]) - (walk [:d]) - (walk [:d]) - (walk [:d]) - (walk [:d]) - (walk [:d]) - (walk [:l]) - (walk [:l]) - (walk [:l]) - (walk [:l]))) - - -(defn-memo activate-menu [] - (->> (walk-to-door) - (advance [:b] [:a :b :start]))) - -(defn-memo save-game [] - (->> (activate-menu) - (advance [] [:d]) - (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]]) - scroll-text)) - -(defn-memo corrupt-save [] - (->> (save-game) - (play-moves - ;; this section is copied from speedrun-2942 - ;; and corrupts the save so that the end-of-list marker - ;; for the pokemon roster is destroyed, but the save is still - ;; playable. - [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [:select] [:restart]]))) - -(defn-memo skip-title-again [] - (->> (corrupt-save) - (play-moves - (first (title))))) - -(defn-memo start-game [] - (->> (skip-title-again) - (advance [] [:start]) - (advance [] [:a]) - (advance [:a] [:a :start]))) - -(defn-memo destroy-item-end-of-list-marker [] - (->> (start-game) - (play-moves - [ - [:start] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] - [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] [] - [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] - [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] - [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d] - [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] [] - [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] - - ;; [:b] [] [] [] [] [] [] [] [] - ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] [] - ;; [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] - ]))) - - - -(defn warp-to-elite-four - "This is copied from speedrun-2942 to ensure that everything is good - up to this point." - [] - (->> (corrupt-save) - (play-moves - [ [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] - [] [] [] [:a] [] [] [:d] [] [] [:a] [] [] [] [] [] [] [] [] [] - [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] - [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] [] [] [:d] [] [] - [] [] [:d] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:a] [] [] [:d] - [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [:u] [] [] - [] [] [:u] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [:a] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] - [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] - [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] - [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] - [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] - [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] - [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] - [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] - [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] - [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] - [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [] - [] [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [:select] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [:b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] - [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [:d] [] [] [] [] [:b] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [:select] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [] - [:d] [] [] [] [] [] [] [] [:d] [] [] [] [] [] [] [:d] [] [] [] - [] [] [] [:d] [] [] [] [] [] [] [] [] [] [] [] [:select] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [:a] [] [] [:d] [] [] [:a] [:u] [] - [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] - [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] - [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] - [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] - [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] - [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] - [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] - [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] - [:u] [] [:u] [] [:u] [] [:u] [] [:u] [] [:u] [:a] [] [] [] [] - [] [:a] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:b] [] [] [] [] [] - [] [] [] [:b] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] - [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] - [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] [:d] - [:d] [:d] [:d] [:d] [:d] [:d] [:d] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [:a] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] - [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] - [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] - [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [:b]]))) - - - - - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/speedruns.clj --- a/clojure/com/aurellem/speedruns.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -(ns com.aurellem.speedruns - (:import java.io.File)) - -(def speedrun-2942 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) - -(def speedrun-2913 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) - -(def speedrun-2771 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) - -(def broken-speedrun-1958 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-1958[bad].vbm")) - -(def broken-speedrun-3256 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-3256[bad].vbm")) \ No newline at end of file diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/title.clj --- a/clojure/com/aurellem/title.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,118 +0,0 @@ -(ns com.aurellem.title - (:use (com.aurellem gb-driver vbm))) - -(defn first-difference [base alt summary root] - (loop [branch-point root - actions []] - (let [base-branch (step branch-point base) - base-val (summary base-branch) - alt-branch (step branch-point alt) - alt-val (summary alt-branch)] - (if (not= base-val alt-val) - [(conj actions alt) alt-branch] - (recur base-branch (conj actions base)))))) - -(defn advance - ([base alt summary [commands state]] - (let [[c s] (first-difference base alt summary state)] - [(concat commands c) s])) - ([base alt [commands state]] - (advance base alt AF [commands state])) - ([alt [commands state]] - (advance [] alt [commands state]))) - -(def scroll-text (partial advance [:b] [:a :b])) - -(defn start [] [[] (root)]) - -(defn-memo title [] - (->> (start) - (advance [] [:a]) - (advance [] [:start]) - (advance [] [:a]) - (advance [] [:start]))) - -(defn-memo oak [] - (->> (title) - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - )) - -(defn-memo name-entry-rlm [] - (->> (oak) - (advance [] [:a]) - (advance [] [:r] DE) - (play-moves - [[] - [:r] [] [:r] [] [:r] [] [:r] [] - [:r] [] [:r] [] [:r] [] [:d] [:a] - [:l] [] [:l] [] [:l] [] [:l] [] - [:l] [] [:l] [:a] [] [:r] [:a] - [:r] [] [:r] [] [:r] [] [:r] [] - [:r] [] [:d] [] [:d] [] [:d] [:a] - ]))) - -(defn-memo name-entry-ash [] - (->> (oak) - (advance [] [:d]) - (advance [] [:d]) - (advance [] [:a]))) - -(defn-memo rival-name-entry-gary [] - (->> (name-entry-ash) - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - (advance [] [:d]) - (advance [] [:d]) - (advance [] [:a]))) - -(defn-memo rival-name-entry-blue [] - (->> (name-entry-ash) - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - (advance [] [:d]) - (advance [] [:a]))) - -(defn-memo finish-title [] - (->> (rival-name-entry-blue) - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text)) - -(def title-frames 2323) - -(defn title-checkpoint! [] - (let [[moves state] (finish-title)] - (assert (= title-frames (:frame state))) - [(write-moves! moves) (write-state! state)])) - -(defn intro [] - [(read-moves title-frames) - (read-state title-frames)]) - -(defn test-intro [] - (play-vbm (moves->filename title-frames))) - -;; TODO might be able to glue these together more elegantly with monads - diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/util.clj --- a/clojure/com/aurellem/util.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -(ns com.aurellem.util - (:use (com.aurellem gb-driver vbm) - (:import [com.aurellem.gb_driver SaveState]))) diff -r ec477931f077 -r 412ca096a9ba clojure/com/aurellem/vbm.clj --- a/clojure/com/aurellem/vbm.clj Mon Mar 19 20:43:38 2012 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -(ns com.aurellem.vbm - (:import java.io.File) - (:import org.apache.commons.io.FileUtils) - (:use com.aurellem.gb-driver)) - -;;;;;;;;;;;;; read vbm file - -(def ^:dynamic *moves-cache* - (File. user-home "proj/pokemon-escape/moves/")) - -(defn buttons [mask] - (loop [buttons [] - masks (seq (dissoc button-code :listen))] - (if (empty? masks) buttons - (let [[button value] (first masks)] - (if (not= 0x0000 (bit-and value mask)) - (recur (conj buttons button) (rest masks)) - (recur buttons (rest masks))))))) - -(defn vbm-bytes [#^File vbm] - (let [bytes (FileUtils/readFileToByteArray vbm) - ints (int-array (count bytes))] - (areduce bytes idx _ nil - (aset ints idx - (bit-and 0xFF (aget bytes idx)))) - ints)) - -(def vbm-header-length 255) - -(defn repair-vbm - "Two 0's must be inserted after every reset." - [vbm-masks] - (loop [fixed [] - pending vbm-masks] - (if (empty? pending) fixed - (let [mask (first pending)] - (if (not= 0x0000 (bit-and mask (button-code :restart))) - (recur (conj fixed mask 0x0000 0x0000) (next pending)) - (recur (conj fixed mask) (next pending))))))) - -(defn vbm-masks [#^File vbm] - (repair-vbm - (map (fn [[a b]] - (+ (bit-shift-left a 8) b)) - (partition - 2 (drop vbm-header-length (vbm-bytes vbm)))))) - -(defn vbm-buttons [#^File vbm] - (map buttons (vbm-masks vbm))) - -(defn convert-buttons - "To write a vbm file, we must remove the last two buttons after any - reset event." - [buttons] - (loop [fixed [] - pending buttons] - (if (empty? pending) fixed - (let [mask (first pending)] - (if (contains? (set (first pending)) :reset) - (recur (conj fixed mask) (drop 3 pending)) - (recur (conj fixed mask) (next pending))))))) - -(defn moves->filename [frame] - (File. *moves-cache* (format "%07d.vbm" frame))) - -(defn read-moves [frame] - (let [target (moves->filename frame)] - (if (.exists target) - (vbm-buttons target)))) -;;;;;;;;;;;;;; write moves to vbm file - - -(def vbm-header - (byte-array - (map - byte - [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 - 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 - 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 - 95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 - 95 95 95 95]))) - -(def vbm-trailer - (byte-array - (map byte [0]))) - -(defn buttons->vbm-bytes [buttons] - (let [bytes-in-ints - (map button-mask (convert-buttons buttons)) - high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8) - bytes-in-ints) - low-bits (map #(bit-and 0xFF %) bytes-in-ints) - convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i))) - contents - (byte-array - (concat - vbm-header - (map convert-byte (interleave high-bits low-bits)) - vbm-trailer))] - contents)) - -(defn write-moves! [moves] - (let [target (moves->filename (count moves))] - (clojure.java.io/copy (buttons->vbm-bytes moves) target) - target)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(use 'clojure.java.shell) - -(def vba-linux (File. user-home "bin/vba-linux")) - -(defn play-vbm [#^File vbm] - (.delete yellow-save-file) - (if (.exists vbm) - (sh (.getCanonicalPath vba-linux) - (str "--playmovie=" (.getCanonicalPath vbm)) - (.getCanonicalPath yellow-rom-image))) - nil) -