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

   235         :stats stats

   236         :experience experience

   237         }))

   238   ([poke-num]

   239      (pokemon-info @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-info 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   ([poke-num]

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

   339 

   340 (defn print-team [] 

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

   342 

   343 

   344 (defn give-status-all

   345   ([^SaveState state status]

   346      (reduce (fn [state num]

   347                (give-status state num status))

   348              state

   349              (range (party-number state))))

   350   ([status]

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

   352 

   353 

   354 (def pokemon-base

   355   {:dv {:attack 15 :hp 15 :defense 15

   356         :special 15 :speed 15}

   357    :species :ditto

   358    :original-trainer "RLM"

   359    :ID 5195

   360    :status :normal

   361    :experience

   362    {:main-exp 500

   363     :attack-exp 0xFF

   364     :defense-exp 0xFF

   365     :speed-exp 0xFF

   366     :special-exp 0xFF

   367     :hp-exp 0xFF}

   368 

   369    :stats

   370    ;; TODO recalculate these from a real ditto

   371    {:level 7

   372     :current-hp 50

   373     :hp 50

   374     :attack 50

   375     :defense 50

   376     :speed 50

   377     :special 50}

   378     

   379    

   380   :moves [[:transform {:pp-up 3 :pp 5}]]})

   381 

   382 (defn expand-pokemon

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

   384    values based on the ones already present."

   385   [pokemon]

   386   (-> (merge pokemon-base pokemon)

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

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

   389       ;; when a pokemon is captured.

   390       ((fn [pokemon]

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

   392            (assoc pokemon :name (.toUpperCase

   393                                  (.substring

   394                                   (str (:species pokemon)) 1)))

   395            pokemon)))

   396       ;; species2 should almost always just be the

   397       ;; same as species.

   398       ((fn [pokemon]

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

   400            (assoc pokemon :species2 (:species pokemon)))))

   401 

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

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

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

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

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

   407       ;; pp-ups.

   408       ((fn [pokemon]

   409          (let [moves (:moves pokemon)]

   410            (assoc pokemon :moves

   411                   (for [move moves]

   412                     (cond

   413                       (keyword? move)

   414                       [move {:pp (max-pp move) :pp-up 0}]

   415                       (vector? move)

   416                       [(first move)

   417                        (merge {:pp (max-pp (first move))

   418                                :pp-up 0} (second move))]))))))

   419 

   420       

   421 

   422       

   423       ))

   424
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 23 Mar 2012 04:00:42 -0500
parents	1ce54929bc0c
children	32ac21c9a30d