This article contains the results of my investigations with Pokémon Yellow as I searched for interesting data in the ROM. By using the Clojure language interface written by Robert¹, I was able to interact with the game in real-time, sending commands and gathering data. The result is a manifestly accurate map of Pokémon Yellow; every result comes with runnable code that works. You can see the code and the output of every function and confirm for yourself that they are all correct. I hope you like the result!

To orient yourself, you can look for a specific topic in the table of contents above, or browse the map of the ROM, below.

If you have any questions or comments, please e-mail rlm@mit.edu.

(ns com.aurellem.gb.hxc
  (:use (com.aurellem.gb assembly characters gb-driver util mem-util
                         constants species))
  (:import [com.aurellem.gb.gb_driver SaveState]))

; ************* HANDWRITTEN CONSTANTS

(def pkmn-types
  [:normal    ;;0
   :fighting  ;;1
   :flying    ;;2
   :poison    ;;3
   :ground    ;;4
   :rock      ;;5
   :bird      ;;6
   :bug       ;;7
   :ghost     ;;8
   :A
   :B
   :C
   :D
   :E
   :F
   :G
   :H
   :I
   :J
   :K
   :fire     ;;20 (0x14)
   :water    ;;21 (0x15)
   :grass    ;;22 (0x16)
   :electric ;;23 (0x17)
   :psychic  ;;24 (0x18)
   :ice      ;;25 (0x19)
   :dragon   ;;26 (0x1A)
   ])


;; question: when status effects claim to take
;; their accuracy from the move accuracy, does
;; this mean that the move always "hits" but the
;; status effect may not?

(def move-effects
  ["normal damage"
   "no damage, just opponent sleep" ;; how many turns? is atk power ignored?
   "0x4C chance of poison"
   "leech half of inflicted damage"
   "0x19 chance of burn"
   "0x19 chance of freeze"
   "0x19 chance of paralyze"
   "user faints; opponent defense halved during attack."
   "leech half of inflicted damage ONLY if sleeping opponent."
   "imitate last attack"
   "user atk +1"
   "user def +1"
   "user spd +1"
   "user spc +1"
   "user acr +1" ;; unused?!
   "user evd +1"
   "get post-battle $ = 2*level*uses"
   "0xFE acr, no matter what."
   "opponent atk -1"     ;; acr taken from move acr?
   "opponent def -1"     ;;
   "opponent spd -1"   ;;
   "opponent spc -1" ;;
   "opponent acr -1";;
   "opponent evd -1"
   "converts user's type to opponent's."
   "(haze)"
   "(bide)"
   "(thrash)"
   "(teleport)"
   "(fury swipes)"
   "attacks 2-5 turns" ;; unused? like rollout?
   "0x19 chance of flinch"
   "opponent sleep for 1-7 turns"
   "0x66 chance of poison"
   "0x4D chance of burn"
   "0x4D chance of freeze"
   "0x4D chance of paralyze"
   "0x4D chance of flinch"
   "one-hit KO"
   "charge one turn, atk next."
   "fixed damage, leaves 1HP." ;; how is dmg determined?
   "fixed damage."             ;; cf seismic toss, dragon rage, psywave.
   "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)
   "charge one turn, atk next. (can't be hit when charging)"
   "atk hits twice."
   "user takes 1 damage if misses."
   "evade status-lowering effects" ;;caused by you or also your opponent?
   "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"
   "atk causes recoil dmg = 1/4 dmg dealt"
   "confuses opponent" ;; acr taken from move acr
   "user atk +2"
   "user def +2"
   "user spd +2"
   "user spc +2"
   "user acr +2" ;; unused!
   "user evd +2" ;; unused!
   "restores up to half of user's max hp." ;; broken: fails if the difference
   ;; b/w max and current hp is one less than a multiple of 256.
   "(transform)"
   "opponent atk -2"
   "opponent def -2"
   "opponent spd -2"
   "opponent spc -2"
   "opponent acr -2"
   "opponent evd -2"
   "doubles user spc when attacked"
   "doubles user def when attacked"
   "just poisons opponent"   ;;acr taken from move acr
   "just paralyzes opponent" ;;
   "0x19 chance opponent atk -1"
   "0x19 chance opponent def -1"
   "0x19 chance opponent spd -1"
   "0x4C chance opponent spc -1" ;; context suggest chance is 0x19
   "0x19 chance opponent acr -1"
   "0x19 chance opponent evd -1"
   "???" ;; unused? no effect?
   "???" ;; unused? no effect?
   "0x19 chance opponent confused"
   "atk hits twice. 0x33 chance opponent poisioned."
   "broken. crash the game after attack."
   "(substitute)"
   "unless opponent faints, user must recharge after atk. some
  exceptions apply."
   "(rage)"
   "(mimic)"
   "(metronome)"
   "(leech seed)"
   "does nothing (splash)"
   "(disable)"
   ])

