Mercurial > vba-clojure
changeset 314:073600cba28a
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 | 363b650a77cc |
files | clojure/com/aurellem/gb/saves.clj clojure/com/aurellem/gb/util.clj clojure/com/aurellem/run/util.clj save-states/normal-conversation.sav save-states/talk-to-oak.sav |
diffstat | 5 files changed, 76 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/gb/saves.clj Mon Apr 02 10:58:16 2012 -0500 1.2 +++ b/clojure/com/aurellem/gb/saves.clj Mon Apr 02 20:30:02 2012 -0500 1.3 @@ -11,5 +11,8 @@ 1.4 (defn rlm-pallet-town [] 1.5 (read-state "rlm-pallet-town")) 1.6 1.7 +(defn talk-to-oak [] 1.8 + (read-state "talk-to-oak")) 1.9 1.10 - 1.11 +(defn normal-conv [] 1.12 + (read-state "normal-conversation")) 1.13 \ No newline at end of file
2.1 --- a/clojure/com/aurellem/gb/util.clj Mon Apr 02 10:58:16 2012 -0500 2.2 +++ b/clojure/com/aurellem/gb/util.clj Mon Apr 02 20:30:02 2012 -0500 2.3 @@ -147,10 +147,12 @@ 2.4 2.5 (defn common-differences [& seqs] 2.6 (let [backbone (range (count (first seqs)))] 2.7 - (filter 2.8 - (comp (partial apply distinct?) second) 2.9 - (zipmap backbone 2.10 - (apply (partial map list) seqs))))) 2.11 + (sort-by 2.12 + first 2.13 + (filter 2.14 + (comp (partial apply distinct?) second) 2.15 + (zipmap backbone 2.16 + (apply (partial map list) seqs)))))) 2.17 2.18 (defn temporal-compare [& states] 2.19 (apply common-differences
3.1 --- a/clojure/com/aurellem/run/util.clj Mon Apr 02 10:58:16 2012 -0500 3.2 +++ b/clojure/com/aurellem/run/util.clj Mon Apr 02 20:30:02 2012 -0500 3.3 @@ -1,5 +1,5 @@ 3.4 (ns com.aurellem.run.util 3.5 - (:use (com.aurellem.gb util gb-driver vbm characters)) 3.6 + (:use (com.aurellem.gb util gb-driver vbm characters saves)) 3.7 (:import [com.aurellem.gb.gb_driver SaveState])) 3.8 3.9 (def ↑ [:u]) 3.10 @@ -19,9 +19,8 @@ 3.11 [(conj actions alt) alt-branch] 3.12 (recur base-branch (conj actions base)))))) 3.13 3.14 - 3.15 (defn repeat-until-different 3.16 - [buttons metric [moves root]] 3.17 + [buttons metric [moves root :as script]] 3.18 (let [baseline (metric root)] 3.19 (loop [actions (vec moves) 3.20 state root] 3.21 @@ -31,8 +30,26 @@ 3.22 [new-actions new-state] 3.23 (recur new-actions new-state)))))) 3.24 3.25 +(defn delayed-difference 3.26 + [base alt delay difference-metric [moves root :as script]] 3.27 + (loop [branch-point root 3.28 + actions moves] 3.29 + (let [base-branch (step branch-point base) 3.30 + base-val 3.31 + (difference-metric 3.32 + (run-moves base-branch 3.33 + (repeat delay base))) 3.34 + alt-branch (step branch-point alt) 3.35 + alt-val 3.36 + (difference-metric 3.37 + (run-moves alt-branch 3.38 + (repeat delay base)))] 3.39 + (if (not= base-val alt-val) 3.40 + [(conj actions alt) alt-branch] 3.41 + (recur base-branch (conj actions base)))))) 3.42 3.43 3.44 + 3.45 ;; (defn advance 3.46 ;; ([base alt difference-metric [commands state]] 3.47 ;; (let [[c s] 3.48 @@ -70,32 +87,19 @@ 3.49 (reduce (fn [script dir] 3.50 (move dir script)) script directions)) 3.51 3.52 -(defn scroll-text 3.53 - ([script] 3.54 - (advance [:b] [:a :b] script)) 3.55 - ([n script] 3.56 - (reduce (fn [script _] 3.57 - (scroll-text script)) 3.58 - script 3.59 - (range n)))) 3.60 - 3.61 (defn menu 3.62 [directions script] 3.63 (reduce (fn [script direction] 3.64 (move direction script)) 3.65 script directions)) 3.66 3.67 -(defn end-text [script] 3.68 - (->> script 3.69 - (scroll-text) 3.70 - (play-moves [[] [:a]]))) 3.71 3.72 (defn search-string 3.73 - [array string] 3.74 + [^SaveState state string] 3.75 (let [codes 3.76 (str->character-codes string) 3.77 codes-length (count codes) 3.78 - mem (vec array) 3.79 + mem (vec (memory state)) 3.80 mem-length (count mem)] 3.81 (loop [idx 0] 3.82 (if (< (- mem-length idx) codes-length) 3.83 @@ -105,6 +109,50 @@ 3.84 idx 3.85 (recur (inc idx))))))) 3.86 3.87 +(def text-address 0x9DC1) 3.88 + 3.89 +(defn displayed-text 3.90 + ([^SaveState state] 3.91 + (character-codes->str 3.92 + (subvec (vec (memory state)) 3.93 + text-address 3.94 + (+ text-address 82)))) 3.95 + ([] (displayed-text @current-state))) 3.96 + 3.97 +;; (defn scroll-text 3.98 +;; ([script] 3.99 +;; (first-difference [:b] [:a :b] AF script)) 3.100 +;; ([n script] 3.101 +;; (reduce (fn [script _] 3.102 +;; (scroll-text script)) 3.103 +;; script 3.104 +;; (range n)))) 3.105 + 3.106 +(defn scroll-text 3.107 + ([script] 3.108 + (delayed-difference 3.109 + [:b] [:a :b] 25 displayed-text script)) 3.110 + ([n script] 3.111 + (reduce (fn [script _] 3.112 + (scroll-text script)) 3.113 + script 3.114 + (range n)))) 3.115 + 3.116 + 3.117 +(defn end-text [script] 3.118 + (->> script 3.119 + (scroll-text) 3.120 + (play-moves [[] [:a]]))) 3.121 + 3.122 + 3.123 + 3.124 +(common-differences 3.125 + (vec (memory (step (talk-to-oak) [:a]))) 3.126 + (vec (memory (step (talk-to-oak) [])))) 3.127 + 3.128 + 3.129 + 3.130 + 3.131 3.132 (defn do-nothing [n script] 3.133 (->> script
4.1 Binary file save-states/normal-conversation.sav has changed
5.1 Binary file save-states/talk-to-oak.sav has changed