1.1 --- a/org/worm_learn.clj	Mon Mar 17 14:01:02 2014 -0400
     1.2 +++ b/org/worm_learn.clj	Mon Mar 17 17:29:59 2014 -0400
     1.3 @@ -41,8 +41,34 @@
     1.4                      effectors
     1.5                      (map #(@current-forces % 0) muscle-positions)))))))
     1.6  
     1.7 -
     1.8 -
     1.9 +(defn worm-direct-control
    1.10 +  "Create keybindings and a muscle control program that will enable
    1.11 +   the user to control the worm via the keyboard."
    1.12 +  [muscle-labels activation-strength]
    1.13 +  (let [strengths (mapv (fn [_] (atom 0)) muscle-labels)
    1.14 +        activator
    1.15 +        (fn [n]
    1.16 +          (fn [world pressed?]
    1.17 +            (let [strength (if pressed? activation-strength 0)]
    1.18 +              (swap! (nth strengths n) (constantly strength)))))
    1.19 +        activators
    1.20 +        (map activator (range (count muscle-labels)))
    1.21 +        worm-keys
    1.22 +        ["key-f" "key-r"
    1.23 +         "key-g" "key-t"
    1.24 +         "key-y" "key-h"
    1.25 +         "key-j" "key-u"
    1.26 +         "key-i" "key-k"
    1.27 +         "key-o" "key-l"]]
    1.28 +    {:motor-control
    1.29 +     (fn [effectors]
    1.30 +      (doall
    1.31 +       (map (fn [strength effector]
    1.32 +              (effector (deref strength)))
    1.33 +            strengths effectors)))
    1.34 +     :keybindings
    1.35 +     ;; assume muscles are listed in pairs and map them to keys.
    1.36 +     (zipmap worm-keys activators)}))
    1.37  
    1.38  ;; These are scripts that direct the worm to move in two radically
    1.39  ;; different patterns -- a sinusoidal wiggling motion, and a curling
    1.40 @@ -54,11 +80,11 @@
    1.41  
    1.42  (def period 18)
    1.43  
    1.44 -(def muscle-labels
    1.45 +(def worm-muscle-labels
    1.46    [:base-up :base-down
    1.47 -   :a-up :a-down
    1.48 +   :a-down :a-up
    1.49     :b-up :b-down
    1.50 -   :c-up :c-down
    1.51 +   :c-down :c-up
    1.52     :d-up :d-down])
    1.53  
    1.54  (defn gen-wiggle [[flexor extensor :as muscle-pair] time-base]
    1.55 @@ -125,49 +151,60 @@
    1.56    [(Vector3f. -0.0708936, -8.570261, 2.6487997)
    1.57     (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
    1.58  
    1.59 +(defn worm-world-defaults []
    1.60 +  (let [direct-control (worm-direct-control worm-muscle-labels 40)]
    1.61 +    {:view worm-side-view
    1.62 +     :motor-control (:motor-control direct-control)
    1.63 +     :keybindings (:keybindings direct-control)
    1.64 +     :record nil}))
    1.65 +
    1.66 +(defn dir! [file]
    1.67 +  (if (not (.exists file))
    1.68 +    (.mkdir file))
    1.69 +  file)
    1.70 +  
    1.71  (defn worm-world
    1.72 -  ""
    1.73 -  ([] (worm-world curl-script))
    1.74 -  ([motion-script]
    1.75 -     (let [record? false ;;true
    1.76 -           worm (doto (worm-model) (body!))
    1.77 -           touch   (touch! worm)
    1.78 -           prop    (proprioception! worm)
    1.79 -           muscles (movement! worm)
    1.80 -           
    1.81 -           touch-display  (view-touch)
    1.82 -           prop-display   (view-proprioception)
    1.83 -           muscle-display (view-movement)
    1.84 +  [& {:keys [record motor-control keybindings view] :as settings}]
    1.85 +  (let [{:keys [record motor-control keybindings view]}
    1.86 +        (merge (worm-world-defaults) settings)
    1.87 +        worm (doto (worm-model) (body!))
    1.88 +        touch   (touch! worm)
    1.89 +        prop    (proprioception! worm)
    1.90 +        muscles (movement! worm)
    1.91 +        
    1.92 +        touch-display  (view-touch)
    1.93 +        prop-display   (view-proprioception)
    1.94 +        muscle-display (view-movement)
    1.95 +        
    1.96 +        floor (box 10 1 10 :position (Vector3f. 0 -10 0)
    1.97 +                   :color ColorRGBA/Gray :mass 0)]
    1.98  
    1.99 -           floor (box 10 1 10 :position (Vector3f. 0 -10 0)
   1.100 -                      :color ColorRGBA/Gray :mass 0)
   1.101 +    (world
   1.102 +       (nodify [worm floor])
   1.103 +       (merge standard-debug-controls keybindings)
   1.104 +       (fn [world]
   1.105 +         (position-camera world view)
   1.106 +         (let [timer (IsoTimer. 60)]
   1.107 +           (.setTimer world timer)
   1.108 +           (display-dilated-time world timer))
   1.109 +         (if record
   1.110 +           (Capture/captureVideo
   1.111 +            world
   1.112 +            (dir! (File. record "main-view"))))
   1.113 +         (speed-up world)
   1.114 +         (light-up-everything world))
   1.115 +       (fn [world tpf]
   1.116 +         (let [strong! (motor-control muscles)]
   1.117 +           (println strong!)
   1.118 +           (muscle-display
   1.119 +            strong!
   1.120 +            (if record (dir! (File. record "muscle")))))
   1.121 +         (prop-display
   1.122 +          (prop)
   1.123 +          (if record (dir! (File. record "proprio"))))
   1.124 +         (touch-display 
   1.125 +          (map #(% (.getRootNode world)) touch)
   1.126 +          (if record
   1.127 +            (File. record "touch")))))))
   1.128  
   1.129 -           control-script (motor-control-program
   1.130 -                           muscle-labels motion-script)]
   1.131 -       (world
   1.132 -        (nodify [worm floor])
   1.133 -        standard-debug-controls
   1.134 -        
   1.135 -        (fn [world]
   1.136 -          ;; (set-gravity world Vector3f/ZERO)
   1.137 -          (position-camera world degenerate-worm-view)
   1.138 -          (let [timer (IsoTimer. 60)]
   1.139 -            (.setTimer world timer)
   1.140 -            (display-dilated-time world timer))
   1.141 -          (if record?
   1.142 -            (Capture/captureVideo
   1.143 -             world
   1.144 -             (File. output-base "main-view")))
   1.145 -          (speed-up world)
   1.146 -          (light-up-everything world))
   1.147 -        (fn [world tpf]
   1.148 -          (muscle-display
   1.149 -           (control-script muscles)
   1.150 -           (if record? (File. output-base "muscle")))
   1.151 -          (prop-display
   1.152 -           (prop)
   1.153 -           (if record? (File. output-base "proprio")))             
   1.154 -          (touch-display 
   1.155 -           (map #(% (.getRootNode world)) touch)
   1.156 -           (if record?
   1.157 -             (File. output-base "touch"))))))))
   1.158 +   
   1.159 \ No newline at end of file