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 stats

     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 read-OT-name

    70   ([^SaveState state poke-num]

    71      (nth (original-trainers state) poke-num))

    72   ([poke-num] (read-OT @current-state poke-num)))

    73 

    74 (defn set-OT-name

    75   "Set the OT name for a pokemon.

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

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

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

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

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

    81      (set-memory-range

    82       state

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

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

    85   ([n new-name]

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

    87 

    88 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD226 0xD252])

    89 

    90 (defn read-OT-id

    91   ([^SaveState state poke-num]

    92      (let [mem (memory state)

    93            start (OT-ID-addresses poke-num)]

    94      (glue-bytes

    95       (aget mem start)

    96       (aget mem (inc start)))))

    97   ([poke-num] (read-OT-id @current-state poke-num)))

    98 

    99 (defn set-OT-id

   100   ([^SaveState state poke-num new-OT-num]

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

   102      (assert (<= 0 new-OT-num 0xFFFF))

   103      (set-memory-range 

   104       state

   105       (OT-ID-addresses poke-num)

   106       (disect-bytes-2 new-OT-num)))

   107   ([poke-num new-OT-num]

   108      (set-pokemon-id @current-state poke-num new-OT-num)))

   109 

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

   111 

   112 (def unknown "")

   113 

   114 (def pokemon-1-record

   115   {0xD16A "Color Map"            ;; 0

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

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

   118    0XD16D "Unused"               ;; 3

   119    0xD16E "Status"               ;; 4

   120    0xD16F "Type 1"               ;; 5

   121    0xD170 "Type 2"               ;; 6

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

   123    0xD172 "Move 1 ID"            ;; 8

   124    0xD173 "Move 2 ID"            ;; 9

   125    0xD174 "Move 3 ID"            ;; 10

   126    0xD175 "Move 4 ID"            ;; 11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   144    0xD187 "PP Move 1"            ;; 29

   145    0xD188 "PP Move 2"            ;; 30

   146    0xD189 "PP Move 3"            ;; 31

   147    0xD18A "PP Move 4"            ;; 32

   148    0xD18B "Current Level"        ;; 33

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

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

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

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

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

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

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

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

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

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

   159    })

   160 

   161 (defn pokemon-record

   162   ([^SaveState state pokemon-num]

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

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

   165        (subvec (vec (memory state)) base

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

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

   168 

   169 (defn set-pokemon-record

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

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

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

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

   174   ([pokemon-num new-data]

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

   176 

   177 (defn print-pokemon-record

   178   ([^SaveState state pokemon-num]

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

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

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

   182        (println "Pokemon " pokemon-num  " -- "

   183                 (nth (party-names state)

   184                      pokemon-num) \newline)

   185 

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

   187        (println "-------------------+------+-----+----------+")

   188        (dorun

   189         (map

   190          (comp println

   191                (fn [desc data]

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

   193                          desc data data

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

   195                            (apply

   196                             str 

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

   198                                     s))))))

   199          (map pokemon-1-record backbone)

   200          poke-data))))

   201   ([pokemon-num]

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

   203 

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

   205 

   206 (defn pokemon-info

   207   ([^SaveState state poke-num]

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

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

   210            type (read-type state poke-num)

   211            species (read-species state poke-num)

   212            species2 (read-species2 state poke-num)

   213            moves (read-moves state poke-num)

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

   215                                    poke-num)

   216                           (range (count moves)))

   217            nickname (pokemon-nickname state poke-num)

   218            status (read-status state poke-num)

   219            stats (read-stats state poke-num)

   220            experience (read-experience state poke-num)

   221            OT-name (read-OT-name state poke-num)

   222            ID (read-OT-id state poke-num)]

   223        {;; persistent 

   224         :name nickname

   225         :species species

   226         :species2 species2

   227         :type type

   228         :dv dv-values

   229         :original-trainer OT-name

   230         :ID ID

   231         :moves (mapv vector moves moves-pp)

   232 

   233         ;; ephemerial

   234         :satus status

   235         :stats stats

   236         :experience experience

   237         }))

   238   ([poke-num]

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

   240 

   241 (defn print-pokemon

   242   ([^SaveState state poke-num]

   243      (let [info (pokemon-info state poke-num)]

   244        (printf

   245         (str

   246          "##################################"

   247          "##################################\n"

   248          "#                                 "

   249          "                                 #\n"

   250          "#  %-44s"

   251          "%-20s#\n"

   252          "#                                 "

   253          "                                 #\n"

   254          "##################################"

   255          "##################################\n\n")

   256         

   257         (str

   258          (:name info)

   259          (str

   260           " (" (.substring (str (:species info)) 1) ")")

   261          (str "  Lvl." (format "%-3d" (:level (:stats info)))))

   262         (str (:original-trainer info) " / " (:ID info)))

   263        

   264        (println

   265         (str 

   266          (str "-----------------------------------"

   267               "---------------------------------\n" )

   268          (str "| Stats     |    HP    |  Attack  "

   269               "| Defense  |  Speed   | Special  |\n")

   270          (str "+-----------+----------+----------"

   271               "+----------+----------+----------+")))

   272 

   273        (printf

   274         (str "|%-11s|  %5d   |  %5d   "

   275              "|  %5d   |  %5d   |  %5d   |\n")

   276         "DV Values" (:hp (:dv info)) (:attack (:dv info))

   277         (:defense (:dv info)) (:speed (:dv info))

   278         (:special (:dv info)))

   279 

   280        (let [c (:stats info)]

   281          (printf

   282           (str "|%-11s|  %5d   |  %5d   "

   283                "|  %5d   |  %5d   |  %5d   |\n")

   284           "Current" (:hp c) (:attack c)

   285           (:defense c) (:speed c)

   286           (:special c)))

   287               

   288        (let [e (:experience info)]

   289          (printf

   290           (str "|%-11s|  %5d   |  %5d   "

   291                "|  %5d   |  %5d   |  %5d   |\n")

   292           "Experience" (:hp-exp e) (:attack-exp e)

   293           (:defense-exp e) (:speed-exp e)

   294           (:special-exp e)))

   295        (println

   296         (str "+-----------+----------+----------"

   297              "+----------+----------+----------+"))

   298 

   299        (print "\n")

   300        (println "+------------------+----+--------+--------+")

   301        (println "|       Move       | PP | Max PP | PP UPs |")

   302        (println "+------------------+----+--------+--------+")

   303 

   304        (dorun

   305         (for [[name {:keys [pp-ups current-pp]}] (:moves info)]

   306           (printf

   307            "| %-17s| %2d |   %02d   |   %02d   |\n"

   308            (.substring (str name) 1)

   309            current-pp (max-pp name pp-ups) pp-ups)))

   310 

   311        (println "+------------------+----+--------+--------+")

   312        

   313        

   314 

   315      

   316      ))

   317   ([poke-num]

   318      (print-pokemon @current-state poke-num)))

   319 

   320 (defn give-status-all

   321   ([^SaveState state status]

   322      (reduce (fn [state num]

   323                (give-status state num status))

   324              state

   325              (range (party-number state))))

   326   ([status]

   327      (give-status-all @current-state status)))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 23 Mar 2012 00:30:34 -0500
parents	659764a2ea40
children	1e2aa688e6e4