Mercurial > vba-clojure

annotate clojure/com/aurellem/exp/item_bridge.clj @ 300:bc1f62b269b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
found program that works as valid items, but now the program is too long...
author Robert McIntyre <rlm@mit.edu>
date Fri, 30 Mar 2012 23:05:38 -0500
parents b7f682bb3090
children 8e63b0bb8ea3
rev   line source
rlm@170 1 (ns com.aurellem.exp.item-bridge
rlm@179 2 (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly))
rlm@170 3 (:use (com.aurellem.run title save-corruption))
rlm@179 4 ;;(:use (com.aurellem.exp pokemon))
rlm@154 5 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@130 6
rlm@131 7 (defn corrupt-item-state []
rlm@131 8 (second (destroy-item-end-of-list-marker)))
rlm@131 9
rlm@131 10 (defn corrupt-item-state []
rlm@131 11 (read-state "corrupt-items"))
rlm@131 12
rlm@133 13 (defn view-memory-range [state start end]
rlm@133 14 (dorun
rlm@133 15 (map (fn [loc val]
rlm@133 16 (println (format "%04X : %02X" loc val)))
rlm@133 17 (range start end) (subvec (vec (memory state)) start end)))
rlm@133 18 state)
rlm@131 19
rlm@133 20 (defn almost-broken
rlm@133 21 "if one more memory location is turned into 0x03, the game crashes."
rlm@133 22 [n]
rlm@133 23 (view-memory-range
rlm@133 24 (set-inv-mem (mid-game)
rlm@133 25 (concat [0xFF] (repeat 64 0x03)
rlm@133 26 (subvec (vec (memory (mid-game)))
rlm@133 27 (+ item-list-start 65)
rlm@133 28 (+ item-list-start 65 n))
rlm@170 29 (repeat (- 255 65 n) 0x03)))
rlm@133 30 item-list-start (+ item-list-start 255)))
rlm@131 31
rlm@133 32 (defn actually-broken
rlm@170 33 "if this memory location is turned into 0x03, the game crashes."
rlm@133 34 []
rlm@133 35 (set-memory (mid-game) 0xD35D 0x03))
rlm@131 36
rlm@131 37
rlm@133 38 ;; (almost-broken 20) more or less works
rlm@133 39
rlm@133 40 (defn capture-program-counter
rlm@133 41 "records the program counter for each tick"
rlm@133 42 [^SaveState state ticks]
rlm@133 43 (let [i (atom 0)]
rlm@133 44 (reduce (fn [[program-counters state] _]
rlm@133 45 (println (swap! i inc))
rlm@133 46 [(conj program-counters (PC state))
rlm@133 47 (tick state)])
rlm@133 48 [[] state]
rlm@133 49 (range ticks))))
rlm@133 50
rlm@133 51
rlm@133 52 (defn capture-program-counter
rlm@133 53 [^SaveState state ticks]
rlm@176 54 (tick state)
rlm@176 55
rlm@133 56 (loop [i 0
rlm@133 57 pcs []]
rlm@133 58 (if (= i ticks)
rlm@179 59 (filter (partial < 0x2000)(sort (set pcs)))
rlm@133 60 (do
rlm@133 61 (com.aurellem.gb.Gb/tick)
rlm@133 62 (recur (inc i)
rlm@133 63 (conj pcs (first (registers))))))))
rlm@170 64
rlm@170 65 (defn loop-program []
rlm@174 66 [0x00 ;0xD31D ;; disable-interrupts
rlm@170 67
rlm@170 68 0xC3 ;; loop forever
rlm@170 69 0x1D
rlm@170 70 0xD3])
rlm@170 71
rlm@170 72 (def map-function-address-start 0xD36D)
rlm@170 73
rlm@170 74 (defn test-loop []
rlm@174 75 (continue!
rlm@170 76 (-> (mid-game)
rlm@170 77 (set-memory-range 0xD31D (loop-program))
rlm@170 78 (set-memory-range
rlm@170 79 map-function-address-start
rlm@174 80 [0xD3 0x1D]))))
rlm@174 81
rlm@170 82 (defn-memo corrupt-moves []
rlm@170 83 (concat
rlm@170 84 (first
rlm@170 85 (->>
rlm@170 86 [[] (mid-game)]
rlm@170 87 (advance [:b] [:b :start])
rlm@170 88 (advance [] [:d])
rlm@170 89 (play-moves [[] [] [] [:d] [] [] [] [:d] [] [] [:a]])
rlm@170 90 scroll-text
rlm@170 91 (play-moves
rlm@170 92 ;; this section is copied from speedrun-2942
rlm@170 93 ;; and corrupts the save so that the end-of-list marker
rlm@170 94 ;; for the pokemon roster is destroyed, but the save is still
rlm@170 95 ;; playable.
rlm@170 96 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@170 97 [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
rlm@250 98 (title)
rlm@170 99 (advance [] [:start])
rlm@170 100 (advance [] [:a])
rlm@170 101 (advance [:a] [:a :start])))
rlm@170 102 [[]]))
rlm@170 103
rlm@170 104 (defn corrupt
rlm@170 105 "enter the codes to destroy the
rlm@170 106 pokemon list using save corruption"
rlm@170 107 ([^SaveState state]
rlm@170 108 (run-moves
rlm@170 109 state
rlm@170 110 (corrupt-moves)))
rlm@171 111 ([] (corrupt @current-state)))
rlm@173 112
rlm@173 113 (defn mid-game-corrupt []
rlm@173 114 (read-state "corrupt-mid-game"))
rlm@170 115
rlm@235 116 (defn gen-start-game-corrupt []
rlm@250 117 (->> (second (intro))
rlm@235 118 (advance [:b] [:a :b :start])
rlm@235 119 (play-moves (corrupt-moves))))
rlm@212 120
rlm@235 121 (defn start-game-corrupt []
rlm@235 122 (read-state "corrupt-start-game"))
rlm@212 123
rlm@187 124 (defn test-memory-fun [n]
rlm@187 125 (capture-program-counter
rlm@187 126 (set-memory-range
rlm@187 127 (tick (mid-game))
rlm@187 128 0xD36D
rlm@187 129 [0 0])
rlm@187 130 n))
rlm@170 131
rlm@187 132 ;;(def good (test-memory-fun 17000))
rlm@187 133
rlm@187 134 ;;(def bad (test-memory-fun 18000))
rlm@187 135
rlm@187 136
rlm@212 137
rlm@212 138 (defn menu-open-state []
rlm@212 139 (read-state "menu-open"))
rlm@212 140
rlm@212 141 (defn prepare-memory
rlm@212 142 ([^SaveState state]
rlm@212 143 (-> state
rlm@212 144 (set-memory-range 0xD31D (loop-program))
rlm@212 145 (set-memory-range 0xD36D [0x1D 0xD3])))
rlm@212 146 ([] (prepare-memory @current-state)))
rlm@212 147
rlm@233 148 (def memory-function-address-start 0xD36D)
rlm@233 149
rlm@233 150 (defn read-map-function-address
rlm@233 151 ([^SaveState state]
rlm@233 152 (let [mem (memory state)]
rlm@233 153 [(aget mem memory-function-address-start)
rlm@233 154 (aget mem (inc memory-function-address-start))]))
rlm@233 155 ([] (read-map-function-address @current-state)))
rlm@212 156
rlm@212 157 (defn succesful-PC-capture
rlm@212 158 "This function demonstrates successful PC capturing by
rlm@212 159 setting 0xD36D to the value of the start location of
rlm@212 160 a specially prepared program.
rlm@212 161
rlm@212 162 You must run the function and then exit the open menu
rlm@212 163 to see the effect."
rlm@212 164 []
rlm@212 165 (dorun
rlm@212 166 (map #(println (Integer/toHexString %))
rlm@212 167 (capture-program-counter
rlm@212 168 (prepare-memory (menu-open-state))
rlm@212 169 9000000))))
rlm@233 170
rlm@233 171 (defn trampoline-assembly [^SaveState state]
rlm@233 172 (flatten
rlm@233 173 [0x3E ;;
rlm@233 174 0x3E ;; load lemonade into A
rlm@233 175
rlm@233 176 0xEA
rlm@233 177 0x1D
rlm@233 178 0xD3 ;; set first item to lemonade
rlm@233 179
rlm@238 180 0xC3 ;; return control to the game via absolute jump.
rlm@233 181 (read-map-function-address state)
rlm@233 182 ]))
rlm@233 183
rlm@233 184 (defn test-trampoline
rlm@233 185 "Demonstrates item-program execution via the map-function that
rlm@233 186 returns control to the main pokemon game after one loop."
rlm@238 187 [assembly-fn state]
rlm@233 188 (let [insertion-address 0xD33D
rlm@233 189 insertion-address-bits [0x3D 0xD3]]
rlm@233 190 (->
rlm@238 191 state
rlm@233 192 (set-memory-range
rlm@233 193 insertion-address
rlm@238 194 (assembly-fn state))
rlm@233 195 (set-memory-range
rlm@233 196 memory-function-address-start
rlm@235 197 insertion-address-bits))))
rlm@235 198
rlm@239 199 (def lemonade-trampoline
rlm@239 200 (partial test-trampoline
rlm@239 201 trampoline-assembly
rlm@239 202 (menu-open-state)))
rlm@235 203
rlm@238 204 (defn trampoline-assembly-burn-heal [^SaveState state]
rlm@238 205 (flatten
rlm@238 206 [0x3E ;;
rlm@238 207 0x3E ;; load lemonade into A
rlm@238 208
rlm@238 209 0xEA
rlm@238 210 0x1D
rlm@238 211 0xD3 ;; set first item to lemonade
rlm@238 212
rlm@239 213 0xC3 ;; return control to the game via absolute jump
rlm@239 214 0x0C ;; to Route 3's map-function
rlm@238 215 0x55
rlm@238 216 ]))
rlm@235 217
rlm@235 218
rlm@247 219
rlm@247 220 (def pc-item-list-start 0xD539)
rlm@247 221 (def pc-item-list-width 101)
rlm@247 222
rlm@247 223 (def corrupted-items-width 512)
rlm@247 224
rlm@247 225 (defn items-record
rlm@247 226 ([^SaveState state]
rlm@247 227 (subvec (vec (memory state))
rlm@247 228 item-list-start
rlm@247 229 (+ item-list-start corrupted-items-width)))
rlm@247 230 ([] (items-record @current-state)))
rlm@247 231
rlm@247 232 (defn pc-items-record
rlm@247 233 ([^SaveState state]
rlm@247 234 (subvec (vec (memory state))
rlm@247 235 pc-item-list-start
rlm@247 236 (+ pc-item-list-width pc-item-list-start)))
rlm@247 237 ([] (pc-items-record @current-state)))
rlm@247 238
rlm@247 239 (defn print-listing-items
rlm@247 240 ([^SaveState state]
rlm@247 241 (print-listing state item-list-start
rlm@247 242 (+ item-list-start corrupted-items-width))
rlm@247 243 state)
rlm@247 244 ([] (print-listing-items @current-state)))
rlm@247 245
rlm@247 246 (defn print-listing-pc-items
rlm@247 247 ([^SaveState state]
rlm@247 248 (print-listing
rlm@247 249 state
rlm@247 250 pc-item-list-start
rlm@247 251 (+ pc-item-list-width pc-item-list-start))
rlm@247 252 state)
rlm@247 253 ([] (print-listing-pc-items @current-state)))
rlm@247 254
rlm@247 255
rlm@247 256