rlm@176: (ns com.aurellem.gb.pokemon
rlm@190:   (:use (com.aurellem.gb gb-driver util constants characters
rlm@190:                          moves types items status dv species
rlm@192:                          experience stats
rlm@190:                          ))
rlm@176:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@176: 
rlm@176: (def pokemon-names-start 0xD2B4)
rlm@176: 
rlm@179: (defn set-party-number
rlm@179:   ([^SaveState state new-party-num]
rlm@237:      (-> state
rlm@237:          (set-memory 0xD162 new-party-num)
rlm@237:          (set-memory (+ 0xD162 new-party-num 1) 0xFF)))
rlm@179:   ([new-party-num]
rlm@179:      (set-party-number @current-state new-party-num)))
rlm@176: 
rlm@176: (def party-number-address 0xD162)
rlm@176: 
rlm@176: (defn party-number
rlm@176:   ([^SaveState state]
rlm@176:      (aget (memory state) party-number-address))
rlm@176:   ([] (party-number @current-state)))
rlm@176: 
rlm@176: (defn party-names
rlm@176:   ([^SaveState state]
rlm@176:      (let [raw-names
rlm@176:            (subvec (vec (memory state))
rlm@176:                    pokemon-names-start
rlm@176:                    (+ pokemon-names-start
rlm@176:                       (* name-width 6)))]
rlm@176:        (map
rlm@176:         read-name
rlm@176:         (take
rlm@176:          (party-number state)
rlm@176:           (partition name-width
rlm@176:                    raw-names)))))
rlm@176:   ([] (party-names @current-state)))
rlm@176: 
rlm@191: (defn pokemon-nickname
rlm@191:   ([^SaveState state poke-num]
rlm@191:      (nth (party-names state) poke-num))
rlm@191:   ([poke-num]
rlm@191:      (pokemon-nickname @current-state poke-num)))
rlm@191: 
rlm@176: (defn rename-pokemon
rlm@176:   ([^SaveState state n new-name]
rlm@176:      (assert (<= 0 n (dec (party-number state))))
rlm@176:      (assert (<= (count new-name) max-name-length))
rlm@176:      (set-memory-range
rlm@176:       state
rlm@176:       (+ (* n name-width) pokemon-names-start)
rlm@176:       (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176:   ([n new-name]
rlm@176:      (rename-pokemon @current-state n new-name)))
rlm@176: 
rlm@176: (def OT-start 0xD272)
rlm@176: 
rlm@176: (defn original-trainers
rlm@176:   ([^SaveState state]
rlm@176:      (let [raw-names
rlm@176:            (subvec (vec (memory state))
rlm@176:                    OT-start
rlm@176:                    (+ OT-start
rlm@176:                       (* name-width 6)))]
rlm@176:        (map read-name
rlm@176:             (take (party-number state)
rlm@176:                   (partition name-width raw-names)))))
rlm@176:   ([] (original-trainers @current-state)))
rlm@176: 
rlm@192: (defn read-OT-name
rlm@192:   ([^SaveState state poke-num]
rlm@192:      (nth (original-trainers state) poke-num))
rlm@209:   ([poke-num] (read-OT-name @current-state poke-num)))
rlm@192: 
rlm@192: (defn set-OT-name
rlm@176:   "Set the OT name for a pokemon.
rlm@176:    Note that a pokemon is still considered 'yours' if
rlm@176:    the OT ID is the same as your own."
rlm@176:   ([^SaveState state poke-num new-name]
rlm@176:      (assert (<= 0 poke-num (dec (party-number state))))
rlm@176:      (assert (<= (count new-name) max-name-length))
rlm@176:      (set-memory-range
rlm@176:       state
rlm@176:       (+ (* poke-num name-width) OT-start)
rlm@176:       (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176:   ([n new-name]
rlm@209:      (set-OT-name @current-state n new-name)))
rlm@176: 
rlm@197: (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD226 0xD252])
rlm@176: 
rlm@192: (defn read-OT-id
rlm@192:   ([^SaveState state poke-num]
rlm@192:      (let [mem (memory state)
rlm@192:            start (OT-ID-addresses poke-num)]
rlm@192:      (glue-bytes
rlm@192:       (aget mem start)
rlm@192:       (aget mem (inc start)))))
rlm@192:   ([poke-num] (read-OT-id @current-state poke-num)))
rlm@192: 
rlm@192: (defn set-OT-id
rlm@192:   ([^SaveState state poke-num new-OT-num]
rlm@192:      (assert (<= 0 poke-num 5))
rlm@192:      (assert (<= 0 new-OT-num 0xFFFF))
rlm@176:      (set-memory-range 
rlm@176:       state
rlm@192:       (OT-ID-addresses poke-num)
rlm@192:       (disect-bytes-2 new-OT-num)))
rlm@192:   ([poke-num new-OT-num]
rlm@209:      (set-OT-id @current-state poke-num new-OT-num)))
rlm@176: 
rlm@176: (def unknown "[[[UNKNOWN]]]")
rlm@176: 
rlm@176: (def unknown "")
rlm@176: 
rlm@189: (def pokemon-1-record
rlm@176:   {0xD16A "Color Map"            ;; 0
rlm@176:    0xD16B "Current-HP (h)"       ;; 1
rlm@176:    0xD16C "Current-HP (l)"       ;; 2
rlm@182:    0XD16D "Unused"               ;; 3
rlm@178:    0xD16E "Status"               ;; 4
rlm@182:    0xD16F "Type 1"               ;; 5
rlm@182:    0xD170 "Type 2"               ;; 6
rlm@182:    0xD171 "scratch/C.R."         ;; 7
rlm@176:    0xD172 "Move 1 ID"            ;; 8
rlm@176:    0xD173 "Move 2 ID"            ;; 9
rlm@176:    0xD174 "Move 3 ID"            ;; 10
rlm@176:    0xD175 "Move 4 ID"            ;; 11
rlm@176:    0xD176 "OT-ID (h)"            ;; 12
rlm@176:    0xD177 "OT-ID (l)"            ;; 13
rlm@176:    0xD178 "Exp. Points (h)"      ;; 14
rlm@176:    0xD179 "Exp. Points (m)"      ;; 15
rlm@176:    0xD17A "Exp. Points (l)"      ;; 16
rlm@176:    0xD17B "HP Exp. (h)"          ;; 17
rlm@176:    0xD17C "HP Exp. (l)"          ;; 18
rlm@176:    0xD17D "Attack Exp. (h)"      ;; 19
rlm@176:    0xD17E "Attack Exp. (l)"      ;; 20
rlm@176:    0xD17F "Defense Exp. (h)"     ;; 21
rlm@176:    0xD180 "Defense Exp. (l)"     ;; 22
rlm@176:    0xD181 "Speed Exp. (h)"       ;; 23
rlm@176:    0xD182 "Speed Exp. (l)"       ;; 24
rlm@176:    0xD183 "Special Exp. (h)"     ;; 25
rlm@176:    0xD184 "Special Exp. (l)"     ;; 26
rlm@176:    0xD185 "DV Atk/Def"           ;; 27
rlm@176:    0xD186 "DV Speed/Spc"         ;; 28
rlm@176:    0xD187 "PP Move 1"            ;; 29
rlm@176:    0xD188 "PP Move 2"            ;; 30
rlm@176:    0xD189 "PP Move 3"            ;; 31
rlm@176:    0xD18A "PP Move 4"            ;; 32
rlm@176:    0xD18B "Current Level"        ;; 33
rlm@176:    0xD18C "HP Total (h)"         ;; 34
rlm@176:    0xD18D "HP Total (l)"         ;; 35
rlm@176:    0xD18E "Attack   (h)"         ;; 36
rlm@176:    0xD18F "Attack   (l)"         ;; 37
rlm@176:    0xD190 "Defense  (h)"         ;; 38
rlm@176:    0xD191 "Defense  (l)"         ;; 39
rlm@176:    0xD192 "Speed    (h)"         ;; 40
rlm@176:    0xD193 "Speed    (l)"         ;; 41
rlm@176:    0xD194 "Special  (h)"         ;; 42
rlm@176:    0xD195 "Special  (l)"         ;; 43
rlm@176:    })
rlm@176: 
rlm@189: (defn pokemon-record
rlm@176:   ([^SaveState state pokemon-num]
rlm@176:      (assert (<= 0 pokemon-num 5))
rlm@176:      (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]
rlm@176:        (subvec (vec (memory state)) base
rlm@176:                (+ base pokemon-record-width))))
rlm@189:   ([pokemon-num] (pokemon-record @current-state pokemon-num)))
rlm@176: 
rlm@189: (defn set-pokemon-record
rlm@176:   ([^SaveState state pokemon-num new-data]
rlm@176:      (assert (<= 0 pokemon-num 5))
rlm@176:      (let [base (+ (* pokemon-num  pokemon-record-width) 0xD16A)]
rlm@176:        (set-memory-range state base new-data)))
rlm@176:   ([pokemon-num new-data]
rlm@189:      (set-pokemon-record @current-state pokemon-num new-data)))
rlm@176: 
rlm@189: (defn print-pokemon-record
rlm@176:   ([^SaveState state pokemon-num]
rlm@176:      (assert (<= 0 pokemon-num 5))
rlm@189:      (let [poke-data (pokemon-record state pokemon-num)
rlm@189:            backbone (sort (keys pokemon-1-record))]
rlm@176:        (println "Pokemon " pokemon-num  " -- "
rlm@176:                 (nth (party-names state)
rlm@176:                      pokemon-num) \newline)
rlm@176: 
rlm@176:        (println "    Desc.          | Hex  | Dec |  Binary  |")
rlm@176:        (println "-------------------+------+-----+----------+")
rlm@176:        (dorun
rlm@176:         (map
rlm@176:          (comp println
rlm@176:                (fn [desc data]
rlm@176:                  (format "%-16s   | 0x%02X | %3d | %s |"
rlm@176:                          desc data data
rlm@176:                          (let [s (Integer/toBinaryString data)]
rlm@176:                            (apply
rlm@176:                             str 
rlm@176:                             (concat (repeat (- 8 (count s)) "0" )
rlm@176:                                     s))))))
rlm@189:          (map pokemon-1-record backbone)
rlm@176:          poke-data))))
rlm@176:   ([pokemon-num]
rlm@189:      (print-pokemon-record @current-state pokemon-num)))
rlm@190: 
rlm@209: (defn pokemon
rlm@191:   ([^SaveState state poke-num]
rlm@191:      (assert (<= 0 poke-num 5))
rlm@191:      (let [dv-values (read-DV state poke-num)
rlm@191:            type (read-type state poke-num)
rlm@191:            species (read-species state poke-num)
rlm@191:            species2 (read-species2 state poke-num)
rlm@191:            moves (read-moves state poke-num)
rlm@191:            moves-pp (mapv (partial read-pp state
rlm@191:                                    poke-num)
rlm@191:                           (range (count moves)))
rlm@191:            nickname (pokemon-nickname state poke-num)
rlm@191:            status (read-status state poke-num)
rlm@192:            stats (read-stats state poke-num)
rlm@191:            experience (read-experience state poke-num)
rlm@192:            OT-name (read-OT-name state poke-num)
rlm@193:            ID (read-OT-id state poke-num)]
rlm@193:        {;; persistent 
rlm@193:         :name nickname
rlm@191:         :species species
rlm@191:         :species2 species2
rlm@191:         :type type
rlm@191:         :dv dv-values
rlm@192:         :original-trainer OT-name
rlm@192:         :ID ID
rlm@196:         :moves (mapv vector moves moves-pp)
rlm@190: 
rlm@193:         ;; ephemerial
rlm@200:         :status status
rlm@192:         :stats stats
rlm@191:         :experience experience
rlm@193:         }))
rlm@191:   ([poke-num]
rlm@209:      (pokemon @current-state poke-num)))
rlm@195: 
rlm@202: (def status-message
rlm@202:   {:sleep-6 "sleeping. It will wake in six turns."
rlm@202:    :sleep-5 "sleeping. It will wake in five turns."
rlm@202:    :sleep-4 "sleeping. It will wake in four turns."
rlm@202:    :sleep-3 "sleeping. It will wake in three turns."
rlm@202:    :sleep-2 "sleeping. It will wake in two turns."
rlm@202:    :sleep-1 "sleeping. It will wake in one turn."
rlm@202:    :poisoned "poisoned."
rlm@202:    :frozen "frozen solid."
rlm@202:    :burned "burned."
rlm@202:    :paralyzed "paralyzed."})
rlm@202: 
rlm@202:    
rlm@195: (defn print-pokemon
rlm@195:   ([^SaveState state poke-num]
rlm@209:      (let [info (pokemon state poke-num)]
rlm@195:        (printf
rlm@195:         (str
rlm@195:          "##################################"
rlm@195:          "##################################\n"
rlm@195:          "#                                 "
rlm@195:          "                                 #\n"
rlm@195:          "#  %-44s"
rlm@195:          "%-20s#\n"
rlm@195:          "#                                 "
rlm@195:          "                                 #\n"
rlm@195:          "##################################"
rlm@195:          "##################################\n\n")
rlm@195:         
rlm@195:         (str
rlm@195:          (:name info)
rlm@195:          (str
rlm@202:           " [" (.toUpperCase
rlm@202:                 (.substring (str (:species info)) 1)) "]")
rlm@195:          (str "  Lvl." (format "%-3d" (:level (:stats info)))))
rlm@195:         (str (:original-trainer info) " / " (:ID info)))
rlm@195:        
rlm@195:        (println
rlm@195:         (str 
rlm@195:          (str "-----------------------------------"
rlm@195:               "---------------------------------\n" )
rlm@195:          (str "| Stats     |    HP    |  Attack  "
rlm@195:               "| Defense  |  Speed   | Special  |\n")
rlm@195:          (str "+-----------+----------+----------"
rlm@195:               "+----------+----------+----------+")))
rlm@195: 
rlm@195:        (printf
rlm@202:         (str "|%-11s|   %5d  |   %5d  "
rlm@202:              "|   %5d  |   %5d  |   %5d  |\n")
rlm@195:         "DV Values" (:hp (:dv info)) (:attack (:dv info))
rlm@195:         (:defense (:dv info)) (:speed (:dv info))
rlm@195:         (:special (:dv info)))
rlm@195: 
rlm@195:        (let [c (:stats info)]
rlm@195:          (printf
rlm@202:           (str "|%-11s|%8s  |   %5d  "
rlm@202:                "|   %5d  |   %5d  |   %5d  |\n")
rlm@202:           "Current" (str (:current-hp c) "/" (:hp c)) (:attack c)
rlm@195:           (:defense c) (:speed c)
rlm@195:           (:special c)))
rlm@195:               
rlm@195:        (let [e (:experience info)]
rlm@195:          (printf
rlm@202:           (str "|%-11s|   %5d  |   %5d  "
rlm@202:                "|   %5d  |   %5d  |   %5d  |\n")
rlm@195:           "Experience" (:hp-exp e) (:attack-exp e)
rlm@195:           (:defense-exp e) (:speed-exp e)
rlm@195:           (:special-exp e)))
rlm@195:        (println
rlm@195:         (str "+-----------+----------+----------"
rlm@195:              "+----------+----------+----------+"))
rlm@195: 
rlm@195:        (print "\n")
rlm@195:        (println "+------------------+----+--------+--------+")
rlm@195:        (println "|       Move       | PP | Max PP | PP UPs |")
rlm@196:        (println "+------------------+----+--------+--------+")
rlm@196: 
rlm@197:        (dorun
rlm@197:         (for [[name {:keys [pp-ups current-pp]}] (:moves info)]
rlm@197:           (printf
rlm@197:            "| %-17s| %2d |   %02d   |   %02d   |\n"
rlm@197:            (.substring (str name) 1)
rlm@197:            current-pp (max-pp name pp-ups) pp-ups)))
rlm@195: 
rlm@200:        (println "+------------------+----+--------+--------+\n")
rlm@195:        
rlm@200:        (println "Total Experience:" (:main-exp (:experience info)))
rlm@202:        (if (not= :normal (:status info))
rlm@202:          (println "\n* This pokemon is currently"
rlm@202:                   (status-message (:status info))))
rlm@200:        (if (not= (:species info) (:species2 info))
rlm@202:          (println "\n* This pokemon has a secondary species"
rlm@200:                   (str
rlm@200:                    "("
rlm@200:                    (.substring (str (:species2 info)) 1) ")\n")
rlm@206:                   "  that does not match its primary species."))
rlm@206:        (if (not= (:type info) (pokemon->type (:species info)))
rlm@206:          (println "\n* This pokemon has a type"
rlm@206:                   (str (:type info))
rlm@206:                   "which \n"
rlm@206:                   "  is inconsistent with the default type for its"
rlm@206:                   "species."))))
rlm@195:   ([poke-num]
rlm@195:      (print-pokemon @current-state poke-num)))
rlm@192: 
rlm@202: (defn print-team [] 
rlm@202:   (dorun (map print-pokemon (range (party-number)))))
rlm@202: 
rlm@202: 
rlm@192: (defn give-status-all
rlm@192:   ([^SaveState state status]
rlm@192:      (reduce (fn [state num]
rlm@192:                (give-status state num status))
rlm@192:              state
rlm@192:              (range (party-number state))))
rlm@192:   ([status]
rlm@192:      (give-status-all @current-state status)))
rlm@203: 
rlm@203: 
rlm@203: (def pokemon-base
rlm@203:   {:dv {:attack 15 :hp 15 :defense 15
rlm@203:         :special 15 :speed 15}
rlm@203:    :species :ditto
rlm@203:    :original-trainer "RLM"
rlm@203:    :ID 5195
rlm@203:    :status :normal
rlm@203:    :experience
rlm@203:    {:main-exp 500
rlm@208:     :attack-exp 0xFFFF
rlm@208:     :defense-exp 0xFFFF
rlm@208:     :speed-exp 0xFFFF
rlm@208:     :special-exp 0xFFFF
rlm@208:     :hp-exp 0xFFFF}
rlm@203: 
rlm@203:    :stats
rlm@203:    {:level 7
rlm@209:     :current-hp 30
rlm@209:     :hp 30
rlm@209:     :attack 18
rlm@209:     :defense 18
rlm@209:     :speed 18
rlm@209:     :special 18}
rlm@219:    :moves [[:transform {:pp-ups 0 :current-pp 5}]]})
rlm@203: 
rlm@203: (defn expand-pokemon
rlm@203:   "Given a map describing a pokemon, fill in any missing
rlm@203:    values based on the ones already present."
rlm@203:   [pokemon]
rlm@203:   (-> (merge pokemon-base pokemon)
rlm@203:       ;; if no nickname is supplied, default to the
rlm@203:       ;; uppercase name of the species, as r/b/y do
rlm@203:       ;; when a pokemon is captured.
rlm@203:       ((fn [pokemon]
rlm@203:          (if (nil? (:name pokemon))
rlm@203:            (assoc pokemon :name (.toUpperCase
rlm@203:                                  (.substring
rlm@203:                                   (str (:species pokemon)) 1)))
rlm@203:            pokemon)))
rlm@203:       ;; species2 should almost always just be the
rlm@203:       ;; same as species.
rlm@203:       ((fn [pokemon]
rlm@203:          (if (nil? (:species2 pokemon))
rlm@209:            (assoc pokemon :species2 (:species pokemon))
rlm@209:            pokemon)))
rlm@203: 
rlm@203:       ;; enable the date in :moves to be any combo of 
rlm@203:       ;; [:move-1 :move-2]
rlm@203:       ;; [[:move-1 {:pp 20}] :move-2]
rlm@203:       ;; [[:move-1 {:pp 20 :pp-up 3}] :move-2]
rlm@203:       ;; default to full pp for the move, with no
rlm@203:       ;; pp-ups.
rlm@203:       ((fn [pokemon]
rlm@203:          (let [moves (:moves pokemon)]
rlm@203:            (assoc pokemon :moves
rlm@203:                   (for [move moves]
rlm@203:                     (cond
rlm@203:                       (keyword? move)
rlm@210:                       [move {:current-pp (max-pp move 0) :pp-ups 0}]
rlm@203:                       (vector? move)
rlm@203:                       [(first move)
rlm@209:                        (merge {:current-pp (max-pp (first move) 0)
rlm@209:                                :pp-ups 0} (second move))]))))))
rlm@206:       ;; The game stores the pokemon's type redundantly
rlm@206:       ;; along with the species.  If it's not specified
rlm@206:       ;; then it should default to that species default type.
rlm@206:       ((fn [pokemon]
rlm@206:          (if (nil? (:type pokemon))
rlm@206:            (assoc pokemon :type
rlm@206:                   (pokemon->type (:species pokemon)))
rlm@208:            pokemon)))))
rlm@208: 
rlm@237: (def mint-berry-item-code-gsc 0x54)
rlm@237: 
rlm@209: (defn give-pokemon
rlm@209:   ([^SaveState state poke-num pokemon]
rlm@209:      (let [pokemon* (expand-pokemon pokemon)]
rlm@209:        (-> state
rlm@209:            ;; expand roster if necessary
rlm@209:            ((fn [state]
rlm@209:               (if (< (dec (party-number state)) poke-num)
rlm@209:                 (set-party-number state (inc poke-num)) state)))
rlm@209:            (rename-pokemon poke-num (:name pokemon*))
rlm@209:            (give-DV poke-num (:dv pokemon*))
rlm@209:            (give-type poke-num (:type pokemon*))
rlm@209:            (set-species poke-num (:species pokemon*))
rlm@209:            (set-species2 poke-num (:species2 pokemon*))
rlm@209:            (set-OT-id poke-num (:ID pokemon*))
rlm@209:            (set-OT-name poke-num (:original-trainer pokemon*))
rlm@209:            (give-moves-pps poke-num (:moves pokemon*))
rlm@209:            (give-status poke-num (:status pokemon*))
rlm@209:            (give-stats  poke-num (:stats  pokemon*))
rlm@212:            (give-experience poke-num (:experience pokemon*))
rlm@212:            (set-memory (+ 0xD16D
rlm@212:                           (* pokemon-record-width poke-num))
rlm@237:                           mint-berry-item-code-gsc))))
rlm@209:   ([poke-num pokemon]
rlm@212:      (give-pokemon @current-state poke-num pokemon)))
rlm@212: 
rlm@212: (defn edit-pokemon
rlm@212:   ([^SaveState state poke-num new-pokemon-data]
rlm@212:      (give-pokemon state poke-num
rlm@212:                    (merge (pokemon state poke-num)
rlm@212:                           new-pokemon-data)))
rlm@212:   ([poke-num new-pokemon-data]
rlm@212:      (edit-pokemon @current-state poke-num new-pokemon-data)))