;; ************** HARDCODED DATA

(defn hxc-thunk
  "Creates a thunk (nullary fn) that grabs data in a certain region of rom and
splits it into a collection by 0x50. If rom is not supplied, uses the
  original rom data."
  [start length]
  (fn self
    ([rom]
       (take-nth 2
                 (partition-by #(= % 0x50)
                               (take length
                                     (drop start rom)))))
    ([]
      (self com.aurellem.gb.gb-driver/original-rom))))

(def hxc-thunk-words
  "Same as hxc-thunk, except it interprets the rom data as characters,
  returning a collection of strings."
  (comp
   (partial comp (partial map character-codes->str))
   hxc-thunk))

;; --------------------------------------------------


(defn hxc-pokenames-raw
  "The hardcoded names of the 190 species in memory. List begins at
ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
  long, these names are stripped of padding. See also, hxc-pokedex-names"
  ([]
     (hxc-pokenames-raw com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [count-species 190
           name-length 10]
       (map character-codes->str
            (partition name-length
                       (map #(if (= 0x50 %) 0x00 %)
                            (take (* count-species name-length)
                                  (drop 0xE8000
                                        rom))))))))
(def hxc-pokenames
  (comp
   (partial map format-name)
   hxc-pokenames-raw))




(defn hxc-pokedex-names
  "The names of the pokemon in hardcoded pokedex order. List of the
  pokedex numbers of each pokemon (in internal order) begins at
ROM@410B1. See also, hxc-pokenames."
  ([] (hxc-pokedex-names
       com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [names (hxc-pokenames rom)]
       (#(mapv %
               ((comp range count keys) %))
        (zipmap
         (take (count names)
               (drop 0x410b1 rom))
         
         names)))))

(def hxc-types
  "The hardcoded type names in memory. List begins at ROM@27D99,
  shortly before hxc-titles."
  (hxc-thunk-words 0x27D99 102))


;; http://hax.iimarck.us/topic/581/
(defn hxc-cry
  "The pokemon cry data in internal order. List begins at ROM@39462"
  ([](hxc-cry com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (zipmap
      (hxc-pokenames rom)
      (map
       (fn [[cry-id pitch length]]
         {:cry-id cry-id
         :pitch pitch
          :length length}
         )
       (partition 3
                  (drop 0x39462 rom))))))

(defn hxc-cry-groups
  ([] (hxc-cry-groups com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (map #(mapv first
                (filter
                 (fn [[k v]]
                   (= % (:cry-id v)))
                 (hxc-cry)))
          ((comp
            range
            count
            set
            (partial map :cry-id)
            vals
            hxc-cry)
           rom))))


(defn cry-conversion!
  "Convert Porygon's cry in ROM to be the cry of the given pokemon."
  [pkmn]
  (write-rom!
   (rewrite-memory
    (vec(rom))
    0x3965D 
    (map second
         ((hxc-cry) pkmn)))))




(def hxc-items-raw
  "The hardcoded names of the items in memory. List begins at
ROM@045B7"
  (hxc-thunk-words 0x45B7 870))

(def hxc-items
  "The hardcoded names of the items in memory, presented as
  keywords. List begins at ROM@045B7. See also, hxc-items-raw."
  (comp (partial map format-name) hxc-items-raw))



(def hxc-titles
  "The hardcoded names of the trainer titles in memory. List begins at
ROM@27E77"
  (hxc-thunk-words 0x27E77 196))


(def hxc-pokedex-text-raw
  "The hardcoded pokedex entries in memory. List begins at
ROM@B8000, shortly before move names."
  (hxc-thunk-words 0xB8000 14754))




(defn hxc-pokedex-text
  "The hardcoded pokedex entries in memory, presented as an
associative hash map. List begins at ROM@B8000."
  ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (zipmap
      (hxc-pokedex-names rom)
      (cons nil ;; for missingno.
            (hxc-pokedex-text-raw rom)))))

