#+title: The BODY!!!

 #+author: Robert McIntyre

 #+email: rlm@mit.edu

 #+description: Simulating a body (movement, touch, propioception) in jMonkeyEngine3.

 #+SETUPFILE: ../../aurellem/org/setup.org

 #+INCLUDE: ../../aurellem/org/level-0.org

 

 * Body  

 

 #+srcname: body-main

 #+begin_src clojure 

 (ns cortex.body

   (use (cortex world util import)))

 

 (use 'clojure.contrib.def)

 (cortex.import/mega-import-jme3)

 (rlm.rlm-commands/help)

 

 ;;(.loadModel 

 ;; (doto (asset-manager)

 ;;   (.registerLoader BlenderModelLoader (into-array String ["blend"])))

 ;;   "Models/person/person.blend")

 

 (defn view-model [^String model]

   (view 

    (.loadModel 

     (doto (asset-manager)

       (.registerLoader BlenderModelLoader (into-array String ["blend"])))

     model)))

 

 (defn load-blender-scene [^String model]

   (.loadModel

    (doto (asset-manager)

      (.registerLoader BlenderLoader (into-array String ["blend"])))

     model))

 

 (defn load-blender-model 

   [^String model]

   (.loadModel

    (doto (asset-manager)

      (.registerLoader BlenderModelLoader (into-array String ["blend"])))

    model))

 

 (defn worm

   []

   (.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml"))

 

 (defn oto

   []

   (.loadModel (asset-manager) "Models/Oto/Oto.mesh.xml"))

 

 (defn sinbad

   []

   (.loadModel (asset-manager) "Models/Sinbad/Sinbad.mesh.xml"))

 

 (defn worm-blender

   []

   (first (seq (.getChildren (load-blender-model

                              "Models/anim2/simple-worm.blend")))))

 

 (defn skel [node]

   (doto

       (.getSkeleton

        (.getControl node SkeletonControl))

     ;; this is necessary to force the skeleton to have accurate world

     ;; transforms before it is rendered to the screen. 

     (.resetAndUpdate)))

 

 (defprotocol Textual

   (text [something]

     "Display a detailed textual analysis of the given object."))

 

 (extend-type com.jme3.scene.Node

   Textual

   (text [node]

     (println "Total Vertexes: " (.getVertexCount node))

     (println "Total Triangles: " (.getTriangleCount node))

     (println "Controls :")

     (dorun (map #(text (.getControl node %)) (range (.getNumControls node))))

     (println "Has " (.getQuantity node) " Children:")

     (doall (map text (.getChildren node)))))

 

 (extend-type com.jme3.animation.AnimControl

   Textual

   (text [control]

     (let [animations (.getAnimationNames control)]

       (println "Animation Control with " (count animations) " animation(s):")

       (dorun (map println animations)))))

 

 (extend-type com.jme3.animation.SkeletonControl

   Textual

   (text [control]

     (println "Skeleton Control with the following skeleton:")

     (println (.getSkeleton control))))

 

 (extend-type com.jme3.bullet.control.KinematicRagdollControl

   Textual

   (text [control]

     (println "Ragdoll Control")))

                  

 

 (extend-type com.jme3.scene.Geometry

   Textual

   (text [control]

     (println "...geo...")))

 

 

 

 

 (defn body

   "given a node with a SkeletonControl, will produce a body sutiable

   for AI control with movement and proprioception."

   [node]

   (let [skeleton-control (.getControl node SkeletonControl)

         krc (KinematicRagdollControl.)]

     (comment

     (dorun

      (map #(.addBoneName krc %)

           ["mid2" "tail" "head" "mid1" "mid3" "mid4" "Dummy-Root" ""]

            ;;"mid2" "mid3" "tail" "head"]

         )))

     (.addControl node krc)

     (.setRagdollMode krc)

     )

   node

   )

 

 (defn green-x-ray []

   (doto (Material. (asset-manager)

                    "Common/MatDefs/Misc/Unshaded.j3md")

     (.setColor "Color" ColorRGBA/Green)

     (-> (.getAdditionalRenderState)

         (.setDepthTest false))))

 

 (defn show-skeleton [node]

   (let [sd

 

         (doto

             (SkeletonDebugger. "aurellem-skel-debug"

                                (skel node))

           (.setMaterial (green-x-ray)))]

     (.attachChild node sd)

     node))

 

   

 

 (defn init-debug-skel-node

   [f debug-node skeleton]

   (let [bones 

         (map #(.getBone skeleton %)

              (range (.getBoneCount skeleton)))]

   (dorun (map #(.setUserControl % true) bones)) 

   (dorun (map (fn [b]

                 (println (.getName b)

                          " -- " (f b)))

               bones))

   (dorun

    (map #(.attachChild

           debug-node 

           (doto 

               (sphere 0.1

                       :position (f %)

                       :physical? false)

           (.setMaterial (green-x-ray))))

         bones)))

     debug-node)

 

 (import jme3test.bullet.PhysicsTestHelper)

 

 

 (defn test-zzz [the-worm world value]

   (if (not value)

     (let [skeleton (skel the-worm)]

       (println-repl "enabling bones")

       (dorun

        (map

         #(.setUserControl (.getBone skeleton %) true)

         (range (.getBoneCount skeleton))))

 

 

       (let [b (.getBone skeleton 2)]

         (println-repl "moving " (.getName b))

         (println-repl (.getLocalPosition b))

         (.setUserTransforms b

                             Vector3f/UNIT_X

                             Quaternion/IDENTITY

                             ;;(doto (Quaternion.)

                              ;; (.fromAngles (/ Math/PI 2)

                              ;;              0

                              ;;              0

                                           

                             (Vector3f. 1 1 1))

         )

       

       (println-repl "hi! <3"))))

 

 

 (defn test-ragdoll []

   

   (let [the-worm

         

          ;;(.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml")

          (doto (show-skeleton (worm-blender))

            (.setLocalTranslation (Vector3f. 0 10 0))

          ;;(worm)

          ;;(oto)

          ;;(sinbad)

         )

     ]

 

 

     (.start 

      (world

       (doto (Node.)

         (.attachChild the-worm))

       {"key-return" (fire-cannon-ball)

        "key-space" (partial test-zzz the-worm)

        }

       (fn [world]

         (light-up-everything world)

         (PhysicsTestHelper/createPhysicsTestWorld

          (.getRootNode world)

          (asset-manager)

          (.getPhysicsSpace

           (.getState (.getStateManager world) BulletAppState)))

         (set-gravity world Vector3f/ZERO)

         ;;(.setTimer world (NanoTimer.))

         ;;(org.lwjgl.input.Mouse/setGrabbed false)

         )

       no-op

       )

   

      

      )))

     

        

 

 

 

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;;; here is the ragdoll stuff

 

 (def worm-mesh (.getMesh (.getChild (worm-blender) 0)))

 (def mesh worm-mesh)

 

 (.getFloatBuffer mesh VertexBuffer$Type/Position)

 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)

 (.getData  (.getBuffer mesh VertexBuffer$Type/BoneIndex))

 

 

 (defn position [index]

   (.get

    (.getFloatBuffer worm-mesh VertexBuffer$Type/Position)

      index))

 

 (defn bones [index]

   (.get

    (.getData  (.getBuffer mesh VertexBuffer$Type/BoneIndex))

    index))

 

 (defn bone-weights [index]

   (.get

    (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)

    index))

 

 

 

 (defn vertex-bones [vertex]

   (vec (map (comp int bones) (range (* vertex 4) (+ (* vertex 4) 4)))))

 

 (defn vertex-weights [vertex]

   (vec (map (comp float bone-weights) (range (* vertex 4) (+ (* vertex 4) 4)))))

 

 (defn vertex-position [index]

   (let [offset (* index 3)]

     (Vector3f. (position offset)

                (position (inc offset))

                (position (inc(inc offset))))))

 

 (def vertex-info (juxt vertex-position vertex-bones vertex-weights))

 

 (defn bone-control-color [index]

   (get {[1 0 0 0] ColorRGBA/Red

         [1 2 0 0] ColorRGBA/Magenta

         [2 0 0 0] ColorRGBA/Blue}

        (vertex-bones index)

        ColorRGBA/White))

 

 (defn influence-color [index bone-num]

   (get

    {(float 0)   ColorRGBA/Blue

     (float 0.5) ColorRGBA/Green

     (float 1)   ColorRGBA/Red}

      ;; find the weight of the desired bone

    ((zipmap (vertex-bones index)(vertex-weights index))

     bone-num)

    ColorRGBA/Blue))

          

 (def worm-vertices (set (map vertex-info (range 60))))

 

 

 (defn test-info []

   (let [points (Node.)]

     (dorun

      (map #(.attachChild points %)

           (map #(sphere 0.01

                         :position (vertex-position %)

                         :color (influence-color % 1)

                         :physical? false)

                (range 60))))

     (view points)))

   

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

 

 

 

 ;;;;;;;;;;;;  eve-style bodies  ;;;;;;;;

 (defn joint-control

   [joint]

   (let [physics-space (ref nil)]

     (reify PhysicsControl

       (setPhysicsSpace [this space]

         (dosync

          (ref-set physics-space space))

         (.addJoint space joint))

       (update [this tpf])

       (setSpatial [this spatial])

       (render [this rm vp])

       (getPhysicsSpace [this] (deref physics-space))

       (isEnabled [this] true)

       (setEnabled [this state]))))

 

 (defn add-joint

   "Add a joint to a particular object. When the object is added to the

   PhysicsSpace of a simulation, the joint will also be added"

   [object joint]

   (let [control (joint-control joint)]

     (.addControl object control))

   object)

 

 (defn hinge-world

   []

   (let [sphere1 (sphere)

         sphere2 (sphere 1 :position (Vector3f. 3 3 3))

         joint (Point2PointJoint.

                (.getControl sphere1 RigidBodyControl)

                (.getControl sphere2 RigidBodyControl) 

                Vector3f/ZERO (Vector3f. 3 3 3))]

     (add-joint sphere1 joint)

     (doto (Node. "hinge-world")

       (.attachChild sphere1)

       (.attachChild sphere2))))

 

 (defn test-joint []

   (view (hinge-world)))

 

 

 (defn worm [segment-length num-segments interstitial-space radius]

   (letfn [(nth-segment

             [n]

             (box segment-length radius radius :mass 0.1

                  :position

                  (Vector3f.

                   (* 2 n (+ interstitial-space segment-length)) 0 0)

                  :name (str "worm-segment" n)

                  :color (ColorRGBA/randomColor)))]

     (map nth-segment (range num-segments))))

 

 (defn nodify

   "take a sequence of things that can be attached to a node and return

   a node with all of the attached"

   ([name children]

      (let [node (Node. name)]

        (dorun (map #(.attachChild node %) children))

        node))

   ([children] (nodify "" children)))

 

 

 (defn connect-at-midpoint

   [segmentA segmentB]

   (let [centerA (.getWorldTranslation segmentA)

         centerB (.getWorldTranslation segmentB)

         midpoint (.mult (.add centerA centerB) (float 0.5))

         pivotA (.subtract midpoint centerA)

         pivotB (.subtract midpoint centerB)

 

         joint (Point2PointJoint.

                (.getControl segmentA RigidBodyControl)

                (.getControl segmentB RigidBodyControl)

                pivotA

                pivotB)]

     (add-joint segmentA joint)

   segmentB))

 

 

 (defn point-worm []

   (let [segments (worm 0.2 5 0.1 0.1)]

     (dorun (map (partial apply connect-at-midpoint)

                 (partition 2 1 segments)))

     (nodify "worm"  segments)))

 

 

 (defn test-worm []

   (.start

    (world

     (doto (Node.)

       ;;(.attachChild (point-worm))

       (.attachChild (load-blender-model

                      "Models/anim2/joint-worm.blend"))

                       

       (.attachChild (box 10 1 10

                          :position (Vector3f. 0 -2 0) :mass 0

                          :color (ColorRGBA/Gray))))

     {

      "key-space" (fire-cannon-ball)

      }

     (fn [world]

       (enable-debug world)

       (light-up-everything world)

       ;;(.setTimer world (NanoTimer.))

       )

     no-op)))

 

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

 

 

 

 

 

 

 

 

 

 

 #+end_src

 

 

 

 

 

 

 

 

 * COMMENT generate Source.

 #+begin_src clojure :tangle ../src/cortex/body.clj

 <<body-main>>

 #+end_src