view org/body.org @ 60:e5e627f50a3a

finally got euler angle stuff working
author Robert McIntyre <rlm@mit.edu>
date Mon, 28 Nov 2011 02:54:48 -0700
parents 25142dad240a
children 7b44348af538
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 * Body
10 #+srcname: body-main
11 #+begin_src clojure
12 (ns cortex.body
13 (use (cortex world util import)))
15 (use 'clojure.contrib.def)
16 (cortex.import/mega-import-jme3)
17 (rlm.rlm-commands/help)
19 ;;(.loadModel
20 ;; (doto (asset-manager)
21 ;; (.registerLoader BlenderModelLoader (into-array String ["blend"])))
22 ;; "Models/person/person.blend")
24 (defn view-model [^String model]
25 (view
26 (.loadModel
27 (doto (asset-manager)
28 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
29 model)))
31 (defn load-blender-scene [^String model]
32 (.loadModel
33 (doto (asset-manager)
34 (.registerLoader BlenderLoader (into-array String ["blend"])))
35 model))
37 (defn load-blender-model
38 [^String model]
39 (.loadModel
40 (doto (asset-manager)
41 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
42 model))
44 (defn worm
45 []
46 (.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml"))
48 (defn oto
49 []
50 (.loadModel (asset-manager) "Models/Oto/Oto.mesh.xml"))
52 (defn sinbad
53 []
54 (.loadModel (asset-manager) "Models/Sinbad/Sinbad.mesh.xml"))
56 (defn worm-blender
57 []
58 (first (seq (.getChildren (load-blender-model
59 "Models/anim2/simple-worm.blend")))))
61 (defn skel [node]
62 (doto
63 (.getSkeleton
64 (.getControl node SkeletonControl))
65 ;; this is necessary to force the skeleton to have accurate world
66 ;; transforms before it is rendered to the screen.
67 (.resetAndUpdate)))
69 (defprotocol Textual
70 (text [something]
71 "Display a detailed textual analysis of the given object."))
73 (extend-type com.jme3.scene.Node
74 Textual
75 (text [node]
76 (println "Total Vertexes: " (.getVertexCount node))
77 (println "Total Triangles: " (.getTriangleCount node))
78 (println "Controls :")
79 (dorun (map #(text (.getControl node %)) (range (.getNumControls node))))
80 (println "Has " (.getQuantity node) " Children:")
81 (doall (map text (.getChildren node)))))
83 (extend-type com.jme3.animation.AnimControl
84 Textual
85 (text [control]
86 (let [animations (.getAnimationNames control)]
87 (println "Animation Control with " (count animations) " animation(s):")
88 (dorun (map println animations)))))
90 (extend-type com.jme3.animation.SkeletonControl
91 Textual
92 (text [control]
93 (println "Skeleton Control with the following skeleton:")
94 (println (.getSkeleton control))))
96 (extend-type com.jme3.bullet.control.KinematicRagdollControl
97 Textual
98 (text [control]
99 (println "Ragdoll Control")))
102 (extend-type com.jme3.scene.Geometry
103 Textual
104 (text [control]
105 (println "...geo...")))
110 (defn body
111 "given a node with a SkeletonControl, will produce a body sutiable
112 for AI control with movement and proprioception."
113 [node]
114 (let [skeleton-control (.getControl node SkeletonControl)
115 krc (KinematicRagdollControl.)]
116 (comment
117 (dorun
118 (map #(.addBoneName krc %)
119 ["mid2" "tail" "head" "mid1" "mid3" "mid4" "Dummy-Root" ""]
120 ;;"mid2" "mid3" "tail" "head"]
121 )))
122 (.addControl node krc)
123 (.setRagdollMode krc)
124 )
125 node
126 )
128 (defn green-x-ray []
129 (doto (Material. (asset-manager)
130 "Common/MatDefs/Misc/Unshaded.j3md")
131 (.setColor "Color" ColorRGBA/Green)
132 (-> (.getAdditionalRenderState)
133 (.setDepthTest false))))
135 (defn show-skeleton [node]
136 (let [sd
138 (doto
139 (SkeletonDebugger. "aurellem-skel-debug"
140 (skel node))
141 (.setMaterial (green-x-ray)))]
142 (.attachChild node sd)
143 node))
146 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
148 ;; this could be a good way to give objects special properties like
149 ;; being eyes and the like
151 (.getUserData
152 (.getChild
153 (load-blender-model "Models/property/test.blend") 0)
154 "properties")
156 ;; the properties are saved along with the blender file.
157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
161 (defn init-debug-skel-node
162 [f debug-node skeleton]
163 (let [bones
164 (map #(.getBone skeleton %)
165 (range (.getBoneCount skeleton)))]
166 (dorun (map #(.setUserControl % true) bones))
167 (dorun (map (fn [b]
168 (println (.getName b)
169 " -- " (f b)))
170 bones))
171 (dorun
172 (map #(.attachChild
173 debug-node
174 (doto
175 (sphere 0.1
176 :position (f %)
177 :physical? false)
178 (.setMaterial (green-x-ray))))
179 bones)))
180 debug-node)
182 (import jme3test.bullet.PhysicsTestHelper)
185 (defn test-zzz [the-worm world value]
186 (if (not value)
187 (let [skeleton (skel the-worm)]
188 (println-repl "enabling bones")
189 (dorun
190 (map
191 #(.setUserControl (.getBone skeleton %) true)
192 (range (.getBoneCount skeleton))))
195 (let [b (.getBone skeleton 2)]
196 (println-repl "moving " (.getName b))
197 (println-repl (.getLocalPosition b))
198 (.setUserTransforms b
199 Vector3f/UNIT_X
200 Quaternion/IDENTITY
201 ;;(doto (Quaternion.)
202 ;; (.fromAngles (/ Math/PI 2)
203 ;; 0
204 ;; 0
206 (Vector3f. 1 1 1))
207 )
209 (println-repl "hi! <3"))))
212 (defn test-ragdoll []
214 (let [the-worm
216 ;;(.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml")
217 (doto (show-skeleton (worm-blender))
218 (.setLocalTranslation (Vector3f. 0 10 0))
219 ;;(worm)
220 ;;(oto)
221 ;;(sinbad)
222 )
223 ]
226 (.start
227 (world
228 (doto (Node.)
229 (.attachChild the-worm))
230 {"key-return" (fire-cannon-ball)
231 "key-space" (partial test-zzz the-worm)
232 }
233 (fn [world]
234 (light-up-everything world)
235 (PhysicsTestHelper/createPhysicsTestWorld
236 (.getRootNode world)
237 (asset-manager)
238 (.getPhysicsSpace
239 (.getState (.getStateManager world) BulletAppState)))
240 (set-gravity world Vector3f/ZERO)
241 ;;(.setTimer world (NanoTimer.))
242 ;;(org.lwjgl.input.Mouse/setGrabbed false)
243 )
244 no-op
245 )
248 )))
254 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
255 ;;; here is the ragdoll stuff
257 (def worm-mesh (.getMesh (.getChild (worm-blender) 0)))
258 (def mesh worm-mesh)
260 (.getFloatBuffer mesh VertexBuffer$Type/Position)
261 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
262 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
265 (defn position [index]
266 (.get
267 (.getFloatBuffer worm-mesh VertexBuffer$Type/Position)
268 index))
270 (defn bones [index]
271 (.get
272 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
273 index))
275 (defn bone-weights [index]
276 (.get
277 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
278 index))
282 (defn vertex-bones [vertex]
283 (vec (map (comp int bones) (range (* vertex 4) (+ (* vertex 4) 4)))))
285 (defn vertex-weights [vertex]
286 (vec (map (comp float bone-weights) (range (* vertex 4) (+ (* vertex 4) 4)))))
288 (defn vertex-position [index]
289 (let [offset (* index 3)]
290 (Vector3f. (position offset)
291 (position (inc offset))
292 (position (inc(inc offset))))))
294 (def vertex-info (juxt vertex-position vertex-bones vertex-weights))
296 (defn bone-control-color [index]
297 (get {[1 0 0 0] ColorRGBA/Red
298 [1 2 0 0] ColorRGBA/Magenta
299 [2 0 0 0] ColorRGBA/Blue}
300 (vertex-bones index)
301 ColorRGBA/White))
303 (defn influence-color [index bone-num]
304 (get
305 {(float 0) ColorRGBA/Blue
306 (float 0.5) ColorRGBA/Green
307 (float 1) ColorRGBA/Red}
308 ;; find the weight of the desired bone
309 ((zipmap (vertex-bones index)(vertex-weights index))
310 bone-num)
311 ColorRGBA/Blue))
313 (def worm-vertices (set (map vertex-info (range 60))))
316 (defn test-info []
317 (let [points (Node.)]
318 (dorun
319 (map #(.attachChild points %)
320 (map #(sphere 0.01
321 :position (vertex-position %)
322 :color (influence-color % 1)
323 :physical? false)
324 (range 60))))
325 (view points)))
327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
329 ;;;;;;;;;;;; eve-style bodies ;;;;;;;;
332 (defrecord JointControl [joint physics-space]
333 PhysicsControl
334 (setPhysicsSpace [this space]
335 (dosync
336 (ref-set (:physics-space this) space))
337 (.addJoint space (:joint this)))
338 (update [this tpf])
339 (setSpatial [this spatial])
340 (render [this rm vp])
341 (getPhysicsSpace [this] (deref (:physics-space this)))
342 (isEnabled [this] true)
343 (setEnabled [this state]))
345 (defn add-joint
346 "Add a joint to a particular object. When the object is added to the
347 PhysicsSpace of a simulation, the joint will also be added"
348 [object joint]
349 (let [control (JointControl. joint (ref nil))]
350 (.addControl object control))
351 object)
353 (defn hinge-world
354 []
355 (let [sphere1 (sphere)
356 sphere2 (sphere 1 :position (Vector3f. 3 3 3))
357 joint (Point2PointJoint.
358 (.getControl sphere1 RigidBodyControl)
359 (.getControl sphere2 RigidBodyControl)
360 Vector3f/ZERO (Vector3f. 3 3 3))]
361 (add-joint sphere1 joint)
362 (doto (Node. "hinge-world")
363 (.attachChild sphere1)
364 (.attachChild sphere2))))
366 (defn test-joint []
367 (view (hinge-world)))
370 (defn worm [segment-length num-segments interstitial-space radius]
371 (letfn [(nth-segment
372 [n]
373 (box segment-length radius radius :mass 0.1
374 :position
375 (Vector3f.
376 (* 2 n (+ interstitial-space segment-length)) 0 0)
377 :name (str "worm-segment" n)
378 :color (ColorRGBA/randomColor)))]
379 (map nth-segment (range num-segments))))
381 (defn nodify
382 "take a sequence of things that can be attached to a node and return
383 a node with all of them attached"
384 ([name children]
385 (let [node (Node. name)]
386 (dorun (map #(.attachChild node %) children))
387 node))
388 ([children] (nodify "" children)))
391 (defn connect-at-midpoint
392 [segmentA segmentB]
393 (let [centerA (.getWorldTranslation segmentA)
394 centerB (.getWorldTranslation segmentB)
395 midpoint (.mult (.add centerA centerB) (float 0.5))
396 pivotA (.subtract midpoint centerA)
397 pivotB (.subtract midpoint centerB)
399 joint (Point2PointJoint.
400 (.getControl segmentA RigidBodyControl)
401 (.getControl segmentB RigidBodyControl)
402 pivotA
403 pivotB)]
404 (add-joint segmentA joint)
405 segmentB))
408 (defn point-worm []
409 (let [segments (worm 0.2 5 0.1 0.1)]
410 (dorun (map (partial apply connect-at-midpoint)
411 (partition 2 1 segments)))
412 (nodify "worm" segments)))
415 (defn test-worm []
416 (.start
417 (world
418 (doto (Node.)
419 ;;(.attachChild (point-worm))
420 (.attachChild (load-blender-model
421 "Models/anim2/joint-worm.blend"))
423 (.attachChild (box 10 1 10
424 :position (Vector3f. 0 -2 0) :mass 0
425 :color (ColorRGBA/Gray))))
426 {
427 "key-space" (fire-cannon-ball)
428 }
429 (fn [world]
430 (enable-debug world)
431 (light-up-everything world)
432 ;;(.setTimer world (NanoTimer.))
433 )
434 no-op)))
436 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
439 ;;;;;;;;; Mortor Control ;;;;;;;;;;;;;
442 ;; surprisingly ehough, terristerial creatures only move by using
443 ;; torque applied to their joints. There's not a single straight line
444 ;; of force in the human body at all! (a straight line of force would
445 ;; correspond to some sort of jet or rocket propulseion)
447 (defn node-seq
448 "take a node and return a seq of all its children
449 recursively. There will be no nodes left in the resulting
450 structure"
451 [#^Node node]
452 (tree-seq #(isa? (class %) Node) #(.getChildren %) node))
455 (defn torque-controls [control]
456 (let [torques
457 (concat
458 (map #(Vector3f. 0 (Math/sin %) (Math/cos %))
459 (range 0 (* Math/PI 2) (/ (* Math/PI 2) 20)))
460 [Vector3f/UNIT_X])]
461 (map (fn [torque-axis]
462 (fn [torque]
463 (.applyTorque
464 control
465 (.mult (.mult (.getPhysicsRotation control)
466 torque-axis)
467 (float
468 (* (.getMass control) torque))))))
469 torques)))
471 (defn motor-map
472 "Take a creature and generate a function that will enable fine
473 grained control over all the creature's limbs."
474 [#^Node creature]
475 (let [controls (keep #(.getControl % RigidBodyControl)
476 (node-seq creature))
477 limb-controls (reduce concat (map torque-controls controls))
478 body-control (partial map #(%1 %2) limb-controls)]
479 body-control))
483 (defn test-motor-map
484 "see how torque works."
485 []
486 (let [finger (box 3 0.5 0.5 :position (Vector3f. 0 2 0)
487 :mass 1 :color ColorRGBA/Green)
488 motor-map (motor-map finger)]
489 (world
490 (nodify [finger
491 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
492 :color ColorRGBA/Gray)])
493 standard-debug-controls
494 (fn [world]
495 (set-gravity world Vector3f/ZERO)
496 (light-up-everything world)
497 (.setTimer world (NanoTimer.)))
498 (fn [_ _]
499 (dorun (motor-map [0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0]))))))
503 (defn test-torque
504 "see how torque works."
505 []
506 (let [finger (box 3 0.5 0.5 :position (Vector3f. 0 2 0)
507 :mass 1 :color ColorRGBA/Green)
508 move-left? (atom false)
509 move-right? (atom false)
510 control (.getControl finger RigidBodyControl)]
511 (world
512 (nodify [finger
513 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
514 :color ColorRGBA/Gray)])
515 (merge standard-debug-controls
516 {"key-k" (fn [_ pressed?] (reset! move-left? pressed?))
517 "key-l" (fn [_ pressed?] (reset! move-right? pressed?))})
518 (fn [world]
519 (set-gravity world Vector3f/ZERO)
520 (light-up-everything world)
521 (.setTimer world (NanoTimer.)))
522 (fn [_ _]
523 (if @move-left?
524 (.applyTorque control
525 (.mult (.getPhysicsRotation control)
526 (Vector3f. -3 20 0))))
527 (if @move-right?
528 (.applyTorque control (Vector3f. 0 0 1)))))))
531 (defn worm-pattern [time]
532 [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
534 0 0 0 0 0 0 0 0 0 0 0
536 (* 20 (Math/sin (* Math/PI 2 (/ (rem time 300 ) 300))))
538 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
539 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
540 0 0 0 0 0 0 0 0 0 0 0 0 0 0
542 ])
545 ;; (defn copier-gen []
546 ;; (let [count (atom 0)]
547 ;; (fn [in]
548 ;; (swap! count inc)
549 ;; (clojure.contrib.duck-streams/copy
550 ;; in (File. (str "/home/r/tmp/mao-test/clojure-images/"
551 ;; ;;/home/r/tmp/mao-test/clojure-images
552 ;; (format "%08d.png" @count)))))))
553 ;; (defn decrease-framerate []
554 ;; (map
555 ;; (copier-gen)
556 ;; (sort
557 ;; (map first
558 ;; (partition
559 ;; 4
560 ;; (filter #(re-matches #".*.png$" (.getCanonicalPath %))
561 ;; (file-seq
562 ;; (file-str
563 ;; "/home/r/media/anime/mao-temp/images"))))))))
567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
572 ;;;;;;;;;;;;;;;;;; Proprioception ;;;;;;;;;;;;;;;;;;;;;;;;
575 ;; this is not used as just getting the rotation would be simpler.
576 (defn proprioception-senses
577 "given a control , create a sequence of thunks that will report the
578 rotation of the control's object along the same axes as the motor-control map."
579 [control]
580 (let [torques
581 (concat
582 (map #(Vector3f. 0 (Math/sin %) (Math/cos %))
583 (range 0 (* Math/PI 2) (/ (* Math/PI 2) 20)))
584 [Vector3f/UNIT_X])]
585 (map (fn [torque-axis]
586 (fn []
587 (.getPhysicsRotation control)))
588 torques)))
590 (defn orthogonal-vect
591 "Return a vector orthogonal to the current one"
592 [vector]
593 (let [x (.getX vector)
594 y (.getY vector)
595 z (.getZ vector)]
596 (cond
597 (not= x (float 0)) (Vector3f. (- z) 0 x)
598 (not= y (float 0)) (Vector3f. 0 (- z) y)
599 (not= z (float 0)) (Vector3f. 0 (- z) y)
600 true Vector3f/ZERO)))
602 ;; from
603 ;; http://stackoverflow.com/questions/3684269/ \\
604 ;; component-of-a-quaternion-rotation-around-an-axis
605 (defn rot-about-axis [#^Quaternion q #^Vector3f axis]
606 (let [basis-1 (orthogonal-vect axis)
607 basis-2 (.cross axis basis-1)
608 rotated (.mult q basis-1)
609 alpha (.dot basis-1 (.project rotated basis-1))
610 beta (.dot basis-2 (.project rotated basis-2))]
611 (println-repl alpha)
612 (println-repl beta)
613 (Math/atan2 beta alpha)))
616 (defn check-rot [a]
617 (rot-about-axis
618 (doto (Quaternion.)
619 (.fromAngleAxis
620 (float a)
621 (Vector3f. 1 0 0))) (Vector3f. 1 0 0)))
623 (defn relative-positions [joint]
624 (let [object-a (.getUserObject (.getBodyA joint))
625 object-b (.getUserObject (.getBodyB joint))
626 arm-a
627 (.normalize
628 (.subtract
629 (.localToWorld object-a (.getPivotA joint) nil)
630 (.getWorldTranslation object-a)))
631 rotate-a
632 (doto (Matrix3f.)
633 (.fromStartEndVectors arm-a Vector3f/UNIT_X))
634 arm-b
635 (.mult
636 rotate-a
637 (.normalize
638 (.subtract
639 (.localToWorld object-b (.getPivotB joint) nil)
640 (.getWorldTranslation object-b))))
641 rotate-b
642 (doto (Matrix3f.)
643 (.fromStartEndVectors arm-b Vector3f/UNIT_X))
645 pitch
646 (.angleBetween
647 (.normalize (Vector2f. (.getX arm-b) (.getY arm-b)))
648 (Vector2f. 1 0))
649 yaw
650 (.angleBetween
651 (.normalize (Vector2f. (.getX arm-b) (.getZ arm-b)))
652 (Vector2f. 1 0))
654 roll
655 (.mult
656 (.getLocalRotation object-b)
657 (doto (Quaternion.)
658 (.fromRotationMatrix rotate-a)))
659 ]
663 ;;(println-repl
664 ;; "arm-b is " arm-b)
665 ;;(println-repl
666 ;; "pivot-b is " (.getPivotB joint))
667 ;;(println-repl
668 ;; (format "pitch: %1.2f\nyaw: %1.2f\nroll: %1.2f\n"
669 ;; pitch yaw roll))
670 [pitch yaw roll]))
676 (defn proprioception
677 "Create a proprioception map that reports the rotations of the
678 various limbs of the creature's body"
679 [creature]
680 [#^Node creature]
681 (let [
682 nodes (node-seq creature)
683 joints
684 (map
685 :joint
686 (filter
687 #(isa? (class %) JointControl)
688 (reduce
689 concat
690 (map (fn [node]
691 (map (fn [num] (.getControl node num))
692 (range (.getNumControls node))))
693 nodes))))]
694 (fn []
695 (reduce concat (map relative-positions (list (first joints)))))))
698 (defn test-worm-control
699 []
700 (let [worm (point-worm)
701 time (atom 0)
702 worm-motor-map (motor-map worm)
703 body-map (proprioception worm)
704 debug-segments
705 (map
706 #(doto
707 (make-shape
708 (assoc base-shape
709 :name "debug-line"
710 :physical? false
711 :shape
712 (com.jme3.scene.shape.Line.
713 (.add (.getWorldTranslation %)
714 (Vector3f. -0.2 0 0 ))
715 (.add (.getWorldTranslation %)
716 (Vector3f. 0.2 0 0)))))
717 (.setMaterial (green-x-ray)))
718 (drop 1 (node-seq worm)))]
719 (world
720 (nodify [worm
721 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
722 :color ColorRGBA/Gray)])
723 standard-debug-controls
724 (fn [world]
725 (.attachChild (.getRootNode world) (nodify debug-segments))
726 (enable-debug world)
727 (light-up-everything world)
728 (com.aurellem.capture.Capture/captureVideo
729 world
730 (file-str "/home/r/proj/cortex/tmp/moving-worm")))
732 (fn [_ _]
733 (dorun
734 (map
735 (fn [worm-segment
736 debug-segment]
737 (.rotate
738 debug-segment
739 (Quaternion. (float 0) (float 0.05) (float 0) (float 1))))
740 (drop 1 (node-seq worm))
741 debug-segments))
742 (swap! time inc)
743 (println-repl (with-out-str (clojure.pprint/pprint (doall (body-map)))))
744 (Thread/sleep 200)
745 (dorun (worm-motor-map
746 (worm-pattern @time)))))))
752 (defn test-prop
753 "see how torque works."
754 []
755 (let [hand (box 1 0.2 0.2 :position (Vector3f. 0 2 0)
756 :mass 0 :color ColorRGBA/Green)
757 finger (box 1 0.2 0.2 :position (Vector3f. 2.4 2 0)
758 :mass 1 :color (ColorRGBA. 0.20 0.40 0.99 1.0))
759 floor (box 10 0.5 10 :position (Vector3f. 0 -5 0)
760 :mass 0 :color ColorRGBA/Gray)
762 move-up? (atom false)
763 move-down? (atom false)
764 move-left? (atom false)
765 move-right? (atom false)
766 roll-left? (atom false)
767 roll-right? (atom false)
768 control (.getControl finger RigidBodyControl)
769 joint
770 (doto
771 (Point2PointJoint.
772 (.getControl hand RigidBodyControl)
773 control
774 (Vector3f. 1.2 0 0)
775 (Vector3f. -1.2 0 0 ))
776 (.setCollisionBetweenLinkedBodys false))
777 time (atom 0)
778 ]
779 (world
780 (nodify [hand finger floor])
781 (merge standard-debug-controls
782 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
783 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
784 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
785 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
786 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
787 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
788 (fn [world]
789 (set-gravity world Vector3f/ZERO)
790 (.setMoveSpeed (.getFlyByCamera world) 50)
791 (.setRotationSpeed (.getFlyByCamera world) 50)
792 (light-up-everything world)
793 (.setTimer world (NanoTimer.))
794 )
795 (fn [_ _]
796 (if @move-up?
797 (.applyTorque control
798 (.mult (.getPhysicsRotation control)
799 (Vector3f. 0 0 1))))
800 (if @move-down?
801 (.applyTorque control
802 (.mult (.getPhysicsRotation control)
803 (Vector3f. 0 0 -1))))
804 (if @move-left?
805 (.applyTorque control
806 (.mult (.getPhysicsRotation control)
807 (Vector3f. 0 1 0))))
808 (if @move-right?
809 (.applyTorque control
810 (.mult (.getPhysicsRotation control)
811 (Vector3f. 0 -1 0))))
812 (if @roll-left?
813 (.applyTorque control
814 (.mult (.getPhysicsRotation control)
815 (Vector3f. -0.1 0 0))))
816 (if @roll-right?
817 (.applyTorque control
818 (.mult (.getPhysicsRotation control)
819 (Vector3f. 0.1 0 0))))
821 (if (= 0 (rem (swap! time inc) 2000))
822 (do
823 ;;(println-repl (.getLocalRotation finger))
824 (println-repl (nth (relative-positions joint) 2))))
826 ))))
831 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
836 #+end_src
838 #+results: body-main
839 : #'cortex.body/test-prop
848 * COMMENT generate Source.
849 #+begin_src clojure :tangle ../src/cortex/body.clj
850 <<body-main>>
851 #+end_src