;; In red/blue, pokedex stats are in internal order.
;; In yellow, pokedex stats are in pokedex order.
(defn hxc-pokedex-stats
  "The hardcoded pokedex stats (species height weight) in memory. List
begins at ROM@40687"
  ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))
           pkmn-count (count pokedex-names)
           ]
     ((fn capture-stats
        [n stats data]
        (if (zero? n) stats
            (let [[species
                   [_
                    height-ft
                    height-in
                    weight-1
                    weight-2
                    _
                    dex-ptr-1
                    dex-ptr-2
                    dex-bank
                    _
                    & data]]
                  (split-with (partial not= 0x50) data)]
              (recur (dec n)
                     (assoc stats
                       (pokedex-names (- pkmn-count (dec n)))
                       {:species
                        (format-name (character-codes->str species))
                        :height-ft
                        height-ft
                        :height-in
                        height-in
                        :weight
                        (/ (low-high weight-1 weight-2) 10.)
                        
                    ;;    :text
                    ;;    (character-codes->str
                    ;;     (take-while
                    ;;      (partial not= 0x50)
                    ;;      (drop
                    ;;       (+ 0xB8000
                    ;;          -0x4000
                    ;;          (low-high dex-ptr-1 dex-ptr-2))
                    ;;       rom)))
                        })
                     
                     data)
              
              
              )))
      
      pkmn-count
      {}
      (drop 0x40687 rom)))       ))




(def hxc-places
  "The hardcoded place names in memory. List begins at
ROM@71500. [Cinnabar/Celadon] Mansion seems to be dynamically calculated."
  (hxc-thunk-words 0x71500 560))

(defn hxc-dialog
  "The hardcoded dialogue in memory, including in-game alerts. Dialog
  seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
  ([rom]
     (map character-codes->str
          (take-nth 2
                    (partition-by #(= % 0x57)
                                  (take 0x0F728
                                        (drop 0x98000 rom))))))
  ([]
     (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))


(def hxc-move-names
  "The hardcoded move names in memory. List begins at ROM@BC000"
  (hxc-thunk-words 0xBC000 1551))
(defn hxc-move-data
  "The hardcoded (basic (move effects)) in memory. List begins at
0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
  :fx-txt}. The move descriptions are handwritten, not hardcoded."
  ([]
     (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [names (vec (hxc-move-names rom))
           move-count (count names)
           move-size 6
           types pkmn-types ;;; !! hardcoded types
           ]
       (zipmap (map format-name names)
               (map
                (fn [[idx effect power type-id accuracy pp]]
                  {:name (names (dec idx))
                   :power power
                   :accuracy  accuracy
                   :pp pp
                   :type (types type-id)
                   :fx-id effect
                   :fx-txt (get move-effects effect) 
                   }
                  )
                
                (partition move-size
                           (take (* move-size move-count)
                                 (drop 0x38000 rom))))))))
  


