view org/body.org @ 131:e98850b83c2c

going to fix error in proprioception
author Robert McIntyre <rlm@mit.edu>
date Mon, 30 Jan 2012 07:21:46 -0700
parents b26017d1fe9a
children 3206d5e20bee
line wrap: on
line source
1 #+title: The BODY!!!
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description: Simulating a body (movement, touch, propioception) in jMonkeyEngine3.
5 #+SETUPFILE: ../../aurellem/org/setup.org
6 #+INCLUDE: ../../aurellem/org/level-0.org
8 * Proprioception
9 #+name: proprioception
10 #+begin_src clojure
11 (ns cortex.body
12 (:use (cortex world util))
13 (:import
14 com.jme3.math.Vector3f
15 com.jme3.math.Quaternion
16 com.jme3.math.Vector2f
17 com.jme3.math.Matrix3f
18 com.jme3.bullet.control.RigidBodyControl))
20 (defn any-orthogonal
21 "Generate an arbitray (but stable) orthogonal vector to a given
22 vector."
23 [vector]
24 (let [x (.getX vector)
25 y (.getY vector)
26 z (.getZ vector)]
27 (cond
28 (not= x (float 0)) (Vector3f. (- z) 0 x)
29 (not= y (float 0)) (Vector3f. 0 (- z) y)
30 (not= z (float 0)) (Vector3f. 0 (- z) y)
31 true Vector3f/ZERO)))
33 (defn project-quaternion
34 "From http://stackoverflow.com/questions/3684269/
35 component-of-a-quaternion-rotation-around-an-axis.
37 Determine the amount of rotation a quaternion will
38 cause about a given axis."
39 [#^Quaternion q #^Vector3f axis]
40 (let [basis-1 (any-orthogonal axis)
41 basis-2 (.cross axis basis-1)
42 rotated (.mult q basis-1)
43 alpha (.dot basis-1 (.project rotated basis-1))
44 beta (.dot basis-2 (.project rotated basis-2))]
45 (Math/atan2 beta alpha)))
47 (defn joint-proprioception
48 "Relative position information for a two-part system connected by a
49 joint. Gives the pitch, yaw, and roll of the 'B' object relative to
50 the 'A' object, as determined by the joint."
51 [joint]
52 (let [object-a (.getUserObject (.getBodyA joint))
53 object-b (.getUserObject (.getBodyB joint))
54 arm-a
55 (.normalize
56 (.subtract
57 (.localToWorld object-a (.getPivotA joint) nil)
58 (.getWorldTranslation object-a)))
60 ;; this is probably wrong!
61 rotate-a
62 (doto (Matrix3f.)
63 (.fromStartEndVectors arm-a Vector3f/UNIT_X))
65 arm-b
66 (.mult
67 rotate-a
68 (.normalize
69 (.subtract
70 (.localToWorld object-b (.getPivotB joint) nil)
71 (.getWorldTranslation object-b))))
72 pitch
73 (.angleBetween
74 (.normalize (Vector2f. (.getX arm-b) (.getY arm-b)))
75 (Vector2f. 1 0))
76 yaw
77 (.angleBetween
78 (.normalize (Vector2f. (.getX arm-b) (.getZ arm-b)))
79 (Vector2f. 1 0))
81 roll
82 (project-quaternion
83 (.mult
84 (.getLocalRotation object-b)
85 (doto (Quaternion.)
86 (.fromRotationMatrix rotate-a)))
87 arm-b)]
88 ;;(println-repl (.getName object-a) (.getName object-b))
89 [pitch yaw roll]))
92 (defn joint-proprioception
93 [joint]
94 (let [object-a (.getUserObject (.getBodyA joint))
95 object-b (.getUserObject (.getBodyB joint))
97 arm-a
98 (.normalize
99 (.subtract
100 (.localToWorld object-a (.getPivotA joint) nil)
101 (.getWorldTranslation object-a)))
102 arm-b
103 (.normalize
104 (.subtract
105 (.localToWorld object-b (.getPivotB joint) nil)
106 (.getWorldTranslation object-b)))
109 ]
115 (defn proprioception
116 "Create a function that provides proprioceptive information about an
117 entire body."
118 [body]
119 ;; extract the body's joints
120 (let [joints
121 (distinct
122 (reduce
123 concat
124 (map #(.getJoints %)
125 (keep
126 #(.getControl % RigidBodyControl)
127 (node-seq body)))))]
128 (fn []
129 (map joint-proprioception joints))))
131 #+end_src
133 * Motor Control
134 #+name: motor-control
135 #+begin_src clojure
136 (in-ns 'cortex.body)
138 ;; surprisingly enough, terristerial creatures only move by using
139 ;; torque applied about their joints. There's not a single straight
140 ;; line of force in the human body at all! (A straight line of force
141 ;; would correspond to some sort of jet or rocket propulseion.)
143 (defn vector-motor-control
144 "Create a function that accepts a sequence of Vector3f objects that
145 describe the torque to be applied to each part of the body."
146 [body]
147 (let [nodes (node-seq body)
148 controls (keep #(.getControl % RigidBodyControl) nodes)]
149 (fn [torques]
150 (map #(.applyTorque %1 %2)
151 controls torques))))
152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
153 #+end_src
155 ## note -- might want to add a lower dimensional, discrete version of
156 ## this if it proves useful from a x-modal clustering perspective.
158 * Examples
160 #+name: test-body
161 #+begin_src clojure
162 (ns cortex.test.body
163 (:use (cortex world util body))
164 (:import
165 com.jme3.math.Vector3f
166 com.jme3.math.ColorRGBA
167 com.jme3.bullet.joints.Point2PointJoint
168 com.jme3.bullet.control.RigidBodyControl
169 com.jme3.system.NanoTimer))
171 (defn worm-segments
172 "Create multiple evenly spaced box segments. They're fabulous!"
173 [segment-length num-segments interstitial-space radius]
174 (letfn [(nth-segment
175 [n]
176 (box segment-length radius radius :mass 0.1
177 :position
178 (Vector3f.
179 (* 2 n (+ interstitial-space segment-length)) 0 0)
180 :name (str "worm-segment" n)
181 :color (ColorRGBA/randomColor)))]
182 (map nth-segment (range num-segments))))
184 (defn connect-at-midpoint
185 "Connect two physics objects with a Point2Point joint constraint at
186 the point equidistant from both objects' centers."
187 [segmentA segmentB]
188 (let [centerA (.getWorldTranslation segmentA)
189 centerB (.getWorldTranslation segmentB)
190 midpoint (.mult (.add centerA centerB) (float 0.5))
191 pivotA (.subtract midpoint centerA)
192 pivotB (.subtract midpoint centerB)
194 ;; A side-effect of creating a joint registers
195 ;; it with both physics objects which in turn
196 ;; will register the joint with the physics system
197 ;; when the simulation is started.
198 joint (Point2PointJoint.
199 (.getControl segmentA RigidBodyControl)
200 (.getControl segmentB RigidBodyControl)
201 pivotA
202 pivotB)]
203 segmentB))
205 (defn eve-worm
206 "Create a worm-like body bound by invisible joint constraints."
207 []
208 (let [segments (worm-segments 0.2 5 0.1 0.1)]
209 (dorun (map (partial apply connect-at-midpoint)
210 (partition 2 1 segments)))
211 (nodify "worm" segments)))
213 (defn worm-pattern
214 "This is a simple, mindless motor control pattern that drives the
215 second segment of the worm's body at an offset angle with
216 sinusoidally varying strength."
217 [time]
218 (let [angle (* Math/PI (/ 9 20))
219 direction (Vector3f. 0 (Math/sin angle) (Math/cos angle))]
220 [Vector3f/ZERO
221 (.mult
222 direction
223 (float (* 2 (Math/sin (* Math/PI 2 (/ (rem time 300 ) 300))))))
224 Vector3f/ZERO
225 Vector3f/ZERO
226 Vector3f/ZERO]))
228 (defn test-motor-control
229 "Testing motor-control:
230 You should see a multi-segmented worm-like object fall onto the
231 table and begin writhing and moving."
232 []
233 (let [worm (eve-worm)
234 time (atom 0)
235 worm-motor-map (vector-motor-control worm)]
236 (world
237 (nodify [worm
238 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
239 :color ColorRGBA/Gray)])
240 standard-debug-controls
241 (fn [world]
242 (enable-debug world)
243 (light-up-everything world)
244 (comment
245 (com.aurellem.capture.Capture/captureVideo
246 world
247 (file-str "/home/r/proj/cortex/tmp/moving-worm")))
248 )
250 (fn [_ _]
251 (swap! time inc)
252 (Thread/sleep 20)
253 (dorun (worm-motor-map
254 (worm-pattern @time)))))))
257 (require 'cortex.silly)
258 (defn join-at-point [obj-a obj-b world-pivot]
259 (cortex.silly/joint-dispatch
260 {:type :point}
261 (.getControl obj-a RigidBodyControl)
262 (.getControl obj-b RigidBodyControl)
263 (cortex.silly/world-to-local obj-a world-pivot)
264 (cortex.silly/world-to-local obj-b world-pivot)
265 nil
266 ))
270 (defn blab-* []
271 (let [hand (box 0.5 0.2 0.2 :position (Vector3f. 0 0 0)
272 :mass 0 :color ColorRGBA/Green)
273 finger (box 0.5 0.2 0.2 :position (Vector3f. 2.4 0 0)
274 :mass 1 :color ColorRGBA/Red)
275 connection-point (Vector3f. 1.2 0 0)
276 root (nodify [hand finger])]
278 (join-at-point hand finger (Vector3f. 1.2 0 0))
280 (.setCollisionGroup
281 (.getControl hand RigidBodyControl)
282 PhysicsCollisionObject/COLLISION_GROUP_NONE)
283 (world
284 root
285 standard-debug-controls
286 (fn [world]
287 (enable-debug world)
288 (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
289 (set-gravity world Vector3f/ZERO)
290 )
291 no-op)))
292 (import java.awt.image.BufferedImage)
294 (defn draw-sprite [image sprite x y color ]
295 (dorun
296 (for [[u v] sprite]
297 (.setRGB image (+ u x) (+ v y) color))))
299 (defn view-angle
300 "create a debug biew of an angle"
301 [color]
302 (let [image (BufferedImage. 50 50 BufferedImage/TYPE_INT_RGB)
303 previous (atom [25 25])
304 sprite [[0 0] [0 1]
305 [0 -1] [-1 0] [1 0]]]
306 (fn [angle]
307 (let [angle (float angle)]
308 (let [position
309 [(+ 25 (int (* 20 (Math/cos angle))))
310 (+ 25 (int (* 20(Math/sin angle))))]]
311 (draw-sprite image sprite (@previous 0) (@previous 1) 0x000000)
312 (draw-sprite image sprite (position 0) (position 1) color)
313 (reset! previous position))
314 image))))
316 (defn proprioception-debug-window
317 []
318 (let [yaw (view-angle 0xFF0000)
319 pitch (view-angle 0x00FF00)
320 roll (view-angle 0xFFFFFF)
321 v-yaw (view-image)
322 v-pitch (view-image)
323 v-roll (view-image)
324 ]
325 (fn [prop-data]
326 (dorun
327 (map
328 (fn [[p y r]]
329 (v-yaw (yaw y))
330 (v-roll (roll r))
331 (v-pitch (pitch p)))
332 prop-data)))))
334 (comment
335 (dorun
336 (map
337 (comp
338 println-repl
339 (fn [[p y r]]
340 (format
341 "pitch: %1.2f\nyaw: %1.2f\nroll: %1.2f\n"
342 p y r)))
343 prop-data)))
349 (defn test-proprioception
350 "Testing proprioception:
351 You should see two foating bars, and a printout of pitch, yaw, and
352 roll. Pressing key-r/key-t should move the blue bar up and down and
353 change only the value of pitch. key-f/key-g moves it side to side
354 and changes yaw. key-v/key-b will spin the blue segment clockwise
355 and counterclockwise, and only affect roll."
356 []
357 (let [hand (box 1 0.2 0.2 :position (Vector3f. 0 2 0)
358 :mass 0 :color ColorRGBA/Green)
359 finger (box 1 0.2 0.2 :position (Vector3f. 2.4 2 0)
360 :mass 1 :color ColorRGBA/Red)
361 floor (box 10 0.5 10 :position (Vector3f. 0 -5 0)
362 :mass 0 :color ColorRGBA/Gray)
364 move-up? (atom false)
365 move-down? (atom false)
366 move-left? (atom false)
367 move-right? (atom false)
368 roll-left? (atom false)
369 roll-right? (atom false)
370 control (.getControl finger RigidBodyControl)
371 time (atom 0)
372 joint (join-at-point hand finger (Vector3f. 1.2 2 0 ))
373 creature (nodify [hand finger])
374 prop (proprioception creature)
376 prop-view (proprioception-debug-window)
379 ]
383 (.setCollisionGroup
384 (.getControl hand RigidBodyControl)
385 PhysicsCollisionObject/COLLISION_GROUP_NONE)
388 (world
389 (nodify [hand finger floor])
390 (merge standard-debug-controls
391 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
392 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
393 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
394 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
395 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
396 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
397 (fn [world]
398 (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
399 (set-gravity world (Vector3f. 0 0 0))
400 (light-up-everything world))
401 (fn [_ _]
402 (if @move-up?
403 (.applyTorque control
404 (.mult (.getPhysicsRotation control)
405 (Vector3f. 0 0 10))))
406 (if @move-down?
407 (.applyTorque control
408 (.mult (.getPhysicsRotation control)
409 (Vector3f. 0 0 -10))))
410 (if @move-left?
411 (.applyTorque control
412 (.mult (.getPhysicsRotation control)
413 (Vector3f. 0 10 0))))
414 (if @move-right?
415 (.applyTorque control
416 (.mult (.getPhysicsRotation control)
417 (Vector3f. 0 -10 0))))
418 (if @roll-left?
419 (.applyTorque control
420 (.mult (.getPhysicsRotation control)
421 (Vector3f. -1 0 0))))
422 (if @roll-right?
423 (.applyTorque control
424 (.mult (.getPhysicsRotation control)
425 (Vector3f. 1 0 0))))
427 ;;(if (= 0 (rem (swap! time inc) 20))
428 (prop-view (prop))))))
430 #+end_src
432 #+results: test-body
433 : #'cortex.test.body/test-proprioception
436 * COMMENT code-limbo
437 #+begin_src clojure
438 ;;(.loadModel
439 ;; (doto (asset-manager)
440 ;; (.registerLoader BlenderModelLoader (into-array String ["blend"])))
441 ;; "Models/person/person.blend")
444 (defn load-blender-model
445 "Load a .blend file using an asset folder relative path."
446 [^String model]
447 (.loadModel
448 (doto (asset-manager)
449 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
450 model))
453 (defn view-model [^String model]
454 (view
455 (.loadModel
456 (doto (asset-manager)
457 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
458 model)))
460 (defn load-blender-scene [^String model]
461 (.loadModel
462 (doto (asset-manager)
463 (.registerLoader BlenderLoader (into-array String ["blend"])))
464 model))
466 (defn worm
467 []
468 (.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml"))
470 (defn oto
471 []
472 (.loadModel (asset-manager) "Models/Oto/Oto.mesh.xml"))
474 (defn sinbad
475 []
476 (.loadModel (asset-manager) "Models/Sinbad/Sinbad.mesh.xml"))
478 (defn worm-blender
479 []
480 (first (seq (.getChildren (load-blender-model
481 "Models/anim2/simple-worm.blend")))))
483 (defn body
484 "given a node with a SkeletonControl, will produce a body sutiable
485 for AI control with movement and proprioception."
486 [node]
487 (let [skeleton-control (.getControl node SkeletonControl)
488 krc (KinematicRagdollControl.)]
489 (comment
490 (dorun
491 (map #(.addBoneName krc %)
492 ["mid2" "tail" "head" "mid1" "mid3" "mid4" "Dummy-Root" ""]
493 ;;"mid2" "mid3" "tail" "head"]
494 )))
495 (.addControl node krc)
496 (.setRagdollMode krc)
497 )
498 node
499 )
500 (defn show-skeleton [node]
501 (let [sd
503 (doto
504 (SkeletonDebugger. "aurellem-skel-debug"
505 (skel node))
506 (.setMaterial (green-x-ray)))]
507 (.attachChild node sd)
508 node))
512 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
514 ;; this could be a good way to give objects special properties like
515 ;; being eyes and the like
517 (.getUserData
518 (.getChild
519 (load-blender-model "Models/property/test.blend") 0)
520 "properties")
522 ;; the properties are saved along with the blender file.
523 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
528 (defn init-debug-skel-node
529 [f debug-node skeleton]
530 (let [bones
531 (map #(.getBone skeleton %)
532 (range (.getBoneCount skeleton)))]
533 (dorun (map #(.setUserControl % true) bones))
534 (dorun (map (fn [b]
535 (println (.getName b)
536 " -- " (f b)))
537 bones))
538 (dorun
539 (map #(.attachChild
540 debug-node
541 (doto
542 (sphere 0.1
543 :position (f %)
544 :physical? false)
545 (.setMaterial (green-x-ray))))
546 bones)))
547 debug-node)
549 (import jme3test.bullet.PhysicsTestHelper)
552 (defn test-zzz [the-worm world value]
553 (if (not value)
554 (let [skeleton (skel the-worm)]
555 (println-repl "enabling bones")
556 (dorun
557 (map
558 #(.setUserControl (.getBone skeleton %) true)
559 (range (.getBoneCount skeleton))))
562 (let [b (.getBone skeleton 2)]
563 (println-repl "moving " (.getName b))
564 (println-repl (.getLocalPosition b))
565 (.setUserTransforms b
566 Vector3f/UNIT_X
567 Quaternion/IDENTITY
568 ;;(doto (Quaternion.)
569 ;; (.fromAngles (/ Math/PI 2)
570 ;; 0
571 ;; 0
573 (Vector3f. 1 1 1))
574 )
576 (println-repl "hi! <3"))))
579 (defn test-ragdoll []
581 (let [the-worm
583 ;;(.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml")
584 (doto (show-skeleton (worm-blender))
585 (.setLocalTranslation (Vector3f. 0 10 0))
586 ;;(worm)
587 ;;(oto)
588 ;;(sinbad)
589 )
590 ]
593 (.start
594 (world
595 (doto (Node.)
596 (.attachChild the-worm))
597 {"key-return" (fire-cannon-ball)
598 "key-space" (partial test-zzz the-worm)
599 }
600 (fn [world]
601 (light-up-everything world)
602 (PhysicsTestHelper/createPhysicsTestWorld
603 (.getRootNode world)
604 (asset-manager)
605 (.getPhysicsSpace
606 (.getState (.getStateManager world) BulletAppState)))
607 (set-gravity world Vector3f/ZERO)
608 ;;(.setTimer world (NanoTimer.))
609 ;;(org.lwjgl.input.Mouse/setGrabbed false)
610 )
611 no-op
612 )
615 )))
618 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
619 ;;; here is the ragdoll stuff
621 (def worm-mesh (.getMesh (.getChild (worm-blender) 0)))
622 (def mesh worm-mesh)
624 (.getFloatBuffer mesh VertexBuffer$Type/Position)
625 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
626 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
629 (defn position [index]
630 (.get
631 (.getFloatBuffer worm-mesh VertexBuffer$Type/Position)
632 index))
634 (defn bones [index]
635 (.get
636 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
637 index))
639 (defn bone-weights [index]
640 (.get
641 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
642 index))
646 (defn vertex-bones [vertex]
647 (vec (map (comp int bones) (range (* vertex 4) (+ (* vertex 4) 4)))))
649 (defn vertex-weights [vertex]
650 (vec (map (comp float bone-weights) (range (* vertex 4) (+ (* vertex 4) 4)))))
652 (defn vertex-position [index]
653 (let [offset (* index 3)]
654 (Vector3f. (position offset)
655 (position (inc offset))
656 (position (inc(inc offset))))))
658 (def vertex-info (juxt vertex-position vertex-bones vertex-weights))
660 (defn bone-control-color [index]
661 (get {[1 0 0 0] ColorRGBA/Red
662 [1 2 0 0] ColorRGBA/Magenta
663 [2 0 0 0] ColorRGBA/Blue}
664 (vertex-bones index)
665 ColorRGBA/White))
667 (defn influence-color [index bone-num]
668 (get
669 {(float 0) ColorRGBA/Blue
670 (float 0.5) ColorRGBA/Green
671 (float 1) ColorRGBA/Red}
672 ;; find the weight of the desired bone
673 ((zipmap (vertex-bones index)(vertex-weights index))
674 bone-num)
675 ColorRGBA/Blue))
677 (def worm-vertices (set (map vertex-info (range 60))))
680 (defn test-info []
681 (let [points (Node.)]
682 (dorun
683 (map #(.attachChild points %)
684 (map #(sphere 0.01
685 :position (vertex-position %)
686 :color (influence-color % 1)
687 :physical? false)
688 (range 60))))
689 (view points)))
692 (defrecord JointControl [joint physics-space]
693 PhysicsControl
694 (setPhysicsSpace [this space]
695 (dosync
696 (ref-set (:physics-space this) space))
697 (.addJoint space (:joint this)))
698 (update [this tpf])
699 (setSpatial [this spatial])
700 (render [this rm vp])
701 (getPhysicsSpace [this] (deref (:physics-space this)))
702 (isEnabled [this] true)
703 (setEnabled [this state]))
705 (defn add-joint
706 "Add a joint to a particular object. When the object is added to the
707 PhysicsSpace of a simulation, the joint will also be added"
708 [object joint]
709 (let [control (JointControl. joint (ref nil))]
710 (.addControl object control))
711 object)
714 (defn hinge-world
715 []
716 (let [sphere1 (sphere)
717 sphere2 (sphere 1 :position (Vector3f. 3 3 3))
718 joint (Point2PointJoint.
719 (.getControl sphere1 RigidBodyControl)
720 (.getControl sphere2 RigidBodyControl)
721 Vector3f/ZERO (Vector3f. 3 3 3))]
722 (add-joint sphere1 joint)
723 (doto (Node. "hinge-world")
724 (.attachChild sphere1)
725 (.attachChild sphere2))))
728 (defn test-joint []
729 (view (hinge-world)))
731 ;; (defn copier-gen []
732 ;; (let [count (atom 0)]
733 ;; (fn [in]
734 ;; (swap! count inc)
735 ;; (clojure.contrib.duck-streams/copy
736 ;; in (File. (str "/home/r/tmp/mao-test/clojure-images/"
737 ;; ;;/home/r/tmp/mao-test/clojure-images
738 ;; (format "%08d.png" @count)))))))
739 ;; (defn decrease-framerate []
740 ;; (map
741 ;; (copier-gen)
742 ;; (sort
743 ;; (map first
744 ;; (partition
745 ;; 4
746 ;; (filter #(re-matches #".*.png$" (.getCanonicalPath %))
747 ;; (file-seq
748 ;; (file-str
749 ;; "/home/r/media/anime/mao-temp/images"))))))))
753 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
755 (defn proprioception
756 "Create a proprioception map that reports the rotations of the
757 various limbs of the creature's body"
758 [creature]
759 [#^Node creature]
760 (let [
761 nodes (node-seq creature)
762 joints
763 (map
764 :joint
765 (filter
766 #(isa? (class %) JointControl)
767 (reduce
768 concat
769 (map (fn [node]
770 (map (fn [num] (.getControl node num))
771 (range (.getNumControls node))))
772 nodes))))]
773 (fn []
774 (reduce concat (map relative-positions (list (first joints)))))))
777 (defn skel [node]
778 (doto
779 (.getSkeleton
780 (.getControl node SkeletonControl))
781 ;; this is necessary to force the skeleton to have accurate world
782 ;; transforms before it is rendered to the screen.
783 (.resetAndUpdate)))
785 (defn green-x-ray []
786 (doto (Material. (asset-manager)
787 "Common/MatDefs/Misc/Unshaded.j3md")
788 (.setColor "Color" ColorRGBA/Green)
789 (-> (.getAdditionalRenderState)
790 (.setDepthTest false))))
792 (defn test-worm []
793 (.start
794 (world
795 (doto (Node.)
796 ;;(.attachChild (point-worm))
797 (.attachChild (load-blender-model
798 "Models/anim2/joint-worm.blend"))
800 (.attachChild (box 10 1 10
801 :position (Vector3f. 0 -2 0) :mass 0
802 :color (ColorRGBA/Gray))))
803 {
804 "key-space" (fire-cannon-ball)
805 }
806 (fn [world]
807 (enable-debug world)
808 (light-up-everything world)
809 ;;(.setTimer world (NanoTimer.))
810 )
811 no-op)))
815 ;; defunct movement stuff
816 (defn torque-controls [control]
817 (let [torques
818 (concat
819 (map #(Vector3f. 0 (Math/sin %) (Math/cos %))
820 (range 0 (* Math/PI 2) (/ (* Math/PI 2) 20)))
821 [Vector3f/UNIT_X])]
822 (map (fn [torque-axis]
823 (fn [torque]
824 (.applyTorque
825 control
826 (.mult (.mult (.getPhysicsRotation control)
827 torque-axis)
828 (float
829 (* (.getMass control) torque))))))
830 torques)))
832 (defn motor-map
833 "Take a creature and generate a function that will enable fine
834 grained control over all the creature's limbs."
835 [#^Node creature]
836 (let [controls (keep #(.getControl % RigidBodyControl)
837 (node-seq creature))
838 limb-controls (reduce concat (map torque-controls controls))
839 body-control (partial map #(%1 %2) limb-controls)]
840 body-control))
842 (defn test-motor-map
843 "see how torque works."
844 []
845 (let [finger (box 3 0.5 0.5 :position (Vector3f. 0 2 0)
846 :mass 1 :color ColorRGBA/Green)
847 motor-map (motor-map finger)]
848 (world
849 (nodify [finger
850 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
851 :color ColorRGBA/Gray)])
852 standard-debug-controls
853 (fn [world]
854 (set-gravity world Vector3f/ZERO)
855 (light-up-everything world)
856 (.setTimer world (NanoTimer.)))
857 (fn [_ _]
858 (dorun (motor-map [0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0]))))))
859 #+end_src
867 * COMMENT generate Source
868 #+begin_src clojure :tangle ../src/cortex/body.clj
869 <<proprioception>>
870 <<motor-control>>
871 #+end_src
873 #+begin_src clojure :tangle ../src/cortex/test/body.clj
874 <<test-body>>
875 #+end_src