view org/test-creature.org @ 91:2bcc7636cfea

faster touch creation code
author Robert McIntyre <rlm@mit.edu>
date Mon, 09 Jan 2012 06:02:06 -0700
parents 6d7c17c847a3
children e70ec4bba96b
line wrap: on
line source
1 #+title: First attempt at a creature!
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description:
5 #+keywords: simulation, jMonkeyEngine3, clojure
6 #+SETUPFILE: ../../aurellem/org/setup.org
7 #+INCLUDE: ../../aurellem/org/level-0.org
9 * Intro
10 So far, I've made the following senses --
11 - Vision
12 - Hearing
13 - Touch
14 - Proprioception
16 And one effector:
17 - Movement
19 However, the code so far has only enabled these senses, but has not
20 actually implemented them. For example, there is still a lot of work
21 to be done for vision. I need to be able to create an /eyeball/ in
22 simulation that can be moved around and see the world from different
23 angles. I also need to determine weather to use log-polar or cartesian
24 for the visual input, and I need to determine how/wether to
25 disceritise the visual input.
27 I also want to be able to visualize both the sensors and the
28 effectors in pretty pictures. This semi-retarted creature will by my
29 first attempt at bringing everything together.
31 * The creature's body
33 Still going to do an eve-like body in blender, but due to problems
34 importing the joints, etc into jMonkeyEngine3, I',m going to do all
35 the connecting here in clojure code, using the names of the individual
36 components and trial and error. Later, I'll maybe make some sort of
37 creature-building modifications to blender that support whatever
38 discreitized senses I'm going to make.
40 #+name: body-1
41 #+begin_src clojure
42 (ns cortex.silly
43 "let's play!"
44 {:author "Robert McIntyre"})
46 ;; TODO remove this!
47 (require 'cortex.import)
48 (cortex.import/mega-import-jme3)
49 (use '(cortex world util body hearing touch vision))
51 (rlm.rlm-commands/help)
53 (declare joint-create)
55 (defn load-bullet []
56 (let [sim (world (Node.) {} no-op no-op)]
57 (.enqueue
58 sim
59 (fn []
60 (.stop sim)))
61 (.start sim)))
63 (defn load-blender-model
64 "Load a .blend file using an asset folder relative path."
65 [^String model]
66 (.loadModel
67 (doto (asset-manager)
68 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
69 model))
71 (defn meta-data [blender-node key]
72 (if-let [data (.getUserData blender-node "properties")]
73 (.findValue data key)
74 nil))
76 (defn blender-to-jme
77 "Convert from Blender coordinates to JME coordinates"
78 [#^Vector3f in]
79 (Vector3f. (.getX in)
80 (.getZ in)
81 (- (.getY in))))
83 (defn jme-to-blender
84 "Convert from JME coordinates to Blender coordinates"
85 [#^Vector3f in]
86 (Vector3f. (.getX in)
87 (- (.getZ in))
88 (.getY in)))
90 (defn joint-targets
91 "Return the two closest two objects to the joint object, ordered
92 from bottom to top according to the joint's rotation."
93 [#^Node parts #^Node joint]
94 ;;(println (meta-data joint "joint"))
95 (.getWorldRotation joint)
96 (loop [radius (float 0.01)]
97 (let [results (CollisionResults.)]
98 (.collideWith
99 parts
100 (BoundingBox. (.getWorldTranslation joint)
101 radius radius radius)
102 results)
103 (let [targets
104 (distinct
105 (map #(.getGeometry %) results))]
106 (if (>= (count targets) 2)
107 (sort-by
108 #(let [v
109 (jme-to-blender
110 (.mult
111 (.inverse (.getWorldRotation joint))
112 (.subtract (.getWorldTranslation %)
113 (.getWorldTranslation joint))))]
114 (println-repl (.getName %) ":" v)
115 (.dot (Vector3f. 1 1 1)
116 v))
117 (take 2 targets))
118 (recur (float (* radius 2))))))))
120 (defn world-to-local
121 "Convert the world coordinates into coordinates relative to the
122 object (i.e. local coordinates), taking into account the rotation
123 of object."
124 [#^Spatial object world-coordinate]
125 (let [out (Vector3f.)]
126 (.worldToLocal object world-coordinate out) out))
128 (defmulti joint-dispatch
129 "Translate blender pseudo-joints into real JME joints."
130 (fn [constraints & _]
131 (:type constraints)))
133 (defmethod joint-dispatch :point
134 [constraints control-a control-b pivot-a pivot-b rotation]
135 (println-repl "creating POINT2POINT joint")
136 (Point2PointJoint.
137 control-a
138 control-b
139 pivot-a
140 pivot-b))
142 (defmethod joint-dispatch :hinge
143 [constraints control-a control-b pivot-a pivot-b rotation]
144 (println-repl "creating HINGE joint")
145 (let [axis
146 (if-let
147 [axis (:axis constraints)]
148 axis
149 Vector3f/UNIT_X)
150 [limit-1 limit-2] (:limit constraints)
151 hinge-axis
152 (.mult
153 rotation
154 (blender-to-jme axis))]
155 (doto
156 (HingeJoint.
157 control-a
158 control-b
159 pivot-a
160 pivot-b
161 hinge-axis
162 hinge-axis)
163 (.setLimit limit-1 limit-2))))
165 (defmethod joint-dispatch :cone
166 [constraints control-a control-b pivot-a pivot-b rotation]
167 (let [limit-xz (:limit-xz constraints)
168 limit-xy (:limit-xy constraints)
169 twist (:twist constraints)]
171 (println-repl "creating CONE joint")
172 (println-repl rotation)
173 (println-repl
174 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
175 (println-repl
176 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
177 (println-repl
178 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
179 (doto
180 (ConeJoint.
181 control-a
182 control-b
183 pivot-a
184 pivot-b
185 rotation
186 rotation)
187 (.setLimit (float limit-xz)
188 (float limit-xy)
189 (float twist)))))
191 (defn connect
192 "here are some examples:
193 {:type :point}
194 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
195 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
197 {:type :cone :limit-xz 0]
198 :limit-xy 0]
199 :twist 0]} (use XZY rotation mode in blender!)"
200 [#^Node obj-a #^Node obj-b #^Node joint]
201 (let [control-a (.getControl obj-a RigidBodyControl)
202 control-b (.getControl obj-b RigidBodyControl)
203 joint-center (.getWorldTranslation joint)
204 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
205 pivot-a (world-to-local obj-a joint-center)
206 pivot-b (world-to-local obj-b joint-center)]
208 (if-let [constraints
209 (map-vals
210 eval
211 (read-string
212 (meta-data joint "joint")))]
213 ;; A side-effect of creating a joint registers
214 ;; it with both physics objects which in turn
215 ;; will register the joint with the physics system
216 ;; when the simulation is started.
217 (do
218 (println-repl "creating joint between"
219 (.getName obj-a) "and" (.getName obj-b))
220 (joint-dispatch constraints
221 control-a control-b
222 pivot-a pivot-b
223 joint-rotation))
224 (println-repl "could not find joint meta-data!"))))
226 (defn assemble-creature [#^Node pieces joints]
227 (dorun
228 (map
229 (fn [geom]
230 (let [physics-control
231 (RigidBodyControl.
232 (HullCollisionShape.
233 (.getMesh geom))
234 (if-let [mass (meta-data geom "mass")]
235 (do
236 (println-repl
237 "setting" (.getName geom) "mass to" (float mass))
238 (float mass))
239 (float 1)))]
241 (.addControl geom physics-control)))
242 (filter #(isa? (class %) Geometry )
243 (node-seq pieces))))
245 (dorun
246 (map
247 (fn [joint]
248 (let [[obj-a obj-b]
249 (joint-targets pieces joint)]
250 (connect obj-a obj-b joint)))
251 joints))
252 pieces)
254 (defn blender-creature [blender-path]
255 (let [model (load-blender-model blender-path)
256 joints
257 (if-let [joint-node (.getChild model "joints")]
258 (seq (.getChildren joint-node))
259 (do (println-repl "could not find joints node")
260 []))]
261 (assemble-creature model joints)))
263 (def hand "Models/creature1/one.blend")
265 (def worm "Models/creature1/try-again.blend")
267 (def touch "Models/creature1/touch.blend")
269 (defn worm-model [] (load-blender-model worm))
271 (defn x-ray [#^ColorRGBA color]
272 (doto (Material. (asset-manager)
273 "Common/MatDefs/Misc/Unshaded.j3md")
274 (.setColor "Color" color)
275 (-> (.getAdditionalRenderState)
276 (.setDepthTest false))))
278 (defn test-creature [thing]
279 (let [x-axis
280 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
281 y-axis
282 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
283 z-axis
284 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)]
285 (world
286 (nodify [(blender-creature thing)
287 (box 10 2 10 :position (Vector3f. 0 -9 0)
288 :color ColorRGBA/Gray :mass 0)
289 x-axis y-axis z-axis
290 ])
291 standard-debug-controls
292 (fn [world]
293 (light-up-everything world)
294 (enable-debug world)
295 ;;(com.aurellem.capture.Capture/captureVideo
296 ;; world (file-str "/home/r/proj/ai-videos/hand"))
297 (.setTimer world (NanoTimer.))
298 ;;(set-gravity world (Vector3f. 0 0 0))
299 (speed-up world)
300 )
301 no-op
302 ;;(let [timer (atom 0)]
303 ;; (fn [_ _]
304 ;; (swap! timer inc)
305 ;; (if (= (rem @timer 60) 0)
306 ;; (println-repl (float (/ @timer 60))))))
307 )))
310 (defn colorful []
311 (.getChild (worm-model) "worm-21"))
313 (import jme3tools.converters.ImageToAwt)
315 (import ij.ImagePlus)
317 (defn triangle-indices
318 "Get the triangle vertex indices of a given triangle from a given
319 mesh."
320 [#^Mesh mesh triangle-index]
321 (let [indices (int-array 3)]
322 (.getTriangle mesh triangle-index indices)
323 (vec indices)))
325 (defn uv-coord
326 "Get the uv-coordinates of the vertex named by vertex-index"
327 [#^Mesh mesh vertex-index]
328 (let [UV-buffer
329 (.getData
330 (.getBuffer
331 mesh
332 VertexBuffer$Type/TexCoord))]
333 (Vector2f.
334 (.get UV-buffer (* vertex-index 2))
335 (.get UV-buffer (+ 1 (* vertex-index 2))))))
337 (defn touch-receptor-image
338 "Return the touch-sensor distribution image in ImagePlus format."
339 [#^Geometry obj]
340 (let
341 [mat (.getMaterial obj)
342 texture
343 (.getTextureValue
344 (.getTextureParam
345 mat
346 MaterialHelper/TEXTURE_TYPE_DIFFUSE))
347 im (.getImage texture)]
348 (ImagePlus.
349 "UV-map"
350 (ImageToAwt/convert im false false 0))))
353 (import ij.process.ImageProcessor)
354 (import java.awt.image.BufferedImage)
356 (defprotocol Frame
357 (frame [this]))
359 (extend-type BufferedImage
360 Frame
361 (frame [image]
362 (merge
363 (apply
364 hash-map
365 (interleave
366 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
367 (vector x y)))
368 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
369 (let [data (.getRGB image x y)]
370 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
371 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
372 :b (bit-and 0x0000ff data)))))))
373 {:width (.getWidth image) :height (.getHeight image)})))
376 (extend-type ImagePlus
377 Frame
378 (frame [image+]
379 (frame (.getBufferedImage image+))))
381 (defn rgb->int [r g b]
382 (+ (bit-shift-left r 16)
383 (bit-shift-left g 8)
384 b))
388 (defn filter-pixels
389 "List the coordinates of all pixels matching pred."
390 [pred #^ImageProcessor ip]
391 (let
392 [width (.getWidth ip)
393 height (.getHeight ip)]
394 ((fn accumulate [x y matches]
395 (cond
396 (>= y height) matches
397 (>= x width) (recur 0 (inc y) matches)
398 (pred (.getPixel ip x y))
399 (recur (inc x) y (conj matches (Vector2f. x y)))
400 :else (recur (inc x) y matches)))
401 0 0 [])))
407 (defn filter-pixels*
408 [pred #^ImageProcessor ip]
409 (let
410 [width (.getWidth ip)
411 height (.getHeight ip)
412 coords (ref [])
413 process
414 (fn [[start end]]
415 (loop [i start]
416 (if (<= i end)
417 (do
418 (let [column (rem i height)
419 row (unchecked-divide i width)]
420 (if (pred (.getPixel ip row column))
421 (dosync (ref-set
422 coords
423 (conj @coords (Vector2f. column row)))))
425 (recur (inc i)))))))
426 ]
429 (dorun
430 (pmap process (partition
431 2
432 (conj (vec (range 0 (* width height) 100))
433 (* width height)))))
434 @coords))
438 (comment
439 ((->
440 f
441 (partial x)
442 (partial y)
443 (partial z))))
445 (defn filter-pixels**
446 [pred #^ImageProcessor ip]
447 (let [width (.getWidth ip)
448 height (.getHeight ip)]
449 ((fn f [x1 x2 y1 y2]
450 (println x1)
451 (if
452 (and
453 (= x1 (dec x2))
454 (= y1 (dec y2)))
455 (if (pred (.getPixel ip x1 y1))
456 [[x1 y1]]
457 [])
458 (let
459 [xm (+ x1 (/ (- x2 x1) 2))
460 ym (+ y1 (/ (- y2 y1) 2))]
461 (apply concat
462 (pvalues
463 ;;(f x1 xm y1 ym)
464 ;;(f xm x2 y1 ym)
465 ;;(f x1 xm ym y2)
466 (f xm x2 ym y2))))))
467 0 width 0 height)))
476 (defn white-coordinates*
477 [#^ImageProcessor ip]
478 (filter-pixels** #(== % -1) ip))
481 (defn white-coordinates
482 "List the coordinates of all the white pixels in an image."
483 [#^ImageProcessor ip]
484 (let [height (.getHeight ip)
485 width (.getWidth ip)
486 coords (transient [])]
487 (dorun
488 (for [x (range width)
489 y (range height)]
490 (let [pixel (.getPixel ip x y)]
491 (if (= pixel -1)
492 (conj! coords (Vector2f. x y))))))
493 (persistent! coords)))
502 (def white {:r 255, :g 255, :b 255})
503 (def black {:r 0, :g 0, :b 0})
506 (defn same-side? [p1 p2 ref p]
507 (<=
508 0
509 (.dot
510 (.cross (.subtract p2 p1) (.subtract p p1))
511 (.cross (.subtract p2 p1) (.subtract ref p1)))))
513 (defn inside-triangle?
514 [vert-1 vert-2 vert-3 p]
515 (and
516 (same-side? vert-1 vert-2 vert-3 p)
517 (same-side? vert-2 vert-3 vert-1 p)
518 (same-side? vert-3 vert-1 vert-2 p)))
521 (defn white? [color]
522 (and
523 (= (:r color) 255)
524 (= (:b color) 255)
525 (= (:g color) 255)))
528 ;; for each triangle in the mesh,
529 ;; get the normal to the triangle,
530 ;; look at the UV touch map, restricted to that triangle,
531 ;; get the positions of those touch sensors in geometry-relative
532 ;; coordinates.
533 (defn tactile-coords [#^Geometry obj]
534 (let [mesh (.getMesh obj)
535 num-triangles (.getTriangleCount mesh)
536 num-verticies (.getVertexCount mesh)
537 uv-coord (partial uv-coord mesh)
538 triangle-indices (partial triangle-indices mesh)
539 receptors (touch-receptor-image obj)
540 ]
541 (map
542 (fn [[tri-1 tri-2 tri-3]]
543 (let [width (.getWidth receptors)
544 height (.getHeight receptors)
545 uv-1 (uv-coord tri-1)
546 uv-2 (uv-coord tri-2)
547 uv-3 (uv-coord tri-3)
548 x-coords (map #(.getX %) [uv-1 uv-2 uv-3])
549 y-coords (map #(.getY %) [uv-1 uv-2 uv-3])
550 max-x (Math/ceil (* width (apply max x-coords)))
551 min-x (Math/floor (* width (apply min x-coords)))
552 max-y (Math/ceil (* height (apply max y-coords)))
553 min-y (Math/floor (* height (apply min y-coords)))
555 image-1 (Vector2f. (* width (.getX uv-1))
556 (* height (.getY uv-1)))
557 image-2 (Vector2f. (* width (.getX uv-2))
558 (* height (.getY uv-2)))
559 image-3 (Vector2f. (* width (.getX uv-3))
560 (* height (.getY uv-3)))
561 left-corner
562 (Vector2f. min-x min-y)
564 ]
566 (.setRoi receptors min-x min-y (- max-x min-x) (- max-y min-y))
567 (let [processor (.crop (.getProcessor receptors))
568 image (frame (.getBufferedImage processor))]
569 (with-meta
570 (filter-keys
571 (fn [[x y]]
572 (inside-triangle?
573 (.subtract image-1 left-corner)
574 (.subtract image-2 left-corner)
575 (.subtract image-3 left-corner)
576 (Vector2f. x y)))
579 (filter-vals white? image))
580 {:image
581 (comment
582 (.getBufferedImage
583 (doto processor
584 (.flipVertical))))
585 }
586 ))
587 )) (map triangle-indices (range num-triangles)))))
595 (defn all-names []
596 (concat
597 (re-split #"\n" (slurp (file-str
598 "/home/r/proj/names/dist.female.first")))
599 (re-split #"\n" (slurp (file-str
600 "/home/r/proj/names/dist.male.first")))
601 (re-split #"\n" (slurp (file-str
602 "/home/r/proj/names/dist.all.last")))))
612 (defrecord LulzLoader [])
613 (defprotocol Lulzable (load-lulz [this]))
614 (extend-type LulzLoader
615 Lulzable
616 (load-lulz [this] (println "the lulz have arrived!")))
619 (defn world-setup [joint]
620 (let [joint-position (Vector3f. 0 0 0)
621 joint-rotation
622 (.toRotationMatrix
623 (.mult
624 (doto (Quaternion.)
625 (.fromAngleAxis
626 (* 1 (/ Math/PI 4))
627 (Vector3f. -1 0 0)))
628 (doto (Quaternion.)
629 (.fromAngleAxis
630 (* 1 (/ Math/PI 2))
631 (Vector3f. 0 0 1)))))
632 top-position (.mult joint-rotation (Vector3f. 8 0 0))
634 origin (doto
635 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
636 :position top-position))
637 top (doto
638 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
639 :position top-position)
641 (.addControl
642 (RigidBodyControl.
643 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
644 bottom (doto
645 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
646 :position (Vector3f. 0 0 0))
647 (.addControl
648 (RigidBodyControl.
649 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
650 table (box 10 2 10 :position (Vector3f. 0 -20 0)
651 :color ColorRGBA/Gray :mass 0)
652 a (.getControl top RigidBodyControl)
653 b (.getControl bottom RigidBodyControl)]
655 (cond
656 (= joint :cone)
658 (doto (ConeJoint.
659 a b
660 (world-to-local top joint-position)
661 (world-to-local bottom joint-position)
662 joint-rotation
663 joint-rotation
664 )
667 (.setLimit (* (/ 10) Math/PI)
668 (* (/ 4) Math/PI)
669 0)))
670 [origin top bottom table]))
672 (defn test-joint [joint]
673 (let [[origin top bottom floor] (world-setup joint)
674 control (.getControl top RigidBodyControl)
675 move-up? (atom false)
676 move-down? (atom false)
677 move-left? (atom false)
678 move-right? (atom false)
679 roll-left? (atom false)
680 roll-right? (atom false)
681 timer (atom 0)]
683 (world
684 (nodify [top bottom floor origin])
685 (merge standard-debug-controls
686 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
687 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
688 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
689 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
690 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
691 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
693 (fn [world]
694 (light-up-everything world)
695 (enable-debug world)
696 (set-gravity world (Vector3f. 0 0 0))
697 )
699 (fn [world _]
700 (if (zero? (rem (swap! timer inc) 100))
701 (do
702 ;; (println-repl @timer)
703 (.attachChild (.getRootNode world)
704 (sphere 0.05 :color ColorRGBA/Yellow
705 :position (.getWorldTranslation top)
706 :physical? false))
707 (.attachChild (.getRootNode world)
708 (sphere 0.05 :color ColorRGBA/LightGray
709 :position (.getWorldTranslation bottom)
710 :physical? false))))
712 (if @move-up?
713 (.applyTorque control
714 (.mult (.getPhysicsRotation control)
715 (Vector3f. 0 0 10))))
716 (if @move-down?
717 (.applyTorque control
718 (.mult (.getPhysicsRotation control)
719 (Vector3f. 0 0 -10))))
720 (if @move-left?
721 (.applyTorque control
722 (.mult (.getPhysicsRotation control)
723 (Vector3f. 0 10 0))))
724 (if @move-right?
725 (.applyTorque control
726 (.mult (.getPhysicsRotation control)
727 (Vector3f. 0 -10 0))))
728 (if @roll-left?
729 (.applyTorque control
730 (.mult (.getPhysicsRotation control)
731 (Vector3f. -1 0 0))))
732 (if @roll-right?
733 (.applyTorque control
734 (.mult (.getPhysicsRotation control)
735 (Vector3f. 1 0 0))))))))
739 #+end_src
741 #+results: body-1
742 : #'cortex.silly/test-joint
745 * COMMENT purgatory
746 #+begin_src clojure
747 (defn bullet-trans []
748 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
749 :position (Vector3f. -10 5 0))
750 obj-b (sphere 0.5 :color ColorRGBA/Blue
751 :position (Vector3f. -10 -5 0)
752 :mass 0)
753 control-a (.getControl obj-a RigidBodyControl)
754 control-b (.getControl obj-b RigidBodyControl)
755 swivel
756 (.toRotationMatrix
757 (doto (Quaternion.)
758 (.fromAngleAxis (/ Math/PI 2)
759 Vector3f/UNIT_X)))]
760 (doto
761 (ConeJoint.
762 control-a control-b
763 (Vector3f. 0 5 0)
764 (Vector3f. 0 -5 0)
765 swivel swivel)
766 (.setLimit (* 0.6 (/ Math/PI 4))
767 (/ Math/PI 4)
768 (* Math/PI 0.8)))
769 (world (nodify
770 [obj-a obj-b])
771 standard-debug-controls
772 enable-debug
773 no-op)))
776 (defn bullet-trans* []
777 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
778 :position (Vector3f. 5 0 0)
779 :mass 90)
780 obj-b (sphere 0.5 :color ColorRGBA/Blue
781 :position (Vector3f. -5 0 0)
782 :mass 0)
783 control-a (.getControl obj-a RigidBodyControl)
784 control-b (.getControl obj-b RigidBodyControl)
785 move-up? (atom nil)
786 move-down? (atom nil)
787 move-left? (atom nil)
788 move-right? (atom nil)
789 roll-left? (atom nil)
790 roll-right? (atom nil)
791 force 100
792 swivel
793 (.toRotationMatrix
794 (doto (Quaternion.)
795 (.fromAngleAxis (/ Math/PI 2)
796 Vector3f/UNIT_X)))
797 x-move
798 (doto (Matrix3f.)
799 (.fromStartEndVectors Vector3f/UNIT_X
800 (.normalize (Vector3f. 1 1 0))))
802 timer (atom 0)]
803 (doto
804 (ConeJoint.
805 control-a control-b
806 (Vector3f. -8 0 0)
807 (Vector3f. 2 0 0)
808 ;;swivel swivel
809 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
810 x-move Matrix3f/IDENTITY
811 )
812 (.setCollisionBetweenLinkedBodys false)
813 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
814 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
815 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
816 (world (nodify
817 [obj-a obj-b])
818 (merge standard-debug-controls
819 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
820 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
821 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
822 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
823 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
824 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
826 (fn [world]
827 (enable-debug world)
828 (set-gravity world Vector3f/ZERO)
829 )
831 (fn [world _]
833 (if @move-up?
834 (.applyForce control-a
835 (Vector3f. force 0 0)
836 (Vector3f. 0 0 0)))
837 (if @move-down?
838 (.applyForce control-a
839 (Vector3f. (- force) 0 0)
840 (Vector3f. 0 0 0)))
841 (if @move-left?
842 (.applyForce control-a
843 (Vector3f. 0 force 0)
844 (Vector3f. 0 0 0)))
845 (if @move-right?
846 (.applyForce control-a
847 (Vector3f. 0 (- force) 0)
848 (Vector3f. 0 0 0)))
850 (if @roll-left?
851 (.applyForce control-a
852 (Vector3f. 0 0 force)
853 (Vector3f. 0 0 0)))
854 (if @roll-right?
855 (.applyForce control-a
856 (Vector3f. 0 0 (- force))
857 (Vector3f. 0 0 0)))
859 (if (zero? (rem (swap! timer inc) 100))
860 (.attachChild
861 (.getRootNode world)
862 (sphere 0.05 :color ColorRGBA/Yellow
863 :physical? false :position
864 (.getWorldTranslation obj-a)))))
865 )
866 ))
870 #+end_src
873 * COMMENT generate source
874 #+begin_src clojure :tangle ../src/cortex/silly.clj
875 <<body-1>>
876 #+end_src