(defn hxc-move-data*
  "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
  ([]
     (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [names (vec (hxc-move-names rom))
           move-count (count names)
           move-size 6
           format-name (fn [s]
                         (keyword (.toLowerCase
                                   (apply str
                                          (map #(if (= % \space) "-" %) s)))))
           ]
       (zipmap (map format-name names)
               (map
                (fn [[idx effect power type accuracy pp]]
                  {:name (names (dec idx))
                   :power power
                   :accuracy (hex accuracy)
                   :pp pp
                   :fx-id (hex effect)
                   :fx-txt (get move-effects effect) 
                   }
                  )
                
                (partition move-size
                           (take (* move-size move-count)
                                 (drop 0x38000 rom))))))))
  

(defn hxc-machines
  "The hardcoded moves taught by TMs and HMs. List begins at ROM@1232D."
  ([] (hxc-machines
       com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [moves (hxc-move-names rom)]
       (zipmap
        (range)
        (take-while
            (comp not nil?)
            (map (comp
                  format-name
                  (zipmap
                   (range)
                   moves)
              dec)
                 (take 100
                       (drop 0x1232D rom))))))))




(defn internal-id
  ([rom]
     (zipmap 
      (hxc-pokenames rom)
      (range)))
  ([]
     (internal-id com.aurellem.gb.gb-driver/original-rom)))





;; nidoran gender change upon levelup
;; (->
;;  @current-state
;;  rom
;;  vec
;;  (rewrite-memory
;;   (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
;;   [1 1 15])
;;  (rewrite-memory
;;   (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
;;   [1 1 3])
;;  (write-rom!)

;;  )



(defn hxc-advantage
  ;; in-game multipliers are stored as 10x their effective value
  ;; to allow for fractional multipliers like 1/2
  
  "The hardcoded type advantages in memory, returned as tuples of
  atk-type def-type multiplier. By default (i.e. if not listed here),
the multiplier is 1. List begins at 0x3E62D."
  ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (map
      (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
                            (get pkmn-types def (hex def))
                            (/ mult 10)])
      (partition 3
                 (take-while (partial not= 0xFF)
                             (drop 0x3E5FA rom))))))



(defn format-evo
  "Parse a sequence of evolution data, returning a map. First is the
method: 0 = end-evolution-data. 1 = level-up, 2 = item, 3 = trade. Next is an item id, if the
  method of evolution is by item (only stones will actually make pokemon
  evolve, for some auxillary reason.) Finally, the minimum level for
  evolution to occur (level 1 means no limit, which is used for trade
  and item evolutions), followed by the internal id of the pokemon
  into which to evolve. Hence, level up and trade evolutions are
  described with 3
  bytes; item evolutions with four."
  [coll]
  (let [method (first coll)]
    (cond (empty? coll) []
          (= 0 method) [] ;; just in case
          (= 1 method) ;; level-up evolution
          (conj (format-evo (drop 3 coll))
                            {:method :level-up
                             :min-level (nth coll 1)
                             :into (dec (nth coll 2))})
          
          (= 2 method) ;; item evolution
          (conj (format-evo (drop 4 coll))
                {:method :item
                 :item (dec (nth coll 1))
                 :min-level (nth coll 2)
                 :into (dec (nth coll 3))})

          (= 3 method) ;; trade evolution
          (conj (format-evo (drop 3 coll))
                {:method :trade
                 :min-level (nth coll 1) ;; always 1 for trade.
                 :into (dec (nth coll 2))}))))


(defn hxc-ptrs-evolve
  "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
in internal order."
  ([]
     (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [
           pkmn-count (count (hxc-pokenames-raw)) ;; 190
           ptrs
           (map (fn [[a b]] (low-high a b))
                (partition 2
                           (take (* 2 pkmn-count)
                                 (drop 0x3b1e5 rom))))]
       (map (partial + 0x34000) ptrs)

       )))

(defn hxc-evolution
  "Hardcoded evolution data in memory. The data exists at ROM@34000,
  sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
  ([rom]
       (apply assoc {}
               (interleave
                (hxc-pokenames rom)
                (map
                 (comp
                  format-evo
                  (partial take-while (comp not zero?))
                  #(drop % rom))
                 (hxc-ptrs-evolve rom)
                 )))))

(defn hxc-evolution-pretty
  "Like hxc-evolution, except it uses the names of items and pokemon
--- grabbed from ROM --- rather than their numerical identifiers."
  ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let
         [poke-names (vec (hxc-pokenames rom))
          item-names (vec (hxc-items rom))
          use-names
          (fn [m]
            (loop [ks (keys m) new-map m]
              (let [k (first ks)]
                (cond (nil? ks) new-map
                      (= k :into)
                      (recur
                       (next ks)
                       (assoc new-map
                         :into
                         (poke-names
                          (:into
                           new-map))))
                      (= k :item)
                      (recur
                       (next ks)
                       (assoc new-map
                         :item
                         (item-names
                          (:item new-map))))
                      :else
                      (recur
                       (next ks)
                       new-map)
                      ))))]

       (into {}
             (map (fn [[pkmn evo-coll]]
                    [pkmn (map use-names evo-coll)])
                  (hxc-evolution rom))))))




(defn hxc-learnsets
  "Hardcoded map associating pokemon names to lists of pairs [lvl
  move] of abilities they learn as they level up. The data
exists at ROM@34000, sorted by internal order. Pointers to the data
  exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
  ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (apply assoc
            {}
            (interleave
             (hxc-pokenames rom)
             (map (comp
                   (partial map
                            (fn [[lvl mv]] [lvl (dec mv)]))
                   (partial partition 2)
                   ;; keep the learnset data
                   (partial take-while (comp not zero?))
                   ;; skip the evolution data
                   rest
                   (partial drop-while (comp not zero?)))
                  (map #(drop % rom) 
                       (hxc-ptrs-evolve rom)))))))

(defn hxc-learnsets-pretty
  "Live hxc-learnsets except it reports the name of each move --- as
it appears in rom --- rather than the move index."
  ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [moves (vec(map format-name (hxc-move-names)))]
       (into {}
             (map (fn [[pkmn learnset]]
                    [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
                               learnset)])
                  (hxc-learnsets rom))))))
             
                                  

