# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1332809845 18000
# Node ID 1b5c33614b0d5551070dabcd912d7ea427956481
# Parent  11cfe6dcb80381367b21e33f08956e19cdf77cad# Parent  b2f9a0cb13e3efa3a553024ad59b3d6c54ba851b
merge

diff -r 11cfe6dcb803 -r 1b5c33614b0d clojure/com/aurellem/gb/characters.clj
--- a/clojure/com/aurellem/gb/characters.clj	Mon Mar 26 19:56:57 2012 -0500
+++ b/clojure/com/aurellem/gb/characters.clj	Mon Mar 26 19:57:25 2012 -0500
@@ -62,16 +62,16 @@
    0x0 "" ;; separator character?
    0x58 "\n"
    ;;0x00   "<";;"end-of-name-sentinel" ;; begin messsage
-   ;;0x49   "\n //" ;; ocsenave: pagebreak pokedex
-   ;;0x4E   "\n..." ; ocsenave: clearscroll pokedex page
-   ;;0x4F   "\n" ; newline
-   ;;0x50   "#";;"end-of-pokemon-name-sentinel"
-   ;;0x51   "\n\n" ;; ocsenave: clear screen
+   0x49   "\n //" ;; ocsenave: pagebreak pokedex
+   0x4E   "\n..." ; ocsenave: clearscroll pokedex page
+   0x4F   "\n" ; newline
+   0x50   "#";;"end-of-pokemon-name-sentinel"
+   0x51   "\n\n" ;; ocsenave: clear screen
    0x52 "[RED]" ;;ocsenave: placeholder for your name?
    0x54   "[POKE]"
-   ;;0x55   "_" ;; ocsenave: breaking space?
-   ;0x57   ">" ;; ocsenave: end message
-   ;0x5F   ">" ;; ocsenave: end pokedex entry??
+   0x55   "_" ;; ocsenave: breaking space?
+   0x57   ">" ;; ocsenave: end message
+   0x5F   ">" ;; ocsenave: end pokedex entry??
    0x60   "A-bold"
    0x61   "B-bold"
    0x62   "C-bold"
diff -r 11cfe6dcb803 -r 1b5c33614b0d clojure/com/aurellem/gb/hxc.clj
--- a/clojure/com/aurellem/gb/hxc.clj	Mon Mar 26 19:56:57 2012 -0500
+++ b/clojure/com/aurellem/gb/hxc.clj	Mon Mar 26 19:57:25 2012 -0500
@@ -9,6 +9,23 @@
 
 ; ************* HANDWRITTEN CONSTANTS
 
