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

   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 

   360 (def pokemon-base

   361   {:dv {:attack 15 :hp 15 :defense 15

   362         :special 15 :speed 15}

   363    :species :ditto

   364    :original-trainer "RLM"

   365    :ID 5195

   366    :status :normal

   367    :experience

   368    {:main-exp 500

   369     :attack-exp 0xFFFF

   370     :defense-exp 0xFFFF

   371     :speed-exp 0xFFFF

   372     :special-exp 0xFFFF

   373     :hp-exp 0xFFFF}

   374 

   375    :stats

   376    {:level 7

   377     :current-hp 30

   378     :hp 30

   379     :attack 18

   380     :defense 18

   381     :speed 18

   382     :special 18}

   383    :moves [[:transform {:pp-ups 3 :current-pp 5}]]})

   384 

   385 (defn expand-pokemon

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

   387    values based on the ones already present."

   388   [pokemon]

   389   (-> (merge pokemon-base pokemon)

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

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

   392       ;; when a pokemon is captured.

   393       ((fn [pokemon]

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

   395            (assoc pokemon :name (.toUpperCase

   396                                  (.substring

   397                                   (str (:species pokemon)) 1)))

   398            pokemon)))

   399       ;; species2 should almost always just be the

   400       ;; same as species.

   401       ((fn [pokemon]

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

   403            (assoc pokemon :species2 (:species pokemon))

   404            pokemon)))

   405 

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

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

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

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

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

   411       ;; pp-ups.

   412       ((fn [pokemon]

   413          (let [moves (:moves pokemon)]

   414            (assoc pokemon :moves

   415                   (for [move moves]

   416                     (cond

   417                       (keyword? move)

   418                       [move {:current-pp (max-pp move) :pp-ups 0}]

   419                       (vector? move)

   420                       [(first move)

   421                        (merge {:current-pp (max-pp (first move) 0)

   422                                :pp-ups 0} (second move))]))))))

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

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

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

   426       ((fn [pokemon]

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

   428            (assoc pokemon :type

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

   430            pokemon)))))

   431 

   432 (defn give-pokemon

   433   ([^SaveState state poke-num pokemon]

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

   435        (-> state

   436            ;; expand roster if necessary

   437            ((fn [state]

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

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

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

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

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

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

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

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

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

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

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

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

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

   451   ([poke-num pokemon]

   452      (give-pokemon @current-state poke-num pokemon)))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 23 Mar 2012 05:45:56 -0500
parents	45f1376b578c
children	565f5d17f90a