(defn hxc-pokemon-base
  ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [entry-size 28
          
           pokemon (rest (hxc-pokedex-names))
 pkmn-count (inc(count pokemon))
           types (apply assoc {}
                        (interleave
                         (range)
                         pkmn-types)) ;;!! softcoded
           moves (apply assoc {}
                        (interleave
                         (range)
                         (map format-name
                              (hxc-move-names rom))))
           machines (hxc-machines)
           ]
       (zipmap
        pokemon
        (map
         (fn [[n
               rating-hp
               rating-atk
               rating-def
               rating-speed
               rating-special
               type-1
               type-2
               rarity ;; catch rate
               rating-xp ;; base exp yield
               pic-dimensions ;; tile_width|tile_height (8px/tile)
               ptr-pic-obverse-1
               ptr-pic-obverse-2
               ptr-pic-reverse-1
               ptr-pic-reverse-2
               move-1 ;; attacks known at level 0 [i.e. by default]
               move-2 ;; (0 for none)
               move-3
               move-4
               growth-rate
               &
               TMs|HMs]]
           (let
               [base-moves
                (mapv moves
                      ((comp
                        ;; since the game uses zero as a delimiter,
                        ;; it must also increment all move indices by 1.
                        ;; heren we decrement to correct this.
                        (partial map dec)
                        (partial take-while (comp not zero?)))
                       [move-1 move-2 move-3 move-4]))
                
                types
                (set (list (types type-1)
                           (types type-2)))
                TMs|HMs
                (map
                 (comp
                  (partial map first)
                  (partial remove (comp zero? second)))
                 (split-at
                  50
                  (map vector
                       (rest(range))
                       (reduce concat
                               (map
                                #(take 8
                                       (concat (bit-list %)
                                               (repeat 0)))
                                
                                TMs|HMs)))))
                
                TMs  (vec (first TMs|HMs))
                HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))
                
                
                ]
             
             
             {:dex# n
              :base-moves base-moves
              :types types
              :TMs TMs
              :HMs HMs
              :base-hp rating-hp
              :base-atk rating-atk
              :base-def rating-def
              :base-speed rating-speed
              :base-special rating-special
              :o0 pic-dimensions
              :o1 ptr-pic-obverse-1
              :o2 ptr-pic-obverse-2
              }))
         
         (partition entry-size
                    (take (* entry-size pkmn-count)
                          (drop 0x383DE
                                rom))))))))

  
  
(defn hxc-intro-pkmn
  "The hardcoded pokemon to display in Prof. Oak's introduction; the pokemon's
internal id is stored at ROM@5EDB."
  ([] (hxc-intro-pkmn
       com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (nth (hxc-pokenames rom) (nth rom 0x5EDB))))

(defn sxc-intro-pkmn!
  "Set the hardcoded pokemon to display in Prof. Oak's introduction."
  [pokemon]
  (write-rom! 
   (rewrite-rom 0x5EDB
                [
                 (inc
                  ((zipmap
                    (hxc-pokenames)
                    (range))
                   pokemon))])))
  

(defn hxc-item-prices
  "The hardcoded list of item prices in memory. List begins at ROM@4495"
  ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [items (hxc-items rom)
           price-size 3]
       (zipmap items
               (map (comp
                     ;; zero-cost items are "priceless"
                     #(if (zero? %) :priceless %)
                     decode-bcd butlast)
                    (partition price-size
                               (take (* price-size (count items))
                                     (drop 0x4495 rom))))))))

