view clojure/com/aurellem/exp/item_bridge.clj @ 304:fefe5ce49b21

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