Mercurial > vba-clojure
view clojure/com/aurellem/world/practice.clj @ 210:565f5d17f90a
fixed minor bug in give-pokemon
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 23 Mar 2012 05:58:04 -0500 |
parents | 67c42608ef9d |
children | d5dddf33543c |
line wrap: on
line source
1 (ns com.aurellem.world.practice2 (:use (com.aurellem.gb saves util constants gb-driver vbm items3 assembly characters))4 (:use (com.aurellem.run title save-corruption))5 ;;(:use (com.aurellem.exp pokemon))6 (:use (com.aurellem.exp item-bridge))7 (:import [com.aurellem.gb.gb_driver SaveState])9 )11 (def hex-pc (comp hex PC))13 (defn nstep [state n]14 (if (zero? n) state15 (recur (step state) (dec n))))18 (defn view-memory* [state start length]19 ((comp vec map)20 #((comp aget) (memory state) %)21 (range start (+ start length))))24 (defn state-surprise25 "This is one tick before the trainer goes [!]"26 []27 (->28 (pre-trainer-battle)29 (step [:r])30 (step)31 (ntick 88147)32 ;(step [:r])34 ;(step [:r])35 ;(step [:r])36 ;(step [:r])37 ;(step [:r])38 ))39 (defn state-inject40 "I have replaced the letter e with e-acute @ 0xC4E8."41 []42 (read-state "inject-surprise"))47 (defn pc-trail48 "Track the PC for a number of ticks."49 [state ticks]50 (tick state)51 (set-state! state)52 (loop [pcs [(PC)] ]53 (if (> (count pcs) ticks) pcs54 (do55 (com.aurellem.gb.Gb/tick)56 (recur (conj pcs (PC)))))))60 (defn differences [list-1 list-2]61 (remove62 (fn [[a b c]] (= b c))63 (map vector64 (range)65 list-166 list-2)))68 (defn pc-diff [state-1 state-2]69 (differences (map hex (pc-trail state-1 10000))70 (map hex (pc-trail state-2 10000))))73 (defn memory-diff [state-1 state-2]74 (remove75 (fn[[a b c]] (= b c))76 (map (comp vec (partial map hex) list)77 (range)78 (vec (memory state-1))79 (vec (memory state-2)))80 )81 )85 (defn state-speak86 "This is when the trainer speaks."87 []88 (->89 (pre-trainer-battle)90 (set-memory 0xD354 0x0)91 (step [:r])92 (step)93 (ntick 88147)94 (tick)95 (nstep 102)97 ;(step [:r])99 ;(step [:r])100 ;(step [:r])101 ;(step [:r])102 ;(step [:r])103 ))107 (defn get-memory [state n]108 (aget (memory state) n))110 (defn first-change111 "Watch the current memory location as it ticks,112 return the first state that differs at location mem."113 [state n]114 (tick state)115 (set-state! state)116 (let [init (aget (memory state) n)]117 (loop []118 (if (= (aget (memory) n) init)119 (do120 (com.aurellem.gb.Gb/tick)121 (recur))))122 (update-state)))126 (defn spell [state mem n]127 (print (character-codes->str128 (take n (drop mem129 (vec(memory state)))))))132 (do133 (println)134 (print (character-codes->str (take 6000 (drop 0xA75F4135 (vec(com.aurellem.gb.gb-driver/rom))))))136 )138 ;(dorun (map println (view-memory* (state-surprise) 0x1AEF 1600)))142 (def surprise-words143 [0x80 0xAB 0xAB 0x7F 0xB1 0xA8 0xA6 0xA7 0xB3 0xE7 0x7F 0x8B 0xA4 0xB3 0xE0 0xB2 0x7F 0xB1 0xAE 0xAB 0xAB 0x7F 0xB3 0xA7 0xA4 0x7F 0xA3 0xA8 0xA2 0xA4 0xE7])145 (defn sublist146 "Unshifts the list until the sublist is at the start."147 [list sub]148 (cond149 (empty? sub) list150 (empty? list) nil151 (= (take (count sub) list) sub) list152 :else (recur (rest list) sub)))154 (defn subloc155 "Returns the position of the first occurence of sublist."156 [list sub]157 (loop [n 0 a list]158 (cond159 (empty? a) nil160 (= (take (count sub) a) sub) n161 :else (recur (inc n) (rest a)))))166 (defn change-speech167 ([state str k]168 (loop [ops str169 s state170 n k]171 (if (empty? ops) s172 (recur173 (rest ops)174 (set-memory (first-change s (+ 0xC4B9 n)) (+ 0xC4B9 n)175 (first ops))176 (if (not= n 19) (inc n)177 (+ n 21))))))178 ([str k]179 (change-speech (state-speak) str k))180 ([str]181 (change-speech str 0))186 )