(defn hxc-shops
  ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [items (zipmap (range) (hxc-items rom))

           ;; temporarily softcode the TM items
           items (into
                  items
                  (map (juxt identity
                             (comp keyword
                                   (partial str "tm-")
                                   (partial + 1 -200)
                                   )) 
                       (take 200 (drop 200 (range)))))
                       
           ]

       ((fn parse-shop [coll [num-items & items-etc]]
          (let [inventory (take-while
                           (partial not= 0xFF)
                           items-etc)
               [separator & items-etc] (drop num-items (rest items-etc))]
           (if (= separator 0x50)
             (map (partial mapv (comp items dec)) (conj coll inventory))
             (recur (conj coll inventory) items-etc)
             )
         ))

        '()
        (drop 0x233C rom))

     
     )))


;; 0x0489, relative to 0xCB95, points to 0xCD89.
(defn hxc-ptrs-wild
  "A list of the hardcoded wild encounter data in memory. Pointers
  begin at ROM@0CB95; data begins at ROM@0x0CD89" 
  ([] (hxc-ptrs-wild com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [ptrs
           (map (fn [[a b]] (+ a (* 0x100 b)))
            (take-while (partial not= (list 0xFF 0xFF))
                            (partition 2 (drop 0xCB95 rom))))]
       ptrs)))



(defn hxc-wilds
  "A list of the hardcoded wild encounter data in memory. Pointers
  begin at ROM@0CB95; data begins at ROM@0x0CD89" 
  ([] (hxc-wilds com.aurellem.gb.gb-driver/original-rom))
  ([rom]
     (let [pokenames (zipmap (range) (hxc-pokenames rom))]
       (map
        (partial map 
                 (fn [[a b]]
                   {:species (pokenames (dec b))
                    :level a}))
        (partition 10  
                   (take-while
                    (comp (partial not= 1) first) 
                    (partition 2
                               (drop 0xCD8C rom))
                   
                   ))))))



;; ********************** MANIPULATION FNS


(defn same-type
  ([pkmn move]
     (same-type
      com.aurellem.gb.gb-driver/original-rom pkmn move))
  ([rom pkmn move]
     (((comp :types (hxc-pokemon-base rom)) pkmn)
      ((comp :type (hxc-move-data rom)) move))))




(defn submap?
  "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false." 
  [map-small map-big]
  (cond (empty? map-small) true
        (and
         (contains? map-big (ffirst map-small))
         (= (get map-big (ffirst map-small))
            (second (first map-small))))
        (recur (next map-small) map-big)

        :else false))  


(defn search-map [proto-map maps]
  "Returns all the maps that make the same associations as proto-map."
  (some (partial submap? proto-map) maps))

(defn filter-vals
  "Returns a map consisting of all the pairs [key val] for
  which (pred key) returns true."
  [pred map]
  (reduce (partial apply assoc) {}
          (filter (fn [[k v]] (pred v)) map)))


(defn search-moves
  "Returns a subcollection of all hardcoded moves with the
  given attributes. Attributes consist of :name :power
  :accuracy :pp :fx-id
  (and also :fx-txt, but it contains the same information
  as :fx-id)"
  ([attribute-map]
     (search-moves
      com.aurellem.gb.gb-driver/original-rom attribute-map))
  ([rom attribute-map]
     (filter-vals (partial submap? attribute-map)
                  (hxc-move-data rom))))





;; note: 0x2f31 contains the names "TM" "HM"?

;; note for later: credits start at F1290

;; note: DADB hyper-potion-hp _ _ _ super-potion-hp _ _ _ potion-hp ??

;; note: DD4D spells out pokemon vital stat names ("speed", etc.)

;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE.
;; The first instance is for Machines; the second, for stones.

;; note: according to
;; http://www.upokecenter.com/games/rby/guides/rgbtrainers.php
;; the amount of money given by a trainer is equal to the 
;; base money times the level of the last Pokemon on that trainer's
;; list. Other sources say it's the the level of the last pokemon 
;; /defeated/.

