Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 598:0b4ff504157d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge.
author Robert McIntyre <rlm@mit.edu>
date Sun, 02 Sep 2012 06:37:11 -0500
parents daa3497bbe12
children
rev   line source
rlm@247 1 (ns com.aurellem.run.bootstrap-0
rlm@320 2 (:use (com.aurellem.gb saves gb-driver util
rlm@320 3 items vbm characters money))
rlm@319 4 (:use (com.aurellem.run util title save-corruption))
rlm@264 5 (:use (com.aurellem.exp item-bridge))
rlm@264 6 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@247 7
rlm@250 8 (defn-memo boot-root []
rlm@255 9 [ [] (root)])
rlm@247 10
rlm@255 11 (defn-memo to-rival-name
rlm@255 12 ([] (to-rival-name (boot-root)))
rlm@255 13 ([script]
rlm@319 14 (->> script
rlm@255 15 title
rlm@255 16 oak
rlm@255 17 name-entry-rlm
rlm@319 18 (scroll-text 5))))
rlm@247 19
rlm@255 20 (defn-memo name-rival-bootstrap
rlm@255 21 ([] (name-rival-bootstrap (to-rival-name)))
rlm@255 22 ([script]
rlm@255 23 (->> script
rlm@319 24 (first-difference [] [:a] AF)
rlm@319 25 (first-difference [] [:r] DE)
rlm@255 26 (play-moves
rlm@255 27 [[]
rlm@313 28 [] [] [:r] [] [:d] [:a] ;; L
rlm@313 29 [:r] [] [:r] [] [:r] [] [:r] []
rlm@313 30 [:r] [] [:d] [] [:d] [:a] ;; [PK]
rlm@333 31 [:u] [] [:l] [] [:l] []
rlm@333 32 [:l] [] [:l] [] [:l] [:a] ;; U
rlm@333 33 [:r] [] [:r] [] [:r] []
rlm@333 34 [:r] [] [:r] [] [:d] [:a] ;; [PK]
rlm@313 35 [] [:a] ;; [PK]
rlm@313 36 [] [:a] ;; [PK]
rlm@313 37 [:r] [] [:d] [:a] ;; END
rlm@255 38 ]))))
rlm@255 39
rlm@255 40 (defn-memo leave-house
rlm@255 41 ([] (leave-house (name-rival-bootstrap)))
rlm@255 42 ([script]
rlm@255 43 (->> script
rlm@255 44 finish-title
rlm@255 45 walk-to-stairs
rlm@255 46 walk-to-door
rlm@255 47 (walk [↓ ↓]))))
rlm@255 48
rlm@255 49 (defn-memo to-pallet-town-edge
rlm@255 50 ([] (to-pallet-town-edge (leave-house)))
rlm@255 51 ([script]
rlm@255 52 (->> script
rlm@255 53 (walk [→ → → → →
rlm@255 54 ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255 55
rlm@257 56 (defn-memo start-pikachu-battle
rlm@257 57 ([] (start-pikachu-battle
rlm@257 58 (to-pallet-town-edge)))
rlm@257 59 ([script]
rlm@257 60 (->> script
rlm@319 61 (first-difference [:b] [:b :a] DE)
rlm@319 62 scroll-text
rlm@319 63 (do-nothing 200)
rlm@319 64 (play-moves [[:b]]))))
rlm@257 65
rlm@257 66 (defn-memo capture-pikachu
rlm@257 67 ([] (capture-pikachu (start-pikachu-battle)))
rlm@257 68 ([script]
rlm@257 69 (->> script
rlm@319 70 (scroll-text 3))))
rlm@257 71
rlm@257 72 (defn-memo go-to-lab
rlm@257 73 ([] (go-to-lab (capture-pikachu)))
rlm@257 74 ([script]
rlm@257 75 (->> script
rlm@319 76 end-text
rlm@257 77 (scroll-text 5)
rlm@319 78 end-text
rlm@319 79 ;; oak walks you to his lab; no input required.
rlm@319 80 (do-nothing 400))))
rlm@319 81
rlm@319 82 (defn-memo talk-to-oak-in-lab
rlm@319 83 ([] (talk-to-oak-in-lab (go-to-lab)))
rlm@319 84 ([script]
rlm@319 85 (->> script
rlm@319 86 (scroll-text 14)
rlm@319 87 end-text)))
rlm@319 88
rlm@319 89 (defn-memo try-to-get-eevee
rlm@319 90 ([] (try-to-get-eevee (talk-to-oak-in-lab)))
rlm@319 91 ([script]
rlm@319 92 (->> script
rlm@319 93 ;; walk to pokeball
rlm@319 94 (walk [↓ → →])
rlm@319 95 ;; and try to grab it
rlm@319 96 (play-moves
rlm@319 97 (concat [↑ ↑ [:a]]
rlm@319 98 (repeat 100 [])))
rlm@319 99 (scroll-text 10)
rlm@257 100 (end-text))))
rlm@257 101
rlm@257 102 (defn-memo obtain-pikachu
rlm@319 103 ([] (obtain-pikachu (try-to-get-eevee)))
rlm@257 104 ([script]
rlm@257 105 (->> script
rlm@319 106 (scroll-text 6)
rlm@319 107 (end-text))))
rlm@319 108
rlm@319 109
rlm@258 110 (defn-memo begin-battle-with-rival
rlm@258 111 ([] (begin-battle-with-rival
rlm@258 112 (obtain-pikachu)))
rlm@258 113 ([script]
rlm@258 114 (->> script
rlm@319 115 (walk [↓ ↓ ↓])
rlm@260 116 (scroll-text 3)
rlm@260 117 (end-text)
rlm@260 118 (scroll-text))))
rlm@260 119
rlm@319 120 (defn-memo defeat-eevee
rlm@319 121 ([] (defeat-eevee
rlm@260 122 (begin-battle-with-rival)))
rlm@260 123 ([script]
rlm@260 124 (->> script
rlm@313 125 (do-nothing 400)
rlm@260 126 (play-moves [[:a]])
rlm@260 127 (critical-hit)
rlm@319 128 (do-nothing 200)
rlm@319 129 (scroll-text 2) ;; for eevee's tail-whip
rlm@319 130 (do-nothing 10)
rlm@313 131 (play-moves [[:a]])
rlm@260 132 (critical-hit)
rlm@319 133 (do-nothing 200)
rlm@319 134 (scroll-text 2) ;; tail whip again
rlm@319 135 (do-nothing 10)
rlm@313 136 (play-moves [[:a]])
rlm@313 137 (critical-hit)
rlm@319 138 (do-nothing 200))))
rlm@260 139
rlm@260 140 (defn-memo finish-rival-text
rlm@260 141 ([] (finish-rival-text
rlm@319 142 (defeat-eevee)))
rlm@260 143 ([script]
rlm@260 144 (->> script
rlm@319 145 (scroll-text 12)
rlm@260 146 (end-text))))
rlm@260 147
rlm@262 148 (defn-memo pikachu-comes-out
rlm@262 149 ([] (pikachu-comes-out
rlm@262 150 (finish-rival-text)))
rlm@262 151 ([script]
rlm@262 152 (->> script
rlm@319 153 (scroll-text 8)
rlm@262 154 (end-text))))
rlm@260 155
rlm@262 156 (defn-memo leave-oaks-lab
rlm@262 157 ([] (leave-oaks-lab
rlm@262 158 (pikachu-comes-out)))
rlm@262 159 ([script]
rlm@262 160 (->> script
rlm@319 161 (walk [↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@257 162
rlm@271 163 (defn-memo oaks-lab->pallet-town-edge
rlm@262 164 ([] (oaks-lab->pallet-town-edge
rlm@262 165 (leave-oaks-lab)))
rlm@262 166 ([script]
rlm@262 167 (->> script
rlm@319 168 (walk [← ← ←
rlm@319 169 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))
rlm@264 170
rlm@264 171 (defn-memo pallet-edge->viridian-mart
rlm@271 172 ([] (pallet-edge->viridian-mart true
rlm@264 173 (oaks-lab->pallet-town-edge)))
rlm@271 174 ([dodge-stupid-guy? script]
rlm@271 175 (let [dodge-1 (if dodge-stupid-guy?
rlm@271 176 [→ →]
rlm@271 177 [→])
rlm@271 178 dodge-2 (if dodge-stupid-guy?
rlm@271 179 [↑ ↑ ←]
rlm@319 180 [↑ ↑])]
rlm@271 181
rlm@271 182 (->> script
rlm@264 183 ;; leave straight grass
rlm@264 184 (walk-thru-grass
rlm@264 185 [↑ ↑ ↑ ↑ ↑])
rlm@313 186
rlm@264 187 (walk [↑ ↑ ↑ ↑])
rlm@313 188
rlm@264 189 (walk-thru-grass
rlm@264 190 [← ← ↑])
rlm@313 191
rlm@264 192 (walk [↑ ↑ ↑ ↑ → → → ])
rlm@264 193
rlm@264 194 (walk-thru-grass
rlm@264 195 [→ ↑ ↑ ←])
rlm@264 196
rlm@264 197 (walk
rlm@264 198 [← ←
rlm@264 199 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264 200 → → → → ])
rlm@264 201
rlm@271 202 ;; this part is dependent on that
rlm@266 203 ;; stupid NPC in the grass patch
rlm@264 204 (walk-thru-grass
rlm@271 205 (concat dodge-1
rlm@271 206 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
rlm@271 207
rlm@264 208 (walk
rlm@271 209 (concat
rlm@271 210 dodge-2
rlm@271 211 [← ← ←
rlm@271 212 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@271 213 ← ←
rlm@271 214 ↑ ↑ ↑ ↑
rlm@271 215 → → → → → → → → → →
rlm@271 216 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
rlm@264 217
rlm@266 218 (defn-memo get-oaks-parcel
rlm@266 219 ([] (get-oaks-parcel
rlm@266 220 (pallet-edge->viridian-mart)))
rlm@266 221 ([script]
rlm@266 222 (->> script
rlm@319 223 (do-nothing 50)
rlm@266 224 (end-text)
rlm@266 225 (scroll-text 3)
rlm@266 226 (do-nothing 197)
rlm@266 227 (play-moves [[:a] []])
rlm@266 228 (walk [↓ ↓ → ↓]))))
rlm@266 229
rlm@269 230 (defn-memo viridian-store->oaks-lab
rlm@269 231 ([] (viridian-store->oaks-lab
rlm@269 232 (get-oaks-parcel)))
rlm@269 233 ([script]
rlm@269 234 (->> script
rlm@269 235 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 236 ← ← ← ← ← ← ← ← ←
rlm@269 237 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 238 ← ←
rlm@269 239 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 240 ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 241 → → → → → → → →
rlm@319 242 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 243 ← ← ← ← ←
rlm@269 244 ↓ ↓ ↓ ↓
rlm@319 245 ])
rlm@269 246 (walk-thru-grass
rlm@269 247 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@319 248 (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@319 249 ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 250 → → → ↑])
rlm@319 251
rlm@319 252 (do-nothing 1))))
rlm@269 253
rlm@269 254
rlm@269 255 (defn-memo viridian-store->oaks-lab-like-a-boss
rlm@269 256 ([] (viridian-store->oaks-lab-like-a-boss
rlm@269 257 (get-oaks-parcel)))
rlm@269 258 ([script]
rlm@269 259 (->> script
rlm@269 260 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 261 ← ← ← ← ← ← ← ← ←
rlm@269 262 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 263
rlm@269 264 (walk-thru-grass
rlm@269 265 [↓ ↓ ↓ ↓ ↓])
rlm@269 266
rlm@269 267 (walk
rlm@269 268 [↓ ↓ ← ↓
rlm@319 269 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 270 → → → ↓])
rlm@269 271
rlm@269 272 (walk-thru-grass
rlm@333 273 [↓ ↓ ↓])
rlm@269 274
rlm@333 275 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 276
rlm@269 277 (walk-thru-grass
rlm@319 278 [↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 279
rlm@319 280 (walk [↓ ↓ ↓ ← ↓ ↓ ↓
rlm@269 281 ↓ ↓ ↓ ↓ ↓
rlm@269 282 → → → ↑]))))
rlm@270 283
rlm@270 284 (defn-memo deliver-oaks-parcel
rlm@270 285 ([] (deliver-oaks-parcel
rlm@270 286 (viridian-store->oaks-lab-like-a-boss)))
rlm@270 287 ([script]
rlm@270 288 (->> script
rlm@270 289 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@319 290 (play-moves [[] [:a]])
rlm@319 291 (scroll-text 13)
rlm@270 292 (end-text)
rlm@270 293 (do-nothing 200)
rlm@319 294 (scroll-text 2)
rlm@270 295 (end-text)
rlm@270 296 (scroll-text 2)
rlm@270 297 (end-text)
rlm@319 298 (scroll-text 8)
rlm@270 299 (end-text)
rlm@270 300 (scroll-text 9)
rlm@270 301 (end-text)
rlm@270 302 (scroll-text 7)
rlm@319 303 (end-text)
rlm@319 304 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@271 305
rlm@271 306 (defn-memo return-to-viridian-mart
rlm@271 307 ([] (return-to-viridian-mart
rlm@271 308 (deliver-oaks-parcel)))
rlm@271 309 ([script]
rlm@271 310 (->> script
rlm@271 311 oaks-lab->pallet-town-edge
rlm@274 312 (pallet-edge->viridian-mart false))))
rlm@274 313
rlm@274 314 (defn-memo walk-to-counter
rlm@274 315 ([] (walk-to-counter
rlm@274 316 (return-to-viridian-mart)))
rlm@274 317 ([script]
rlm@274 318 (->> script
rlm@319 319 (walk [↑ ↑ ←]))))
rlm@275 320
rlm@320 321
rlm@320 322
rlm@320 323 ;; useful addresses
rlm@320 324 52262 ;; --- current-cursor-offset
rlm@320 325 52278 ;; --- current screen-offset
rlm@320 326
rlm@320 327
rlm@320 328 (defn exp-item-list []
rlm@320 329 (clojure.pprint/pprint
rlm@320 330 (apply harmonic-compare
rlm@320 331 (map read-state
rlm@320 332 ["up-1" "down-1"
rlm@320 333 "up-2" "down-2"
rlm@320 334 "up-3" "down-3"
rlm@320 335 "up-4" "down-4"
rlm@320 336 "up-5" "down-5"
rlm@320 337 "up-6"]))))
rlm@321 338
rlm@322 339
rlm@323 340 ;; turns out that these addresses are the cursor position
rlm@323 341 ;; for all lists in the game (start list, pokemon list, shop
rlm@323 342 ;; lists, inventory lists, battle list, basically
rlm@323 343 ;; everything!)
rlm@322 344
rlm@323 345 (def list-cursor-offset-address 52262)
rlm@323 346 (def list-screen-offset-address 52278)
rlm@321 347
rlm@323 348 (defn list-offset
rlm@321 349 ([^SaveState state]
rlm@321 350 (let [mem (memory state)]
rlm@327 351 (+ (aget mem list-screen-offset-address)
rlm@327 352 (aget mem list-cursor-offset-address))))
rlm@327 353 ([] (list-offset @current-state)))
rlm@320 354
rlm@322 355 (defn exp-item-selection []
rlm@322 356 (clojure.pprint/pprint
rlm@322 357 (apply memory-compare
rlm@322 358 (map read-state
rlm@322 359 ["1-item"
rlm@322 360 "2-items"
rlm@322 361 "3-items"
rlm@322 362 "4-items"
rlm@322 363 ]))))
rlm@322 364
rlm@322 365 (def item-quantity-selected-address 65432)
rlm@322 366
rlm@322 367 (defn item-quantity-selected
rlm@322 368 ([^SaveState state]
rlm@329 369 (println "items:" (aget (memory state) item-quantity-selected-address))
rlm@322 370 (aget (memory state) item-quantity-selected-address))
rlm@322 371 ([] (item-quantity-selected @current-state)))
rlm@322 372
rlm@368 373 (defn wait-until
rlm@368 374 ([script-fn default-key script]
rlm@368 375 (let [wait-time
rlm@368 376 (- (dec (count (first (script-fn script))))
rlm@368 377 (count (first script)))]
rlm@368 378 (println "wait-time" wait-time)
rlm@368 379 (play-moves (repeat wait-time default-key) script)))
rlm@368 380 ([script-fn script]
rlm@368 381 (wait-until script-fn [] script)))
rlm@368 382
rlm@323 383 (defn set-cursor-relative
rlm@323 384 "Assumes the arrow keys currently control the cursor.
rlm@323 385 Moves the cursor n steps relative to its current
rlm@323 386 position."
rlm@323 387 [n script]
rlm@323 388 (let [key (if (< 0 n) ↓ ↑)]
rlm@323 389 (multiple-times
rlm@324 390 (Math/abs n)
rlm@325 391 (partial first-difference
rlm@325 392 [] key list-offset)
rlm@324 393 script)))
rlm@322 394
rlm@368 395 (defn set-cursor*
rlm@368 396 [n [moves state :as script]]
rlm@368 397 (let [current-position (list-offset state)
rlm@368 398 difference (- n current-position)]
rlm@368 399 (set-cursor-relative difference script)))
rlm@368 400
rlm@323 401 (defn set-cursor
rlm@323 402 "Assumes the arrow keys currently control the cursor. Sets
rlm@323 403 the cursor to the desired position. Works for any menu
rlm@323 404 that uses a cursor including the start menu, item menu,
rlm@323 405 pokemon menu, and battle menu."
rlm@323 406 [n [moves state :as script]]
rlm@368 407 (->> script
rlm@368 408 (wait-until (partial set-cursor-relative 1))
rlm@368 409 (set-cursor* n)))
rlm@329 410
rlm@368 411 (defn first-character [state]
rlm@368 412 (aget (memory state) text-address))
rlm@368 413
rlm@369 414 (defn first-20-characters [state]
rlm@369 415 (subvec (vec (memory state)) text-address (+ 20 text-address)))
rlm@369 416
rlm@368 417 (defn set-quantity*
rlm@329 418 "Set the quantity of an item to buy or sell to the desired value
rlm@329 419 using the fewest possible button presses."
rlm@368 420 [total-quantity desired-quantity [moves state :as script]]
rlm@345 421 (cond (= desired-quantity 1) (do (println "1 of 1") script)
rlm@345 422 (= total-quantity desired-quantity)
rlm@345 423 (do (println "get everything!")
rlm@345 424 (delayed-difference [] ↓ 5 item-quantity-selected
rlm@345 425 script))
rlm@345 426 true
rlm@345 427 (let [current-quantity (item-quantity-selected state)
rlm@345 428 loop-point (if (= 0 total-quantity) 0x100 total-quantity)
rlm@345 429 distance (- desired-quantity current-quantity)
rlm@345 430 loop-distance (int(* -1 (Math/signum (float distance))
rlm@345 431 (- loop-point (Math/abs distance))))
rlm@345 432 best-path (first (sort-by #(Math/abs %)
rlm@345 433 [distance loop-distance]))
rlm@345 434 direction (if (< 0 best-path) ↑ ↓)]
rlm@345 435 (println "best-path" best-path)
rlm@345 436 (println "current-quantity" current-quantity)
rlm@345 437 (println "desired-quantity" desired-quantity)
rlm@345 438 (println "options" [distance loop-distance])
rlm@345 439 (reduce
rlm@345 440 (fn [script _]
rlm@345 441 (delayed-difference [] direction 5 item-quantity-selected
rlm@345 442 script))
rlm@345 443 script
rlm@345 444 (range (Math/abs best-path))))))
rlm@368 445
rlm@368 446 (defn set-quantity
rlm@368 447 ([total-quantity desired-quantity [moves state :as script]]
rlm@369 448 (->> script (wait-until (partial delayed-difference [] [:a] 100
rlm@369 449 first-20-characters))
rlm@369 450 (set-quantity* total-quantity desired-quantity)))
rlm@330 451 ([desired-quantity [moves state :as script]]
rlm@330 452 (set-quantity 99 desired-quantity script)))
rlm@275 453
rlm@368 454
rlm@331 455 (defn activate-start-menu [script]
rlm@331 456 (first-difference [:b] [:b :start] AF script))
rlm@331 457
rlm@345 458 (defn select-menu-entry
rlm@345 459 ([test-direction [moves state :as script]]
rlm@345 460 (->> script
rlm@345 461 (wait-until (partial set-cursor-relative test-direction))
rlm@345 462 (play-moves [[] [:a] []])))
rlm@345 463 ([[moves state :as script]]
rlm@345 464 (select-menu-entry
rlm@345 465 1 script)))
rlm@345 466
rlm@336 467 (defn restart
rlm@336 468 "The two button presses after a restart event are converted to
rlm@336 469 blanks. Due to weirdness with the VBM format. To compensate, ensure
rlm@336 470 that the two button presses after restart are both blanks."
rlm@336 471 [script]
rlm@336 472 (play-moves [[:restart] [] []] script))
rlm@336 473
rlm@593 474 (defn do-save-corruption
rlm@329 475 ([] (do-save-corruption
rlm@275 476 (walk-to-counter)))
rlm@345 477 ([script] (do-save-corruption 4 script))
rlm@345 478 ([n script]
rlm@275 479 (->> script
rlm@331 480 activate-start-menu
rlm@345 481 (set-cursor n)
rlm@331 482 select-menu-entry
rlm@593 483
rlm@593 484 ;; say yes to save game
rlm@593 485 ;; first-difference is faster than select-menu-entry
rlm@593 486 ;; for this special case
rlm@593 487 ;;select-menu-entry
rlm@593 488 (first-difference [:b] [:a] AF)
rlm@593 489
rlm@280 490 (play-moves
rlm@280 491 ;; this section is copied from speedrun-2942 and corrupts
rlm@290 492 ;; the save so that the total number of pokemon is set to
rlm@290 493 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
rlm@290 494 ;; via the pokemon interface.
rlm@280 495 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@336 496 [] [] [] [] [] [] [] [] [] [] [] []])
rlm@336 497 (restart)
rlm@280 498 (title)
rlm@319 499 (first-difference [] [:start] AF)
rlm@329 500 (first-difference [] [:a] AF))))
rlm@329 501
rlm@329 502 (defn gen-corrupted-checkpoint! []
rlm@329 503 (let [[cor-moves cor-save] (do-save-corruption)]
rlm@329 504 (write-moves! cor-moves "cor-checkpoint")
rlm@329 505 (write-state! cor-save "cor-checkpoint")))
rlm@329 506
rlm@329 507 (defn corrupted-checkpoint []
rlm@329 508 [(read-moves "cor-checkpoint")
rlm@329 509 (read-state "cor-checkpoint")])
rlm@319 510
rlm@319 511 (def menu do-nothing )
rlm@280 512
rlm@345 513
rlm@345 514 (defn investivate-close-menu []
rlm@345 515 (clojure.pprint/pprint
rlm@345 516 (apply harmonic-compare
rlm@345 517 (map read-state
rlm@345 518 ["start-up-1"
rlm@345 519 "start-down-1"
rlm@345 520 ;;"start-up-2"
rlm@345 521 ;;"start-down-2"
rlm@345 522 ;;"start-up-3"
rlm@345 523 ;;"start-down-3"
rlm@345 524 ;;"computer-up-1"
rlm@345 525 ;;"computer-down-2"
rlm@345 526 "computer-up-2"
rlm@345 527 "computer-down-2"
rlm@345 528 "pokemon-up-1"
rlm@345 529 "pokemon-down-1"
rlm@345 530 "pokemon-up-2"
rlm@345 531 "pokemon-down-2"
rlm@345 532 "item-up-1"
rlm@345 533 "item-down-1"
rlm@345 534 "save-up-1"
rlm@345 535 "save-down-1"
rlm@345 536 "item-nest-up-1"
rlm@345 537 "item-nest-down-1"]))))
rlm@345 538
rlm@345 539 (def list-nesting-depth-address 50339)
rlm@345 540
rlm@345 541 (defn current-depth
rlm@345 542 ([^SaveState state] (aget (memory state) list-nesting-depth-address))
rlm@345 543 ([] (current-depth @current-state)))
rlm@345 544
rlm@345 545
rlm@330 546 (defn close-menu [script]
rlm@345 547 (delayed-difference
rlm@345 548 [] [:b] 50
rlm@345 549 current-depth
rlm@345 550 script))
rlm@345 551
rlm@330 552
rlm@330 553 (defn purchase-item
rlm@330 554 "Assumes that the cursor is over the desired item, and purchases
rlm@330 555 quantity of that item."
rlm@330 556 [n script]
rlm@330 557 (->> script
rlm@330 558 select-menu-entry
rlm@330 559 (set-quantity n)
rlm@330 560 (first-difference [] [:a] AF)
rlm@330 561 scroll-text
rlm@330 562 select-menu-entry
rlm@330 563 scroll-text))
rlm@330 564
rlm@337 565 (defn-memo corrupt-item-list
rlm@329 566 "Corrupt the num-of-items variable by switching a corrupted pokemon
rlm@329 567 into out-of-bounds memory."
rlm@284 568 ([] (corrupt-item-list
rlm@336 569 ;;(corrupted-checkpoint)
rlm@336 570 (do-save-corruption)
rlm@331 571 ))
rlm@345 572 ([script] (corrupt-item-list 1))
rlm@345 573 ([n script]
rlm@284 574 (->> script
rlm@330 575 activate-start-menu
rlm@345 576 (set-cursor n) ; select "POKEMON"
rlm@330 577 select-menu-entry ; from main menu.
rlm@330 578 (set-cursor 5) ; select 6th pokemon
rlm@330 579 select-menu-entry
rlm@329 580 (set-cursor 1)
rlm@330 581 select-menu-entry
rlm@329 582 (repeat-until-different [] list-offset)
rlm@329 583 (set-cursor 9)
rlm@330 584 select-menu-entry ; switch 6th with 10th
rlm@330 585 close-menu
rlm@333 586 close-menu)))
rlm@329 587
rlm@337 588 (defn-memo get-lots-of-money
rlm@329 589 "Sell 0xFE cancel buttons to make a tremendous amount of money."
rlm@329 590 ([] (get-lots-of-money (corrupt-item-list)))
rlm@329 591 ([script]
rlm@329 592 (->> script
rlm@330 593 (first-difference [] [:a] AF) ; talk to shopkeep
rlm@329 594 (repeat-until-different [] list-offset)
rlm@329 595 (set-cursor 1)
rlm@330 596 select-menu-entry
rlm@329 597 (repeat-until-different [] list-offset)
rlm@330 598 select-menu-entry
rlm@332 599 (set-quantity 0xFF 0xF7)
rlm@332 600 (first-difference [] [:a] AF)
rlm@332 601 select-menu-entry
rlm@333 602 close-menu)))
rlm@329 603
rlm@330 604 (defn note [str script]
rlm@330 605 (println str) script)
rlm@329 606
rlm@337 607 (defn-memo buy-bootstrapping-items
rlm@330 608 "Buy items that will become part of the bootstrapping
rlm@330 609 program."
rlm@330 610 ([] (buy-bootstrapping-items (get-lots-of-money)))
rlm@284 611 ([script]
rlm@284 612 (->> script
rlm@330 613 close-menu
rlm@330 614 select-menu-entry
rlm@330 615 (purchase-item 1) ; buying a pokeball overflows
rlm@330 616 ; the item-counter from 0xFF to 0x00
rlm@330 617 ; repairing the item-list.
rlm@330 618 (set-cursor 1)
rlm@330 619 (purchase-item 1) ; these other items are here to
rlm@330 620 ; protect the burn heals when the
rlm@330 621 (set-cursor 2) ; item list is corrupted again.
rlm@330 622 (purchase-item 1)
rlm@284 623
rlm@330 624 (set-cursor 3)
rlm@330 625 (purchase-item 1)
rlm@284 626
rlm@330 627 (set-cursor 4) ; 95 burn-heals spells out the
rlm@330 628 (purchase-item 96) ; return address to the pokemon
rlm@330 629 ; kernel. 96 so that they can be
rlm@330 630 ; deposited without causing a shift.
rlm@284 631
rlm@330 632 close-menu ; stop talking to shopkeep
rlm@330 633 (wait-until select-menu-entry)
rlm@330 634 (play-moves [[:b]])
rlm@330 635 end-text)))
rlm@330 636
rlm@337 637 (defn-memo corrupt-item-list-again
rlm@330 638 ([] (corrupt-item-list-again (buy-bootstrapping-items)))
rlm@284 639 ([script]
rlm@284 640 (->> script
rlm@330 641 activate-start-menu
rlm@330 642 (set-cursor-relative 0)
rlm@330 643 select-menu-entry
rlm@330 644
rlm@330 645 ;; repair list-offset for pokemon-list
rlm@330 646 (set-cursor-relative -1)
rlm@330 647
rlm@330 648 (set-cursor 4) ; switching it to
rlm@330 649 select-menu-entry ; tenth place.
rlm@330 650 (set-cursor 1)
rlm@330 651 select-menu-entry ; select "switch" on 5th
rlm@330 652
rlm@330 653 (repeat-until-different [] list-offset)
rlm@330 654 (set-cursor 9) ; goto 10th pokemon
rlm@330 655 select-menu-entry ; do switch
rlm@330 656 close-menu
rlm@331 657 close-menu)))
rlm@333 658
rlm@337 659 (defn-memo leave-viridian-store
rlm@333 660 ([] (leave-viridian-store (corrupt-item-list-again)))
rlm@290 661 ([script]
rlm@290 662 (->> script
rlm@290 663 ;; leave store
rlm@336 664 (walk [↓ ↓ → ↓]))))
rlm@333 665
rlm@333 666 (defn force-encounter [direction script]
rlm@333 667 (delayed-improbability-search
rlm@333 668 600
rlm@333 669 #(search-string % "Wild")
rlm@333 670 (partial move direction) script))
rlm@333 671
rlm@337 672 (defn-memo fight-wild-pokemon
rlm@333 673 ([] (fight-wild-pokemon (leave-viridian-store)))
rlm@333 674 ([script]
rlm@333 675 (->> script
rlm@333 676 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@333 677 ← ← ← ← ← ← ← ←
rlm@333 678 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@333 679 (force-encounter →))))
rlm@333 680
rlm@337 681 (defn-memo run-from-pokemon
rlm@333 682 ([] (run-from-pokemon (fight-wild-pokemon)))
rlm@333 683 ([script]
rlm@333 684 (->> script
rlm@333 685 (scroll-text)
rlm@336 686 (play-moves [[:a]])
rlm@333 687 (wait-until select-menu-entry)
rlm@333 688 (set-cursor 1)
rlm@333 689 (first-difference [] → AF)
rlm@333 690 (scroll-text)
rlm@333 691 (scroll-text))))
rlm@290 692
rlm@337 693 (defn-memo to-poke-center-computer
rlm@290 694 ([] (to-poke-center-computer
rlm@333 695 (run-from-pokemon)))
rlm@290 696 ([script]
rlm@290 697 (->> script
rlm@336 698 (walk-thru-grass [→ → ↑])
rlm@333 699 (walk [↑ ← ← ←
rlm@333 700 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@333 701 ← ←
rlm@333 702 ↑ ↑ ↑ ↑
rlm@333 703 → → → → ↑])
rlm@333 704 (walk [→ →
rlm@290 705 ↑ ↑ ↑
rlm@334 706 → → → → → → → → →])
rlm@334 707 (first-difference [] ↑ AF))))
rlm@333 708
rlm@291 709 (defn-memo begin-deposits
rlm@291 710 ([] (begin-deposits
rlm@291 711 (to-poke-center-computer)))
rlm@291 712 ([script]
rlm@291 713 (->> script
rlm@291 714 ;; access PC
rlm@291 715 (scroll-text 2)
rlm@291 716
rlm@291 717 ;; access item storage
rlm@291 718 (menu [[:a] [:d] [:a]])
rlm@291 719 (scroll-text 2)
rlm@291 720
rlm@291 721 ;; begin deposit
rlm@291 722 (menu [[:d] [:a]])
rlm@291 723 (do-nothing 40))))
rlm@291 724
rlm@293 725 (defn deposit-n-items
rlm@293 726 [n script]
rlm@293 727 (->> script
rlm@293 728 (do-nothing 100)
rlm@293 729 (play-moves [[:a]])
rlm@293 730 (do-nothing 80)
rlm@293 731 (multiple-times
rlm@293 732 (dec n)
rlm@293 733 (fn [script]
rlm@293 734 (->> script
rlm@293 735 (play-moves [[:u]])
rlm@293 736 (do-nothing 1))))
rlm@293 737 (play-moves [[:a]])
rlm@293 738 (scroll-text)))
rlm@296 739
rlm@296 740 (defn deposit-one-item
rlm@296 741 [script]
rlm@296 742 (->> script
rlm@296 743 (do-nothing 100)
rlm@296 744 (play-moves [[:a]])
rlm@296 745 (do-nothing 80)
rlm@296 746 (play-moves [[:a]])
rlm@296 747 (scroll-text)))
rlm@293 748
rlm@293 749 (defn-memo create-header
rlm@291 750 ([] (create-header (begin-deposits)))
rlm@291 751 ([script]
rlm@291 752 (->> script
rlm@293 753 (multiple-times 33 deposit-one-item)
rlm@291 754 (do-nothing 1))))
rlm@297 755
rlm@297 756 (defn bootstrap-init []
rlm@297 757 [(read-moves "bootstrap-init")
rlm@297 758 (read-state "bootstrap-init")])
rlm@296 759
rlm@296 760 (defn create-bootstrap-program
rlm@296 761 ([] (create-bootstrap-program
rlm@296 762 (create-header)))
rlm@296 763 ([script]
rlm@296 764 (->> script
rlm@296 765 (do-nothing 120)
rlm@296 766 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@296 767 ;;(deposit-n-items 33)
rlm@296 768
rlm@296 769 (menu (repeat 17 ↓))
rlm@296 770
rlm@296 771
rlm@296 772
rlm@296 773 (do-nothing 1))))
rlm@296 774
rlm@297 775
rlm@302 776 (defn test-pc-item-program []
rlm@302 777 (-> (read-state "bootstrap-init")
rlm@302 778 (set-memory pc-item-list-start 50)
rlm@302 779 (set-memory-range
rlm@305 780 map-function-address-start [0x8B 0xD5])
rlm@304 781 (set-memory-range
rlm@302 782 (inc pc-item-list-start)
rlm@302 783 (flatten
rlm@304 784 [(repeat
rlm@303 785 28
rlm@302 786 [0xFF 0x01])
rlm@303 787 [;; second part of item manipulation program
rlm@303 788 0x00 ;; this starts at address 0xD56C
rlm@303 789 0x2A ;; save (HL)=(target) to A, increment HL
rlm@302 790
rlm@302 791 0x00
rlm@303 792 0x47 ;; save A to B
rlm@302 793
rlm@302 794 0x00
rlm@303 795 0x3A ;; save (target+1) to A, decrement HL
rlm@302 796
rlm@302 797 0x00
rlm@303 798 0x22 ;; A -> target, increment HL [(target+1) -> target]
rlm@302 799
rlm@303 800 0x00
rlm@303 801 0x70 ;; load B into target+1 [(target) -> target+1]
rlm@303 802
rlm@303 803 0x00
rlm@303 804 0xC3 ;; first part of absolute jump
rlm@303 805
rlm@303 806 0x0C ;; return control to pokemon kernel
rlm@302 807 0x5F]
rlm@302 808 (repeat
rlm@303 809 5
rlm@302 810 [0xFF 0x01])
rlm@302 811
rlm@303 812 [;; first part of item manipulation program
rlm@303 813 0x00
rlm@333 814 0x21 ;; load target into HL
rlm@302 815
rlm@333 816 0x94 ;; this is the target address
rlm@302 817 0xD5
rlm@302 818
rlm@303 819 0x00 ;; relative jump back to first part
rlm@303 820 0x18
rlm@302 821
rlm@303 822 0xE1 ;; of program
rlm@302 823 0x01
rlm@302 824
rlm@303 825 0xFF ;; spacer
rlm@302 826 0x01
rlm@302 827
rlm@303 828 0x04 ;; target ID (pokeball)
rlm@303 829 0x3E ;; target Quantity (lemonade)
rlm@302 830 ]]))))
rlm@338 831
rlm@338 832
rlm@338 833
rlm@338 834
rlm@338 835
rlm@338 836 (defn basic-writer [target-address limit return-address]
rlm@338 837 (let [[target-high target-low] (disect-bytes-2 target-address)
rlm@338 838 [return-high return-low] (disect-bytes-2 return-address)]
rlm@338 839 (flatten
rlm@338 840 [0xF3 ;; disable interrupts
rlm@340 841
rlm@338 842 0x1E ;; load limit into E
rlm@338 843 limit
rlm@338 844
rlm@338 845 0x21 ;; load target into HL
rlm@338 846 target-low
rlm@338 847 target-high
rlm@338 848
rlm@338 849 ;; load 1 into C.
rlm@338 850 0x0E ;; C == 1 means input-first nybble
rlm@338 851 0x01 ;; C == 0 means input-second nybble
rlm@338 852
rlm@338 853 ;; Input Section
rlm@338 854
rlm@338 855 0x3E ;; load 0x20 into A, to measure dpad
rlm@338 856 0x20
rlm@338 857
rlm@338 858 0xE0 ;; load A into [FF00]
rlm@338 859 0x00
rlm@338 860
rlm@338 861 0xF0 ;; load 0xFF00 into A to get
rlm@338 862 0x00 ;; d-pad presses
rlm@338 863
rlm@338 864 0xE6
rlm@338 865 0x0F ;; select bottom four bits of A
rlm@338 866
rlm@338 867 0xB8 ;; see if input is different (CP A B)
rlm@338 868
rlm@338 869 0x28 ;; repeat above steps if input is not different
rlm@338 870 ;; (jump relative backwards if B != A)
rlm@338 871 0xF5 ;; (literal -11)
rlm@338 872
rlm@338 873 0x47 ;; load A into B
rlm@338 874
rlm@338 875 0x0D ;; dec C
rlm@338 876 ;; branch based on C:
rlm@338 877 0x20 ;; JR NZ
rlm@338 878 0x07 ;; skip "input first nybble" below
rlm@338 879
rlm@338 880
rlm@338 881 ;; input first nybble
rlm@338 882
rlm@338 883 0xCB
rlm@338 884 0x37 ;; swap nybbles on A
rlm@338 885
rlm@338 886 0x57 ;; A -> D
rlm@338 887
rlm@338 888 0x18
rlm@338 889 0xEC ;; literal -20 -- go back to input section
rlm@338 890
rlm@338 891 ;; input second nybble
rlm@338 892
rlm@338 893 0x0C ;; inc C
rlm@338 894
rlm@338 895 0xE6 ;; select bottom bits
rlm@338 896 0x0F
rlm@338 897
rlm@338 898 0xB2 ;; (OR A D) -> A
rlm@338 899
rlm@338 900 0x22 ;; (do (A -> (HL)) (INC HL))
rlm@338 901
rlm@338 902 0x1D ;; (DEC E)
rlm@338 903
rlm@338 904 0x20 ;; jump back to input section if not done
rlm@338 905 0xE4 ;; literal -28
rlm@338 906
rlm@338 907 0xFB ;; re-enable interrupts
rlm@338 908
rlm@338 909 0xC3
rlm@338 910 return-low
rlm@338 911 return-high ])))
rlm@338 912
rlm@338 913
rlm@338 914 (defn test-basic-writer []
rlm@338 915 (-> (read-state "bootstrap-init")
rlm@338 916 (set-memory pc-item-list-start 50)
rlm@338 917 (set-memory-range
rlm@338 918 map-function-address-start
rlm@338 919 (reverse (disect-bytes-2 (inc pc-item-list-start))))
rlm@338 920 (set-memory-range
rlm@338 921 (inc pc-item-list-start)
rlm@338 922 (basic-writer 0xD162 10 0x5F0C))))
rlm@338 923
rlm@338 924 (defn debug-basic-writer []
rlm@338 925 (PC! (test-basic-writer) (inc pc-item-list-start)))
rlm@338 926
rlm@338 927 (defn d-ticks [state n]
rlm@338 928 (reduce (fn [state _] (d-tick state))
rlm@338 929 state (range n)))
rlm@338 930
rlm@338 931 (defn d-print [state message]
rlm@338 932 (println message) state)
rlm@338 933
rlm@338 934 (defn dddd
rlm@338 935 []
rlm@338 936 (-> (debug-basic-writer)
rlm@338 937 (d-ticks 20)
rlm@338 938 (set-memory 0xFF00 0xFF)
rlm@338 939 (d-print "============== second cycle")
rlm@338 940 (d-ticks 14)
rlm@338 941 (d-print "============== end")
rlm@338 942 (d-ticks 20)))
rlm@338 943
rlm@339 944 ;;TMs at celadon store ---
rlm@339 945 ;;01 (any-number) mega punch
rlm@339 946 ;;02 (any-number) razor wind
rlm@339 947 ;;05 (any-number) mega kick
rlm@339 948 ;;07 (any-number) hyper beam
rlm@339 949 ;;09 (any-number) take down
rlm@339 950 ;;13 (only 1) ice beam
rlm@339 951 ;;17 (any-number) submission
rlm@339 952 ;;18 (only 1) counter
rlm@339 953 ;;32 (any-number) double team
rlm@339 954 ;;33 (any-number) reflect
rlm@339 955 ;;37 (any-number) egg bomb
rlm@339 956 ;;48 (only 1) rock slide
rlm@339 957 ;;49 (only 1) tri attack
rlm@339 958
rlm@339 959
rlm@339 960 ;; no-ops
rlm@339 961 ;; 0x00
rlm@339 962 ;; 0xB8 - 0xBF (compares) :garbage
rlm@339 963 ;; 0x3F clear carry flag :s.s.ticket
rlm@339 964 ;; 0x37 set carry flag :guard-spec [!]
rlm@339 965 ;; 0x33 increment SP :poke-doll [!]
rlm@339 966 ;; 0x3B decrement SP :coin
rlm@339 967
rlm@339 968 ;;0x7F A->A :garbage
rlm@339 969 ;;0x40 B->B :gold-teeth
rlm@339 970 ;;0x49 C->C :poke-flute
rlm@339 971 ;;0x52 D->D :elixer
rlm@339 972 ;;0x5B E->E :garbage
rlm@339 973 ;;0x6D L->L :garbage
rlm@339 974 ;;0x64 H->H :garbage
rlm@339 975
rlm@339 976
rlm@339 977 ;;0xC5 push BC :HM02
rlm@339 978 ;;0xD5 push DE :TM13 (ice-beam)
rlm@339 979 ;;0xE5 push HL :TM29 (psychic)
rlm@339 980 ;;0xF5 push AF :TM45 (thunder-wave)
rlm@339 981
rlm@339 982 ;; 0xA7 (AND A A) :garbage
rlm@339 983 ;; 0xB7 (OR A A) :garbage
rlm@339 984
rlm@339 985 ;; 0x2F (CPL A) :leaf-stone
rlm@339 986
rlm@339 987
rlm@339 988 (defn item-writer
rlm@339 989 "This is the basic writer, optimized to be made of valid
rlm@339 990 item-quantity pairs."
rlm@339 991 [target-address limit return-address]
rlm@339 992 (let [[target-high target-low] (disect-bytes-2 target-address)
rlm@339 993 [return-high return-low] (disect-bytes-2 return-address)]
rlm@339 994 (flatten
rlm@339 995 [
rlm@339 996 ;;0xC5 ;; push junk onto stack
rlm@339 997 ;;0xD5
rlm@339 998 ;;0xE5
rlm@339 999 ;;0xF5
rlm@341 1000 0x33 ;; (item-hack) set increment stack pointer no-op
rlm@339 1001 0x1E ;; load limit into E
rlm@339 1002 limit
rlm@339 1003 0x3F ;; (item-hack) set carry flag no-op
rlm@339 1004
rlm@341 1005 ;; load 2 into C.
rlm@341 1006 0x0E ;; C == 1 means input-first nybble
rlm@341 1007 0x04 ;; C == 0 means input-second nybble
rlm@340 1008
rlm@339 1009 0x21 ;; load target into HL
rlm@339 1010 target-low
rlm@339 1011 target-high
rlm@339 1012 0x37 ;; (item-hack) set carry flag no-op
rlm@339 1013
rlm@339 1014 0x2F ;; (item-hack) cpl A
rlm@339 1015 0x2F ;; (item-hack) cpl A --together a spacer no-op
rlm@339 1016
rlm@339 1017 0x00 ;; (item-hack) no-op
rlm@339 1018 0xF3 ;; disable interrupts
rlm@339 1019 ;; Input Section
rlm@339 1020
rlm@339 1021 0x3E ;; load 0x20 into A, to measure buttons
rlm@339 1022 0x10
rlm@339 1023
rlm@339 1024 0x00 ;; (item-hack) no-op
rlm@339 1025 0xE0 ;; load A into [FF00]
rlm@339 1026 0x00
rlm@339 1027
rlm@339 1028 0xF0 ;; load 0xFF00 into A to get
rlm@339 1029 0x00 ;; button presses
rlm@339 1030
rlm@339 1031 0xE6
rlm@339 1032 0x0F ;; select bottom four bits of A
rlm@339 1033 0x37 ;; (item-hack) set carry flag no-op
rlm@339 1034
rlm@339 1035 0x00 ;; (item-hack) no-op
rlm@339 1036 0xB8 ;; see if input is different (CP A B)
rlm@339 1037
rlm@341 1038 0x00 ;; (item-hack) (INC SP)
rlm@339 1039 0x28 ;; repeat above steps if input is not different
rlm@339 1040 ;; (jump relative backwards if B != A)
rlm@339 1041 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
rlm@339 1042
rlm@339 1043 0x47 ;; load A into B
rlm@339 1044
rlm@339 1045 0x0D ;; dec C
rlm@340 1046 0x37 ;; (item-hack) set-carry flag
rlm@339 1047 ;; branch based on C:
rlm@339 1048 0x20 ;; JR NZ
rlm@341 1049 23 ;; skip "input second nybble" and "jump to target" below
rlm@339 1050
rlm@339 1051 ;; input second nybble
rlm@339 1052
rlm@339 1053 0x0C ;; inc C
rlm@342 1054 0x0C ;; inc C
rlm@340 1055
rlm@340 1056 0x00 ;; (item-hack) no-op
rlm@339 1057 0xE6 ;; select bottom bits
rlm@339 1058 0x0F
rlm@340 1059 0x37 ;; (item-hack) set-carry flag no-op
rlm@339 1060
rlm@340 1061 0x00 ;; (item-hack) no-op
rlm@339 1062 0xB2 ;; (OR A D) -> A
rlm@339 1063
rlm@339 1064 0x22 ;; (do (A -> (HL)) (INC HL))
rlm@339 1065
rlm@339 1066 0x1D ;; (DEC E)
rlm@339 1067
rlm@340 1068 0x00 ;; (item-hack)
rlm@339 1069 0x20 ;; jump back to input section if not done
rlm@340 1070 0xDA ;; literal -36 == TM 18 (counter)
rlm@341 1071 0x01 ;; (item-hack) set BC to literal (no-op)
rlm@339 1072
rlm@341 1073 ;; jump to target
rlm@341 1074 0x00 ;; (item-hack) these two bytes can be anything.
rlm@341 1075 0x01
rlm@341 1076
rlm@341 1077 0x00 ;; (item-hack) no-op
rlm@341 1078 0xBF ;; (CP A A) ensures Z
rlm@341 1079
rlm@341 1080 0xCA ;; (item-hack) jump if Z
rlm@341 1081 return-low
rlm@341 1082 return-high
rlm@341 1083 0x01 ;; (item-hack) will never be reached.
rlm@341 1084
rlm@341 1085
rlm@341 1086
rlm@340 1087 ;; input first nybble
rlm@340 1088 0x00
rlm@340 1089 0xCB
rlm@340 1090 0x37 ;; swap nybbles on A
rlm@340 1091
rlm@340 1092 0x57 ;; A -> D
rlm@340 1093
rlm@341 1094 0x37 ;; (item-hack) set carry flag no-op
rlm@341 1095 0x18 ;; relative jump backwards
rlm@341 1096 0xCD ;; literal -51 == TM05; go back to input section
rlm@341 1097 0x01 ;; (item-hack) will never reach this instruction
rlm@340 1098
rlm@341 1099 ])))
rlm@340 1100
rlm@341 1101 (defn test-item-writer []
rlm@341 1102 (-> (read-state "bootstrap-init")
rlm@341 1103 (set-memory pc-item-list-start 50)
rlm@341 1104 (set-memory-range
rlm@341 1105 map-function-address-start
rlm@341 1106 (reverse (disect-bytes-2 (inc pc-item-list-start))))
rlm@341 1107 (set-memory-range
rlm@341 1108 (inc pc-item-list-start)
rlm@341 1109 (item-writer 0xD162 201 0xD162))))
rlm@342 1110
rlm@342 1111 (defn item-writer-state []
rlm@342 1112 (read-state "item-writer"))
rlm@342 1113
rlm@342 1114 (defn test-item-writer-2 []
rlm@342 1115 (let [orig (item-writer-state)]
rlm@342 1116 (-> orig
rlm@342 1117 (print-listing 0xD162 (+ 0xD162 20))
rlm@343 1118 (run-moves (reduce concat
rlm@343 1119 (repeat 10 [[:a :b :start :select] []])))
rlm@342 1120 ((fn [_] (println "===========") _))
rlm@342 1121 (print-listing 0xD162 (+ 0xD162 20)))))
rlm@343 1122