view org/body.org @ 137:39c89ae5c7d0

saving progress
author Robert McIntyre <rlm@mit.edu>
date Wed, 01 Feb 2012 23:46:31 -0700
parents 47a4d74761f0
children 16bdf9e80daf
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
19 com.jme3.collision.CollisionResults
20 com.jme3.bounding.BoundingBox))
22 (import com.jme3.scene.Node)
24 (defn jme-to-blender
25 "Convert from JME coordinates to Blender coordinates"
26 [#^Vector3f in]
27 (Vector3f. (.getX in)
28 (- (.getZ in))
29 (.getY in)))
31 (defn joint-targets
32 "Return the two closest two objects to the joint object, ordered
33 from bottom to top according to the joint's rotation."
34 [#^Node parts #^Node joint]
35 (loop [radius (float 0.01)]
36 (let [results (CollisionResults.)]
37 (.collideWith
38 parts
39 (BoundingBox. (.getWorldTranslation joint)
40 radius radius radius)
41 results)
42 (let [targets
43 (distinct
44 (map #(.getGeometry %) results))]
45 (if (>= (count targets) 2)
46 (sort-by
47 #(let [v
48 (jme-to-blender
49 (.mult
50 (.inverse (.getWorldRotation joint))
51 (.subtract (.getWorldTranslation %)
52 (.getWorldTranslation joint))))]
53 (println-repl (.getName %) ":" v)
54 (.dot (Vector3f. 1 1 1)
55 v))
56 (take 2 targets))
57 (recur (float (* radius 2))))))))
59 (defn creature-joints
60 "Return the children of the creature's \"joints\" node."
61 [#^Node creature]
62 (if-let [joint-node (.getChild creature "joints")]
63 (seq (.getChildren joint-node))
64 (do (println-repl "could not find JOINTS node") [])))
66 (defn joint-proprioception [#^Node parts #^Node joint]
67 (let [[obj-a obj-b] (joint-targets parts joint)
68 joint-rot (.getWorldRotation joint)
69 pre-inv-a (.inverse (.getWorldRotation obj-a))
70 x (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_X))
71 y (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_Y))
72 z (.mult pre-inv-a (.mult joint-rot Vector3f/UNIT_Z))]
73 (println-repl "x:" x)
74 (println-repl "y:" y)
75 (println-repl "z:" z)
76 ;; this function will report proprioceptive information for the
77 ;; joint.
78 (fn []
79 ;; x is the "twist" axis, y and z are the "bend" axes
80 (let [rot-a (.getWorldRotation obj-a)
81 ;;inv-a (.inverse rot-a)
82 rot-b (.getWorldRotation obj-b)
83 ;;relative (.mult rot-b inv-a)
84 basis (doto (Matrix3f.)
85 (.setColumn 0 (.mult rot-a x))
86 (.setColumn 1 (.mult rot-a y))
87 (.setColumn 2 (.mult rot-a z)))
88 rotation-about-joint
89 (doto (Quaternion.)
90 (.fromRotationMatrix
91 (.mult (.invert basis)
92 (.toRotationMatrix rot-b))))
93 [yaw roll pitch]
94 (seq (.toAngles rotation-about-joint nil))]
95 ;;return euler angles of the quaternion around the new basis
96 [yaw roll pitch]
97 ))))
100 (defn proprioception
101 "Create a function that provides proprioceptive information about an
102 entire body."
103 [#^Node creature]
104 ;; extract the body's joints
105 (let [joints (creature-joints creature)
106 senses (map (partial joint-proprioception creature) joints)]
107 (fn []
108 (map #(%) senses))))
110 #+end_src
112 #+results: proprioception
113 : #'cortex.body/proprioception
115 * Motor Control
116 #+name: motor-control
117 #+begin_src clojure
118 (in-ns 'cortex.body)
120 ;; surprisingly enough, terristerial creatures only move by using
121 ;; torque applied about their joints. There's not a single straight
122 ;; line of force in the human body at all! (A straight line of force
123 ;; would correspond to some sort of jet or rocket propulseion.)
125 (defn vector-motor-control
126 "Create a function that accepts a sequence of Vector3f objects that
127 describe the torque to be applied to each part of the body."
128 [body]
129 (let [nodes (node-seq body)
130 controls (keep #(.getControl % RigidBodyControl) nodes)]
131 (fn [torques]
132 (map #(.applyTorque %1 %2)
133 controls torques))))
134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135 #+end_src
137 ## note -- might want to add a lower dimensional, discrete version of
138 ## this if it proves useful from a x-modal clustering perspective.
140 * Examples
142 #+name: test-body
143 #+begin_src clojure
144 (ns cortex.test.body
145 (:use (cortex world util body))
146 (:require cortex.silly)
147 (:import
148 com.jme3.math.Vector3f
149 com.jme3.math.ColorRGBA
150 com.jme3.bullet.joints.Point2PointJoint
151 com.jme3.bullet.control.RigidBodyControl
152 com.jme3.system.NanoTimer))
154 (defn worm-segments
155 "Create multiple evenly spaced box segments. They're fabulous!"
156 [segment-length num-segments interstitial-space radius]
157 (letfn [(nth-segment
158 [n]
159 (box segment-length radius radius :mass 0.1
160 :position
161 (Vector3f.
162 (* 2 n (+ interstitial-space segment-length)) 0 0)
163 :name (str "worm-segment" n)
164 :color (ColorRGBA/randomColor)))]
165 (map nth-segment (range num-segments))))
167 (defn connect-at-midpoint
168 "Connect two physics objects with a Point2Point joint constraint at
169 the point equidistant from both objects' centers."
170 [segmentA segmentB]
171 (let [centerA (.getWorldTranslation segmentA)
172 centerB (.getWorldTranslation segmentB)
173 midpoint (.mult (.add centerA centerB) (float 0.5))
174 pivotA (.subtract midpoint centerA)
175 pivotB (.subtract midpoint centerB)
177 ;; A side-effect of creating a joint registers
178 ;; it with both physics objects which in turn
179 ;; will register the joint with the physics system
180 ;; when the simulation is started.
181 joint (Point2PointJoint.
182 (.getControl segmentA RigidBodyControl)
183 (.getControl segmentB RigidBodyControl)
184 pivotA
185 pivotB)]
186 segmentB))
188 (defn eve-worm
189 "Create a worm-like body bound by invisible joint constraints."
190 []
191 (let [segments (worm-segments 0.2 5 0.1 0.1)]
192 (dorun (map (partial apply connect-at-midpoint)
193 (partition 2 1 segments)))
194 (nodify "worm" segments)))
196 (defn worm-pattern
197 "This is a simple, mindless motor control pattern that drives the
198 second segment of the worm's body at an offset angle with
199 sinusoidally varying strength."
200 [time]
201 (let [angle (* Math/PI (/ 9 20))
202 direction (Vector3f. 0 (Math/sin angle) (Math/cos angle))]
203 [Vector3f/ZERO
204 (.mult
205 direction
206 (float (* 2 (Math/sin (* Math/PI 2 (/ (rem time 300 ) 300))))))
207 Vector3f/ZERO
208 Vector3f/ZERO
209 Vector3f/ZERO]))
211 (defn test-motor-control
212 "Testing motor-control:
213 You should see a multi-segmented worm-like object fall onto the
214 table and begin writhing and moving."
215 []
216 (let [worm (eve-worm)
217 time (atom 0)
218 worm-motor-map (vector-motor-control worm)]
219 (world
220 (nodify [worm
221 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
222 :color ColorRGBA/Gray)])
223 standard-debug-controls
224 (fn [world]
225 (enable-debug world)
226 (light-up-everything world)
227 (comment
228 (com.aurellem.capture.Capture/captureVideo
229 world
230 (file-str "/home/r/proj/cortex/tmp/moving-worm")))
231 )
233 (fn [_ _]
234 (swap! time inc)
235 (Thread/sleep 20)
236 (dorun (worm-motor-map
237 (worm-pattern @time)))))))
241 (defn join-at-point [obj-a obj-b world-pivot]
242 (cortex.silly/joint-dispatch
243 {:type :point}
244 (.getControl obj-a RigidBodyControl)
245 (.getControl obj-b RigidBodyControl)
246 (cortex.silly/world-to-local obj-a world-pivot)
247 (cortex.silly/world-to-local obj-b world-pivot)
248 nil
249 ))
251 (import com.jme3.bullet.collision.PhysicsCollisionObject)
253 (defn blab-* []
254 (let [hand (box 0.5 0.2 0.2 :position (Vector3f. 0 0 0)
255 :mass 0 :color ColorRGBA/Green)
256 finger (box 0.5 0.2 0.2 :position (Vector3f. 2.4 0 0)
257 :mass 1 :color ColorRGBA/Red)
258 connection-point (Vector3f. 1.2 0 0)
259 root (nodify [hand finger])]
261 (join-at-point hand finger (Vector3f. 1.2 0 0))
263 (.setCollisionGroup
264 (.getControl hand RigidBodyControl)
265 PhysicsCollisionObject/COLLISION_GROUP_NONE)
266 (world
267 root
268 standard-debug-controls
269 (fn [world]
270 (enable-debug world)
271 (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
272 (set-gravity world Vector3f/ZERO)
273 )
274 no-op)))
275 (import java.awt.image.BufferedImage)
277 (defn draw-sprite [image sprite x y color ]
278 (dorun
279 (for [[u v] sprite]
280 (.setRGB image (+ u x) (+ v y) color))))
282 (defn view-angle
283 "create a debug view of an angle"
284 [color]
285 (let [image (BufferedImage. 50 50 BufferedImage/TYPE_INT_RGB)
286 previous (atom [25 25])
287 sprite [[0 0] [0 1]
288 [0 -1] [-1 0] [1 0]]]
289 (fn [angle]
290 (let [angle (float angle)]
291 (let [position
292 [(+ 25 (int (* 20 (Math/cos angle))))
293 (+ 25 (int (* 20(Math/sin angle))))]]
294 (draw-sprite image sprite (@previous 0) (@previous 1) 0x000000)
295 (draw-sprite image sprite (position 0) (position 1) color)
296 (reset! previous position))
297 image))))
299 (defn proprioception-debug-window
300 []
301 (let [yaw (view-angle 0xFF0000)
302 roll (view-angle 0x00FF00)
303 pitch (view-angle 0xFFFFFF)
304 v-yaw (view-image)
305 v-roll (view-image)
306 v-pitch (view-image)
307 ]
308 (fn [prop-data]
309 (dorun
310 (map
311 (fn [[y r p]]
312 (v-yaw (yaw y))
313 (v-roll (roll r))
314 (v-pitch (pitch p)))
315 prop-data)))))
316 (comment
318 (defn proprioception-debug-window
319 []
320 (let [time (atom 0)]
321 (fn [prop-data]
322 (if (= 0 (rem (swap! time inc) 40))
323 (println-repl prop-data)))))
324 )
326 (comment
327 (dorun
328 (map
329 (comp
330 println-repl
331 (fn [[p y r]]
332 (format
333 "pitch: %1.2f\nyaw: %1.2f\nroll: %1.2f\n"
334 p y r)))
335 prop-data)))
339 (defn tap [obj direction force]
340 (let [control (.getControl obj RigidBodyControl)]
341 (.applyTorque
342 control
343 (.mult (.getPhysicsRotation control)
344 (.mult (.normalize direction) (float force))))))
348 (defmacro with-movement
349 [object
350 [up down left right roll-up roll-down :as keyboard]
351 forces
352 [world-invocation
353 root-node
354 keymap
355 intilization
356 world-loop]]
357 (let [add-keypress
358 (fn [state keymap key]
359 `(merge ~keymap
360 {~key
361 (fn [_ pressed?#]
362 (reset! ~state pressed?#))}))
363 move-left? (gensym "move-left?")
364 move-right? (gensym "move-right?")
365 move-up? (gensym "move-up?")
366 move-down? (gensym "move-down?")
367 roll-left? (gensym "roll-left?")
368 roll-right? (gensym "roll-right?")
369 directions
370 [(Vector3f. 0 1 0)
371 (Vector3f. 0 -1 0)
372 (Vector3f. 0 0 1)
373 (Vector3f. 0 0 -1)
374 (Vector3f. -1 0 0)
375 (Vector3f. 1 0 0)]
376 symbols [move-left? move-right? move-up? move-down?
377 roll-left? roll-right?]
379 keymap* (vec (map #(add-keypress %1 keymap %2)
380 symbols
381 keyboard))
383 splice-loop (map (fn [sym force direction]
384 `(if (deref ~sym)
385 (tap ~object ~direction ~force)))
386 symbols directions forces)
388 world-loop* `(fn [world# tpf#]
389 (~world-loop world# tpf#)
390 ~@splice-loop)]
392 `(let [~move-up? (atom false)
393 ~move-down? (atom false)
394 ~move-left? (atom false)
395 ~move-right? (atom false)
396 ~roll-left? (atom false)
397 ~roll-right? (atom false)]
398 (~world-invocation
399 ~root-node
400 (reduce merge ~keymap*)
401 ~intilization
402 ~world-loop*)
403 )))
406 (defn test-proprioception
407 "Testing proprioception:
408 You should see two foating bars, and a printout of pitch, yaw, and
409 roll. Pressing key-r/key-t should move the blue bar up and down and
410 change only the value of pitch. key-f/key-g moves it side to side
411 and changes yaw. key-v/key-b will spin the blue segment clockwise
412 and counterclockwise, and only affect roll."
413 []
414 (let [hand (box 1 0.2 0.2 :position (Vector3f. 0 2 0)
415 :mass 0 :color ColorRGBA/Green :name "hand")
416 finger (box 1 0.2 0.2 :position (Vector3f. 2.4 2 0)
417 :mass 1 :color ColorRGBA/Red :name "finger")
418 joint-node (box 0.1 0.05 0.05 :color ColorRGBA/Yellow
419 :position (Vector3f. 1.2 2 0)
420 :physical? false)
421 joint (join-at-point hand finger (Vector3f. 1.2 2 0 ))
422 creature (nodify [hand finger joint-node])
423 ;; *******************************************
425 floor (box 10 10 10 :position (Vector3f. 0 -15 0)
426 :mass 0 :color ColorRGBA/Gray)
428 move-up? (atom false)
429 move-down? (atom false)
430 move-left? (atom false)
431 move-right? (atom false)
432 roll-left? (atom false)
433 roll-right? (atom false)
436 root (nodify [creature floor])
437 prop (joint-proprioception creature joint-node)
438 prop-view (proprioception-debug-window)]
442 (.setCollisionGroup
443 (.getControl hand RigidBodyControl)
444 PhysicsCollisionObject/COLLISION_GROUP_NONE)
446 (with-movement
447 finger
448 ["key-r" "key-t" "key-f" "key-g" "key-v" "key-b"]
449 [10 10 10 10 1 1]
450 (world
451 root
452 (merge standard-debug-controls
453 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
454 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
455 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
456 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
457 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
458 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
459 (fn [world]
460 (.setTimer world (com.aurellem.capture.RatchetTimer. 60))
461 (set-gravity world (Vector3f. 0 0 0))
462 (light-up-everything world))
463 (fn [_ _]
464 (let [force 10
465 left (Vector3f. 0 1 0)
466 right (Vector3f. 0 -1 0)
467 up (Vector3f. 0 0 1)
468 down (Vector3f. 0 0 -1)
469 roll-left (Vector3f. -1 0 0)
470 roll-right (Vector3f. 1 0 0)]
471 (if @move-up? (tap finger up force))
473 (if @move-down? (tap finger down force))
475 (if @move-left? (tap finger left force))
477 (if @move-right? (tap finger right force))
479 (if @roll-left? (tap finger roll-left (/ force 10)))
481 (if @roll-right? (tap finger roll-right (/ force 10))))
483 (prop-view (list (prop))))))))
485 #+end_src
487 #+results: test-body
488 : #'cortex.test.body/test-proprioception
491 * COMMENT code-limbo
492 #+begin_src clojure
493 ;;(.loadModel
494 ;; (doto (asset-manager)
495 ;; (.registerLoader BlenderModelLoader (into-array String ["blend"])))
496 ;; "Models/person/person.blend")
499 (defn load-blender-model
500 "Load a .blend file using an asset folder relative path."
501 [^String model]
502 (.loadModel
503 (doto (asset-manager)
504 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
505 model))
508 (defn view-model [^String model]
509 (view
510 (.loadModel
511 (doto (asset-manager)
512 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
513 model)))
515 (defn load-blender-scene [^String model]
516 (.loadModel
517 (doto (asset-manager)
518 (.registerLoader BlenderLoader (into-array String ["blend"])))
519 model))
521 (defn worm
522 []
523 (.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml"))
525 (defn oto
526 []
527 (.loadModel (asset-manager) "Models/Oto/Oto.mesh.xml"))
529 (defn sinbad
530 []
531 (.loadModel (asset-manager) "Models/Sinbad/Sinbad.mesh.xml"))
533 (defn worm-blender
534 []
535 (first (seq (.getChildren (load-blender-model
536 "Models/anim2/simple-worm.blend")))))
538 (defn body
539 "given a node with a SkeletonControl, will produce a body sutiable
540 for AI control with movement and proprioception."
541 [node]
542 (let [skeleton-control (.getControl node SkeletonControl)
543 krc (KinematicRagdollControl.)]
544 (comment
545 (dorun
546 (map #(.addBoneName krc %)
547 ["mid2" "tail" "head" "mid1" "mid3" "mid4" "Dummy-Root" ""]
548 ;;"mid2" "mid3" "tail" "head"]
549 )))
550 (.addControl node krc)
551 (.setRagdollMode krc)
552 )
553 node
554 )
555 (defn show-skeleton [node]
556 (let [sd
558 (doto
559 (SkeletonDebugger. "aurellem-skel-debug"
560 (skel node))
561 (.setMaterial (green-x-ray)))]
562 (.attachChild node sd)
563 node))
567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
569 ;; this could be a good way to give objects special properties like
570 ;; being eyes and the like
572 (.getUserData
573 (.getChild
574 (load-blender-model "Models/property/test.blend") 0)
575 "properties")
577 ;; the properties are saved along with the blender file.
578 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583 (defn init-debug-skel-node
584 [f debug-node skeleton]
585 (let [bones
586 (map #(.getBone skeleton %)
587 (range (.getBoneCount skeleton)))]
588 (dorun (map #(.setUserControl % true) bones))
589 (dorun (map (fn [b]
590 (println (.getName b)
591 " -- " (f b)))
592 bones))
593 (dorun
594 (map #(.attachChild
595 debug-node
596 (doto
597 (sphere 0.1
598 :position (f %)
599 :physical? false)
600 (.setMaterial (green-x-ray))))
601 bones)))
602 debug-node)
604 (import jme3test.bullet.PhysicsTestHelper)
607 (defn test-zzz [the-worm world value]
608 (if (not value)
609 (let [skeleton (skel the-worm)]
610 (println-repl "enabling bones")
611 (dorun
612 (map
613 #(.setUserControl (.getBone skeleton %) true)
614 (range (.getBoneCount skeleton))))
617 (let [b (.getBone skeleton 2)]
618 (println-repl "moving " (.getName b))
619 (println-repl (.getLocalPosition b))
620 (.setUserTransforms b
621 Vector3f/UNIT_X
622 Quaternion/IDENTITY
623 ;;(doto (Quaternion.)
624 ;; (.fromAngles (/ Math/PI 2)
625 ;; 0
626 ;; 0
628 (Vector3f. 1 1 1))
629 )
631 (println-repl "hi! <3"))))
634 (defn test-ragdoll []
636 (let [the-worm
638 ;;(.loadModel (asset-manager) "Models/anim2/Cube.mesh.xml")
639 (doto (show-skeleton (worm-blender))
640 (.setLocalTranslation (Vector3f. 0 10 0))
641 ;;(worm)
642 ;;(oto)
643 ;;(sinbad)
644 )
645 ]
648 (.start
649 (world
650 (doto (Node.)
651 (.attachChild the-worm))
652 {"key-return" (fire-cannon-ball)
653 "key-space" (partial test-zzz the-worm)
654 }
655 (fn [world]
656 (light-up-everything world)
657 (PhysicsTestHelper/createPhysicsTestWorld
658 (.getRootNode world)
659 (asset-manager)
660 (.getPhysicsSpace
661 (.getState (.getStateManager world) BulletAppState)))
662 (set-gravity world Vector3f/ZERO)
663 ;;(.setTimer world (NanoTimer.))
664 ;;(org.lwjgl.input.Mouse/setGrabbed false)
665 )
666 no-op
667 )
670 )))
673 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
674 ;;; here is the ragdoll stuff
676 (def worm-mesh (.getMesh (.getChild (worm-blender) 0)))
677 (def mesh worm-mesh)
679 (.getFloatBuffer mesh VertexBuffer$Type/Position)
680 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
681 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
684 (defn position [index]
685 (.get
686 (.getFloatBuffer worm-mesh VertexBuffer$Type/Position)
687 index))
689 (defn bones [index]
690 (.get
691 (.getData (.getBuffer mesh VertexBuffer$Type/BoneIndex))
692 index))
694 (defn bone-weights [index]
695 (.get
696 (.getFloatBuffer mesh VertexBuffer$Type/BoneWeight)
697 index))
701 (defn vertex-bones [vertex]
702 (vec (map (comp int bones) (range (* vertex 4) (+ (* vertex 4) 4)))))
704 (defn vertex-weights [vertex]
705 (vec (map (comp float bone-weights) (range (* vertex 4) (+ (* vertex 4) 4)))))
707 (defn vertex-position [index]
708 (let [offset (* index 3)]
709 (Vector3f. (position offset)
710 (position (inc offset))
711 (position (inc(inc offset))))))
713 (def vertex-info (juxt vertex-position vertex-bones vertex-weights))
715 (defn bone-control-color [index]
716 (get {[1 0 0 0] ColorRGBA/Red
717 [1 2 0 0] ColorRGBA/Magenta
718 [2 0 0 0] ColorRGBA/Blue}
719 (vertex-bones index)
720 ColorRGBA/White))
722 (defn influence-color [index bone-num]
723 (get
724 {(float 0) ColorRGBA/Blue
725 (float 0.5) ColorRGBA/Green
726 (float 1) ColorRGBA/Red}
727 ;; find the weight of the desired bone
728 ((zipmap (vertex-bones index)(vertex-weights index))
729 bone-num)
730 ColorRGBA/Blue))
732 (def worm-vertices (set (map vertex-info (range 60))))
735 (defn test-info []
736 (let [points (Node.)]
737 (dorun
738 (map #(.attachChild points %)
739 (map #(sphere 0.01
740 :position (vertex-position %)
741 :color (influence-color % 1)
742 :physical? false)
743 (range 60))))
744 (view points)))
747 (defrecord JointControl [joint physics-space]
748 PhysicsControl
749 (setPhysicsSpace [this space]
750 (dosync
751 (ref-set (:physics-space this) space))
752 (.addJoint space (:joint this)))
753 (update [this tpf])
754 (setSpatial [this spatial])
755 (render [this rm vp])
756 (getPhysicsSpace [this] (deref (:physics-space this)))
757 (isEnabled [this] true)
758 (setEnabled [this state]))
760 (defn add-joint
761 "Add a joint to a particular object. When the object is added to the
762 PhysicsSpace of a simulation, the joint will also be added"
763 [object joint]
764 (let [control (JointControl. joint (ref nil))]
765 (.addControl object control))
766 object)
769 (defn hinge-world
770 []
771 (let [sphere1 (sphere)
772 sphere2 (sphere 1 :position (Vector3f. 3 3 3))
773 joint (Point2PointJoint.
774 (.getControl sphere1 RigidBodyControl)
775 (.getControl sphere2 RigidBodyControl)
776 Vector3f/ZERO (Vector3f. 3 3 3))]
777 (add-joint sphere1 joint)
778 (doto (Node. "hinge-world")
779 (.attachChild sphere1)
780 (.attachChild sphere2))))
783 (defn test-joint []
784 (view (hinge-world)))
786 ;; (defn copier-gen []
787 ;; (let [count (atom 0)]
788 ;; (fn [in]
789 ;; (swap! count inc)
790 ;; (clojure.contrib.duck-streams/copy
791 ;; in (File. (str "/home/r/tmp/mao-test/clojure-images/"
792 ;; ;;/home/r/tmp/mao-test/clojure-images
793 ;; (format "%08d.png" @count)))))))
794 ;; (defn decrease-framerate []
795 ;; (map
796 ;; (copier-gen)
797 ;; (sort
798 ;; (map first
799 ;; (partition
800 ;; 4
801 ;; (filter #(re-matches #".*.png$" (.getCanonicalPath %))
802 ;; (file-seq
803 ;; (file-str
804 ;; "/home/r/media/anime/mao-temp/images"))))))))
808 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
810 (defn proprioception
811 "Create a proprioception map that reports the rotations of the
812 various limbs of the creature's body"
813 [creature]
814 [#^Node creature]
815 (let [
816 nodes (node-seq creature)
817 joints
818 (map
819 :joint
820 (filter
821 #(isa? (class %) JointControl)
822 (reduce
823 concat
824 (map (fn [node]
825 (map (fn [num] (.getControl node num))
826 (range (.getNumControls node))))
827 nodes))))]
828 (fn []
829 (reduce concat (map relative-positions (list (first joints)))))))
832 (defn skel [node]
833 (doto
834 (.getSkeleton
835 (.getControl node SkeletonControl))
836 ;; this is necessary to force the skeleton to have accurate world
837 ;; transforms before it is rendered to the screen.
838 (.resetAndUpdate)))
840 (defn green-x-ray []
841 (doto (Material. (asset-manager)
842 "Common/MatDefs/Misc/Unshaded.j3md")
843 (.setColor "Color" ColorRGBA/Green)
844 (-> (.getAdditionalRenderState)
845 (.setDepthTest false))))
847 (defn test-worm []
848 (.start
849 (world
850 (doto (Node.)
851 ;;(.attachChild (point-worm))
852 (.attachChild (load-blender-model
853 "Models/anim2/joint-worm.blend"))
855 (.attachChild (box 10 1 10
856 :position (Vector3f. 0 -2 0) :mass 0
857 :color (ColorRGBA/Gray))))
858 {
859 "key-space" (fire-cannon-ball)
860 }
861 (fn [world]
862 (enable-debug world)
863 (light-up-everything world)
864 ;;(.setTimer world (NanoTimer.))
865 )
866 no-op)))
870 ;; defunct movement stuff
871 (defn torque-controls [control]
872 (let [torques
873 (concat
874 (map #(Vector3f. 0 (Math/sin %) (Math/cos %))
875 (range 0 (* Math/PI 2) (/ (* Math/PI 2) 20)))
876 [Vector3f/UNIT_X])]
877 (map (fn [torque-axis]
878 (fn [torque]
879 (.applyTorque
880 control
881 (.mult (.mult (.getPhysicsRotation control)
882 torque-axis)
883 (float
884 (* (.getMass control) torque))))))
885 torques)))
887 (defn motor-map
888 "Take a creature and generate a function that will enable fine
889 grained control over all the creature's limbs."
890 [#^Node creature]
891 (let [controls (keep #(.getControl % RigidBodyControl)
892 (node-seq creature))
893 limb-controls (reduce concat (map torque-controls controls))
894 body-control (partial map #(%1 %2) limb-controls)]
895 body-control))
897 (defn test-motor-map
898 "see how torque works."
899 []
900 (let [finger (box 3 0.5 0.5 :position (Vector3f. 0 2 0)
901 :mass 1 :color ColorRGBA/Green)
902 motor-map (motor-map finger)]
903 (world
904 (nodify [finger
905 (box 10 0.5 10 :position (Vector3f. 0 -5 0) :mass 0
906 :color ColorRGBA/Gray)])
907 standard-debug-controls
908 (fn [world]
909 (set-gravity world Vector3f/ZERO)
910 (light-up-everything world)
911 (.setTimer world (NanoTimer.)))
912 (fn [_ _]
913 (dorun (motor-map [0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0]))))))
914 #+end_src
922 * COMMENT generate Source
923 #+begin_src clojure :tangle ../src/cortex/body.clj
924 <<proprioception>>
925 <<motor-control>>
926 #+end_src
928 #+begin_src clojure :tangle ../src/cortex/test/body.clj
929 <<test-body>>
930 #+end_src