1.1 --- a/org/test-creature.org	Wed Dec 28 00:00:23 2011 -0700
     1.2 +++ b/org/test-creature.org	Wed Dec 28 06:44:36 2011 -0700
     1.3 @@ -61,13 +61,132 @@
     1.4       (.registerLoader BlenderModelLoader (into-array String ["blend"])))
     1.5     model))
     1.6  
     1.7 +(defn meta-data [blender-node key]
     1.8 +  (if-let [data (.getUserData blender-node "properties")]
     1.9 +    (.findValue data key)
    1.10 +    nil))
    1.11  
    1.12 -(defn apply-skeleton
    1.13 -  "Given an imported blender model, apply the armature using the
    1.14 -  following pattern: if two bones are connected and have the same
    1.15 -  names as two shapes, connect the shapes with a joint constraint."
    1.16 -  [armature-name creature]
    1.17 +(defn hand2 []
    1.18 +  (load-blender-model "Models/creature1/try-again.blend"))
    1.19 +
    1.20 +(defn hand []
    1.21 +  (load-blender-model "Models/creature1/one.blend"))
    1.22 +
    1.23 +
    1.24    
    1.25 +(def hand-names
    1.26 +  #{
    1.27 +    "middle-1"
    1.28 +    "middle-2"
    1.29 +    "middle-3"
    1.30 +    "palm"
    1.31 +    "pinky-1"
    1.32 +    "pinky-2"
    1.33 +    "pinky-3"
    1.34 +    "pointer-1"
    1.35 +    "pointer-2"
    1.36 +    "pointer-3"
    1.37 +    "ring-1"
    1.38 +    "ring-2"
    1.39 +    "ring-3"
    1.40 +    "thumb-1"
    1.41 +    "thumb-2"})
    1.42 +
    1.43 +(defn hand-pieces []
    1.44 +  (filter
    1.45 +   (comp hand-names #(apply str (drop-last (.getName %)))) (node-seq (hand))))
    1.46 +
    1.47 +(defn hand-joints []
    1.48 +  (map #(.getWorldTranslation %)
    1.49 +       (filter #(re-matches #"joint\.\d\d\d" (.getName %))
    1.50 +               (node-seq (hand)))))
    1.51 +
    1.52 +(defn worm-pieces []
    1.53 +  (filter
    1.54 +   (comp #{"worm-2" "worm-1"}
    1.55 +         #(apply str (drop-last (.getName %))))
    1.56 +   (node-seq (hand2))))
    1.57 +
    1.58 +(defn worm-joints []
    1.59 +  [Vector3f/ZERO])
    1.60 +
    1.61 +
    1.62 +
    1.63 +(defn find-joint
    1.64 +  [#^Node parts #^Vector3f joint-position]
    1.65 +  (loop [radius (float 0.01)]
    1.66 +    (let [results (CollisionResults.)]
    1.67 +      (.collideWith
    1.68 +       parts
    1.69 +       (BoundingBox. joint-position radius radius radius)
    1.70 +       results)
    1.71 +      (let [targets
    1.72 +            (distinct
    1.73 +             (map  #(.getGeometry %) results))]
    1.74 +        (if (>= (count targets) 2)
    1.75 +          (take 2 targets)
    1.76 +          (recur (float (* radius 2))))))))
    1.77 +
    1.78 +
    1.79 +
    1.80 +(defn connect-at-point
    1.81 +  [obj-a obj-b point]
    1.82 +  (let [center-a (.getWorldTranslation obj-a)
    1.83 +        center-b (.getWorldTranslation obj-b)
    1.84 +        pivot-a (.subtract point center-a)
    1.85 +        pivot-b (.subtract point center-b)
    1.86 +        ;; A side-effect of creating a joint registers
    1.87 +        ;; it with both physics objects which in turn
    1.88 +        ;; will register the joint with the physics system
    1.89 +        ;; when the simulation is started.
    1.90 +        joint (Point2PointJoint.
    1.91 +               (.getControl obj-a RigidBodyControl)
    1.92 +               (.getControl obj-b RigidBodyControl)
    1.93 +               pivot-a
    1.94 +               pivot-b)]
    1.95 +    obj-a))
    1.96 +
    1.97 +
    1.98 +(defn physical-hand [#^Node pieces joints]
    1.99 +  ;; Make each piece a physical entity in the simulation.
   1.100 +  (dorun
   1.101 +   (map
   1.102 +    (fn [geom]
   1.103 +      (let [physics-control
   1.104 +            (RigidBodyControl.
   1.105 +             (HullCollisionShape.
   1.106 +              (.getMesh geom))
   1.107 +             ;; TODO: fix this.
   1.108 +             (float 1.0))]
   1.109 +        (.addControl geom physics-control)))
   1.110 +    (filter #(isa? (class %) Geometry )
   1.111 +            (node-seq pieces))))
   1.112 +  (dorun
   1.113 +   (map
   1.114 +    (fn [joint-position]
   1.115 +      (let [[geom-a geom-b] (find-joint pieces joint-position)]
   1.116 +        (connect-at-point geom-a geom-b joint-position)))
   1.117 +      joints))
   1.118 +   pieces)
   1.119 +
   1.120 +
   1.121 +(defn the-hand! [] (physical-hand  (hand) (hand-joints)))
   1.122 +
   1.123 +
   1.124 +(defn test-hand []
   1.125 +  (world
   1.126 +   (nodify [(the-hand!)
   1.127 +            (box 10 0.1 10 :position (Vector3f. 0 -10 0)
   1.128 +                 :color ColorRGBA/Gray
   1.129 +                 :mass 0)])
   1.130 +   standard-debug-controls
   1.131 +   enable-debug
   1.132 +   no-op))
   1.133 +
   1.134 +
   1.135 +
   1.136 +
   1.137 +
   1.138  
   1.139  
   1.140  #+end_src