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 change-party-number [^SaveState state new-num]

     8   (set-memory state 0xD162 new-num))

     9 

    10 (def party-number-address 0xD162)

    11 

    12 (defn party-number

    13   ([^SaveState state]

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

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

    16 

    17 (defn party-names

    18   ([^SaveState state]

    19      (let [raw-names

    20            (subvec (vec (memory state))

    21                    pokemon-names-start

    22                    (+ pokemon-names-start

    23                       (* name-width 6)))]

    24        (map

    25         read-name

    26         (take

    27          (party-number state)

    28           (partition name-width

    29                    raw-names)))))

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

    31 

    32 (defn rename-pokemon

    33   ([^SaveState state n new-name]

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

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

    36      (set-memory-range

    37       state

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

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

    40   ([n new-name]

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

    42 

    43 (def OT-start 0xD272)

    44 

    45 (defn original-trainers

    46   ([^SaveState state]

    47      (let [raw-names

    48            (subvec (vec (memory state))

    49                    OT-start

    50                    (+ OT-start

    51                       (* name-width 6)))]

    52        (map read-name

    53             (take (party-number state)

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

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

    56 

    57 (defn set-original-trainer

    58   "Set the OT name for a pokemon.

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

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

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

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

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

    64      (set-memory-range

    65       state

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

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

    68   ([n new-name]

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

    70 

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

    72 

    73 (defn set-pokemon-id

    74   ([^SaveState state n new-id]

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

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

    77      (set-memory-range 

    78       state

    79       (OT-ID-addresses n)

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

    81        (bit-and new-id 0xFF)

    82        ]))

    83   ([n new-id]

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

    85 

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

    87 

    88 (def unknown "")

    89 

    90 (def pokemon-1-info

    91   {0xD16A "Color Map"            ;; 0

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

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

    94    0XD16D unknown                ;; 3

    95    0xD16E "Status"               ;; 4

    96    0xD16F unknown                ;; 5

    97    0xD170 unknown                ;; 6

    98    0xD171 unknown                ;; 7

    99    0xD172 "Move 1 ID"            ;; 8

   100    0xD173 "Move 2 ID"            ;; 9

   101    0xD174 "Move 3 ID"            ;; 10

   102    0xD175 "Move 4 ID"            ;; 11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   120    0xD187 "PP Move 1"            ;; 29

   121    0xD188 "PP Move 2"            ;; 30

   122    0xD189 "PP Move 3"            ;; 31

   123    0xD18A "PP Move 4"            ;; 32

   124    0xD18B "Current Level"        ;; 33

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

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

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

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

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

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

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

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

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

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

   135    })

   136 

   137 (defn pokemon-data

   138   ([^SaveState state pokemon-num]

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

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

   141        (subvec (vec (memory state)) base

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

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

   144 

   145 (defn set-pokemon-data

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

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

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

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

   150   ([pokemon-num new-data]

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

   152 

   153 (defn print-pokemon-data

   154   ([^SaveState state pokemon-num]

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

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

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

   158        (println "Pokemon " pokemon-num  " -- "

   159                 (nth (party-names state)

   160                      pokemon-num) \newline)

   161 

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

   163        (println "-------------------+------+-----+----------+")

   164        (dorun

   165         (map

   166          (comp println

   167                (fn [desc data]

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

   169                          desc data data

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

   171                            (apply

   172                             str 

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

   174                                     s))))))

   175          (map pokemon-1-info backbone)

   176          poke-data))))

   177   ([pokemon-num]

   178      (print-pokemon-data @current-state pokemon-num)))
author	Robert McIntyre <rlm@mit.edu>
date	Wed, 21 Mar 2012 22:17:06 -0500
parents	95b2758dd517
children	d63886d63b2f