Mercurial > cortex

comparison org/worm_learn.clj @ 404:939bcc5950b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
completed debug control of worm.
author Robert McIntyre <rlm@mit.edu>
date Mon, 17 Mar 2014 17:29:59 -0400
parents 6ba908c1a0a9
children 9b4a4da08b78
comparison
equal deleted inserted replaced
403:92acbe7e5c91 404:939bcc5950b2
39 (doall (map (fn [effector power] 39 (doall (map (fn [effector power]
40 (effector (int power))) 40 (effector (int power)))
41 effectors 41 effectors
42 (map #(@current-forces % 0) muscle-positions))))))) 42 (map #(@current-forces % 0) muscle-positions)))))))
43 43
44 44 (defn worm-direct-control
45 45 "Create keybindings and a muscle control program that will enable
46 the user to control the worm via the keyboard."
47 [muscle-labels activation-strength]
48 (let [strengths (mapv (fn [_] (atom 0)) muscle-labels)
49 activator
50 (fn [n]
51 (fn [world pressed?]
52 (let [strength (if pressed? activation-strength 0)]
53 (swap! (nth strengths n) (constantly strength)))))
54 activators
55 (map activator (range (count muscle-labels)))
56 worm-keys
57 ["key-f" "key-r"
58 "key-g" "key-t"
59 "key-y" "key-h"
60 "key-j" "key-u"
61 "key-i" "key-k"
62 "key-o" "key-l"]]
63 {:motor-control
64 (fn [effectors]
65 (doall
66 (map (fn [strength effector]
67 (effector (deref strength)))
68 strengths effectors)))
69 :keybindings
70 ;; assume muscles are listed in pairs and map them to keys.
71 (zipmap worm-keys activators)}))
46 72
47 ;; These are scripts that direct the worm to move in two radically 73 ;; These are scripts that direct the worm to move in two radically
48 ;; different patterns -- a sinusoidal wiggling motion, and a curling 74 ;; different patterns -- a sinusoidal wiggling motion, and a curling
49 ;; motions that causes the worm to form a circle. 75 ;; motions that causes the worm to form a circle.
50 76
52 [[370 :d-up 40] 78 [[370 :d-up 40]
53 [600 :d-up 0]]) 79 [600 :d-up 0]])
54 80
55 (def period 18) 81 (def period 18)
56 82
57 (def muscle-labels 83 (def worm-muscle-labels
58 [:base-up :base-down 84 [:base-up :base-down
59 :a-up :a-down 85 :a-down :a-up
60 :b-up :b-down 86 :b-up :b-down
61 :c-up :c-down 87 :c-down :c-up
62 :d-up :d-down]) 88 :d-up :d-down])
63 89
64 (defn gen-wiggle [[flexor extensor :as muscle-pair] time-base] 90 (defn gen-wiggle [[flexor extensor :as muscle-pair] time-base]
65 (let [period period 91 (let [period period
66 power 45] 92 power 45]
123 149
124 (def degenerate-worm-view 150 (def degenerate-worm-view
125 [(Vector3f. -0.0708936, -8.570261, 2.6487997) 151 [(Vector3f. -0.0708936, -8.570261, 2.6487997)
126 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)]) 152 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
127 153
154 (defn worm-world-defaults []
155 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
156 {:view worm-side-view
157 :motor-control (:motor-control direct-control)
158 :keybindings (:keybindings direct-control)
159 :record nil}))
160
161 (defn dir! [file]
162 (if (not (.exists file))
163 (.mkdir file))
164 file)
165
128 (defn worm-world 166 (defn worm-world
129 "" 167 [& {:keys [record motor-control keybindings view] :as settings}]
130 ([] (worm-world curl-script)) 168 (let [{:keys [record motor-control keybindings view]}
131 ([motion-script] 169 (merge (worm-world-defaults) settings)
132 (let [record? false ;;true 170 worm (doto (worm-model) (body!))
133 worm (doto (worm-model) (body!)) 171 touch (touch! worm)
134 touch (touch! worm) 172 prop (proprioception! worm)
135 prop (proprioception! worm) 173 muscles (movement! worm)
136 muscles (movement! worm)
137
138 touch-display (view-touch)
139 prop-display (view-proprioception)
140 muscle-display (view-movement)
141
142 floor (box 10 1 10 :position (Vector3f. 0 -10 0)
143 :color ColorRGBA/Gray :mass 0)
144
145 control-script (motor-control-program
146 muscle-labels motion-script)]
147 (world
148 (nodify [worm floor])
149 standard-debug-controls
150 174
151 (fn [world] 175 touch-display (view-touch)
152 ;; (set-gravity world Vector3f/ZERO) 176 prop-display (view-proprioception)
153 (position-camera world degenerate-worm-view) 177 muscle-display (view-movement)
154 (let [timer (IsoTimer. 60)] 178
155 (.setTimer world timer) 179 floor (box 10 1 10 :position (Vector3f. 0 -10 0)
156 (display-dilated-time world timer)) 180 :color ColorRGBA/Gray :mass 0)]
157 (if record? 181
158 (Capture/captureVideo 182 (world
159 world 183 (nodify [worm floor])
160 (File. output-base "main-view"))) 184 (merge standard-debug-controls keybindings)
161 (speed-up world) 185 (fn [world]
162 (light-up-everything world)) 186 (position-camera world view)
163 (fn [world tpf] 187 (let [timer (IsoTimer. 60)]
164 (muscle-display 188 (.setTimer world timer)
165 (control-script muscles) 189 (display-dilated-time world timer))
166 (if record? (File. output-base "muscle"))) 190 (if record
167 (prop-display 191 (Capture/captureVideo
168 (prop) 192 world
169 (if record? (File. output-base "proprio"))) 193 (dir! (File. record "main-view"))))
170 (touch-display 194 (speed-up world)
171 (map #(% (.getRootNode world)) touch) 195 (light-up-everything world))
172 (if record? 196 (fn [world tpf]
173 (File. output-base "touch")))))))) 197 (let [strong! (motor-control muscles)]
198 (println strong!)
199 (muscle-display
200 strong!
201 (if record (dir! (File. record "muscle")))))
202 (prop-display
203 (prop)
204 (if record (dir! (File. record "proprio"))))
205 (touch-display
206 (map #(% (.getRootNode world)) touch)
207 (if record
208 (File. record "touch")))))))
209
210