1.1 --- a/clojure/com/aurellem/run/bootstrap_0.clj	Mon Apr 09 01:40:26 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/bootstrap_0.clj	Mon Apr 09 01:44:19 2012 -0500
     1.3 @@ -397,22 +397,30 @@
     1.4    "Set the quantity of an item to buy or sell to the desired value
     1.5    using the fewest possible button presses."
     1.6    ([total-quantity desired-quantity [moves state :as script]]
     1.7 -     (let [current-quantity (item-quantity-selected state)
     1.8 -           loop-point (if (> total-quantity 99) 0xFF 99)
     1.9 -           distance (- desired-quantity current-quantity)
    1.10 -           loop-distance (int(* -1 (Math/signum (float distance))
    1.11 -                                (- loop-point (Math/abs distance))))
    1.12 -           best-path (first (sort-by #(Math/abs %)
    1.13 -                                     [distance loop-distance]))
    1.14 -           direction (if (< 0 best-path) ↑ ↓)]
    1.15 -       (println "best-path" best-path)
    1.16 -       (reduce
    1.17 -        (fn [script _]
    1.18 -          (delayed-difference [] direction 5 item-quantity-selected
    1.19 -                              script))
    1.20 -        
    1.21 -        script
    1.22 -        (range (Math/abs best-path)))))
    1.23 +     (cond (= desired-quantity 1) (do (println "1 of 1") script)
    1.24 +           (= total-quantity desired-quantity)
    1.25 +           (do (println "get everything!")
    1.26 +               (delayed-difference [] ↓ 5 item-quantity-selected
    1.27 +                                   script))
    1.28 +           true
    1.29 +           (let [current-quantity (item-quantity-selected state)
    1.30 +                 loop-point (if (= 0 total-quantity) 0x100 total-quantity)
    1.31 +                 distance (- desired-quantity current-quantity)
    1.32 +                 loop-distance (int(* -1 (Math/signum (float distance))
    1.33 +                                      (- loop-point (Math/abs distance))))
    1.34 +                 best-path (first (sort-by #(Math/abs %)
    1.35 +                                           [distance loop-distance]))
    1.36 +                 direction (if (< 0 best-path) ↑ ↓)]
    1.37 +             (println "best-path" best-path)
    1.38 +             (println "current-quantity" current-quantity)
    1.39 +             (println "desired-quantity" desired-quantity)
    1.40 +             (println "options" [distance loop-distance])
    1.41 +             (reduce
    1.42 +              (fn [script _]
    1.43 +                (delayed-difference [] direction 5 item-quantity-selected
    1.44 +                                    script))
    1.45 +              script
    1.46 +              (range (Math/abs best-path))))))
    1.47    ([desired-quantity [moves state :as script]]
    1.48       (set-quantity 99 desired-quantity script)))
    1.49  
    1.50 @@ -426,11 +434,15 @@
    1.51      (println "wait-time" wait-time)
    1.52      (do-nothing wait-time script)))
    1.53  
    1.54 -(defn select-menu-entry [script]
    1.55 -  (->> script
    1.56 -       (wait-until (partial set-cursor-relative 1))
    1.57 -       (play-moves [[:a] []])))
    1.58 -
    1.59 +(defn select-menu-entry
    1.60 +  ([test-direction [moves state :as script]]
    1.61 +     (->> script
    1.62 +          (wait-until (partial set-cursor-relative test-direction))
    1.63 +          (play-moves [[] [:a] []])))
    1.64 +  ([[moves state :as script]]
    1.65 +     (select-menu-entry
    1.66 +      1 script)))
    1.67 +         
    1.68  (defn restart
    1.69    "The two button presses after a restart event are converted to
    1.70     blanks. Due to weirdness with the VBM format. To compensate, ensure
    1.71 @@ -441,10 +453,11 @@
    1.72  (defn-memo do-save-corruption
    1.73    ([] (do-save-corruption
    1.74         (walk-to-counter)))
    1.75 -  ([script]
    1.76 +  ([script] (do-save-corruption 4 script))
    1.77 +  ([n script]
    1.78       (->> script
    1.79            activate-start-menu
    1.80 -          (set-cursor 4)
    1.81 +          (set-cursor n)
    1.82            select-menu-entry
    1.83            select-menu-entry
    1.84            (play-moves
    1.85 @@ -470,8 +483,45 @@
    1.86  
    1.87  (def menu do-nothing )
    1.88  
    1.89 +
    1.90 +(defn investivate-close-menu []
    1.91 +  (clojure.pprint/pprint
    1.92 +   (apply harmonic-compare
    1.93 +          (map read-state
    1.94 +               ["start-up-1"
    1.95 +                "start-down-1"
    1.96 +                ;;"start-up-2"
    1.97 +                ;;"start-down-2"
    1.98 +                ;;"start-up-3"
    1.99 +                ;;"start-down-3"
   1.100 +                ;;"computer-up-1"
   1.101 +                ;;"computer-down-2"
   1.102 +                "computer-up-2"
   1.103 +                "computer-down-2"
   1.104 +                "pokemon-up-1"
   1.105 +                "pokemon-down-1"
   1.106 +                "pokemon-up-2"
   1.107 +                "pokemon-down-2"
   1.108 +                "item-up-1"
   1.109 +                "item-down-1"
   1.110 +                "save-up-1"
   1.111 +                "save-down-1"
   1.112 +                "item-nest-up-1"
   1.113 +                "item-nest-down-1"]))))
   1.114 +
   1.115 +(def list-nesting-depth-address 50339)
   1.116 +
   1.117 +(defn current-depth
   1.118 +  ([^SaveState state] (aget (memory state) list-nesting-depth-address))
   1.119 +  ([] (current-depth @current-state)))
   1.120 +  
   1.121 +
   1.122  (defn close-menu [script]
   1.123 -  (first-difference [] [:b] AF script))
   1.124 +  (delayed-difference
   1.125 +   [] [:b] 50
   1.126 +   current-depth
   1.127 +   script))
   1.128 +                                        
   1.129  
   1.130  (defn purchase-item
   1.131    "Assumes that the cursor is over the desired item, and purchases
   1.132 @@ -492,10 +542,11 @@
   1.133         ;;(corrupted-checkpoint)
   1.134         (do-save-corruption)
   1.135         ))
   1.136 -  ([script]
   1.137 +  ([script] (corrupt-item-list 1))
   1.138 +  ([n script]
   1.139       (->> script
   1.140            activate-start-menu
   1.141 -          (set-cursor 1)        ; select "POKEMON" from
   1.142 +          (set-cursor n)        ; select "POKEMON"
   1.143            select-menu-entry     ; from main menu.
   1.144            (set-cursor 5)        ; select 6th pokemon
   1.145            select-menu-entry
   1.146 @@ -1042,159 +1093,3 @@
   1.147      ((fn [_] (println "===========") _))
   1.148      (print-listing 0xD162 (+ 0xD162 20)))))
   1.149  
   1.150 -(defn pc-item-writer-program
   1.151 -  []
   1.152 -  (let [limit 201
   1.153 -        [target-high target-low] (disect-bytes-2 0xD162)]
   1.154 -    (flatten
   1.155 -     [[0x00  ;; (item-hack) set increment stack pointer no-op
   1.156 -       0x1E  ;; load limit into E
   1.157 -       limit
   1.158 -       0x3F  ;; (item-hack) set carry flag no-op
   1.159 -
   1.160 -       ;; load 2 into C.
   1.161 -       0x0E   ;; C == 1 means input-first nybble
   1.162 -       0x04   ;; C == 0 means input-second nybble
   1.163 -
   1.164 -       0x21 ;; load target into HL
   1.165 -       target-low
   1.166 -       target-high
   1.167 -       0x37 ;; (item-hack) set carry flag no-op
   1.168 -
   1.169 -       0x00 ;; (item-hack) no-op
   1.170 -       0x37 ;; (item-hack) set carry flag no-op
   1.171 -       
   1.172 -       0x00 ;; (item-hack) no-op
   1.173 -       0xF3 ;; disable interrupts
   1.174 -       ;; Input Section
   1.175 -
   1.176 -       0x3E ;; load 0x20 into A, to measure buttons
   1.177 -       0x10 
   1.178 -
   1.179 -       0x00 ;; (item-hack) no-op
   1.180 -       0xE0 ;; load A into [FF00]
   1.181 -       0x00
   1.182 -
   1.183 -       0xF0 ;; load 0xFF00 into A to get
   1.184 -       0x00 ;; button presses
   1.185 -       
   1.186 -       0xE6
   1.187 -       0x0F ;; select bottom four bits of A
   1.188 -       0x37 ;; (item-hack) set carry flag no-op
   1.189 -
   1.190 -       0x00 ;; (item-hack) no-op
   1.191 -       0xB8 ;; see if input is different (CP A B)
   1.192 -
   1.193 -       0x00 ;; (item-hack) (INC SP)
   1.194 -       0x28 ;; repeat above steps if input is not different
   1.195 -       ;; (jump relative backwards if B != A)
   1.196 -       0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
   1.197 -
   1.198 -       0x47 ;; load A into B
   1.199 -       
   1.200 -       0x0D ;; dec C
   1.201 -       0x37 ;; (item-hack) set-carry flag
   1.202 -       ;; branch based on C:
   1.203 -       0x20 ;; JR NZ
   1.204 -       23 ;; skip "input second nybble" and "jump to target" below
   1.205 -       
   1.206 -       ;; input second nybble
   1.207 -
   1.208 -       0x0C ;; inc C
   1.209 -       0x0C ;; inc C
   1.210 -
   1.211 -       0x00 ;; (item-hack) no-op
   1.212 -       0xE6 ;; select bottom bits
   1.213 -       0x0F
   1.214 -       0x37 ;; (item-hack) set-carry flag no-op
   1.215 -
   1.216 -       0x00 ;; (item-hack) no-op
   1.217 -       0xB2 ;; (OR A D) -> A
   1.218 -
   1.219 -       0x22 ;; (do (A -> (HL)) (INC HL))
   1.220 -
   1.221 -       0x1D ;; (DEC E)
   1.222 -
   1.223 -       0x00 ;; (item-hack) 
   1.224 -       0x20 ;; jump back to input section if not done
   1.225 -       0xDA ;; literal -36 == TM 18 (counter)
   1.226 -       0x01 ;; (item-hack) set BC to literal (no-op)
   1.227 -
   1.228 -       ;; jump to target
   1.229 -       0x00  ;; (item-hack) these two bytes can be anything.
   1.230 -       0x01 
   1.231 -
   1.232 -       0x00   ;; (item-hack) no-op
   1.233 -       0xBF   ;; (CP A A) ensures Z
   1.234 -       
   1.235 -       0xCA   ;; (item-hack) jump if Z
   1.236 -       target-low
   1.237 -       target-high
   1.238 -       0x01   ;; (item-hack) will never be reached.
   1.239 -       
   1.240 -       ;; input first nybble
   1.241 -       0x00
   1.242 -       0xCB
   1.243 -       0x37  ;; swap nybbles on A
   1.244 -
   1.245 -       0x57  ;; A -> D
   1.246 -
   1.247 -       0x37  ;; (item-hack) set carry flag no-op
   1.248 -       0x18  ;; relative jump backwards
   1.249 -       0xCD  ;; literal -51 == TM05; go back to input section
   1.250 -       0x01  ;; (item-hack) will never reach this instruction
   1.251 -
   1.252 -       ]
   1.253 -      (repeat 8 [0xFF 0x01])
   1.254 -
   1.255 -      [;; jump to actual program
   1.256 -       0x00
   1.257 -       0x37  ;; (item-hack) set carry flag no-op
   1.258 -
   1.259 -       0x2E  ;; 0x3A -> L
   1.260 -       0x3A
   1.261 -
   1.262 -
   1.263 -       0x00  ;; (item-hack) no-op
   1.264 -       0x26  ;; 0xD5 -> L
   1.265 -       0xD5  
   1.266 -       0x01  ;; (item-hack) set-carry BC
   1.267 -
   1.268 -       0x00  ;; (item-hack) these can be anything
   1.269 -       0x00  
   1.270 -
   1.271 -       ;; 0x00
   1.272 -       ;; 0x44 ;; H -> B
   1.273 -
   1.274 -       ;; 0x00
   1.275 -       ;; 0x7D ;; L -> A
   1.276 -       
   1.277 -       ;; 0x00
   1.278 -       ;; 0x7C ;; A -> H
   1.279 -
   1.280 -       ;; 0x00
   1.281 -       ;; 0x68 ;; B -> L
   1.282 -       
   1.283 -       0x00
   1.284 -       0xE9 ;; jump to (HL)
   1.285 -       ]])))
   1.286 -
   1.287 -
   1.288 -(defn test-pc-item-writer []
   1.289 -    (-> (read-state "bootstrap-init")
   1.290 -      (set-memory pc-item-list-start 50)
   1.291 -      (set-memory-range
   1.292 -       map-function-address-start
   1.293 -       [0x8B 0xD5])
   1.294 -      (set-memory-range
   1.295 -       (inc pc-item-list-start)
   1.296 -       (pc-item-writer-program))))
   1.297 -
   1.298 -(defn test-pc-item-writer-2 []
   1.299 -  (let [orig (read-state "pc-item-writer")]
   1.300 -    (-> orig
   1.301 -    (print-listing 0xD162 (+ 0xD162 20))
   1.302 -    (run-moves (reduce concat
   1.303 -                (repeat 10 [[:a :b :start :select] []])))
   1.304 -    ((fn [_] (println "===========") _))
   1.305 -    (print-listing 0xD162 (+ 0xD162 20)))))