Mercurial > vba-clojure

     1 (ns com.aurellem.gb.pokemon

     2   (:use (com.aurellem.gb gb-driver util constants characters))

     3   (:import [com.aurellem.gb.gb_driver SaveState]))

     4 

     5 (def pokemon-names-start 0xD2B4)

     6 

     7 (defn set-party-number

     8   ([^SaveState state new-party-num]

     9      (set-memory state 0xD162 new-party-num))

    10   ([new-party-num]

    11      (set-party-number @current-state new-party-num)))

    12 

    13 (def party-number-address 0xD162)

    14 

    15 (defn party-number

    16   ([^SaveState state]

    17      (aget (memory state) party-number-address))

    18   ([] (party-number @current-state)))

    19 

    20 (defn party-names

    21   ([^SaveState state]

    22      (let [raw-names

    23            (subvec (vec (memory state))

    24                    pokemon-names-start

    25                    (+ pokemon-names-start

    26                       (* name-width 6)))]

    27        (map

    28         read-name

    29         (take

    30          (party-number state)

    31           (partition name-width

    32                    raw-names)))))

    33   ([] (party-names @current-state)))

    34 

    35 (defn rename-pokemon

    36   ([^SaveState state n new-name]

    37      (assert (<= 0 n (dec (party-number state))))

    38      (assert (<= (count new-name) max-name-length))

    39      (set-memory-range

    40       state

    41       (+ (* n name-width) pokemon-names-start)

    42       (concat (str->character-codes new-name) [end-of-name-marker])))

    43   ([n new-name]

    44      (rename-pokemon @current-state n new-name)))

    45 

    46 (def OT-start 0xD272)

    47 

    48 (defn original-trainers

    49   ([^SaveState state]

    50      (let [raw-names

    51            (subvec (vec (memory state))

    52                    OT-start

    53                    (+ OT-start

    54                       (* name-width 6)))]

    55        (map read-name

    56             (take (party-number state)

    57                   (partition name-width raw-names)))))

    58   ([] (original-trainers @current-state)))

    59 

    60 (defn set-original-trainer

    61   "Set the OT name for a pokemon.

    62    Note that a pokemon is still considered 'yours' if

    63    the OT ID is the same as your own."

    64   ([^SaveState state poke-num new-name]

    65      (assert (<= 0 poke-num (dec (party-number state))))

    66      (assert (<= (count new-name) max-name-length))

    67      (set-memory-range

    68       state

    69       (+ (* poke-num name-width) OT-start)

    70       (concat (str->character-codes new-name) [end-of-name-marker])))

    71   ([n new-name]

    72      (set-original-trainer @current-state n new-name)))

    73 

    74 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD228 0xD252])

    75 

    76 (defn set-pokemon-id

    77   ([^SaveState state n new-id]

    78      (assert (<= 0 n (dec (party-number state))))

    79      (assert (<= 0 new-id 0xFFFF))

    80      (set-memory-range 

    81       state

    82       (OT-ID-addresses n)

    83       [(bit-shift-right (bit-and new-id 0xFF00) 8)

    84        (bit-and new-id 0xFF)

    85        ]))

    86   ([n new-id]

    87      (set-pokemon-id @current-state n new-id)))

    88 

    89 (def unknown "[[[UNKNOWN]]]")

    90 

    91 (def unknown "")

    92 

    93 (def pokemon-1-info

    94   {0xD16A "Color Map"            ;; 0

    95    0xD16B "Current-HP (h)"       ;; 1

    96    0xD16C "Current-HP (l)"       ;; 2

    97    0XD16D "Unused"               ;; 3

    98    0xD16E "Status"               ;; 4

    99    0xD16F "Type 1"               ;; 5

   100    0xD170 "Type 2"               ;; 6

   101    0xD171 "scratch/C.R."         ;; 7

   102    0xD172 "Move 1 ID"            ;; 8

   103    0xD173 "Move 2 ID"            ;; 9

   104    0xD174 "Move 3 ID"            ;; 10

   105    0xD175 "Move 4 ID"            ;; 11

   106    0xD176 "OT-ID (h)"            ;; 12

   107    0xD177 "OT-ID (l)"            ;; 13

   108    0xD178 "Exp. Points (h)"      ;; 14

   109    0xD179 "Exp. Points (m)"      ;; 15

   110    0xD17A "Exp. Points (l)"      ;; 16

   111    0xD17B "HP Exp. (h)"          ;; 17

   112    0xD17C "HP Exp. (l)"          ;; 18

   113    0xD17D "Attack Exp. (h)"      ;; 19

   114    0xD17E "Attack Exp. (l)"      ;; 20

   115    0xD17F "Defense Exp. (h)"     ;; 21

   116    0xD180 "Defense Exp. (l)"     ;; 22

   117    0xD181 "Speed Exp. (h)"       ;; 23

   118    0xD182 "Speed Exp. (l)"       ;; 24

   119    0xD183 "Special Exp. (h)"     ;; 25

   120    0xD184 "Special Exp. (l)"     ;; 26

   121    0xD185 "DV Atk/Def"           ;; 27

   122    0xD186 "DV Speed/Spc"         ;; 28

   123    0xD187 "PP Move 1"            ;; 29

   124    0xD188 "PP Move 2"            ;; 30

   125    0xD189 "PP Move 3"            ;; 31

   126    0xD18A "PP Move 4"            ;; 32

   127    0xD18B "Current Level"        ;; 33

   128    0xD18C "HP Total (h)"         ;; 34

   129    0xD18D "HP Total (l)"         ;; 35

   130    0xD18E "Attack   (h)"         ;; 36

   131    0xD18F "Attack   (l)"         ;; 37

   132    0xD190 "Defense  (h)"         ;; 38

   133    0xD191 "Defense  (l)"         ;; 39

   134    0xD192 "Speed    (h)"         ;; 40

   135    0xD193 "Speed    (l)"         ;; 41

   136    0xD194 "Special  (h)"         ;; 42

   137    0xD195 "Special  (l)"         ;; 43

   138    })

   139 

   140 (defn pokemon-data

   141   ([^SaveState state pokemon-num]

   142      (assert (<= 0 pokemon-num 5))

   143      (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]

   144        (subvec (vec (memory state)) base

   145                (+ base pokemon-record-width))))

   146   ([pokemon-num] (pokemon-data @current-state pokemon-num)))

   147 

   148 (defn set-pokemon-data

   149   ([^SaveState state pokemon-num new-data]

   150      (assert (<= 0 pokemon-num 5))

   151      (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]

   152        (set-memory-range state base new-data)))

   153   ([pokemon-num new-data]

   154      (set-pokemon-data @current-state pokemon-num new-data)))

   155 

   156 (defn print-pokemon-data

   157   ([^SaveState state pokemon-num]

   158      (assert (<= 0 pokemon-num 5))

   159      (let [poke-data (pokemon-data state pokemon-num)

   160            backbone (sort (keys pokemon-1-info))]

   161        (println "Pokemon " pokemon-num  " -- "

   162                 (nth (party-names state)

   163                      pokemon-num) \newline)

   164 

   165        (println "    Desc.          | Hex  | Dec |  Binary  |")

   166        (println "-------------------+------+-----+----------+")

   167        (dorun

   168         (map

   169          (comp println

   170                (fn [desc data]

   171                  (format "%-16s   | 0x%02X | %3d | %s |"

   172                          desc data data

   173                          (let [s (Integer/toBinaryString data)]

   174                            (apply

   175                             str 

   176                             (concat (repeat (- 8 (count s)) "0" )

   177                                     s))))))

   178          (map pokemon-1-info backbone)

   179          poke-data))))

   180   ([pokemon-num]

   181      (print-pokemon-data @current-state pokemon-num)))
author	Dylan Holmes <ocsenave@gmail.com>
date	Thu, 22 Mar 2012 07:02:50 -0500
parents	d63886d63b2f
children	d954835b24a4