Mercurial > vba-clojure

comparison clojure/com/aurellem/run/util.clj @ 314:073600cba28a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
scroll text works robustly but is slow
author Robert McIntyre <rlm@mit.edu>
date Mon, 02 Apr 2012 20:30:02 -0500
parents 8e63b0bb8ea3
children d263df762c59
comparison
equal deleted inserted replaced
313:8e63b0bb8ea3 314:073600cba28a
1 (ns com.aurellem.run.util 1 (ns com.aurellem.run.util
2 (:use (com.aurellem.gb util gb-driver vbm characters)) 2 (:use (com.aurellem.gb util gb-driver vbm characters saves))
3 (:import [com.aurellem.gb.gb_driver SaveState])) 3 (:import [com.aurellem.gb.gb_driver SaveState]))
4 4
5 (def ↑ [:u]) 5 (def ↑ [:u])
6 (def ↓ [:d]) 6 (def ↓ [:d])
7 (def ← [:l]) 7 (def ← [:l])
17 alt-val (difference-metric alt-branch)] 17 alt-val (difference-metric alt-branch)]
18 (if (not= base-val alt-val) 18 (if (not= base-val alt-val)
19 [(conj actions alt) alt-branch] 19 [(conj actions alt) alt-branch]
20 (recur base-branch (conj actions base)))))) 20 (recur base-branch (conj actions base))))))
21 21
22
23 (defn repeat-until-different 22 (defn repeat-until-different
24 [buttons metric [moves root]] 23 [buttons metric [moves root :as script]]
25 (let [baseline (metric root)] 24 (let [baseline (metric root)]
26 (loop [actions (vec moves) 25 (loop [actions (vec moves)
27 state root] 26 state root]
28 (let [new-state (step state buttons) 27 (let [new-state (step state buttons)
29 new-actions (conj actions buttons)] 28 new-actions (conj actions buttons)]
30 (if (not= (metric new-state) baseline) 29 (if (not= (metric new-state) baseline)
31 [new-actions new-state] 30 [new-actions new-state]
32 (recur new-actions new-state)))))) 31 (recur new-actions new-state))))))
33 32
34 33 (defn delayed-difference
35 34 [base alt delay difference-metric [moves root :as script]]
35 (loop [branch-point root
36 actions moves]
37 (let [base-branch (step branch-point base)
38 base-val
39 (difference-metric
40 (run-moves base-branch
41 (repeat delay base)))
42 alt-branch (step branch-point alt)
43 alt-val
44 (difference-metric
45 (run-moves alt-branch
46 (repeat delay base)))]
47 (if (not= base-val alt-val)
48 [(conj actions alt) alt-branch]
49 (recur base-branch (conj actions base))))))
50
51
52
36 ;; (defn advance 53 ;; (defn advance
37 ;; ([base alt difference-metric [commands state]] 54 ;; ([base alt difference-metric [commands state]]
38 ;; (let [[c s] 55 ;; (let [[c s]
39 ;; (first-difference base alt difference-metric state)] 56 ;; (first-difference base alt difference-metric state)]
40 ;; [(concat commands c) s])) 57 ;; [(concat commands c) s]))
68 "Move the character along the given directions." 85 "Move the character along the given directions."
69 [directions script] 86 [directions script]
70 (reduce (fn [script dir] 87 (reduce (fn [script dir]
71 (move dir script)) script directions)) 88 (move dir script)) script directions))
72 89
73 (defn scroll-text
74 ([script]
75 (advance [:b] [:a :b] script))
76 ([n script]
77 (reduce (fn [script _]
78 (scroll-text script))
79 script
80 (range n))))
81
82 (defn menu 90 (defn menu
83 [directions script] 91 [directions script]
84 (reduce (fn [script direction] 92 (reduce (fn [script direction]
85 (move direction script)) 93 (move direction script))
86 script directions)) 94 script directions))
87 95
88 (defn end-text [script]
89 (->> script
90 (scroll-text)
91 (play-moves [[] [:a]])))
92 96
93 (defn search-string 97 (defn search-string
94 [array string] 98 [^SaveState state string]
95 (let [codes 99 (let [codes
96 (str->character-codes string) 100 (str->character-codes string)
97 codes-length (count codes) 101 codes-length (count codes)
98 mem (vec array) 102 mem (vec (memory state))
99 mem-length (count mem)] 103 mem-length (count mem)]
100 (loop [idx 0] 104 (loop [idx 0]
101 (if (< (- mem-length idx) codes-length) 105 (if (< (- mem-length idx) codes-length)
102 nil 106 nil
103 (if (= (subvec mem idx (+ idx codes-length)) 107 (if (= (subvec mem idx (+ idx codes-length))
104 codes) 108 codes)
105 idx 109 idx
106 (recur (inc idx))))))) 110 (recur (inc idx)))))))
111
112 (def text-address 0x9DC1)
113
114 (defn displayed-text
115 ([^SaveState state]
116 (character-codes->str
117 (subvec (vec (memory state))
118 text-address
119 (+ text-address 82))))
120 ([] (displayed-text @current-state)))
121
122 ;; (defn scroll-text
123 ;; ([script]
124 ;; (first-difference [:b] [:a :b] AF script))
125 ;; ([n script]
126 ;; (reduce (fn [script _]
127 ;; (scroll-text script))
128 ;; script
129 ;; (range n))))
130
131 (defn scroll-text
132 ([script]
133 (delayed-difference
134 [:b] [:a :b] 25 displayed-text script))
135 ([n script]
136 (reduce (fn [script _]
137 (scroll-text script))
138 script
139 (range n))))
140
141
142 (defn end-text [script]
143 (->> script
144 (scroll-text)
145 (play-moves [[] [:a]])))
146
147
148
149 (common-differences
150 (vec (memory (step (talk-to-oak) [:a])))
151 (vec (memory (step (talk-to-oak) []))))
152
153
154
107 155
108 156
109 (defn do-nothing [n script] 157 (defn do-nothing [n script]
110 (->> script 158 (->> script
111 (play-moves 159 (play-moves