Mercurial > vba-clojure

comparison clojure/com/aurellem/run/bootstrap_0.clj @ 372:998702f021e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged changes
author Dylan Holmes <ocsenave@gmail.com>
date Mon, 09 Apr 2012 01:44:19 -0500
parents 3b3cd62b6106
children 08f8284e2f1b
comparison
equal deleted inserted replaced
371:b477970d0b7a 372:998702f021e3
395 395
396 (defn set-quantity 396 (defn set-quantity
397 "Set the quantity of an item to buy or sell to the desired value 397 "Set the quantity of an item to buy or sell to the desired value
398 using the fewest possible button presses." 398 using the fewest possible button presses."
399 ([total-quantity desired-quantity [moves state :as script]] 399 ([total-quantity desired-quantity [moves state :as script]]
400 (let [current-quantity (item-quantity-selected state) 400 (cond (= desired-quantity 1) (do (println "1 of 1") script)
401 loop-point (if (> total-quantity 99) 0xFF 99) 401 (= total-quantity desired-quantity)
402 distance (- desired-quantity current-quantity) 402 (do (println "get everything!")
403 loop-distance (int(* -1 (Math/signum (float distance)) 403 (delayed-difference [] ↓ 5 item-quantity-selected
404 (- loop-point (Math/abs distance)))) 404 script))
405 best-path (first (sort-by #(Math/abs %) 405 true
406 [distance loop-distance])) 406 (let [current-quantity (item-quantity-selected state)
407 direction (if (< 0 best-path) ↑ ↓)] 407 loop-point (if (= 0 total-quantity) 0x100 total-quantity)
408 (println "best-path" best-path) 408 distance (- desired-quantity current-quantity)
409 (reduce 409 loop-distance (int(* -1 (Math/signum (float distance))
410 (fn [script _] 410 (- loop-point (Math/abs distance))))
411 (delayed-difference [] direction 5 item-quantity-selected 411 best-path (first (sort-by #(Math/abs %)
412 script)) 412 [distance loop-distance]))
413 413 direction (if (< 0 best-path) ↑ ↓)]
414 script 414 (println "best-path" best-path)
415 (range (Math/abs best-path))))) 415 (println "current-quantity" current-quantity)
416 (println "desired-quantity" desired-quantity)
417 (println "options" [distance loop-distance])
418 (reduce
419 (fn [script _]
420 (delayed-difference [] direction 5 item-quantity-selected
421 script))
422 script
423 (range (Math/abs best-path))))))
416 ([desired-quantity [moves state :as script]] 424 ([desired-quantity [moves state :as script]]
417 (set-quantity 99 desired-quantity script))) 425 (set-quantity 99 desired-quantity script)))
418 426
419 (defn activate-start-menu [script] 427 (defn activate-start-menu [script]
420 (first-difference [:b] [:b :start] AF script)) 428 (first-difference [:b] [:b :start] AF script))
424 (- (dec (count (first (script-fn script)))) 432 (- (dec (count (first (script-fn script))))
425 (count (first script)))] 433 (count (first script)))]
426 (println "wait-time" wait-time) 434 (println "wait-time" wait-time)
427 (do-nothing wait-time script))) 435 (do-nothing wait-time script)))
428 436
429 (defn select-menu-entry [script] 437 (defn select-menu-entry
430 (->> script 438 ([test-direction [moves state :as script]]
431 (wait-until (partial set-cursor-relative 1)) 439 (->> script
432 (play-moves [[:a] []]))) 440 (wait-until (partial set-cursor-relative test-direction))
433 441 (play-moves [[] [:a] []])))
442 ([[moves state :as script]]
443 (select-menu-entry
444 1 script)))
445
434 (defn restart 446 (defn restart
435 "The two button presses after a restart event are converted to 447 "The two button presses after a restart event are converted to
436 blanks. Due to weirdness with the VBM format. To compensate, ensure 448 blanks. Due to weirdness with the VBM format. To compensate, ensure
437 that the two button presses after restart are both blanks." 449 that the two button presses after restart are both blanks."
438 [script] 450 [script]
439 (play-moves [[:restart] [] []] script)) 451 (play-moves [[:restart] [] []] script))
440 452
441 (defn-memo do-save-corruption 453 (defn-memo do-save-corruption
442 ([] (do-save-corruption 454 ([] (do-save-corruption
443 (walk-to-counter))) 455 (walk-to-counter)))
444 ([script] 456 ([script] (do-save-corruption 4 script))
457 ([n script]
445 (->> script 458 (->> script
446 activate-start-menu 459 activate-start-menu
447 (set-cursor 4) 460 (set-cursor n)
448 select-menu-entry 461 select-menu-entry
449 select-menu-entry 462 select-menu-entry
450 (play-moves 463 (play-moves
451 ;; this section is copied from speedrun-2942 and corrupts 464 ;; this section is copied from speedrun-2942 and corrupts
452 ;; the save so that the total number of pokemon is set to 465 ;; the save so that the total number of pokemon is set to
468 [(read-moves "cor-checkpoint") 481 [(read-moves "cor-checkpoint")
469 (read-state "cor-checkpoint")]) 482 (read-state "cor-checkpoint")])
470 483
471 (def menu do-nothing ) 484 (def menu do-nothing )
472 485
486
487 (defn investivate-close-menu []
488 (clojure.pprint/pprint
489 (apply harmonic-compare
490 (map read-state
491 ["start-up-1"
492 "start-down-1"
493 ;;"start-up-2"
494 ;;"start-down-2"
495 ;;"start-up-3"
496 ;;"start-down-3"
497 ;;"computer-up-1"
498 ;;"computer-down-2"
499 "computer-up-2"
500 "computer-down-2"
501 "pokemon-up-1"
502 "pokemon-down-1"
503 "pokemon-up-2"
504 "pokemon-down-2"
505 "item-up-1"
506 "item-down-1"
507 "save-up-1"
508 "save-down-1"
509 "item-nest-up-1"
510 "item-nest-down-1"]))))
511
512 (def list-nesting-depth-address 50339)
513
514 (defn current-depth
515 ([^SaveState state] (aget (memory state) list-nesting-depth-address))
516 ([] (current-depth @current-state)))
517
518
473 (defn close-menu [script] 519 (defn close-menu [script]
474 (first-difference [] [:b] AF script)) 520 (delayed-difference
521 [] [:b] 50
522 current-depth
523 script))
524
475 525
476 (defn purchase-item 526 (defn purchase-item
477 "Assumes that the cursor is over the desired item, and purchases 527 "Assumes that the cursor is over the desired item, and purchases
478 quantity of that item." 528 quantity of that item."
479 [n script] 529 [n script]
490 into out-of-bounds memory." 540 into out-of-bounds memory."
491 ([] (corrupt-item-list 541 ([] (corrupt-item-list
492 ;;(corrupted-checkpoint) 542 ;;(corrupted-checkpoint)
493 (do-save-corruption) 543 (do-save-corruption)
494 )) 544 ))
495 ([script] 545 ([script] (corrupt-item-list 1))
546 ([n script]
496 (->> script 547 (->> script
497 activate-start-menu 548 activate-start-menu
498 (set-cursor 1) ; select "POKEMON" from 549 (set-cursor n) ; select "POKEMON"
499 select-menu-entry ; from main menu. 550 select-menu-entry ; from main menu.
500 (set-cursor 5) ; select 6th pokemon 551 (set-cursor 5) ; select 6th pokemon
501 select-menu-entry 552 select-menu-entry
502 (set-cursor 1) 553 (set-cursor 1)
503 select-menu-entry 554 select-menu-entry
1040 (run-moves (reduce concat 1091 (run-moves (reduce concat
1041 (repeat 10 [[:a :b :start :select] []]))) 1092 (repeat 10 [[:a :b :start :select] []])))
1042 ((fn [_] (println "===========") _)) 1093 ((fn [_] (println "===========") _))
1043 (print-listing 0xD162 (+ 0xD162 20))))) 1094 (print-listing 0xD162 (+ 0xD162 20)))))
1044 1095
1045 (defn pc-item-writer-program
1046 []
1047 (let [limit 201
1048 [target-high target-low] (disect-bytes-2 0xD162)]
1049 (flatten
1050 [[0x00 ;; (item-hack) set increment stack pointer no-op
1051 0x1E ;; load limit into E
1052 limit
1053 0x3F ;; (item-hack) set carry flag no-op
1054
1055 ;; load 2 into C.
1056 0x0E ;; C == 1 means input-first nybble
1057 0x04 ;; C == 0 means input-second nybble
1058
1059 0x21 ;; load target into HL
1060 target-low
1061 target-high
1062 0x37 ;; (item-hack) set carry flag no-op
1063
1064 0x00 ;; (item-hack) no-op
1065 0x37 ;; (item-hack) set carry flag no-op
1066
1067 0x00 ;; (item-hack) no-op
1068 0xF3 ;; disable interrupts
1069 ;; Input Section
1070
1071 0x3E ;; load 0x20 into A, to measure buttons
1072 0x10
1073
1074 0x00 ;; (item-hack) no-op
1075 0xE0 ;; load A into [FF00]
1076 0x00
1077
1078 0xF0 ;; load 0xFF00 into A to get
1079 0x00 ;; button presses
1080
1081 0xE6
1082 0x0F ;; select bottom four bits of A
1083 0x37 ;; (item-hack) set carry flag no-op
1084
1085 0x00 ;; (item-hack) no-op
1086 0xB8 ;; see if input is different (CP A B)
1087
1088 0x00 ;; (item-hack) (INC SP)
1089 0x28 ;; repeat above steps if input is not different
1090 ;; (jump relative backwards if B != A)
1091 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
1092
1093 0x47 ;; load A into B
1094
1095 0x0D ;; dec C
1096 0x37 ;; (item-hack) set-carry flag
1097 ;; branch based on C:
1098 0x20 ;; JR NZ
1099 23 ;; skip "input second nybble" and "jump to target" below
1100
1101 ;; input second nybble
1102
1103 0x0C ;; inc C
1104 0x0C ;; inc C
1105
1106 0x00 ;; (item-hack) no-op
1107 0xE6 ;; select bottom bits
1108 0x0F
1109 0x37 ;; (item-hack) set-carry flag no-op
1110
1111 0x00 ;; (item-hack) no-op
1112 0xB2 ;; (OR A D) -> A
1113
1114 0x22 ;; (do (A -> (HL)) (INC HL))
1115
1116 0x1D ;; (DEC E)
1117
1118 0x00 ;; (item-hack)
1119 0x20 ;; jump back to input section if not done
1120 0xDA ;; literal -36 == TM 18 (counter)
1121 0x01 ;; (item-hack) set BC to literal (no-op)
1122
1123 ;; jump to target
1124 0x00 ;; (item-hack) these two bytes can be anything.
1125 0x01
1126
1127 0x00 ;; (item-hack) no-op
1128 0xBF ;; (CP A A) ensures Z
1129
1130 0xCA ;; (item-hack) jump if Z
1131 target-low
1132 target-high
1133 0x01 ;; (item-hack) will never be reached.
1134
1135 ;; input first nybble
1136 0x00
1137 0xCB
1138 0x37 ;; swap nybbles on A
1139
1140 0x57 ;; A -> D
1141
1142 0x37 ;; (item-hack) set carry flag no-op
1143 0x18 ;; relative jump backwards
1144 0xCD ;; literal -51 == TM05; go back to input section
1145 0x01 ;; (item-hack) will never reach this instruction
1146
1147 ]
1148 (repeat 8 [0xFF 0x01])
1149
1150 [;; jump to actual program
1151 0x00
1152 0x37 ;; (item-hack) set carry flag no-op
1153
1154 0x2E ;; 0x3A -> L
1155 0x3A
1156
1157
1158 0x00 ;; (item-hack) no-op
1159 0x26 ;; 0xD5 -> L
1160 0xD5
1161 0x01 ;; (item-hack) set-carry BC
1162
1163 0x00 ;; (item-hack) these can be anything
1164 0x00
1165
1166 ;; 0x00
1167 ;; 0x44 ;; H -> B
1168
1169 ;; 0x00
1170 ;; 0x7D ;; L -> A
1171
1172 ;; 0x00
1173 ;; 0x7C ;; A -> H
1174
1175 ;; 0x00
1176 ;; 0x68 ;; B -> L
1177
1178 0x00
1179 0xE9 ;; jump to (HL)
1180 ]])))
1181
1182
1183 (defn test-pc-item-writer []
1184 (-> (read-state "bootstrap-init")
1185 (set-memory pc-item-list-start 50)
1186 (set-memory-range
1187 map-function-address-start
1188 [0x8B 0xD5])
1189 (set-memory-range
1190 (inc pc-item-list-start)
1191 (pc-item-writer-program))))
1192
1193 (defn test-pc-item-writer-2 []
1194 (let [orig (read-state "pc-item-writer")]
1195 (-> orig
1196 (print-listing 0xD162 (+ 0xD162 20))
1197 (run-moves (reduce concat
1198 (repeat 10 [[:a :b :start :select] []])))
1199 ((fn [_] (println "===========") _))
1200 (print-listing 0xD162 (+ 0xD162 20)))))