1.1 --- a/clojure/com/aurellem/gb/hxc.clj	Mon Mar 26 21:00:23 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/hxc.clj	Mon Mar 26 21:25:10 2012 -0500
     1.3 @@ -382,6 +382,21 @@
     1.4    
     1.5  
     1.6  
     1.7 +;; nidoran gender change upon levelup
     1.8 +;; (->
     1.9 +;;  @current-state
    1.10 +;;  rom
    1.11 +;;  vec
    1.12 +;;  (rewrite-memory
    1.13 +;;   (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
    1.14 +;;   [1 1 15])
    1.15 +;;  (rewrite-memory
    1.16 +;;   (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
    1.17 +;;   [1 1 3])
    1.18 +;;  (write-rom!)
    1.19 +
    1.20 +;;  )
    1.21 +
    1.22  
    1.23  
    1.24  
    1.25 @@ -399,95 +414,103 @@
    1.26                               (drop 0x3E62D rom))))))
    1.27  
    1.28  
    1.29 +(defn format-evo
    1.30 +  [coll]
    1.31 +  (let [method (first coll)]
    1.32 +    (cond (empty? coll) []
    1.33 +          (= 0 method) [] ;; just in case
    1.34 +          (= 1 method) ;; level-up evolution
    1.35 +          (conj (format-evo (drop 3 coll))
    1.36 +                            {:method :level-up
    1.37 +                             :min-level (nth coll 1)
    1.38 +                             :into (dec (nth coll 2))})
    1.39 +          
    1.40 +          (= 2 method) ;; item evolution
    1.41 +          (conj (format-evo (drop 4 coll))
    1.42 +                {:method :item
    1.43 +                 :item (dec (nth coll 1))
    1.44 +                 :min-level (nth coll 2)
    1.45 +                 :into (dec (nth coll 3))})
    1.46  
    1.47 +          (= 3 method) ;; trade evolution
    1.48 +          (conj (format-evo (drop 3 coll))
    1.49 +                {:method :trade
    1.50 +                 :min-level (nth coll 1) ;; always 1 for trade.
    1.51 +                 :into (dec (nth coll 2))}))))
    1.52  
    1.53 -(defn format-evo
    1.54 -  [[method x y z & _]]
    1.55 -   (cond (= 0 method)
    1.56 -         {:method :none}
    1.57 -         (= 1 method)
    1.58 -         {:method :level-up
    1.59 -          :min-level x
    1.60 -          :into y}
    1.61 -         (= 2 method)
    1.62 -         {:method :item
    1.63 -          :item-id x
    1.64 -          :min-level y
    1.65 -          :into z}
    1.66 -         (= 3 method)
    1.67 -         {:method :trade
    1.68 -          :min-level x
    1.69 -          :into y}))
    1.70  
    1.71 -(defn format-evo*
    1.72 -  [[method x y z & _]]
    1.73 -  (cond (= 0 method)
    1.74 -        {:method :none}
    1.75 -        (= 1 method)
    1.76 -        {:method :level-up
    1.77 -         :min-level x
    1.78 -         :into (format-name (nth (hxc-pokenames) (dec y)))}
    1.79 -        (= 2 method)
    1.80 -        {:method :item
    1.81 -         :item (format-name (nth (hxc-items)  (dec x)))
    1.82 -         :min-level y
    1.83 -         :into (format-name (nth (hxc-pokenames) (dec z)))}
    1.84 -        (= 3 method)
    1.85 -        {:method :trade
    1.86 -         :min-level x
    1.87 -         :into (format-name (nth (hxc-pokenames) (dec y)))}))
    1.88 -
    1.89 -(defn hxc-evolution
    1.90 -  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
    1.91 +(defn hxc-ptrs-evolve
    1.92 +  "A hardcoded collection of 190 pointers to evolution/learnset data,
    1.93 +in internal order."
    1.94 +  ([]
    1.95 +     (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
    1.96    ([rom]
    1.97       (let [names (hxc-pokenames rom)
    1.98             pkmn-count (count names)
    1.99 -           evo-data (drop 0x33fef rom) 
   1.100             ptrs
   1.101 -           (map (fn [[a b]](low-high a b))
   1.102 +           (map (fn [[a b]] (low-high a b))
   1.103                  (partition 2
   1.104                             (take (* 2 pkmn-count)
   1.105 -                                 (drop 0x3b1e5 rom))))
   1.106 -           ]
   1.107 +                                 (drop 0x3b1e5 rom))))]
   1.108 +       (map (partial + 0x34000) ptrs)
   1.109 +
   1.110 +       )))
   1.111 +
   1.112 +(defn hxc-evolution
   1.113 +  "Hardcoded evolution data in memory. The data exists at ROM@34000,
   1.114 +  sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
   1.115 +  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
   1.116 +  ([rom]
   1.117         (apply assoc {}
   1.118                 (interleave
   1.119                  (map format-name (hxc-pokenames))
   1.120                  (map
   1.121                   (comp
   1.122                    format-evo
   1.123 -                  (partial take 5)
   1.124 -                  #(drop % rom)
   1.125 -                  (partial + 0x34000))
   1.126 -                 ptrs)))
   1.127 +                  (partial take-while (comp not zero?))
   1.128 +                  #(drop % rom))
   1.129 +                 (hxc-ptrs-evolve rom)
   1.130 +                 )))))
   1.131  
   1.132 -       )))
   1.133 +(defn hxc-evolution-pretty
   1.134 +  "Like hxc-evolution, except it uses the names of items and pokemon
   1.135 +--- grabbed from ROM --- rather than their numerical identifiers."
   1.136 +  ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
   1.137 +  ([rom]
   1.138 +     (let
   1.139 +         [poke-names (vec (map format-name (hxc-pokenames rom)))
   1.140 +          item-names (vec (map format-name (hxc-items rom)))
   1.141 +          use-names
   1.142 +          (fn [m]
   1.143 +            (loop [ks (keys m) new-map m]
   1.144 +              (let [k (first ks)]
   1.145 +                (cond (nil? ks) new-map
   1.146 +                      (= k :into)
   1.147 +                      (recur
   1.148 +                       (next ks)
   1.149 +                       (assoc new-map
   1.150 +                         :into
   1.151 +                         (poke-names
   1.152 +                          (:into
   1.153 +                           new-map))))
   1.154 +                      (= k :item)
   1.155 +                      (recur
   1.156 +                       (next ks)
   1.157 +                       (assoc new-map
   1.158 +                         :item
   1.159 +                         (item-names
   1.160 +                          (:item new-map))))
   1.161 +                      :else
   1.162 +                      (recur
   1.163 +                       (next ks)
   1.164 +                       new-map)
   1.165 +                      ))))]
   1.166  
   1.167 -
   1.168 -(defn hxc-evolution*
   1.169 -  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
   1.170 -  ([rom]
   1.171 -     (let [names (hxc-pokenames rom)
   1.172 -           pkmn-count (count names)
   1.173 -           evo-data (drop 0x33fef rom) 
   1.174 -           ptrs
   1.175 -           (map (fn [[a b]](low-high a b))
   1.176 -                (partition 2
   1.177 -                           (take (* 2 pkmn-count)
   1.178 -                                 (drop 0x3b1e5 rom))))
   1.179 -           ]
   1.180 -       (apply assoc {}
   1.181 -               (interleave
   1.182 -                (map format-name (hxc-pokenames))
   1.183 -                (map
   1.184 -                 (comp
   1.185 -                  format-evo*
   1.186 -                  (partial take 5)
   1.187 -                  #(drop % rom)
   1.188 -                  (partial + 0x34000))
   1.189 -                 ptrs)))
   1.190 -
   1.191 -       )))
   1.192 -
   1.193 +       (into {}
   1.194 +             (map (fn [[pkmn evo-coll]]
   1.195 +                    [pkmn (map use-names evo-coll)])
   1.196 +                  (hxc-evolution rom))))))
   1.197 +       
   1.198  
   1.199  
   1.200  
   1.201 @@ -535,12 +558,6 @@
   1.202       (filter-vals (partial submap? attribute-map)
   1.203                    (hxc-move-data rom))))
   1.204  
   1.205 -  
   1.206 -
   1.207 -
   1.208 -
   1.209 -
   1.210 -
   1.211  
   1.212  
   1.213