1.1 --- a/org/worm_learn.clj	Tue Mar 04 00:01:38 2014 -0500
     1.2 +++ b/org/worm_learn.clj	Tue Mar 04 23:04:43 2014 -0500
     1.3 @@ -15,73 +15,121 @@
     1.4  (rlm.rlm-commands/help)
     1.5  
     1.6  
     1.7 -(defn worm-segment []
     1.8 -  (load-blender-model "Models/worm-segment/worm-segment.blend"))
     1.9 +(def hand "Models/test-creature/hand.blend")
    1.10  
    1.11 +(defn worm-model []
    1.12 +  (load-blender-model "Models/worm/worm.blend"))
    1.13  
    1.14 -(defn worm []
    1.15 -  (load-blender-model "Models/worm-segment/worm.blend"))
    1.16 +(def output-base (File. "/home/r/proj/cortex/render/worm-learn/"))
    1.17  
    1.18  
    1.19 -(defn gen-worm
    1.20 -  "create a creature acceptable for testing as a replacement for the
    1.21 -   worm."
    1.22 -  []
    1.23 -  (nodify
    1.24 -   "worm"
    1.25 -   [(nodify
    1.26 -     "eyes"
    1.27 -     [(doto
    1.28 -          (Node. "eye1")
    1.29 -        (.setLocalTranslation (Vector3f. 0 -1.1 0))
    1.30 -        (.setUserData
    1.31 -         
    1.32 -         "eye" 
    1.33 -         "(let [retina
    1.34 -                \"Models/test-creature/retina-small.png\"]
    1.35 -                {:all retina :red retina
    1.36 -                 :green retina :blue retina})"))])
    1.37 -    (box
    1.38 -     0.2 0.2 0.2
    1.39 -     :name "worm-segment"
    1.40 -     :position (Vector3f. 0 0 0)
    1.41 -     :color ColorRGBA/Orange)]))
    1.42 +(defn motor-control-program
    1.43 +  "Create a function which will execute the motor script"
    1.44 +  [muscle-positions
    1.45 +   script]
    1.46 +  (let [current-frame (atom -1)
    1.47 +        keyed-script (group-by first script)
    1.48 +        current-forces (atom {}) ]
    1.49 +    (fn [effectors]
    1.50 +      (let [indexed-effectors (vec effectors)]
    1.51 +        (dorun 
    1.52 +         (for [[_ part force] (keyed-script (swap! current-frame inc))]
    1.53 +           (swap! current-forces (fn [m] (assoc m part force)))))
    1.54 +        (doall (map (fn [effector power]
    1.55 +                      (effector (int power)))
    1.56 +                    effectors
    1.57 +                    (map #(@current-forces % 0) muscle-positions)))))))
    1.58  
    1.59 +(def muscle-labels
    1.60 +  [:base-up :base-down
    1.61 +   :a-up :a-down
    1.62 +   :b-up :b-down
    1.63 +   :c-up :c-down
    1.64 +   :d-up :d-down
    1.65 +   ])
    1.66  
    1.67 -(defn test-basic-touch
    1.68 -  "Testing touch:
    1.69 -   You should see a cube fall onto a table.  There is a cross-shaped
    1.70 -   display which reports the cube's sensation of touch. This display
    1.71 -   should change when the cube hits the table, and whenever you hit
    1.72 -   the cube with balls.
    1.73 +(def curl-script
    1.74 +  [[370 :d-up 20]
    1.75 +   [390 :d-up 0]])
    1.76  
    1.77 -   Keys:
    1.78 -     <space> : fire ball"
    1.79 -  ([] (test-basic-touch false))
    1.80 -  ([record?]
    1.81 -     (let [head (doto (worm) (body!))
    1.82 -           touch (touch! head)
    1.83 -           touch-display (view-touch)]
    1.84 +(def period 18)
    1.85 +
    1.86 +(defn gen-wiggle [[flexor extensor :as muscle-pair] time-base]
    1.87 +  (let [period period
    1.88 +        power 45]
    1.89 +    [[time-base flexor power]
    1.90 +     [(+ time-base period) flexor 0]
    1.91 +     [(+ time-base period 1) extensor power]
    1.92 +     [(+ time-base (+ (* 2 period) 2))  extensor 0]]))
    1.93 +  
    1.94 +(def wiggle-script
    1.95 +  (mapcat gen-wiggle [[:d-up :d-down]
    1.96 +                      [:c-up :c-down]
    1.97 +                      [:b-up :b-down]
    1.98 +                      [:a-up :a-down]] (range 100 1000 12)))
    1.99 +
   1.100 +(def wiggle-script
   1.101 +  (mapcat gen-wiggle (repeat 40 [:a-down :a-up])
   1.102 +                     (range 100 10000 (+ 3 (* period 2)))))
   1.103 +
   1.104 +
   1.105 +
   1.106 +(defn worm-world
   1.107 +  ""
   1.108 +  ([] (worm-world curl-script))
   1.109 +  ([motion-script]
   1.110 +     (let [record? false
   1.111 +           worm (doto (worm-model) (body!))
   1.112 +           touch   '();;(touch! worm)
   1.113 +           prop    (proprioception! worm)
   1.114 +           muscles (movement! worm)
   1.115 +           
   1.116 +           touch-display  (view-touch)
   1.117 +           prop-display   (view-proprioception)
   1.118 +           muscle-display (view-movement)
   1.119 +
   1.120 +           floor (box 10 1 10 :position (Vector3f. 0 -10 0)
   1.121 +                      :color ColorRGBA/Gray :mass 0)
   1.122 +
   1.123 +           control-script (motor-control-program
   1.124 +                           muscle-labels motion-script)]
   1.125         (world
   1.126 -        (nodify [head
   1.127 -                 (box 10 1 10 :position (Vector3f. 0 -10 0)
   1.128 -                      :color ColorRGBA/Gray :mass 0)])
   1.129 -        
   1.130 +        (nodify [worm floor])
   1.131          standard-debug-controls
   1.132          
   1.133          (fn [world]
   1.134 +          ;; (set-gravity world Vector3f/ZERO)
   1.135 +          ;; (position-camera
   1.136 +          ;;  world (Vector3f. 4.207176, -3.7366982, 3.0816958)
   1.137 +          ;;  (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771))
   1.138 +
   1.139 +
   1.140 +
   1.141 +          (position-camera
   1.142 +           world (Vector3f. 4.207176, -3.7366982, 3.0816958)
   1.143 +           (Quaternion. -0.11555642, 0.88188726, -0.2854942, -0.3569518))
   1.144 +
   1.145 +
   1.146 +
   1.147 +
   1.148            (let [timer (IsoTimer. 60)]
   1.149              (.setTimer world timer)
   1.150              (display-dilated-time world timer))
   1.151            (if record?
   1.152              (Capture/captureVideo
   1.153               world
   1.154 -             (File. "/home/r/proj/cortex/render/touch-cube/main-view/")))
   1.155 +             (File. output-base "main-view")))
   1.156            (speed-up world)
   1.157            (light-up-everything world))
   1.158          
   1.159          (fn [world tpf]
   1.160 +          (muscle-display
   1.161 +           (control-script muscles)
   1.162 +           (if record? (File. output-base "muscle")))
   1.163 +          (prop-display
   1.164 +           (prop)
   1.165 +           (if record? (File. output-base "proprio")))             
   1.166            (touch-display 
   1.167             (map #(% (.getRootNode world)) touch)
   1.168             (if record?
   1.169 -             (File. "/home/r/proj/cortex/render/touch-cube/touch/"))))))))
   1.170 +             (File. output-base "touch"))))))))