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

     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      (-> state

    13          (set-memory 0xD162 new-party-num)

    14          (set-memory (+ 0xD162 new-party-num 1) 0xFF)))

    15   ([new-party-num]

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

    17 

    18 (def party-number-address 0xD162)

    19 

    20 (defn party-number

    21   ([^SaveState state]

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

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

    24 

    25 (defn party-names

    26   ([^SaveState state]

    27      (let [raw-names

    28            (subvec (vec (memory state))

    29                    pokemon-names-start

    30                    (+ pokemon-names-start

    31                       (* name-width 6)))]

    32        (map

    33         read-name

    34         (take

    35          (party-number state)

    36           (partition name-width

    37                    raw-names)))))

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

    39 

    40 (defn pokemon-nickname

    41   ([^SaveState state poke-num]

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

    43   ([poke-num]

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

    45 

    46 (defn rename-pokemon

    47   ([^SaveState state n new-name]

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

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

    50      (set-memory-range

    51       state

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

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

    54   ([n new-name]

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

    56 

    57 (def OT-start 0xD272)

    58 

    59 (defn original-trainers

    60   ([^SaveState state]

    61      (let [raw-names

    62            (subvec (vec (memory state))

    63                    OT-start

    64                    (+ OT-start

    65                       (* name-width 6)))]

    66        (map read-name

    67             (take (party-number state)

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

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

    70 

    71 (defn read-OT-name

    72   ([^SaveState state poke-num]

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

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

    75 

    76 (defn set-OT-name

    77   "Set the OT name for a pokemon.

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

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

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

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

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

    83      (set-memory-range

    84       state

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

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

    87   ([n new-name]

    88      (set-OT-name @current-state n new-name)))

    89 

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

    91 

    92 (defn read-OT-id

    93   ([^SaveState state poke-num]

    94      (let [mem (memory state)

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

    96      (glue-bytes

    97       (aget mem start)

    98       (aget mem (inc start)))))

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

   100 

   101 (defn set-OT-id

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

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

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

   105      (set-memory-range 

   106       state

   107       (OT-ID-addresses poke-num)

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

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

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

   111 

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

   113 

   114 (def unknown "")

   115 

   116 (def pokemon-1-record

   117   {0xD16A "Color Map"            ;; 0

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

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

   120    0XD16D "Unused"               ;; 3

   121    0xD16E "Status"               ;; 4

   122    0xD16F "Type 1"               ;; 5

   123    0xD170 "Type 2"               ;; 6

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

   125    0xD172 "Move 1 ID"            ;; 8

   126    0xD173 "Move 2 ID"            ;; 9

   127    0xD174 "Move 3 ID"            ;; 10

   128    0xD175 "Move 4 ID"            ;; 11

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   146    0xD187 "PP Move 1"            ;; 29

   147    0xD188 "PP Move 2"            ;; 30

   148    0xD189 "PP Move 3"            ;; 31

   149    0xD18A "PP Move 4"            ;; 32

   150    0xD18B "Current Level"        ;; 33

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

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

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

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

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

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

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

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

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

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

   161    })

   162 

   163 (defn pokemon-record

   164   ([^SaveState state pokemon-num]

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

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

   167        (subvec (vec (memory state)) base

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

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

   170 

   171 (defn set-pokemon-record

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

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

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

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

   176   ([pokemon-num new-data]

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

   178 

   179 (defn print-pokemon-record

   180   ([^SaveState state pokemon-num]

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

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

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

   184        (println "Pokemon " pokemon-num  " -- "

   185                 (nth (party-names state)

   186                      pokemon-num) \newline)

   187 

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

   189        (println "-------------------+------+-----+----------+")

   190        (dorun

   191         (map

   192          (comp println

   193                (fn [desc data]

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

   195                          desc data data

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

   197                            (apply

   198                             str 

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

   200                                     s))))))

   201          (map pokemon-1-record backbone)

   202          poke-data))))

   203   ([pokemon-num]

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

   205 

   206 (defn pokemon

   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         :status status

   235         :stats stats

   236         :experience experience

   237         }))

   238   ([poke-num]

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

   240 

   241 (def status-message

   242   {:sleep-6 "sleeping. It will wake in six turns."

   243    :sleep-5 "sleeping. It will wake in five turns."

   244    :sleep-4 "sleeping. It will wake in four turns."

   245    :sleep-3 "sleeping. It will wake in three turns."

   246    :sleep-2 "sleeping. It will wake in two turns."

   247    :sleep-1 "sleeping. It will wake in one turn."

   248    :poisoned "poisoned."

   249    :frozen "frozen solid."

   250    :burned "burned."

   251    :paralyzed "paralyzed."})

   252 

   253    

   254 (defn print-pokemon

   255   ([^SaveState state poke-num]

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

   257        (printf

   258         (str

   259          "##################################"

   260          "##################################\n"

   261          "#                                 "

   262          "                                 #\n"

   263          "#  %-44s"

   264          "%-20s#\n"

   265          "#                                 "

   266          "                                 #\n"

   267          "##################################"

   268          "##################################\n\n")

   269         

   270         (str

   271          (:name info)

   272          (str

   273           " [" (.toUpperCase

   274                 (.substring (str (:species info)) 1)) "]")

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

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

   277        

   278        (println

   279         (str 

   280          (str "-----------------------------------"

   281               "---------------------------------\n" )

   282          (str "| Stats     |    HP    |  Attack  "

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

   284          (str "+-----------+----------+----------"

   285               "+----------+----------+----------+")))

   286 

   287        (printf

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

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

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

   291         (:defense (:dv info)) (:speed (:dv info))

   292         (:special (:dv info)))

   293 

   294        (let [c (:stats info)]

   295          (printf

   296           (str "|%-11s|%8s  |   %5d  "

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

   298           "Current" (str (:current-hp c) "/" (:hp c)) (:attack c)

   299           (:defense c) (:speed c)

   300           (:special c)))

   301               

   302        (let [e (:experience info)]

   303          (printf

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

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

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

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

   308           (:special-exp e)))

   309        (println

   310         (str "+-----------+----------+----------"

   311              "+----------+----------+----------+"))

   312 

   313        (print "\n")

   314        (println "+------------------+----+--------+--------+")

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

   316        (println "+------------------+----+--------+--------+")

   317 

   318        (dorun

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

   320           (printf

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

   322            (.substring (str name) 1)

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

   324 

   325        (println "+------------------+----+--------+--------+\n")

   326        

   327        (println "Total Experience:" (:main-exp (:experience info)))

   328        (if (not= :normal (:status info))

   329          (println "\n* This pokemon is currently"

   330                   (status-message (:status info))))

   331        (if (not= (:species info) (:species2 info))

   332          (println "\n* This pokemon has a secondary species"

   333                   (str

   334                    "("

   335                    (.substring (str (:species2 info)) 1) ")\n")

   336                   "  that does not match its primary species."))

   337        (if (not= (:type info) (pokemon->type (:species info)))

   338          (println "\n* This pokemon has a type"

   339                   (str (:type info))

   340                   "which \n"

   341                   "  is inconsistent with the default type for its"

   342                   "species."))))

   343   ([poke-num]

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

   345 

   346 (defn print-team [] 

   347   (dorun (map print-pokemon (range (party-number)))))

   348 

   349 

   350 (defn give-status-all

   351   ([^SaveState state status]

   352      (reduce (fn [state num]

   353                (give-status state num status))

   354              state

   355              (range (party-number state))))

   356   ([status]

   357      (give-status-all @current-state status)))

   358 

   359 (defn expand-pokemon

   360   "Given a map describing a pokemon, fill in any missing

   361    values based on the ones already present."

   362   [pokemon]

   363   (-> (merge pokemon-base pokemon)

   364       ;; if no nickname is supplied, default to the

   365       ;; uppercase name of the species, as r/b/y do

   366       ;; when a pokemon is captured.

   367       ((fn [pokemon]

   368          (if (nil? (:name pokemon))

   369            (assoc pokemon :name (.toUpperCase

   370                                  (.substring

   371                                   (str (:species pokemon)) 1)))

   372            pokemon)))

   373       ;; species2 should almost always just be the

   374       ;; same as species.

   375       ((fn [pokemon]

   376          (if (nil? (:species2 pokemon))

   377            (assoc pokemon :species2 (:species pokemon))

   378            pokemon)))

   379 

   380       ;; enable the date in :moves to be any combo of 

   381       ;; [:move-1 :move-2]

   382       ;; [[:move-1 {:pp 20}] :move-2]

   383       ;; [[:move-1 {:pp 20 :pp-up 3}] :move-2]

   384       ;; default to full pp for the move, with no

   385       ;; pp-ups.

   386       ((fn [pokemon]

   387          (let [moves (:moves pokemon)]

   388            (assoc pokemon :moves

   389                   (for [move moves]

   390                     (cond

   391                       (keyword? move)

   392                       [move {:current-pp (max-pp move 3) :pp-ups 3}]

   393                       (vector? move)

   394                       [(first move)

   395                        (merge {:current-pp (max-pp (first move) 3)

   396                                :pp-ups 3} (second move))]))))))

   397       ;; The game stores the pokemon's type redundantly

   398       ;; along with the species.  If it's not specified

   399       ;; then it should default to that species default type.

   400       ((fn [pokemon]

   401          (if (nil? (:type pokemon))

   402            (assoc pokemon :type

   403                   (pokemon->type (:species pokemon)))

   404            pokemon)))))

   405 

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

   407 

   408 (defn give-pokemon

   409   ([^SaveState state poke-num pokemon]

   410      (let [pokemon* (expand-pokemon pokemon)]

   411        (-> state

   412            ;; expand roster if necessary

   413            ((fn [state]

   414               (if (< (dec (party-number state)) poke-num)

   415                 (set-party-number state (inc poke-num)) state)))

   416            (rename-pokemon poke-num (:name pokemon*))

   417            (give-DV poke-num (:dv pokemon*))

   418            (give-type poke-num (:type pokemon*))

   419            (set-species poke-num (:species pokemon*))

   420            (set-species2 poke-num (:species2 pokemon*))

   421            (set-OT-id poke-num (:ID pokemon*))

   422            (set-OT-name poke-num (:original-trainer pokemon*))

   423            (give-moves-pps poke-num (:moves pokemon*))

   424            (give-status poke-num (:status pokemon*))

   425            (give-stats  poke-num (:stats  pokemon*))

   426            (give-experience poke-num (:experience pokemon*))

   427            (set-memory (+ 0xD16D

   428                           (* pokemon-record-width poke-num))

   429                           mint-berry-item-code-gsc))))

   430   ([poke-num pokemon]

   431      (give-pokemon @current-state poke-num pokemon)))

   432 

   433 (defn edit-pokemon

   434   ([^SaveState state poke-num new-pokemon-data]

   435      (give-pokemon state poke-num

   436                    (merge (pokemon state poke-num)

   437                           new-pokemon-data)))

   438   ([poke-num new-pokemon-data]

   439      (edit-pokemon @current-state poke-num new-pokemon-data)))

   440 

   441 (defn give-powerful-party

   442   ([^SaveState state]

   443      (-> state

   444           (give-pokemon 0 tauros)

   445           (give-pokemon 1 chansey)

   446           (give-pokemon 2 alakazam)

   447           (give-pokemon 3 golem)

   448           (give-pokemon 4 exeggutor)

   449           (give-pokemon 5 starmie)

   450 

   451           ))

   452   ([] (give-powerful-party @current-state)))
author	Robert McIntyre <rlm@mit.edu>
date	Sun, 02 Sep 2012 09:18:43 -0500
parents	fe6fd2323264
children