;; todo: find base money.


;; note: 0xDFEA (in indexable mem) is the dex# of the currently-viewed Pokemon in
   ;; in the pokedex. It's used for other purposes if there is none.

;; note: 0x9D35 (index.) switches from 0xFF to 0x00 temporarily when
;;   you walk between areas. 

;; note: 0xD059 (index.) is the special battle type of your next battle:
;; - 00 is a usual battle
;; - 01 is a pre-scripted OLD MAN battle which always fails to catch the
;;      target Pokemon.
;; - 02 is a safari zone battle
;; - 03  obligates you to run away. (unused) 
;; - 04 is a pre-scripted OAK battle, which (temporarily) causes the
;;      enemy Pokemon to cry PIKAAA, and which always catches the target
;;      Pokemon. The target Pokemon is erased after the battle.
;; - 05+ are glitch states in which you are sort of the Pokemon.


;; note: 0x251A (in indexable mem): image decompression routine seems to begin here.

;; note: 0x4845 (index): vending inventory is loaded here. possibly
   ;; other things, too.
(comment
  ;; temporarily intercept/adjust what pops out of the vending
  ;; machine.
  ;; (and how much it costs)

  ;; located at 0x4845
  ;; not to be confused with shop inventory, 0xCF7B
  (do 
    (step (read-state "vend-menu"))
    (write-memory! (rewrite-memory (vec(memory)) 0x4845 [2 0 1 0]))
    (step @current-state [:a])
    (step @current-state [])
    (nstep @current-state 200) ))


;; Note: There are two tile tables, one from 8000-8FFF, the other from
;; 8800-97FF. The latter contains symbols, possibly map tiles(?), with some japanese chars and stuff at the end. 
(defn print-pixel-letters!
  "The pixel tiles representing letters. Neat!"
 ([] (print-pixel-letters! (read-state "oak-speaks"))) 
([state] 
   (map
    (comp
     println
     (partial map #(if (zero? %) \space 0))
     #(if (< (count %) 8)
        (recur (cons 0 %))
        %)
     reverse bit-list)
    
    (take 0xFFF (drop 0x8800 (memory state))))))


;; (defn test-2 []
;;   (loop [n 0
;;          pc-1 (pc-trail (-> state-defend (tick) (step [:a]) (step [:a]) (step []) (nstep 100)) 100000)
;;          pc-2 (pc-trail (-> state-speed (tick) (step [:a]) (step [:a])
;;   (step []) (nstep 100)) 100000)]
;;     (cond (empty? (drop n pc-1)) [pc-1 n]
;;           (not= (take 10 (drop n pc-1)) (take 10 pc-2))
;;           (recur  pc-1 pc-2 (inc n))
;;           :else
;;           [(take 1000 pc-2) n])))




(defn test-3 
  "Explore trainer data"
  ([] (test-3 0x3A289))
  ([start]
  (let [pokenames (vec(hxc-pokenames-raw))]
    (println 
     (reduce
      str
      (map
       (fn [[adr lvl pkmn]]
         (str (format "%-11s %4d       %02X %02X \t %05X\n"
                      
                      (cond
                        (zero? lvl) "+"
                        (nil? (get pokenames (dec pkmn)))
                        "-"
                        :else
                        (get pokenames (dec pkmn)))
                      lvl
                      pkmn
                      lvl
                      adr
                      )))
       (map cons
            (take-nth 2 (drop start (range)))
            (partition 2
                       (take 400;;703
                             (drop
                              start
                              ;; 0x3A75D
                              (rom)))))))))))
  
(defn search-memory* [mem codes k]
  (loop [index 0
         index-next 1
         start-match 0
         to-match codes
         matches []]
    (cond
      (>= index (count mem)) matches

      (empty? to-match)
      (recur
       index-next
       (inc index-next)
       index-next
       codes
       (conj matches
             [(hex start-match) (take k (drop start-match mem))])
       )

      (or (= (first to-match) \_) ;; wildcard
          (= (first to-match) (nth mem index)))
      (recur
       (inc index)
       index-next
       start-match
       (rest to-match)
       matches)

      :else
      (recur
       index-next
       (inc index-next)
       index-next
       codes
       matches))))


