1.1 --- a/org/body.org	Thu Feb 09 04:15:09 2012 -0700
     1.2 +++ b/org/body.org	Thu Feb 09 04:21:12 2012 -0700
     1.3 @@ -568,727 +568,8 @@
     1.4  - cortex.test.body
     1.5  - blender files
     1.6  
     1.7 -* COMMENT Examples
     1.8  
     1.9 -#+name: test-body
    1.10 -#+begin_src clojure
    1.11 -
    1.12 -(defn worm-segments
    1.13 -  "Create multiple evenly spaced box segments. They're fabulous!"
    1.14 -  [segment-length num-segments interstitial-space radius]
    1.15 -  (letfn [(nth-segment
    1.16 -            [n]
    1.17 -            (box segment-length radius radius :mass 0.1
    1.18 -                 :position
    1.19 -                 (Vector3f.
    1.20 -                  (* 2 n (+ interstitial-space segment-length)) 0 0)
    1.21 -                 :name (str "worm-segment" n)
    1.22 -                 :color (ColorRGBA/randomColor)))]
    1.23 -    (map nth-segment (range num-segments))))
    1.24 -
    1.25 -(defn connect-at-midpoint
    1.26 -  "Connect two physics objects with a Point2Point joint constraint at
    1.27 -  the point equidistant from both objects' centers."
    1.28 -  [segmentA segmentB]
    1.29 -  (let [centerA (.getWorldTranslation segmentA)
    1.30 -        centerB (.getWorldTranslation segmentB)
    1.31 -        midpoint (.mult (.add centerA centerB) (float 0.5))
    1.32 -        pivotA (.subtract midpoint centerA)
    1.33 -        pivotB (.subtract midpoint centerB)
    1.34 -        
    1.35 -        ;; A side-effect of creating a joint registers
    1.36 -        ;; it with both physics objects which in turn
    1.37 -        ;; will register the joint with the physics system
    1.38 -        ;; when the simulation is started.
    1.39 -        joint (Point2PointJoint.
    1.40 -               (.getControl segmentA RigidBodyControl)
    1.41 -               (.getControl segmentB RigidBodyControl)
    1.42 -               pivotA
    1.43 -               pivotB)]
    1.44 -    segmentB))
    1.45 -
    1.46 -(defn eve-worm
    1.47 -  "Create a worm-like body bound by invisible joint constraints."
    1.48 -  []
    1.49 -  (let [segments (worm-segments 0.2 5 0.1 0.1)]
    1.50 -    (dorun (map (partial apply connect-at-midpoint)
    1.51 -                (partition 2 1 segments)))
    1.52 -    (nodify "worm" segments)))
    1.53 -
    1.54 -(defn worm-pattern
    1.55 -  "This is a simple, mindless motor control pattern that drives the
    1.56 -   second segment of the worm's body at an offset angle with
    1.57 -   sinusoidally varying strength."
    1.58 -  [time]
    1.59 -  (let [angle (* Math/PI (/ 9 20))
    1.60 -        direction (Vector3f. 0 (Math/sin angle) (Math/cos angle))]
    1.61 -    [Vector3f/ZERO
    1.62 -     (.mult
    1.63 -      direction
    1.64 -      (float (* 2 (Math/sin (* Math/PI 2 (/ (rem time 300 ) 300))))))
    1.65 -     Vector3f/ZERO
    1.66 -     Vector3f/ZERO
    1.67 -     Vector3f/ZERO]))
    1.68 -
    1.69 -(defn test-motor-control
    1.70 -  "Testing motor-control:
    1.71 -   You should see a multi-segmented worm-like object fall onto the
    1.72 -   table and begin writhing and moving."
    1.73 -  []
    1.74 -  (let [worm (eve-worm)
    1.75 -        time (atom 0)
    1.76 -        worm-motor-map (vector-motor-control worm)]
    1.77 -    (world
    1.78 -     (nodify [worm
    1.79 -              (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
    1.80 -                   :color ColorRGBA/Gray)])
    1.81 -     standard-debug-controls
    1.82 -     (fn [world]
    1.83 -       (enable-debug world)
    1.84 -       (light-up-everything world)
    1.85 -       (comment
    1.86 -         (com.aurellem.capture.Capture/captureVideo
    1.87 -          world
    1.88 -          (file-str "/home/r/proj/cortex/tmp/moving-worm")))
    1.89 -       )
    1.90 -     
    1.91 -     (fn [_ _]
    1.92 -       (swap! time inc)
    1.93 -       (Thread/sleep 20)
    1.94 -       (dorun (worm-motor-map
    1.95 -               (worm-pattern @time)))))))
    1.96 -
    1.97 -
    1.98 -
    1.99 -(defn join-at-point [obj-a obj-b world-pivot]
   1.100 -  (cortex.silly/joint-dispatch
   1.101 -   {:type :point}
   1.102 -   (.getControl obj-a RigidBodyControl)
   1.103 -   (.getControl obj-b RigidBodyControl)
   1.104 -   (cortex.silly/world-to-local obj-a world-pivot)
   1.105 -   (cortex.silly/world-to-local obj-b world-pivot)
   1.106 -   nil
   1.107 -   ))
   1.108 -
   1.109 -(import com.jme3.bullet.collision.PhysicsCollisionObject)
   1.110 -
   1.111 -(defn blab-* []
   1.112 -  (let [hand   (box 0.5 0.2 0.2 :position (Vector3f. 0 0 0)
   1.113 -                     :mass 0 :color ColorRGBA/Green)
   1.114 -        finger (box 0.5 0.2 0.2 :position (Vector3f. 2.4 0 0)
   1.115 -                    :mass 1 :color ColorRGBA/Red)
   1.116 -        connection-point (Vector3f. 1.2 0 0)
   1.117 -        root (nodify [hand finger])]
   1.118 -
   1.119 -    (join-at-point hand finger (Vector3f. 1.2 0 0))
   1.120 -    
   1.121 -    (.setCollisionGroup
   1.122 -     (.getControl hand RigidBodyControl)
   1.123 -     PhysicsCollisionObject/COLLISION_GROUP_NONE)
   1.124 -    (world
   1.125 -     root
   1.126 -     standard-debug-controls
   1.127 -     (fn [world]
   1.128 -       (enable-debug world)
   1.129 -       (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
   1.130 -       (set-gravity world Vector3f/ZERO)
   1.131 -       )
   1.132 -     no-op)))
   1.133 -(comment  
   1.134 -     
   1.135 -(defn proprioception-debug-window
   1.136 -  []
   1.137 -  (let [time (atom 0)]
   1.138 -    (fn [prop-data]
   1.139 -      (if (= 0 (rem (swap! time inc) 40))
   1.140 -        (println-repl prop-data)))))
   1.141 -)
   1.142 -
   1.143 -(comment
   1.144 -  (dorun
   1.145 -   (map
   1.146 -    (comp 
   1.147 -     println-repl
   1.148 -     (fn [[p y r]]
   1.149 -       (format
   1.150 -        "pitch: %1.2f\nyaw: %1.2f\nroll: %1.2f\n"
   1.151 -        p y r)))
   1.152 -    prop-data)))
   1.153 -
   1.154 -
   1.155 -
   1.156 -
   1.157 -(defn test-proprioception
   1.158 -  "Testing proprioception:
   1.159 -   You should see two foating bars, and a printout of pitch, yaw, and
   1.160 -   roll. Pressing key-r/key-t should move the blue bar up and down and
   1.161 -   change only the value of pitch. key-f/key-g moves it side to side
   1.162 -   and changes yaw. key-v/key-b will spin the blue segment clockwise
   1.163 -   and counterclockwise, and only affect roll."
   1.164 -  []
   1.165 -  (let [hand    (box 0.2 1 0.2 :position (Vector3f. 0 0 0)
   1.166 -                     :mass 0 :color ColorRGBA/Green :name "hand")
   1.167 -        finger (box 0.2 1 0.2 :position (Vector3f. 0 2.4 0)
   1.168 -                    :mass 1 :color ColorRGBA/Red :name "finger")
   1.169 -        joint-node (box 0.1 0.05 0.05 :color ColorRGBA/Yellow
   1.170 -                        :position (Vector3f. 0 1.2 0)
   1.171 -                        :rotation (doto (Quaternion.)
   1.172 -                                    (.fromAngleAxis
   1.173 -                                     (/ Math/PI 2)
   1.174 -                                     (Vector3f. 0 0 1)))
   1.175 -                        :physical? false)
   1.176 -        joint (join-at-point hand finger (Vector3f. 0 1.2 0 ))
   1.177 -        creature (nodify [hand finger joint-node])
   1.178 -        finger-control (.getControl finger RigidBodyControl)
   1.179 -        hand-control (.getControl hand RigidBodyControl)]
   1.180 -    
   1.181 -
   1.182 -    (let
   1.183 -        ;; *******************************************
   1.184 -                
   1.185 -        [floor   (box 10 10 10 :position (Vector3f. 0 -15 0)
   1.186 -                     :mass 0 :color ColorRGBA/Gray)
   1.187 -        
   1.188 -        root (nodify [creature floor])
   1.189 -        prop (joint-proprioception creature joint-node)
   1.190 -        prop-view (proprioception-debug-window)
   1.191 -        
   1.192 -        controls
   1.193 -        (merge standard-debug-controls
   1.194 -               {"key-o"
   1.195 -                (fn [_ _] (.setEnabled finger-control true))
   1.196 -                "key-p"
   1.197 -                (fn [_ _] (.setEnabled finger-control false))
   1.198 -                "key-k"
   1.199 -                (fn [_ _] (.setEnabled hand-control true))
   1.200 -                "key-l"
   1.201 -                (fn [_ _] (.setEnabled hand-control false))
   1.202 -                "key-i"
   1.203 -                (fn [world _] (set-gravity world (Vector3f. 0 0 0)))
   1.204 -                "key-period"
   1.205 -                (fn [world _]
   1.206 -                  (.setEnabled finger-control false)
   1.207 -                  (.setEnabled hand-control false)
   1.208 -                  (.rotate creature (doto (Quaternion.)
   1.209 -                                      (.fromAngleAxis
   1.210 -                                       (float (/ Math/PI 15))
   1.211 -                                       (Vector3f. 0 0 -1))))
   1.212 -                                              
   1.213 -                  (.setEnabled finger-control true)
   1.214 -                  (.setEnabled hand-control true)
   1.215 -                  (set-gravity world (Vector3f. 0 0 0))
   1.216 -                  )
   1.217 -                
   1.218 -                  
   1.219 -                }
   1.220 -               )
   1.221 -
   1.222 -        ]
   1.223 -    (comment
   1.224 -      (.setCollisionGroup
   1.225 -       (.getControl hand RigidBodyControl)
   1.226 -       PhysicsCollisionObject/COLLISION_GROUP_NONE)
   1.227 -      )
   1.228 -    (apply
   1.229 -     world
   1.230 -     (with-movement
   1.231 -       hand
   1.232 -       ["key-y" "key-u" "key-h" "key-j" "key-n" "key-m"]
   1.233 -       [10 10 10 10 1 1]
   1.234 -       (with-movement
   1.235 -         finger
   1.236 -         ["key-r" "key-t" "key-f" "key-g" "key-v" "key-b"]
   1.237 -         [1 1 10 10 10 10]
   1.238 -         [root
   1.239 -          controls
   1.240 -          (fn [world]
   1.241 -            (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
   1.242 -            (set-gravity world (Vector3f. 0 0 0))
   1.243 -            (light-up-everything world))
   1.244 -          (fn [_ _] (prop-view (list (prop))))]))))))
   1.245 -
   1.246 -#+end_src
   1.247 -
   1.248 -#+results: test-body
   1.249 -: #'cortex.test.body/test-proprioception
   1.250 -
   1.251 -
   1.252 -* COMMENT code-limbo
   1.253 -#+begin_src clojure
   1.254 -;;(.loadModel 
   1.255 -;; (doto (asset-manager)
   1.256 -;;   (.registerLoader BlenderModelLoader (into-array String ["blend"])))
   1.257 -;;   "Models/person/person.blend")
   1.258 -
   1.259 -
   1.260 -(defn load-blender-model
   1.261 -  "Load a .blend file using an asset folder relative path."
   1.262 -  [^String model]
   1.263 -  (.loadModel
   1.264 -   (doto (asset-manager)
   1.265 -     (.registerLoader BlenderModelLoader (into-array String ["blend"])))
   1.266 -   model))
   1.267 -
   1.268 -
   1.269 -(defn view-model [^String model]
   1.270 -  (view 
   1.271 -   (.loadModel 
   1.272 -    (doto (asset-manager)
   1.273 -      (.registerLoader BlenderModelLoader (into-array String ["blend"])))
   1.274 -    model)))
   1.275 -
   1.276 -(defn load-blender-scene [^String model]
   1.277 -  (.loadModel
   1.278 -   (doto (asset-manager)
   1.279 -     (.registerLoader BlenderLoader (into-array String ["blend"])))
   1.280 -    model))
   1.281 -
   1.282 -(defn worm
   1.283 -  []
   1.284 -  (.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml"))
   1.285 -
   1.286 -(defn oto
   1.287 -  []
   1.288 -  (.loadModel (asset-manager) "Models/Oto/Oto.mesh.xml"))
   1.289 -
   1.290 -(defn sinbad
   1.291 -  []
   1.292 -  (.loadModel (asset-manager) "Models/Sinbad/Sinbad.mesh.xml"))
   1.293 -
   1.294 -(defn worm-blender
   1.295 -  []
   1.296 -  (first (seq (.getChildren (load-blender-model
   1.297 -                             "Models/anim2/simple-worm.blend")))))
   1.298 -
   1.299 -(defn body
   1.300 -  "given a node with a SkeletonControl, will produce a body sutiable
   1.301 -  for AI control with movement and proprioception."
   1.302 -  [node]
   1.303 -  (let [skeleton-control (.getControl node SkeletonControl)
   1.304 -        krc (KinematicRagdollControl.)]
   1.305 -    (comment
   1.306 -    (dorun
   1.307 -     (map #(.addBoneName krc %)
   1.308 -          ["mid2" "tail" "head" "mid1" "mid3" "mid4" "Dummy-Root" ""]
   1.309 -           ;;"mid2" "mid3" "tail" "head"]
   1.310 -        )))
   1.311 -    (.addControl node krc)
   1.312 -    (.setRagdollMode krc)
   1.313 -    )
   1.314 -  node
   1.315 -  )
   1.316 -(defn show-skeleton [node]
   1.317 -  (let [sd
   1.318 -
   1.319 -        (doto
   1.320 -            (SkeletonDebugger. "aurellem-skel-debug"
   1.321 -                               (skel node))
   1.322 -          (.setMaterial (green-x-ray)))]
   1.323 -    (.attachChild node sd)
   1.324 -    node))
   1.325 -
   1.326 -
   1.327 -  
   1.328 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.329 -
   1.330 -;; this could be a good way to give objects special properties like
   1.331 -;; being eyes and the like
   1.332 -
   1.333 -(.getUserData 
   1.334 - (.getChild
   1.335 -  (load-blender-model "Models/property/test.blend") 0)
   1.336 - "properties")
   1.337 -
   1.338 -;; the properties are saved along with the blender file.
   1.339 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.340 -
   1.341 -
   1.342 -
   1.343 -
   1.344 -(defn init-debug-skel-node
   1.345 -  [f debug-node skeleton]
   1.346 -  (let [bones 
   1.347 -        (map #(.getBone skeleton %)
   1.348 -             (range (.getBoneCount skeleton)))]
   1.349 -  (dorun (map #(.setUserControl % true) bones)) 
   1.350 -  (dorun (map (fn [b]
   1.351 -                (println (.getName b)
   1.352 -                         " -- " (f b)))
   1.353 -              bones))
   1.354 -  (dorun
   1.355 -   (map #(.attachChild
   1.356 -          debug-node 
   1.357 -          (doto 
   1.358 -              (sphere 0.1
   1.359 -                      :position (f %)
   1.360 -                      :physical? false)
   1.361 -          (.setMaterial (green-x-ray))))
   1.362 -        bones)))
   1.363 -    debug-node)
   1.364 -
   1.365 -(import jme3test.bullet.PhysicsTestHelper)
   1.366 -
   1.367 -
   1.368 -(defn test-zzz [the-worm world value]
   1.369 -  (if (not value)
   1.370 -    (let [skeleton (skel the-worm)]
   1.371 -      (println-repl "enabling bones")
   1.372 -      (dorun
   1.373 -       (map
   1.374 -        #(.setUserControl (.getBone skeleton %) true)
   1.375 -        (range (.getBoneCount skeleton))))
   1.376 -
   1.377 -
   1.378 -      (let [b (.getBone skeleton 2)]
   1.379 -        (println-repl "moving " (.getName b))
   1.380 -        (println-repl (.getLocalPosition b))
   1.381 -        (.setUserTransforms b
   1.382 -                            Vector3f/UNIT_X
   1.383 -                            Quaternion/IDENTITY
   1.384 -                            ;;(doto (Quaternion.)
   1.385 -                             ;; (.fromAngles (/ Math/PI 2)
   1.386 -                             ;;              0
   1.387 -                             ;;              0
   1.388 -                                          
   1.389 -                            (Vector3f. 1 1 1))
   1.390 -        )
   1.391 -      
   1.392 -      (println-repl "hi! <3"))))
   1.393 -
   1.394 -
   1.395 -(defn test-ragdoll []
   1.396 -  
   1.397 -  (let [the-worm
   1.398 -        
   1.399 -         ;;(.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml")
   1.400 -         (doto (show-skeleton (worm-blender))
   1.401 -           (.setLocalTranslation (Vector3f. 0 10 0))
   1.402 -         ;;(worm)
   1.403 -         ;;(oto)
   1.404 -         ;;(sinbad)
   1.405 -        )
   1.406 -    ]
   1.407 -
   1.408 -
   1.409 -    (.start 
   1.410 -     (world
   1.411 -      (doto (Node.)
   1.412 -        (.attachChild the-worm))
   1.413 -      {"key-return" (fire-cannon-ball)
   1.414 -       "key-space" (partial test-zzz the-worm)
   1.415 -       }
   1.416 -      (fn [world]
   1.417 -        (light-up-everything world)
   1.418 -        (PhysicsTestHelper/createPhysicsTestWorld
   1.419 -         (.getRootNode world)
   1.420 -         (asset-manager)
   1.421 -         (.getPhysicsSpace
   1.422 -          (.getState (.getStateManager world) BulletAppState)))
   1.423 -        (set-gravity world Vector3f/ZERO)
   1.424 -        ;;(.setTimer world (NanoTimer.))
   1.425 -        ;;(org.lwjgl.input.Mouse/setGrabbed false)
   1.426 -        )
   1.427 -      no-op
   1.428 -      )
   1.429 -  
   1.430 -     
   1.431 -     )))
   1.432 -
   1.433 -
   1.434 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.435 -;;; here is the ragdoll stuff
   1.436 -
   1.437 -(def worm-mesh (.getMesh (.getChild (worm-blender) 0)))
   1.438 -(def mesh worm-mesh)
   1.439 -
   1.440 -(.getFloatBuffer mesh VertexBuffer$Type/Position)
   1.441 -(.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
   1.442 -(.getData  (.getBuffer mesh VertexBuffer$Type/BoneIndex))
   1.443 -
   1.444 -
   1.445 -(defn position [index]
   1.446 -  (.get
   1.447 -   (.getFloatBuffer worm-mesh VertexBuffer$Type/Position)
   1.448 -     index))
   1.449 -
   1.450 -(defn bones [index]
   1.451 -  (.get
   1.452 -   (.getData  (.getBuffer mesh VertexBuffer$Type/BoneIndex))
   1.453 -   index))
   1.454 -
   1.455 -(defn bone-weights [index]
   1.456 -  (.get
   1.457 -   (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
   1.458 -   index))
   1.459 -
   1.460 -
   1.461 -
   1.462 -(defn vertex-bones [vertex]
   1.463 -  (vec (map (comp int bones) (range (* vertex 4) (+ (* vertex 4) 4)))))
   1.464 -
   1.465 -(defn vertex-weights [vertex]
   1.466 -  (vec (map (comp float bone-weights) (range (* vertex 4) (+ (* vertex 4) 4)))))
   1.467 -
   1.468 -(defn vertex-position [index]
   1.469 -  (let [offset (* index 3)]
   1.470 -    (Vector3f. (position offset)
   1.471 -               (position (inc offset))
   1.472 -               (position (inc(inc offset))))))
   1.473 -
   1.474 -(def vertex-info (juxt vertex-position vertex-bones vertex-weights))
   1.475 -
   1.476 -(defn bone-control-color [index]
   1.477 -  (get {[1 0 0 0] ColorRGBA/Red
   1.478 -        [1 2 0 0] ColorRGBA/Magenta
   1.479 -        [2 0 0 0] ColorRGBA/Blue}
   1.480 -       (vertex-bones index)
   1.481 -       ColorRGBA/White))
   1.482 -
   1.483 -(defn influence-color [index bone-num]
   1.484 -  (get
   1.485 -   {(float 0)   ColorRGBA/Blue
   1.486 -    (float 0.5) ColorRGBA/Green
   1.487 -    (float 1)   ColorRGBA/Red}
   1.488 -     ;; find the weight of the desired bone
   1.489 -   ((zipmap (vertex-bones index)(vertex-weights index))
   1.490 -    bone-num)
   1.491 -   ColorRGBA/Blue))
   1.492 -         
   1.493 -(def worm-vertices (set (map vertex-info (range 60))))
   1.494 -
   1.495 -
   1.496 -(defn test-info []
   1.497 -  (let [points (Node.)]
   1.498 -    (dorun
   1.499 -     (map #(.attachChild points %)
   1.500 -          (map #(sphere 0.01
   1.501 -                        :position (vertex-position %)
   1.502 -                        :color (influence-color % 1)
   1.503 -                        :physical? false)
   1.504 -               (range 60))))
   1.505 -    (view points)))
   1.506 -  
   1.507 -
   1.508 -(defrecord JointControl [joint physics-space]
   1.509 -  PhysicsControl
   1.510 -  (setPhysicsSpace [this space]
   1.511 -    (dosync
   1.512 -     (ref-set (:physics-space this) space))
   1.513 -    (.addJoint space (:joint this)))
   1.514 -  (update [this tpf])
   1.515 -  (setSpatial [this spatial])
   1.516 -  (render [this rm vp])
   1.517 -  (getPhysicsSpace [this] (deref (:physics-space this)))
   1.518 -  (isEnabled [this] true)
   1.519 -  (setEnabled [this state]))
   1.520 -  
   1.521 -(defn add-joint
   1.522 -  "Add a joint to a particular object. When the object is added to the
   1.523 -  PhysicsSpace of a simulation, the joint will also be added"
   1.524 -  [object joint]
   1.525 -  (let [control (JointControl. joint (ref nil))]
   1.526 -    (.addControl object control))
   1.527 -  object)
   1.528 -
   1.529 -
   1.530 -(defn hinge-world
   1.531 -  []
   1.532 -  (let [sphere1 (sphere)
   1.533 -        sphere2 (sphere 1 :position (Vector3f. 3 3 3))
   1.534 -        joint (Point2PointJoint.
   1.535 -               (.getControl sphere1 RigidBodyControl)
   1.536 -               (.getControl sphere2 RigidBodyControl) 
   1.537 -               Vector3f/ZERO (Vector3f. 3 3 3))]
   1.538 -    (add-joint sphere1 joint)
   1.539 -    (doto (Node. "hinge-world")
   1.540 -      (.attachChild sphere1)
   1.541 -      (.attachChild sphere2))))
   1.542 -
   1.543 -
   1.544 -(defn test-joint []
   1.545 -  (view (hinge-world)))
   1.546 -
   1.547 -;; (defn copier-gen []
   1.548 -;;   (let [count (atom 0)]
   1.549 -;;     (fn [in]
   1.550 -;;       (swap! count inc)
   1.551 -;;       (clojure.contrib.duck-streams/copy
   1.552 -;;        in (File. (str "/home/r/tmp/mao-test/clojure-images/"
   1.553 -;;                      ;;/home/r/tmp/mao-test/clojure-images
   1.554 -;;                (format "%08d.png" @count)))))))
   1.555 -;; (defn decrease-framerate []
   1.556 -;;   (map
   1.557 -;;    (copier-gen)
   1.558 -;;    (sort
   1.559 -;;     (map first
   1.560 -;;          (partition
   1.561 -;;           4
   1.562 -;;           (filter #(re-matches #".*.png$" (.getCanonicalPath %))
   1.563 -;;                   (file-seq
   1.564 -;;                    (file-str
   1.565 -;;                     "/home/r/media/anime/mao-temp/images"))))))))
   1.566 -
   1.567 -
   1.568 -
   1.569 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.570 -
   1.571 -(defn proprioception
   1.572 -  "Create a proprioception map that reports the rotations of the
   1.573 -  various limbs of the creature's body"
   1.574 -  [creature]
   1.575 -  [#^Node creature]
   1.576 -  (let [
   1.577 -        nodes (node-seq creature)
   1.578 -        joints
   1.579 -        (map
   1.580 -         :joint 
   1.581 -         (filter
   1.582 -          #(isa? (class %) JointControl)
   1.583 -          (reduce
   1.584 -           concat
   1.585 -           (map (fn [node]
   1.586 -                  (map (fn [num] (.getControl node num))
   1.587 -                       (range (.getNumControls node))))
   1.588 -                nodes))))]
   1.589 -    (fn []
   1.590 -      (reduce concat (map relative-positions (list (first joints)))))))
   1.591 -
   1.592 -
   1.593 -(defn skel [node]
   1.594 -  (doto
   1.595 -      (.getSkeleton
   1.596 -       (.getControl node SkeletonControl))
   1.597 -    ;; this is necessary to force the skeleton to have accurate world
   1.598 -    ;; transforms before it is rendered to the screen. 
   1.599 -    (.resetAndUpdate)))
   1.600 -
   1.601 -(defn green-x-ray []
   1.602 -  (doto (Material. (asset-manager)
   1.603 -                   "Common/MatDefs/Misc/Unshaded.j3md")
   1.604 -    (.setColor "Color" ColorRGBA/Green)
   1.605 -    (-> (.getAdditionalRenderState)
   1.606 -        (.setDepthTest false))))
   1.607 -
   1.608 -(defn test-worm []
   1.609 -  (.start
   1.610 -   (world
   1.611 -    (doto (Node.)
   1.612 -      ;;(.attachChild (point-worm))
   1.613 -      (.attachChild (load-blender-model
   1.614 -                     "Models/anim2/joint-worm.blend"))
   1.615 -                      
   1.616 -      (.attachChild (box 10 1 10
   1.617 -                         :position (Vector3f. 0 -2 0) :mass 0
   1.618 -                         :color (ColorRGBA/Gray))))
   1.619 -    {
   1.620 -     "key-space" (fire-cannon-ball)
   1.621 -     }
   1.622 -    (fn [world]
   1.623 -      (enable-debug world)
   1.624 -      (light-up-everything world)
   1.625 -      ;;(.setTimer world (NanoTimer.))
   1.626 -      )
   1.627 -    no-op)))
   1.628 -
   1.629 -
   1.630 -
   1.631 -;; defunct movement stuff
   1.632 -(defn torque-controls [control]
   1.633 -  (let [torques
   1.634 -        (concat
   1.635 -         (map #(Vector3f. 0 (Math/sin %) (Math/cos %))
   1.636 -              (range 0 (* Math/PI 2) (/ (* Math/PI 2) 20)))
   1.637 -         [Vector3f/UNIT_X])]
   1.638 -    (map (fn [torque-axis]
   1.639 -           (fn [torque]
   1.640 -             (.applyTorque
   1.641 -              control
   1.642 -              (.mult (.mult (.getPhysicsRotation control)
   1.643 -                            torque-axis)
   1.644 -                     (float
   1.645 -                      (* (.getMass control) torque))))))
   1.646 -         torques)))
   1.647 -
   1.648 -(defn motor-map
   1.649 -  "Take a creature and generate a function that will enable fine
   1.650 -   grained control over all the creature's limbs."  
   1.651 -  [#^Node creature]
   1.652 -  (let [controls (keep #(.getControl % RigidBodyControl)
   1.653 -                       (node-seq creature))
   1.654 -        limb-controls (reduce concat (map torque-controls controls))
   1.655 -        body-control  (partial map #(%1 %2) limb-controls)]
   1.656 -    body-control))
   1.657 -
   1.658 -(defn test-motor-map
   1.659 -  "see how torque works."
   1.660 -  []
   1.661 -  (let [finger (box 3 0.5 0.5 :position (Vector3f. 0 2 0)
   1.662 -                    :mass 1 :color ColorRGBA/Green)
   1.663 -        motor-map (motor-map finger)]
   1.664 -    (world
   1.665 -     (nodify [finger
   1.666 -              (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
   1.667 -                   :color ColorRGBA/Gray)])
   1.668 -     standard-debug-controls
   1.669 -     (fn [world]
   1.670 -       (set-gravity world Vector3f/ZERO)
   1.671 -       (light-up-everything world)
   1.672 -       (.setTimer world (NanoTimer.)))
   1.673 -     (fn [_ _]
   1.674 -       (dorun (motor-map [0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
   1.675 -     0]))))))
   1.676 -
   1.677 -(defn joint-proprioception [#^Node parts #^Node joint]
   1.678 -  (let [[obj-a obj-b] (joint-targets parts joint)
   1.679 -        joint-rot (.getWorldRotation joint)
   1.680 -        pre-inv-a (.inverse (.getWorldRotation obj-a))
   1.681 -        x (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_X))
   1.682 -        y (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_Y))
   1.683 -        z (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_Z))
   1.684 -
   1.685 -        x Vector3f/UNIT_Y
   1.686 -        y Vector3f/UNIT_Z
   1.687 -        z Vector3f/UNIT_X
   1.688 -
   1.689 -
   1.690 -        tmp-rot-a (.getWorldRotation obj-a)]
   1.691 -    (println-repl "x:" (.mult tmp-rot-a x))
   1.692 -    (println-repl "y:" (.mult tmp-rot-a y))
   1.693 -    (println-repl "z:" (.mult tmp-rot-a z))
   1.694 -    (println-repl "rot-a" (.getWorldRotation obj-a))
   1.695 -    (println-repl "rot-b" (.getWorldRotation obj-b))
   1.696 -    (println-repl "joint-rot" joint-rot)
   1.697 -    ;; this function will report proprioceptive information for the
   1.698 -    ;; joint.
   1.699 -    (fn []
   1.700 -      ;; x is the "twist" axis, y and z are the "bend" axes
   1.701 -      (let [rot-a (.getWorldRotation obj-a)
   1.702 -            ;;inv-a (.inverse rot-a)
   1.703 -            rot-b (.getWorldRotation obj-b)
   1.704 -            ;;relative (.mult rot-b inv-a)
   1.705 -            basis (doto (Matrix3f.)
   1.706 -                    (.setColumn 0 (.mult rot-a x))
   1.707 -                    (.setColumn 1 (.mult rot-a y))
   1.708 -                    (.setColumn 2 (.mult rot-a z)))
   1.709 -            rotation-about-joint
   1.710 -            (doto (Quaternion.)
   1.711 -              (.fromRotationMatrix 
   1.712 -               (.mult (.invert basis)
   1.713 -                      (.toRotationMatrix rot-b))))
   1.714 -            [yaw roll pitch]
   1.715 -            (seq (.toAngles rotation-about-joint nil))]
   1.716 -        ;;return euler angles of the quaternion around the new basis            
   1.717 -        [yaw roll pitch]))))
   1.718 -
   1.719 -#+end_src
   1.720 -
   1.721 -
   1.722 -
   1.723 -
   1.724 -
   1.725 -
   1.726 -
   1.727 -* COMMENT generate Source
   1.728 +* COMMENT Generate Source
   1.729  #+begin_src clojure :tangle ../src/cortex/body.clj
   1.730  <<body-header>>
   1.731  <<body-1>>
   1.732 @@ -1309,3 +590,4 @@
   1.733  
   1.734  
   1.735    
   1.736 +

     2.1 --- a/org/proprioception.org	Thu Feb 09 04:15:09 2012 -0700
     2.2 +++ b/org/proprioception.org	Thu Feb 09 04:21:12 2012 -0700
     2.3 @@ -148,6 +148,102 @@
     2.4  
     2.5  #+end_src
     2.6  
     2.7 +#+name: test-body
     2.8 +#+begin_src clojure
     2.9 +
    2.10 +
    2.11 +(defn test-proprioception
    2.12 +  "Testing proprioception:
    2.13 +   You should see two foating bars, and a printout of pitch, yaw, and
    2.14 +   roll. Pressing key-r/key-t should move the blue bar up and down and
    2.15 +   change only the value of pitch. key-f/key-g moves it side to side
    2.16 +   and changes yaw. key-v/key-b will spin the blue segment clockwise
    2.17 +   and counterclockwise, and only affect roll."
    2.18 +  []
    2.19 +  (let [hand    (box 0.2 1 0.2 :position (Vector3f. 0 0 0)
    2.20 +                     :mass 0 :color ColorRGBA/Green :name "hand")
    2.21 +        finger (box 0.2 1 0.2 :position (Vector3f. 0 2.4 0)
    2.22 +                    :mass 1 :color ColorRGBA/Red :name "finger")
    2.23 +        joint-node (box 0.1 0.05 0.05 :color ColorRGBA/Yellow
    2.24 +                        :position (Vector3f. 0 1.2 0)
    2.25 +                        :rotation (doto (Quaternion.)
    2.26 +                                    (.fromAngleAxis
    2.27 +                                     (/ Math/PI 2)
    2.28 +                                     (Vector3f. 0 0 1)))
    2.29 +                        :physical? false)
    2.30 +        joint (join-at-point hand finger (Vector3f. 0 1.2 0 ))
    2.31 +        creature (nodify [hand finger joint-node])
    2.32 +        finger-control (.getControl finger RigidBodyControl)
    2.33 +        hand-control (.getControl hand RigidBodyControl)]
    2.34 +    
    2.35 +
    2.36 +    (let
    2.37 +        ;; *******************************************
    2.38 +                
    2.39 +        [floor   (box 10 10 10 :position (Vector3f. 0 -15 0)
    2.40 +                     :mass 0 :color ColorRGBA/Gray)
    2.41 +        
    2.42 +        root (nodify [creature floor])
    2.43 +        prop (joint-proprioception creature joint-node)
    2.44 +        prop-view (proprioception-debug-window)
    2.45 +        
    2.46 +        controls
    2.47 +        (merge standard-debug-controls
    2.48 +               {"key-o"
    2.49 +                (fn [_ _] (.setEnabled finger-control true))
    2.50 +                "key-p"
    2.51 +                (fn [_ _] (.setEnabled finger-control false))
    2.52 +                "key-k"
    2.53 +                (fn [_ _] (.setEnabled hand-control true))
    2.54 +                "key-l"
    2.55 +                (fn [_ _] (.setEnabled hand-control false))
    2.56 +                "key-i"
    2.57 +                (fn [world _] (set-gravity world (Vector3f. 0 0 0)))
    2.58 +                "key-period"
    2.59 +                (fn [world _]
    2.60 +                  (.setEnabled finger-control false)
    2.61 +                  (.setEnabled hand-control false)
    2.62 +                  (.rotate creature (doto (Quaternion.)
    2.63 +                                      (.fromAngleAxis
    2.64 +                                       (float (/ Math/PI 15))
    2.65 +                                       (Vector3f. 0 0 -1))))
    2.66 +                                              
    2.67 +                  (.setEnabled finger-control true)
    2.68 +                  (.setEnabled hand-control true)
    2.69 +                  (set-gravity world (Vector3f. 0 0 0))
    2.70 +                  )
    2.71 +                
    2.72 +                  
    2.73 +                }
    2.74 +               )
    2.75 +
    2.76 +        ]
    2.77 +    (comment
    2.78 +      (.setCollisionGroup
    2.79 +       (.getControl hand RigidBodyControl)
    2.80 +       PhysicsCollisionObject/COLLISION_GROUP_NONE)
    2.81 +      )
    2.82 +    (apply
    2.83 +     world
    2.84 +     (with-movement
    2.85 +       hand
    2.86 +       ["key-y" "key-u" "key-h" "key-j" "key-n" "key-m"]
    2.87 +       [10 10 10 10 1 1]
    2.88 +       (with-movement
    2.89 +         finger
    2.90 +         ["key-r" "key-t" "key-f" "key-g" "key-v" "key-b"]
    2.91 +         [1 1 10 10 10 10]
    2.92 +         [root
    2.93 +          controls
    2.94 +          (fn [world]
    2.95 +            (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
    2.96 +            (set-gravity world (Vector3f. 0 0 0))
    2.97 +            (light-up-everything world))
    2.98 +          (fn [_ _] (prop-view (list (prop))))]))))))
    2.99 +
   2.100 +#+end_src
   2.101 +
   2.102 +
   2.103  * COMMENT generate source
   2.104  #+begin_src clojure :tangle ../src/cortex/proprioception.clj
   2.105  <<proprioception>>