Mercurial > vba-clojure

annotate clojure/com/aurellem/exp/item_bridge.clj @ 291:c8b0db518de3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
script: creating header for initial bootstrap program.
author Robert McIntyre <rlm@mit.edu>
date Thu, 29 Mar 2012 18:23:20 -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