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 

     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 rename-pokemon

    39   ([^SaveState state n new-name]

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

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

    42      (set-memory-range

    43       state

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

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

    46   ([n new-name]

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

    48 

    49 (def OT-start 0xD272)

    50 

    51 (defn original-trainers

    52   ([^SaveState state]

    53      (let [raw-names

    54            (subvec (vec (memory state))

    55                    OT-start

    56                    (+ OT-start

    57                       (* name-width 6)))]

    58        (map read-name

    59             (take (party-number state)

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

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

    62 

    63 (defn set-original-trainer

    64   "Set the OT name for a pokemon.

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

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

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

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

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

    70      (set-memory-range

    71       state

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

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

    74   ([n new-name]

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

    76 

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

    78 

    79 (defn set-pokemon-id

    80   ([^SaveState state n new-id]

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

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

    83      (set-memory-range 

    84       state

    85       (OT-ID-addresses n)

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

    87        (bit-and new-id 0xFF)

    88        ]))

    89   ([n new-id]

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

    91 

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

    93 

    94 (def unknown "")

    95 

    96 (def pokemon-1-record

    97   {0xD16A "Color Map"            ;; 0

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

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

   100    0XD16D "Unused"               ;; 3

   101    0xD16E "Status"               ;; 4

   102    0xD16F "Type 1"               ;; 5

   103    0xD170 "Type 2"               ;; 6

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

   105    0xD172 "Move 1 ID"            ;; 8

   106    0xD173 "Move 2 ID"            ;; 9

   107    0xD174 "Move 3 ID"            ;; 10

   108    0xD175 "Move 4 ID"            ;; 11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   126    0xD187 "PP Move 1"            ;; 29

   127    0xD188 "PP Move 2"            ;; 30

   128    0xD189 "PP Move 3"            ;; 31

   129    0xD18A "PP Move 4"            ;; 32

   130    0xD18B "Current Level"        ;; 33

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

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

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

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

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

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

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

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

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

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

   141    })

   142 

   143 (defn pokemon-record

   144   ([^SaveState state pokemon-num]

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

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

   147        (subvec (vec (memory state)) base

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

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

   150 

   151 (defn set-pokemon-record

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

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

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

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

   156   ([pokemon-num new-data]

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

   158 

   159 (defn print-pokemon-record

   160   ([^SaveState state pokemon-num]

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

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

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

   164        (println "Pokemon " pokemon-num  " -- "

   165                 (nth (party-names state)

   166                      pokemon-num) \newline)

   167 

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

   169        (println "-------------------+------+-----+----------+")

   170        (dorun

   171         (map

   172          (comp println

   173                (fn [desc data]

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

   175                          desc data data

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

   177                            (apply

   178                             str 

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

   180                                     s))))))

   181          (map pokemon-1-record backbone)

   182          poke-data))))

   183   ([pokemon-num]

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

   185 

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

   187 

   188 (defn pokemon-info [^SaveState state poke-num]

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

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

   191         type (read-type state poke-num)

   192         species (read-species state poke-num)

   193         

   194         ]

   195 

   196        

   197 

   198 

   199     ))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 22 Mar 2012 16:34:10 -0500
parents	d954835b24a4
children	893c753f8088