+
+
+(defn low-high
+  [low high]
+  (+ low (* 256 high)))
+  
+
+(defn format-name
+  "Convert the string of alphabetic/space characters into a keyword by
+  replacing spaces with hyphens and converting to lowercase."
+  [s]
+  (keyword (.toLowerCase
+            (apply str
+                   (map #(if (= % \space) "-" %) s)))))
+
+  
+
 (def pkmn-types
   [:normal
    :fighting
@@ -53,7 +70,7 @@
    "0x19 chance of burn"
    "0x19 chance of freeze"
    "0x19 chance of paralyze"
-   "user faints; opponent defense halved."
+   "user faints; opponent defense halved during attack."
    "leech half of inflicted damage ONLY if sleeping opponent."
    "imitate last attack"
    "user atk +1"
@@ -141,7 +158,7 @@
 ;; ************** HARDCODED DATA
 
 (defn hxc-thunk
-  "Creates a thunk (unary fn) that grabs data in a certain region of rom and
+  "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]
@@ -179,6 +196,78 @@
 ROM@27E77"
   (hxc-thunk-words 0x27E77 196))
 
+
+(def hxc-pokedex-text
+  "The hardcoded pokedex entries in memory. List begins at
+ROM@B8000, shortly before move names."
+  (hxc-thunk-words 0xB8000 14754))
+
+
+;; In red/blue, pokemon are in internal order.
+;; In yellow, pokemon are in pokedex order.
+
+(defn hxc-pokedex-stats
+  ;; uses hxc-pokedex-text to count pokemon
+  ;; since hxc-pokenames includes several missingno"
+  ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
+  ([rom]
+     (let [poketext (hxc-pokedex-text)
+           pkmn-count (count poketext)
+           ]
+     ((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
+                       (- pkmn-count n)
+                       {:species
+                        (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] Mansion seems to be dynamically calculated."
@@ -198,10 +287,7 @@
      (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
 
 
-(def hxc-pokedex
-  "The hardcoded pokedex entries in memory. List begins at
-ROM@B8000, shortly before move names."
-  (hxc-thunk-words 0xB8000 14754))
+
 
 (def hxc-move-names
   "The hardcoded move names in memory. List begins at ROM@BC000"
@@ -217,11 +303,7 @@
   ([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)))))]
+           move-size 6]
        (zipmap (map format-name names)
                (map
                 (fn [[idx effect power type accuracy pp]]
@@ -287,6 +369,22 @@
                                   (drop 0xE8000
                                         rom))))))))
 
+
+
+
+(defn internal-id
+  ([rom]
+     (zipmap 
+      (map format-name (hxc-pokenames rom))
+      (range)))
+  ([]
+     (internal-id com.aurellem.gb.gb-driver/original-rom)))
+  
+
+
+
+
+
 (defn hxc-advantage
   "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."
@@ -303,7 +401,92 @@
 
 
 
+(defn format-evo
+  [[method x y z & _]]
+   (cond (= 0 method)
+         {:method :none}
+         (= 1 method)
+         {:method :level-up
+          :min-level x
+          :into y}
+         (= 2 method)
+         {:method :item
+          :item-id x
+          :min-level y
+          :into z}
+         (= 3 method)
+         {:method :trade
+          :min-level x
+          :into y}))
 
+(defn format-evo*
+  [[method x y z & _]]
+  (cond (= 0 method)
+        {:method :none}
+        (= 1 method)
+        {:method :level-up
+         :min-level x
+         :into (format-name (nth (hxc-pokenames) (dec y)))}
+        (= 2 method)
+        {:method :item
+         :item (format-name (nth (hxc-items)  (dec x)))
+         :min-level y
+         :into (format-name (nth (hxc-pokenames) (dec z)))}
+        (= 3 method)
+        {:method :trade
+         :min-level x
+         :into (format-name (nth (hxc-pokenames) (dec y)))}))
+
+(defn hxc-evolution
+  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
+  ([rom]
+     (let [names (hxc-pokenames rom)
+           pkmn-count (count names)
+           evo-data (drop 0x33fef rom) 
+           ptrs
+           (map (fn [[a b]](low-high a b))
+                (partition 2
+                           (take (* 2 pkmn-count)
+                                 (drop 0x3b1e5 rom))))
+           ]
+       (apply assoc {}
+               (interleave
+                (map format-name (hxc-pokenames))
+                (map
+                 (comp
+                  format-evo
+                  (partial take 5)
+                  #(drop % rom)
+                  (partial + 0x34000))
+                 ptrs)))
+
+       )))
+
+
+(defn hxc-evolution*
+  ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
+  ([rom]
+     (let [names (hxc-pokenames rom)
+           pkmn-count (count names)
+           evo-data (drop 0x33fef rom) 
+           ptrs
+           (map (fn [[a b]](low-high a b))
+                (partition 2
+                           (take (* 2 pkmn-count)
+                                 (drop 0x3b1e5 rom))))
+           ]
+       (apply assoc {}
+               (interleave
+                (map format-name (hxc-pokenames))
+                (map
+                 (comp
+                  format-evo*
+                  (partial take 5)
+                  #(drop % rom)
+                  (partial + 0x34000))
+                 ptrs)))
+
+       )))
 
 
 
@@ -384,4 +567,8 @@
   (def hxc-species
     (map character-codes->str
          (take-nth 4 dex))))
-)
\ No newline at end of file
+)
+
+
+
+
diff -r 11cfe6dcb803 -r 1b5c33614b0d clojure/com/aurellem/world/practice.clj
--- a/clojure/com/aurellem/world/practice.clj	Mon Mar 26 19:56:57 2012 -0500
+++ b/clojure/com/aurellem/world/practice.clj	Mon Mar 26 19:57:25 2012 -0500
@@ -1,6 +1,4 @@
 (ns com.aurellem.world.practice
-  (:use (com.aurellem.gb gb-driver))
-
  (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly characters))
  (:use (com.aurellem.run title))
  (:use (com.aurellem.exp pokemon))
@@ -18,7 +16,9 @@
       (recur (step state) (dec n))))
 
 
-(defn view-memory* [state start length]
+(defn view-memory*
+  "View a region of indexable memory in the given state."
+  [state start length]
   ((comp vec map)
    #((comp  aget) (memory state) %)
    (range start (+ start length))))
@@ -181,19 +181,34 @@
                     (drop (inc m) list)
                     sub))))))
 
+
+
+(defn search-rom
+  "Search for the given codes in ROM, returning short snippets of
+text around the results."
+  ([codes k]
+     (search-rom com.aurellem.gb.gb-driver/original-rom codes k))
+  ([rom codes k]
+     (map
+      (fn [n]
+        [(hex n)
+         (take k (drop n rom))])
+      
+      (find-sublists
+       rom
+       codes))))
+
 (defn spelling-bee
   "Search for the given string in ROM, returning short snippets of
-text around the results."
-  [str k]
-  (let [rom (rom(root))]
-    (map
-     (fn [n]
-       [(hex n)
-        (character-codes->str (take k (drop n rom)))])
+  text around the results."
+  ([str k]
+     (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
+  ([rom str k]
+     (map
+      (fn [[address snip]]
+        [address (character-codes->str snip)]
+        (search-rom rom (str->character-codes str) k)))))
      
-     (find-sublists
-      rom
-      (str->character-codes str)))))