1.1 --- a/clojure/com/aurellem/gb/hxc.clj	Wed Mar 28 06:06:13 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/hxc.clj	Thu Mar 29 13:31:31 2012 -0500
     1.3 @@ -1,7 +1,7 @@
     1.4  (ns com.aurellem.gb.hxc
     1.5    (:use (com.aurellem.gb assembly characters gb-driver util
     1.6                           constants species))
     1.7 -  (:use (com.aurellem.world practice))
     1.8 + ;; (:use (com.aurellem.world practice))
     1.9    (:import [com.aurellem.gb.gb_driver SaveState]))
    1.10  
    1.11  
    1.12 @@ -11,37 +11,6 @@
    1.13  
    1.14  
    1.15  
    1.16 -(defn low-high
    1.17 -  [low high]
    1.18 -  (+ low (* 256 high)))
    1.19 -  
    1.20 -
    1.21 -(defn format-name
    1.22 -  "Convert the string of alphabetic/space characters into a keyword by
    1.23 -  replacing spaces with hyphens and converting to lowercase."
    1.24 -  [s]
    1.25 -  (if (nil? s) nil
    1.26 -  (keyword (.toLowerCase
    1.27 -            (apply str
    1.28 -                   (map #(if (= % \space) "-" %) s))))))
    1.29 -
    1.30 -
    1.31 -;; used to decode item prices
    1.32 -
    1.33 -(defn decode-bcd
    1.34 -  "Take a sequence of binary-coded digits (in written order) and return the number they represent."
    1.35 -  [digits]
    1.36 -  ((fn self [coll]
    1.37 -     (if (empty? coll) 0
    1.38 -         (+ (first coll) (* 100 (self (rest coll))))))
    1.39 -   (map
    1.40 -    #(+ (* 10 (int (/ % 16)))
    1.41 -        (rem % 16))
    1.42 -    (reverse digits))))
    1.43 -
    1.44 -
    1.45 -  
    1.46 -
    1.47  (def pkmn-types
    1.48    [:normal    ;;0
    1.49     :fighting  ;;1
    1.50 @@ -197,7 +166,50 @@
    1.51  
    1.52  ;; --------------------------------------------------
    1.53  
    1.54 -(def hxc-items
    1.55 +
    1.56 +
    1.57 +(defn hxc-pokenames-raw
    1.58 +  "The hardcoded names of the 190 species in memory. List begins at
    1.59 +ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
    1.60 +  long, these names are stripped of padding. See also, hxc-pokedex-names"
    1.61 +  ([]
    1.62 +     (hxc-pokenames-raw com.aurellem.gb.gb-driver/original-rom))
    1.63 +  ([rom]
    1.64 +     (let [count-species 190
    1.65 +           name-length 10]
    1.66 +       (map character-codes->str
    1.67 +            (partition name-length
    1.68 +                       (map #(if (= 0x50 %) 0x00 %)
    1.69 +                            (take (* count-species name-length)
    1.70 +                                  (drop 0xE8000
    1.71 +                                        rom))))))))
    1.72 +(def hxc-pokenames
    1.73 +  (comp
    1.74 +   (partial map format-name)
    1.75 +   hxc-pokenames-raw))
    1.76 +
    1.77 +
    1.78 +
    1.79 +
    1.80 +(defn hxc-pokedex-names
    1.81 +  "The names of the pokemon in hardcoded pokedex order. List begins at
    1.82 +ROM@410B1. See also, hxc-pokenames."
    1.83 +  ([] (hxc-pokedex-names
    1.84 +       com.aurellem.gb.gb-driver/original-rom))
    1.85 +  ([rom]
    1.86 +     (let [names (hxc-pokenames rom)]
    1.87 +       (#(mapv %
    1.88 +               ((comp range count keys) %))
    1.89 +        (zipmap
    1.90 +         (take (count names)
    1.91 +               (drop 0x410b1 rom))
    1.92 +         
    1.93 +         names)))))
    1.94 +
    1.95 +
    1.96 +
    1.97 +
    1.98 +(def hxc-items-raw
    1.99    "The hardcoded names of the items in memory. List begins at
   1.100  ROM@045B7"
   1.101    (hxc-thunk-words 0x45B7 870))
   1.102 @@ -213,11 +225,18 @@
   1.103    (hxc-thunk-words 0x27E77 196))
   1.104  
   1.105  
   1.106 -(def hxc-pokedex-text*
   1.107 +(def hxc-pokedex-text-raw
   1.108    "The hardcoded pokedex entries in memory. List begins at
   1.109  ROM@B8000, shortly before move names."
   1.110    (hxc-thunk-words 0xB8000 14754))
   1.111  
   1.112 +
   1.113 +
   1.114 +(def hxc-items
   1.115 +  "The hardcoded names of the items in memory, presented as
   1.116 +  keywords. List begins at ROM@045B7. See also, hxc-items-raw."
   1.117 +  (comp (partial map format-name) hxc-items-raw))
   1.118 +
   1.119  (defn hxc-pokedex-text
   1.120    "The hardcoded pokedex entries in memory, presented as an
   1.121  associative hash map. List begins at ROM@B8000."
   1.122 @@ -226,7 +245,7 @@
   1.123       (zipmap
   1.124        (hxc-pokedex-names rom)
   1.125        (cons nil ;; for missingno.
   1.126 -            (hxc-pokedex-text* rom)))))
   1.127 +            (hxc-pokedex-text-raw rom)))))
   1.128  
   1.129  ;; In red/blue, pokedex stats are in internal order.
   1.130  ;; In yellow, pokedex stats are in pokedex order.
   1.131 @@ -234,13 +253,10 @@
   1.132  (defn hxc-pokedex-stats
   1.133    "The hardcoded pokedex stats (species height weight) in memory. List
   1.134  begins at ROM@40687"
   1.135 -  ;; uses hxc-pokedex-text to count pokemon
   1.136 -  ;; since hxc-pokenames includes several missingno"
   1.137    ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
   1.138    ([rom]
   1.139 -     (let [poketext (hxc-pokedex-text rom)
   1.140 -           pkmn-count (count poketext)
   1.141 -           pokedex-names (zipmap (range) (hxc-pokedex-names rom))
   1.142 +     (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))
   1.143 +           pkmn-count (count pokedex-names)
   1.144             ]
   1.145       ((fn capture-stats
   1.146          [n stats data]
   1.147 @@ -399,46 +415,13 @@
   1.148                dec)
   1.149                   (take 100
   1.150                         (drop 0x1232D rom))))))))
   1.151 -  
   1.152 -(defn hxc-pokenames
   1.153 -  "The hardcoded names of the 190 species in memory. List begins at
   1.154 -ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
   1.155 -  long, these names are stripped of padding. See also, hxc-pokedex-names"
   1.156 -  ([]
   1.157 -     (hxc-pokenames com.aurellem.gb.gb-driver/original-rom))
   1.158 -  ([rom]
   1.159 -     (let [count-species 190
   1.160 -           name-length 10]
   1.161 -       (map character-codes->str
   1.162 -            (partition name-length
   1.163 -                       (map #(if (= 0x50 %) 0x00 %)
   1.164 -                            (take (* count-species name-length)
   1.165 -                                  (drop 0xE8000
   1.166 -                                        rom))))))))
   1.167 -
   1.168 -
   1.169 -
   1.170 -(defn hxc-pokedex-names
   1.171 -  "The names of the pokemon in hardcoded pokedex order. List begins at
   1.172 -ROM@410B1. See also, hxc-pokenames."
   1.173 -  ([] (hxc-pokedex-names
   1.174 -       com.aurellem.gb.gb-driver/original-rom))
   1.175 -  ([rom]
   1.176 -     (let [names (hxc-pokenames rom)]
   1.177 -       (#(mapv %
   1.178 -               ((comp range count keys) %))
   1.179 -        (zipmap
   1.180 -         (take (count names)
   1.181 -               (drop 0x410b1 rom))
   1.182 -         
   1.183 -         (map format-name names))))))
   1.184  
   1.185  
   1.186  
   1.187  (defn internal-id
   1.188    ([rom]
   1.189       (zipmap 
   1.190 -      (map format-name (hxc-pokenames rom))
   1.191 +      (hxc-pokenames rom)
   1.192        (range)))
   1.193    ([]
   1.194       (internal-id com.aurellem.gb.gb-driver/original-rom)))
   1.195 @@ -511,8 +494,8 @@
   1.196    ([]
   1.197       (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
   1.198    ([rom]
   1.199 -     (let [names (hxc-pokenames rom)
   1.200 -           pkmn-count (count names)
   1.201 +     (let [
   1.202 +           pkmn-count (count (hxc-pokenames-raw)) ;; 190
   1.203             ptrs
   1.204             (map (fn [[a b]] (low-high a b))
   1.205                  (partition 2
   1.206 @@ -533,7 +516,7 @@
   1.207       (apply assoc
   1.208              {}
   1.209              (interleave
   1.210 -             (map format-name (hxc-pokenames rom))
   1.211 +             (hxc-pokenames rom)
   1.212               (map (comp
   1.213                     (partial map
   1.214                              (fn [[lvl mv]] [lvl (dec mv)]))
   1.215 @@ -568,7 +551,7 @@
   1.216    ([rom]
   1.217         (apply assoc {}
   1.218                 (interleave
   1.219 -                (map format-name (hxc-pokenames rom))
   1.220 +                (hxc-pokenames rom)
   1.221                  (map
   1.222                   (comp
   1.223                    format-evo
   1.224 @@ -583,8 +566,8 @@
   1.225    ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
   1.226    ([rom]
   1.227       (let
   1.228 -         [poke-names (vec (map format-name (hxc-pokenames rom)))
   1.229 -          item-names (vec (map format-name (hxc-items rom)))
   1.230 +         [poke-names (vec (hxc-pokenames rom))
   1.231 +          item-names (vec (hxc-items rom))
   1.232            use-names
   1.233            (fn [m]
   1.234              (loop [ks (keys m) new-map m]
   1.235 @@ -615,9 +598,6 @@
   1.236               (map (fn [[pkmn evo-coll]]
   1.237                      [pkmn (map use-names evo-coll)])
   1.238                    (hxc-evolution rom))))))
   1.239 -       
   1.240 -
   1.241 -
   1.242  
   1.243  
   1.244  (defn hxc-pokemon-base
   1.245 @@ -635,6 +615,7 @@
   1.246                           (range)
   1.247                           (map format-name
   1.248                                (hxc-move-names rom))))
   1.249 +           machines (hxc-machines)
   1.250             ]
   1.251         (zipmap
   1.252          pokemon
   1.253 @@ -722,7 +703,7 @@
   1.254    "The hardcoded list of item prices in memory. List begins at ROM@4495"
   1.255    ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
   1.256    ([rom]
   1.257 -     (let [items (map format-name (hxc-items rom))
   1.258 +     (let [items (hxc-items rom)
   1.259             price-size 3]
   1.260         (zipmap items
   1.261                 (map (comp
   1.262 @@ -736,7 +717,7 @@
   1.263  (defn hxc-shops
   1.264    ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
   1.265    ([rom]
   1.266 -     (let [items (zipmap (range) (map format-name (hxc-items rom)))
   1.267 +     (let [items (zipmap (range) (hxc-items rom))
   1.268  
   1.269             ;; temporarily softcode the TM items
   1.270             items (into
   1.271 @@ -774,7 +755,7 @@
   1.272  
   1.273  (defn same-type
   1.274    ([pkmn move]
   1.275 -     (same-type?
   1.276 +     (same-type
   1.277        com.aurellem.gb.gb-driver/original-rom pkmn move))
   1.278    ([rom pkmn move]
   1.279       (((comp :types (hxc-pokemon-base rom)) pkmn)

     2.1 --- a/clojure/com/aurellem/gb/util.clj	Wed Mar 28 06:06:13 2012 -0500
     2.2 +++ b/clojure/com/aurellem/gb/util.clj	Thu Mar 29 13:31:31 2012 -0500
     2.3 @@ -29,6 +29,47 @@
     2.4            (Integer/parseInt
     2.5             (Integer/toBinaryString num) 10)))
     2.6  
     2.7 +(defn bit-list
     2.8 +  "List the bits of n in order of decreasing significance."
     2.9 +  [n]
    2.10 +  ((fn this [coll n]
    2.11 +     (if (zero? n) coll
    2.12 +         (recur
    2.13 +          (conj coll (rem n 2))
    2.14 +          (int (/ n 2)))))
    2.15 +   [] n))
    2.16 +
    2.17 +
    2.18 +(defn low-high
    2.19 +  [low high]
    2.20 +  (+ low (* 256 high)))
    2.21 +  
    2.22 +
    2.23 +(defn format-name
    2.24 +  "Convert the string of alphabetic/space characters into a keyword by
    2.25 +  replacing spaces with hyphens and converting to lowercase."
    2.26 +  [s]
    2.27 +  (if (nil? s) nil
    2.28 +      (keyword (.toLowerCase
    2.29 +                (apply str
    2.30 +                       (map #(if (= % \space) "-" %) s))))))
    2.31 +
    2.32 +
    2.33 +;; used to decode item prices
    2.34 +
    2.35 +(defn decode-bcd
    2.36 +  "Take a sequence of binary-coded digits (in written order) and return the number they represent."
    2.37 +  [digits]
    2.38 +  ((fn self [coll]
    2.39 +     (if (empty? coll) 0
    2.40 +         (+ (first coll) (* 100 (self (rest coll))))))
    2.41 +   (map
    2.42 +    #(+ (* 10 (int (/ % 16)))
    2.43 +        (rem % 16))
    2.44 +    (reverse digits))))
    2.45 +
    2.46 +
    2.47 +  
    2.48  
    2.49  (defn view-register [state name reg-fn]
    2.50    (println (format "%s: %s" name