Mercurial > vba-clojure
view clojure/com/aurellem/exp/item_bridge.clj @ 370:5aabbe326eb0
fixed a few blocks that were not tangling properly.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sun, 08 Apr 2012 07:59:15 -0500 |
parents | 92c47a9cdaea |
children | 3b3cd62b6106 |
line wrap: on
line source
1 (ns com.aurellem.exp.item-bridge2 (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly))3 (:use (com.aurellem.run util title save-corruption))4 ;;(:use (com.aurellem.exp pokemon))5 (:import [com.aurellem.gb.gb_driver SaveState]))7 (defn corrupt-item-state []8 (second (destroy-item-end-of-list-marker)))10 (defn corrupt-item-state []11 (read-state "corrupt-items"))13 (defn view-memory-range14 ([start end]15 (view-memory-range16 @current-state start end))17 ([state start end]18 (dorun19 (map (fn [loc val]20 (println (format "%04X : %02X" loc val)))21 (range start end) (subvec (vec (memory state)) start end)))22 state))24 (defn almost-broken25 "if one more memory location is turned into 0x03, the game crashes."26 [n]27 (view-memory-range28 (set-inv-mem (mid-game)29 (concat [0xFF] (repeat 64 0x03)30 (subvec (vec (memory (mid-game)))31 (+ item-list-start 65)32 (+ item-list-start 65 n))33 (repeat (- 255 65 n) 0x03)))34 item-list-start (+ item-list-start 255)))36 (defn actually-broken37 "if this memory location is turned into 0x03, the game crashes."38 []39 (set-memory (mid-game) 0xD35D 0x03))42 ;; (almost-broken 20) more or less works44 (defn capture-program-counter45 "records the program counter for each tick"46 [^SaveState state ticks]47 (let [i (atom 0)]48 (reduce (fn [[program-counters state] _]49 (println (swap! i inc))50 [(conj program-counters (PC state))51 (tick state)])52 [[] state]53 (range ticks))))56 (defn capture-program-counter57 [^SaveState state ticks]58 (tick state)60 (loop [i 061 pcs []]62 (if (= i ticks)63 (filter (partial < 0x2000)(sort (set pcs)))64 (do65 (com.aurellem.gb.Gb/tick)66 (recur (inc i)67 (conj pcs (first (registers))))))))69 (defn loop-program []70 [0x00 ;0xD31D ;; disable-interrupts72 0xC3 ;; loop forever73 0x1D74 0xD3])76 (def map-function-address-start 0xD36D)78 (defn test-loop []79 (continue!80 (-> (mid-game)81 (set-memory-range 0xD31D (loop-program))82 (set-memory-range83 map-function-address-start84 [0xD3 0x1D]))))86 (defn-memo corrupt-moves []87 (concat88 (first89 (->>90 [[] (mid-game)]91 (first-difference [:b] [:b :start] AF)92 (first-difference [] [:d] AF)93 (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]])94 (do-nothing 200)95 (play-moves [[:a]])96 (play-moves97 ;; this section is copied from speedrun-294298 ;; and corrupts the save so that the end-of-list marker99 ;; for the pokemon roster is destroyed, but the save is still100 ;; playable.101 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []102 [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])103 (title)104 (first-difference [] [:start] AF)105 (first-difference [] [:a] AF)106 (first-difference [:a] [:a :start] AF)))107 [[]]))109 (defn corrupt110 "enter the codes to destroy the111 pokemon list using save corruption"112 ([^SaveState state]113 (run-moves114 state115 (corrupt-moves)))116 ([] (corrupt @current-state)))118 (defn mid-game-corrupt []119 (read-state "corrupt-mid-game"))121 (defn gen-start-game-corrupt []122 (->> (second (intro))123 (first-difference [:b] [:a :b :start] AF)124 (play-moves (corrupt-moves))))126 (defn start-game-corrupt []127 (read-state "corrupt-start-game"))129 (defn test-memory-fun [n]130 (capture-program-counter131 (set-memory-range132 (tick (mid-game))133 0xD36D134 [0 0])135 n))137 ;;(def good (test-memory-fun 17000))139 ;;(def bad (test-memory-fun 18000))143 (defn menu-open-state []144 (read-state "menu-open"))146 (defn prepare-memory147 ([^SaveState state]148 (-> state149 (set-memory-range 0xD31D (loop-program))150 (set-memory-range 0xD36D [0x1D 0xD3])))151 ([] (prepare-memory @current-state)))153 (def memory-function-address-start 0xD36D)155 (defn read-map-function-address156 ([^SaveState state]157 (let [mem (memory state)]158 [(aget mem memory-function-address-start)159 (aget mem (inc memory-function-address-start))]))160 ([] (read-map-function-address @current-state)))162 (defn succesful-PC-capture163 "This function demonstrates successful PC capturing by164 setting 0xD36D to the value of the start location of165 a specially prepared program.167 You must run the function and then exit the open menu168 to see the effect."169 []170 (dorun171 (map #(println (Integer/toHexString %))172 (capture-program-counter173 (prepare-memory (menu-open-state))174 9000000))))176 (defn trampoline-assembly [^SaveState state]177 (flatten178 [0x3E ;;179 0x3E ;; load lemonade into A181 0xEA182 0x1D183 0xD3 ;; set first item to lemonade185 0xC3 ;; return control to the game via absolute jump.186 (read-map-function-address state)187 ]))189 (defn test-trampoline190 "Demonstrates item-program execution via the map-function that191 returns control to the main pokemon game after one loop."192 [assembly-fn state]193 (let [insertion-address 0xD33D194 insertion-address-bits [0x3D 0xD3]]195 (->196 state197 (set-memory-range198 insertion-address199 (assembly-fn state))200 (set-memory-range201 memory-function-address-start202 insertion-address-bits))))204 (def lemonade-trampoline205 (partial test-trampoline206 trampoline-assembly207 (menu-open-state)))209 (defn trampoline-assembly-burn-heal [^SaveState state]210 (flatten211 [0x3E ;;212 0x3E ;; load lemonade into A214 0xEA215 0x1D216 0xD3 ;; set first item to lemonade218 0xC3 ;; return control to the game via absolute jump219 0x0C ;; to Route 3's map-function220 0x55221 ]))225 (def pc-item-list-start 0xD539)226 (def pc-item-list-width 101)228 (def corrupted-items-width 512)230 (defn items-record231 ([^SaveState state]232 (subvec (vec (memory state))233 item-list-start234 (+ item-list-start corrupted-items-width)))235 ([] (items-record @current-state)))237 (defn pc-items-record238 ([^SaveState state]239 (subvec (vec (memory state))240 pc-item-list-start241 (+ pc-item-list-width pc-item-list-start)))242 ([] (pc-items-record @current-state)))244 (defn print-listing-items245 ([^SaveState state]246 (print-listing state item-list-start247 (+ item-list-start corrupted-items-width))248 state)249 ([] (print-listing-items @current-state)))251 (defn print-listing-pc-items252 ([^SaveState state]253 (print-listing254 state255 pc-item-list-start256 (+ pc-item-list-width pc-item-list-start))257 state)258 ([] (print-listing-pc-items @current-state)))