1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/gb/pokemon.clj	Wed Mar 21 22:13:43 2012 -0500
     1.3 @@ -0,0 +1,178 @@
     1.4 +(ns com.aurellem.gb.pokemon
     1.5 +  (:use (com.aurellem.gb gb-driver util constants characters))
     1.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     1.7 +
     1.8 +(def pokemon-names-start 0xD2B4)
     1.9 +
    1.10 +(defn change-party-number [^SaveState state new-num]
    1.11 +  (set-memory state 0xD162 new-num))
    1.12 +
    1.13 +(def party-number-address 0xD162)
    1.14 +
    1.15 +(defn party-number
    1.16 +  ([^SaveState state]
    1.17 +     (aget (memory state) party-number-address))
    1.18 +  ([] (party-number @current-state)))
    1.19 +
    1.20 +(defn party-names
    1.21 +  ([^SaveState state]
    1.22 +     (let [raw-names
    1.23 +           (subvec (vec (memory state))
    1.24 +                   pokemon-names-start
    1.25 +                   (+ pokemon-names-start
    1.26 +                      (* name-width 6)))]
    1.27 +       (map
    1.28 +        read-name
    1.29 +        (take
    1.30 +         (party-number state)
    1.31 +          (partition name-width
    1.32 +                   raw-names)))))
    1.33 +  ([] (party-names @current-state)))
    1.34 +
    1.35 +(defn rename-pokemon
    1.36 +  ([^SaveState state n new-name]
    1.37 +     (assert (<= 0 n (dec (party-number state))))
    1.38 +     (assert (<= (count new-name) max-name-length))
    1.39 +     (set-memory-range
    1.40 +      state
    1.41 +      (+ (* n name-width) pokemon-names-start)
    1.42 +      (concat (str->character-codes new-name) [end-of-name-marker])))
    1.43 +  ([n new-name]
    1.44 +     (rename-pokemon @current-state n new-name)))
    1.45 +
    1.46 +(def OT-start 0xD272)
    1.47 +
    1.48 +(defn original-trainers
    1.49 +  ([^SaveState state]
    1.50 +     (let [raw-names
    1.51 +           (subvec (vec (memory state))
    1.52 +                   OT-start
    1.53 +                   (+ OT-start
    1.54 +                      (* name-width 6)))]
    1.55 +       (map read-name
    1.56 +            (take (party-number state)
    1.57 +                  (partition name-width raw-names)))))
    1.58 +  ([] (original-trainers @current-state)))
    1.59 +
    1.60 +(defn set-original-trainer
    1.61 +  "Set the OT name for a pokemon.
    1.62 +   Note that a pokemon is still considered 'yours' if
    1.63 +   the OT ID is the same as your own."
    1.64 +  ([^SaveState state poke-num new-name]
    1.65 +     (assert (<= 0 poke-num (dec (party-number state))))
    1.66 +     (assert (<= (count new-name) max-name-length))
    1.67 +     (set-memory-range
    1.68 +      state
    1.69 +      (+ (* poke-num name-width) OT-start)
    1.70 +      (concat (str->character-codes new-name) [end-of-name-marker])))
    1.71 +  ([n new-name]
    1.72 +     (set-original-trainer @current-state n new-name)))
    1.73 +
    1.74 +(def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD228 0xD252])
    1.75 +
    1.76 +(defn set-pokemon-id
    1.77 +  ([^SaveState state n new-id]
    1.78 +     (assert (<= 0 n (dec (party-number state))))
    1.79 +     (assert (<= 0 new-id 0xFFFF))
    1.80 +     (set-memory-range 
    1.81 +      state
    1.82 +      (OT-ID-addresses n)
    1.83 +      [(bit-shift-right (bit-and new-id 0xFF00) 8)
    1.84 +       (bit-and new-id 0xFF)
    1.85 +       ]))
    1.86 +  ([n new-id]
    1.87 +     (set-pokemon-id @current-state n new-id)))
    1.88 +
    1.89 +(def unknown "[[[UNKNOWN]]]")
    1.90 +
    1.91 +(def unknown "")
    1.92 +
    1.93 +(def pokemon-1-info
    1.94 +  {0xD16A "Color Map"            ;; 0
    1.95 +   0xD16B "Current-HP (h)"       ;; 1
    1.96 +   0xD16C "Current-HP (l)"       ;; 2
    1.97 +   0XD16D unknown                ;; 3
    1.98 +   0xD16E unknown                ;; 4
    1.99 +   0xD16F unknown                ;; 5
   1.100 +   0xD170 unknown                ;; 6
   1.101 +   0xD171 unknown                ;; 7
   1.102 +   0xD172 "Move 1 ID"            ;; 8
   1.103 +   0xD173 "Move 2 ID"            ;; 9
   1.104 +   0xD174 "Move 3 ID"            ;; 10
   1.105 +   0xD175 "Move 4 ID"            ;; 11
   1.106 +   0xD176 "OT-ID (h)"            ;; 12
   1.107 +   0xD177 "OT-ID (l)"            ;; 13
   1.108 +   0xD178 "Exp. Points (h)"      ;; 14
   1.109 +   0xD179 "Exp. Points (m)"      ;; 15
   1.110 +   0xD17A "Exp. Points (l)"      ;; 16
   1.111 +   0xD17B "HP Exp. (h)"          ;; 17
   1.112 +   0xD17C "HP Exp. (l)"          ;; 18
   1.113 +   0xD17D "Attack Exp. (h)"      ;; 19
   1.114 +   0xD17E "Attack Exp. (l)"      ;; 20
   1.115 +   0xD17F "Defense Exp. (h)"     ;; 21
   1.116 +   0xD180 "Defense Exp. (l)"     ;; 22
   1.117 +   0xD181 "Speed Exp. (h)"       ;; 23
   1.118 +   0xD182 "Speed Exp. (l)"       ;; 24
   1.119 +   0xD183 "Special Exp. (h)"     ;; 25
   1.120 +   0xD184 "Special Exp. (l)"     ;; 26
   1.121 +   0xD185 "DV Atk/Def"           ;; 27
   1.122 +   0xD186 "DV Speed/Spc"         ;; 28
   1.123 +   0xD187 "PP Move 1"            ;; 29
   1.124 +   0xD188 "PP Move 2"            ;; 30
   1.125 +   0xD189 "PP Move 3"            ;; 31
   1.126 +   0xD18A "PP Move 4"            ;; 32
   1.127 +   0xD18B "Current Level"        ;; 33
   1.128 +   0xD18C "HP Total (h)"         ;; 34
   1.129 +   0xD18D "HP Total (l)"         ;; 35
   1.130 +   0xD18E "Attack   (h)"         ;; 36
   1.131 +   0xD18F "Attack   (l)"         ;; 37
   1.132 +   0xD190 "Defense  (h)"         ;; 38
   1.133 +   0xD191 "Defense  (l)"         ;; 39
   1.134 +   0xD192 "Speed    (h)"         ;; 40
   1.135 +   0xD193 "Speed    (l)"         ;; 41
   1.136 +   0xD194 "Special  (h)"         ;; 42
   1.137 +   0xD195 "Special  (l)"         ;; 43
   1.138 +   })
   1.139 +
   1.140 +(defn pokemon-data
   1.141 +  ([^SaveState state pokemon-num]
   1.142 +     (assert (<= 0 pokemon-num 5))
   1.143 +     (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]
   1.144 +       (subvec (vec (memory state)) base
   1.145 +               (+ base pokemon-record-width))))
   1.146 +  ([pokemon-num] (pokemon-data @current-state pokemon-num)))
   1.147 +
   1.148 +(defn set-pokemon-data
   1.149 +  ([^SaveState state pokemon-num new-data]
   1.150 +     (assert (<= 0 pokemon-num 5))
   1.151 +     (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]
   1.152 +       (set-memory-range state base new-data)))
   1.153 +  ([pokemon-num new-data]
   1.154 +     (set-pokemon-data @current-state pokemon-num new-data)))
   1.155 +
   1.156 +(defn print-pokemon-data
   1.157 +  ([^SaveState state pokemon-num]
   1.158 +     (assert (<= 0 pokemon-num 5))
   1.159 +     (let [poke-data (pokemon-data state pokemon-num)
   1.160 +           backbone (sort (keys pokemon-1-info))]
   1.161 +       (println "Pokemon " pokemon-num  " -- "
   1.162 +                (nth (party-names state)
   1.163 +                     pokemon-num) \newline)
   1.164 +
   1.165 +       (println "    Desc.          | Hex  | Dec |  Binary  |")
   1.166 +       (println "-------------------+------+-----+----------+")
   1.167 +       (dorun
   1.168 +        (map
   1.169 +         (comp println
   1.170 +               (fn [desc data]
   1.171 +                 (format "%-16s   | 0x%02X | %3d | %s |"
   1.172 +                         desc data data
   1.173 +                         (let [s (Integer/toBinaryString data)]
   1.174 +                           (apply
   1.175 +                            str 
   1.176 +                            (concat (repeat (- 8 (count s)) "0" )
   1.177 +                                    s))))))
   1.178 +         (map pokemon-1-info backbone)
   1.179 +         poke-data))))
   1.180 +  ([pokemon-num]
   1.181 +     (print-pokemon-data @current-state pokemon-num)))