(def script-use-ball
  [0xFA ;; ld A, nn
   \_
   \_
   0xA7 ;; and A
   0xCA ;; JP Z
   \_
   \_
   0x3D ;; dec A
   0xC2 ;; JP NZ
   \_
   \_
   0xFA ;; LD A
   \_
   \_
   ])



(defn search-pattern [ptn coll]
  (loop
      [index 0
       to-match ptn
       binds {}

       next-index 1
       match-start 0
       matches []]

    (cond
        (>= index (count coll)) matches
        (empty? to-match)
        (recur
         next-index
         ptn
         {}
         (inc next-index)
         next-index
         (conj match-start
               [(hex match-start) binds]))

        :else
        (let [k (first to-match)
              v (nth coll index)]
        (cond
          (= k \_) ;; wildcard
          (recur
           (inc index)
           (rest to-match)
           binds

           next-index
           match-start
           matches)

          (keyword? k)
          (if (binds k)
            (if (= (binds k) v)
              (recur
               (inc index)
               (rest to-match)
               binds
               next-index
               match-start
               matches)

              (recur
               next-index
               ptn
               {}
               (inc next-index)
               next-index
               matches))
              
              ;; ;; consistent bindings
              ;; (recur
              ;;  (inc index)
              ;;  (rest to-match)
              ;;  binds

              ;;  next-index
              ;;  match-start
              ;;  matches)

              ;; ;; inconsistent bindings
              ;; (recur
              ;;  next-index
              ;;  ptn
              ;;  {}
              ;;  (inc next-index)
              ;;  next-index
              ;;  matches))
              
            (if ((set (vals binds)) v)
              ;; bindings are not unique
              (recur
               next-index
               ptn
               {}
               (inc next-index)
               next-index
               matches)

              ;; bindings are unique
              (recur
               (inc index)
               (rest to-match)
               (assoc binds k v)

               next-index
               match-start
               matches)))

          :else ;; k is just a number
          (if (= k v)
            (recur
             (inc index)
             (rest to-match)
             binds

             next-index
             match-start
             matches)

            (recur
             next-index
             ptn
             {}
             (inc next-index)
             next-index
             matches)))))))

            
            

              




(defn search-pattern* [ptn coll]
  (loop
      [
       binds {}
       index 0
       index-next 1
       start-match 0
       to-match ptn
       matches []]

    (cond
        (>= index (count coll)) matches
        (empty? to-match)
        (recur
         {}
         index-next
         (inc index-next)
         index-next
         ptn
         (conj matches
               [(hex start-match) binds]))

        :else
        (let [k (first to-match)
              v (nth coll index)]
        (cond
          (= k \_) ;; wildcard
          (recur
           binds
           (inc index)
           index-next
           start-match
           (rest to-match)
           matches)

          (keyword? k)
          (if (binds k)
            (if (= (binds k) v)
              (recur
               binds
               (inc index)
               index-next
               start-match
               (rest to-match)
               matches)
              (recur
               {}
               index-next
               (inc index-next)
               index-next
               ptn
               matches))
            (if
                ;; every symbol must be bound to a different thing.
              ((set (vals binds)) v)
              (recur
               {}
               index-next
               (inc index-next)
               index-next
               ptn
               matches)
              (recur
               (assoc binds k v)
               (inc index)
               index-next
               start-match
               (rest to-match)
               matches)))

          :else
          (if (= k v)
            (recur
             binds
             (inc index)
             index-next
             start-match
             (rest to-match)
             matches)
            (recur
             {}
             index-next
             (inc index-next)
             index-next
             ptn
             matches))



)))))
             



;; look for the rainbow badge in memory
(println (reduce str (map #(str (first %) "\t" (vec(second %)) "\n") (search-memory (rom) [221] 10))))


(comment 

(def hxc-later
  "Running this code produces, e.g. hardcoded names NPCs give
their pokemon. Will sort through it later."
(print (character-codes->str(take 10000
                          (drop 0x71597
                                (rom (root)))))))

(let [dex
      (partition-by #(= 0x50 %)
                    (take 2540
                          (drop 0x40687
                                (rom (root)))))]
  (def dex dex)
  (def hxc-species
    (map character-codes->str
         (take-nth 4 dex))))
)