view clojure/com/aurellem/world/practice.clj @ 194:67c42608ef9d

Further explorations in memory.
author Dylan Holmes <ocsenave@gmail.com>
date Fri, 23 Mar 2012 00:24:54 -0500
parents c8ec477beeac
children d5dddf33543c
line wrap: on
line source
1 (ns com.aurellem.world.practice
2 (:use (com.aurellem.gb saves util constants gb-driver vbm items
3 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) state
15 (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-surprise
25 "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-inject
40 "I have replaced the letter e with e-acute @ 0xC4E8."
41 []
42 (read-state "inject-surprise"))
47 (defn pc-trail
48 "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) pcs
54 (do
55 (com.aurellem.gb.Gb/tick)
56 (recur (conj pcs (PC)))))))
60 (defn differences [list-1 list-2]
61 (remove
62 (fn [[a b c]] (= b c))
63 (map vector
64 (range)
65 list-1
66 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 (remove
75 (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-speak
86 "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-change
111 "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 (do
120 (com.aurellem.gb.Gb/tick)
121 (recur))))
122 (update-state)))
126 (defn spell [state mem n]
127 (print (character-codes->str
128 (take n (drop mem
129 (vec(memory state)))))))
132 (do
133 (println)
134 (print (character-codes->str (take 6000 (drop 0xA75F4
135 (vec(com.aurellem.gb.gb-driver/rom))))))
136 )
138 ;(dorun (map println (view-memory* (state-surprise) 0x1AEF 1600)))
142 (def surprise-words
143 [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 sublist
146 "Unshifts the list until the sublist is at the start."
147 [list sub]
148 (cond
149 (empty? sub) list
150 (empty? list) nil
151 (= (take (count sub) list) sub) list
152 :else (recur (rest list) sub)))
154 (defn subloc
155 "Returns the position of the first occurence of sublist."
156 [list sub]
157 (loop [n 0 a list]
158 (cond
159 (empty? a) nil
160 (= (take (count sub) a) sub) n
161 :else (recur (inc n) (rest a)))))
166 (defn change-speech
167 ([state str k]
168 (loop [ops str
169 s state
170 n k]
171 (if (empty? ops) s
172 (recur
173 (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 )