Mercurial > vba-clojure

     1 (ns com.aurellem.gb.pokemon

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

     3                          moves types items status dv species

     4                          experience

     5                          ))

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

     7 

     8 (def pokemon-names-start 0xD2B4)

     9 

    10 (defn set-party-number

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

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

    13   ([new-party-num]

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

    15 

    16 (def party-number-address 0xD162)

    17 

    18 (defn party-number

    19   ([^SaveState state]

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

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

    22 

    23 (defn party-names

    24   ([^SaveState state]

    25      (let [raw-names

    26            (subvec (vec (memory state))

    27                    pokemon-names-start

    28                    (+ pokemon-names-start

    29                       (* name-width 6)))]

    30        (map

    31         read-name

    32         (take

    33          (party-number state)

    34           (partition name-width

    35                    raw-names)))))

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

    37 

    38 (defn pokemon-nickname

    39   ([^SaveState state poke-num]

    40      (nth (party-names state) poke-num))

    41   ([poke-num]

    42      (pokemon-nickname @current-state poke-num)))

    43 

    44 (defn rename-pokemon

    45   ([^SaveState state n new-name]

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

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

    48      (set-memory-range

    49       state

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

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

    52   ([n new-name]

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

    54 

    55 (def OT-start 0xD272)

    56 

    57 (defn original-trainers

    58   ([^SaveState state]

    59      (let [raw-names

    60            (subvec (vec (memory state))

    61                    OT-start

    62                    (+ OT-start

    63                       (* name-width 6)))]

    64        (map read-name

    65             (take (party-number state)

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

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

    68 

    69 (defn set-original-trainer

    70   "Set the OT name for a pokemon.

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

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

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

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

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

    76      (set-memory-range

    77       state

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

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

    80   ([n new-name]

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

    82 

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

    84 

    85 (defn set-pokemon-id

    86   ([^SaveState state n new-id]

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

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

    89      (set-memory-range 

    90       state

    91       (OT-ID-addresses n)

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

    93        (bit-and new-id 0xFF)

    94        ]))

    95   ([n new-id]

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

    97 

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

    99 

   100 (def unknown "")

   101 

   102 (def pokemon-1-record

   103   {0xD16A "Color Map"            ;; 0

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

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

   106    0XD16D "Unused"               ;; 3

   107    0xD16E "Status"               ;; 4

   108    0xD16F "Type 1"               ;; 5

   109    0xD170 "Type 2"               ;; 6

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

   111    0xD172 "Move 1 ID"            ;; 8

   112    0xD173 "Move 2 ID"            ;; 9

   113    0xD174 "Move 3 ID"            ;; 10

   114    0xD175 "Move 4 ID"            ;; 11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   132    0xD187 "PP Move 1"            ;; 29

   133    0xD188 "PP Move 2"            ;; 30

   134    0xD189 "PP Move 3"            ;; 31

   135    0xD18A "PP Move 4"            ;; 32

   136    0xD18B "Current Level"        ;; 33

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

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

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

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

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

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

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

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

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

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

   147    })

   148 

   149 (defn pokemon-record

   150   ([^SaveState state pokemon-num]

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

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

   153        (subvec (vec (memory state)) base

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

   155   ([pokemon-num] (pokemon-record @current-state pokemon-num)))

   156 

   157 (defn set-pokemon-record

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

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

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

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

   162   ([pokemon-num new-data]

   163      (set-pokemon-record @current-state pokemon-num new-data)))

   164 

   165 (defn print-pokemon-record

   166   ([^SaveState state pokemon-num]

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

   168      (let [poke-data (pokemon-record state pokemon-num)

   169            backbone (sort (keys pokemon-1-record))]

   170        (println "Pokemon " pokemon-num  " -- "

   171                 (nth (party-names state)

   172                      pokemon-num) \newline)

   173 

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

   175        (println "-------------------+------+-----+----------+")

   176        (dorun

   177         (map

   178          (comp println

   179                (fn [desc data]

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

   181                          desc data data

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

   183                            (apply

   184                             str 

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

   186                                     s))))))

   187          (map pokemon-1-record backbone)

   188          poke-data))))

   189   ([pokemon-num]

   190      (print-pokemon-record @current-state pokemon-num)))

   191 

   192 (def mint-berry-item-code-gsc 0x54)

   193 

   194 (defn pokemon-info

   195   ([^SaveState state poke-num]

   196      (assert (<= 0 poke-num 5))

   197      (let [dv-values (read-DV state poke-num)

   198            type (read-type state poke-num)

   199            species (read-species state poke-num)

   200            species2 (read-species2 state poke-num)

   201            moves (read-moves state poke-num)

   202            moves-pp (mapv (partial read-pp state

   203                                    poke-num)

   204                           (range (count moves)))

   205            nickname (pokemon-nickname state poke-num)

   206            status (read-status state poke-num)

   207            experience (read-experience state poke-num)

   208            ]

   209 

   210        {:name nickname

   211         :species species

   212         :species2 species2

   213         :type type

   214         :dv dv-values

   215         :moves (zipmap moves moves-pp)

   216 

   217         :satus status

   218         :experience experience

   219         }

   220        ))

   221   ([poke-num]

   222      (pokemon-info @current-state poke-num)))

   223
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 22 Mar 2012 20:10:09 -0500
parents	9a7a46c4aa1b
children	fd549c8f42ae