view org/test-creature.org @ 95:e4bcd0c481ba

now with more accurate authorship
author Robert McIntyre <rlm@mit.edu>
date Tue, 10 Jan 2012 08:38:50 -0700
parents 69174ed0f9f6
children 4a9096f31017
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 tri-uv-coord
338 "Get the uv-cooridnates of the triangle's verticies."
339 [#^Mesh mesh #^Triangle triangle]
340 (map (partial uv-coord mesh)
341 (triangle-indices mesh (.getIndex triangle))))
343 (defn touch-receptor-image
344 "Return the touch-sensor distribution image in ImagePlus format."
345 [#^Geometry obj]
346 (let
347 [mat (.getMaterial obj)
348 texture
349 (.getTextureValue
350 (.getTextureParam
351 mat
352 MaterialHelper/TEXTURE_TYPE_DIFFUSE))
353 im (.getImage texture)]
354 (ImagePlus.
355 "UV-map"
356 (ImageToAwt/convert im false false 0))))
359 (import ij.process.ImageProcessor)
360 (import java.awt.image.BufferedImage)
362 (defprotocol Frame
363 (frame [this]))
365 (extend-type BufferedImage
366 Frame
367 (frame [image]
368 (merge
369 (apply
370 hash-map
371 (interleave
372 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
373 (vector x y)))
374 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
375 (let [data (.getRGB image x y)]
376 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
377 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
378 :b (bit-and 0x0000ff data)))))))
379 {:width (.getWidth image) :height (.getHeight image)})))
382 (extend-type ImagePlus
383 Frame
384 (frame [image+]
385 (frame (.getBufferedImage image+))))
388 (def white -1)
390 (defn filter-pixels
391 "List the coordinates of all pixels matching pred."
392 {:author "Dylan Holmes"}
393 [pred #^ImageProcessor ip]
394 (let
395 [width (.getWidth ip)
396 height (.getHeight ip)]
397 ((fn accumulate [x y matches]
398 (cond
399 (>= y height) matches
400 (>= x width) (recur 0 (inc y) matches)
401 (pred (.getPixel ip x y))
402 (recur (inc x) y (conj matches (Vector2f. x y)))
403 :else (recur (inc x) y matches)))
404 0 0 [])))
406 (defn white-coordinates
407 "List the coordinates of all the white pixels in an image."
408 [#^ImageProcessor ip]
409 (filter-pixels #(= % white) ip))
411 (defn same-side? [p1 p2 ref p]
412 (<=
413 0
414 (.dot
415 (.cross (.subtract p2 p1) (.subtract p p1))
416 (.cross (.subtract p2 p1) (.subtract ref p1)))))
419 (defn triangle->matrix4f
420 "Converts the triangle into a 4x4 matrix of vertices: The first
421 three columns contain the vertices of the triangle; the last
422 contains the unit normal of the triangle. The bottom row is filled
423 with 1s."
424 [#^Triangle t]
425 (let [mat (Matrix4f.)
426 [vert-1 vert-2 vert-3]
427 ((comp vec map) #(.get t %) (range 3))
428 unit-normal (do (.calculateNormal t)(.getNormal t))
429 vertices [vert-1 vert-2 vert-3 unit-normal]]
431 (dorun
432 (for [row (range 4) col (range 3)]
433 (do
434 (.set mat col row (.get (vertices row)col))
435 (.set mat 3 row 1))))
436 mat))
438 (defn triangle-transformation
439 "Returns the affine transformation that converts each vertex in the
440 first triangle into the corresponding vertex in the second
441 triangle."
442 [#^Triangle tri-1 #^Triangle tri-2]
443 (.mult
444 (triangle->matrix4f tri-2)
445 (.invert (triangle->matrix4f tri-1))))
447 (def death (Triangle.
448 (Vector3f. 1 1 1)
449 (Vector3f. 1 2 3)
450 (Vector3f. 5 6 7)))
452 (def death-2 (Triangle.
453 (Vector3f. 2 2 2)
454 (Vector3f. 1 1 1)
455 (Vector3f. 0 1 0)))
457 (defn vector2f->vector3f [v]
458 (Vector3f. (.getX v) (.getY v) 0))
461 (extend-type Triangle
462 Textual
463 (text [t]
464 (println "Triangle: " \newline (.get1 t) \newline
465 (.get2 t) \newline (.get3 t))))
468 (defn map-triangle [f #^Triangle tri]
469 (Triangle.
470 (f 0 (.get1 tri))
471 (f 1 (.get2 tri))
472 (f 2 (.get3 tri))))
474 (defn triangle-seq [#^Triangle tri]
475 [(.get1 tri) (.get2 tri) (.get3 tri)])
477 (defn vector3f-seq [#^Vector3f v]
478 [(.getX v) (.getY v) (.getZ v)])
480 (defn inside-triangle?
481 "Is the point inside the triangle? Now what do we do?
482 You might want to hold on there"
483 {:author "Dylan Holmes"}
484 [tri p]
485 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
486 (and
487 (same-side? vert-1 vert-2 vert-3 p)
488 (same-side? vert-2 vert-3 vert-1 p)
489 (same-side? vert-3 vert-1 vert-2 p))))
491 (defn uv-triangle
492 "Convert the mesh triangle into the cooresponding triangle in
493 UV-space. Z-component of these triangles is always zero."
494 [#^Mesh mesh #^Triangle tri]
495 (apply #(Triangle. %1 %2 %3)
496 (map vector2f->vector3f
497 (tri-uv-coord mesh tri))))
499 (defn pixel-triangle
500 "Convert the mesh triange into the corresponding triangle in
501 UV-pixel-space. Z compenent will be zero."
502 [#^Mesh mesh #^Triangle tri width height]
503 (map-triangle (fn [_ v]
504 (Vector3f. (* width (.getX v))
505 (* height (.getY v))
506 0))
507 (uv-triangle mesh tri)))
509 (defn triangle-bounds
510 "Dimensions of the bounding square of the triangle in the form
511 [x y width height].
512 Assumes that the triangle lies in the XY plane."
513 [#^Triangle tri]
514 (let [verts (map vector3f-seq (triangle-seq tri))
515 x (apply min (map first verts))
516 y (apply min (map second verts))]
518 [x y
519 (- (apply max (map first verts)) x)
520 (- (apply max (map second verts)) y)
521 ]))
524 (defn locate-tactile-sensors
525 "Search the geometry's tactile UV image for touch sensors, returning
526 their positions in geometry-relative coordinates."
527 [#^Geometry geo]
529 ;; inside-triangle? white-coordinates triangle-transformation
530 ;; tri-uv-coord touch-receptor-image
531 (let [mesh (.getMesh geo)
532 image (touch-receptor-image geo)
533 width (.getWidth image)
534 height (.getHeight image)
535 tris (triangles geo)
537 ;; for each triangle
538 sensor-coords
539 (fn [tri]
540 ;; translate triangle to uv-pixel-space
541 (let [uv-tri
542 (pixel-triangle mesh tri width height)
543 bounds (vec (triangle-bounds uv-tri))]
545 ;; get that part of the picture
547 (apply #(.setRoi image %1 %2 %3 %4) bounds)
548 (let [cutout (.crop (.getProcessor image))
549 ;; extract white pixels inside triangle
550 cutout-tri
551 (map-triangle
552 (fn [_ v]
553 (.subtract
554 v
555 (Vector3f. (bounds 0) (bounds 1) (float 0))))
556 uv-tri)
557 whites (filter (partial inside-triangle? cutout-tri)
558 (map vector2f->vector3f
559 (white-coordinates cutout)))
560 ;; translate pixel coordinates to world-space
561 transform (triangle-transformation cutout-tri tri)]
562 (map #(.mult transform %) whites))))]
563 (map sensor-coords tris)))
577 ;; for each triangle in the mesh,
578 ;; get the normal to the triangle,
579 ;; look at the UV touch map, restricted to that triangle,
580 ;; get the positions of those touch sensors in geometry-relative
581 ;; coordinates.
582 (defn tactile-coords [#^Geometry obj]
583 (let [mesh (.getMesh obj)
584 num-triangles (.getTriangleCount mesh)
585 num-verticies (.getVertexCount mesh)
586 uv-coord (partial uv-coord mesh)
587 triangle-indices (partial triangle-indices mesh)
588 receptors (touch-receptor-image obj)
589 tris (triangles obj)
590 ]
591 (map
592 (fn [[tri-1 tri-2 tri-3]]
593 (let [width (.getWidth receptors)
594 height (.getHeight receptors)
595 uv-1 (uv-coord tri-1)
596 uv-2 (uv-coord tri-2)
597 uv-3 (uv-coord tri-3)
598 x-coords (map #(.getX %) [uv-1 uv-2 uv-3])
599 y-coords (map #(.getY %) [uv-1 uv-2 uv-3])
600 max-x (Math/ceil (* width (apply max x-coords)))
601 min-x (Math/floor (* width (apply min x-coords)))
602 max-y (Math/ceil (* height (apply max y-coords)))
603 min-y (Math/floor (* height (apply min y-coords)))
605 image-1 (Vector2f. (* width (.getX uv-1))
606 (* height (.getY uv-1)))
607 image-2 (Vector2f. (* width (.getX uv-2))
608 (* height (.getY uv-2)))
609 image-3 (Vector2f. (* width (.getX uv-3))
610 (* height (.getY uv-3)))
611 left-corner
612 (Vector2f. min-x min-y)
613 ]
615 (.setRoi receptors min-x min-y (- max-x min-x) (- max-y min-y))
616 (let [processor (.crop (.getProcessor receptors))]
617 (map
618 #(.add left-corner %)
620 (filter
621 (partial
622 inside-triangle?
623 (.subtract image-1 left-corner)
624 (.subtract image-2 left-corner)
625 (.subtract image-3 left-corner))
626 (white-coordinates processor))))
627 )) (map triangle-indices (range num-triangles)))))
635 (defn all-names []
636 (concat
637 (re-split #"\n" (slurp (file-str
638 "/home/r/proj/names/dist.female.first")))
639 (re-split #"\n" (slurp (file-str
640 "/home/r/proj/names/dist.male.first")))
641 (re-split #"\n" (slurp (file-str
642 "/home/r/proj/names/dist.all.last")))))
652 (defrecord LulzLoader [])
653 (defprotocol Lulzable (load-lulz [this]))
654 (extend-type LulzLoader
655 Lulzable
656 (load-lulz [this] (println "the lulz have arrived!")))
659 (defn world-setup [joint]
660 (let [joint-position (Vector3f. 0 0 0)
661 joint-rotation
662 (.toRotationMatrix
663 (.mult
664 (doto (Quaternion.)
665 (.fromAngleAxis
666 (* 1 (/ Math/PI 4))
667 (Vector3f. -1 0 0)))
668 (doto (Quaternion.)
669 (.fromAngleAxis
670 (* 1 (/ Math/PI 2))
671 (Vector3f. 0 0 1)))))
672 top-position (.mult joint-rotation (Vector3f. 8 0 0))
674 origin (doto
675 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
676 :position top-position))
677 top (doto
678 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
679 :position top-position)
681 (.addControl
682 (RigidBodyControl.
683 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
684 bottom (doto
685 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
686 :position (Vector3f. 0 0 0))
687 (.addControl
688 (RigidBodyControl.
689 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
690 table (box 10 2 10 :position (Vector3f. 0 -20 0)
691 :color ColorRGBA/Gray :mass 0)
692 a (.getControl top RigidBodyControl)
693 b (.getControl bottom RigidBodyControl)]
695 (cond
696 (= joint :cone)
698 (doto (ConeJoint.
699 a b
700 (world-to-local top joint-position)
701 (world-to-local bottom joint-position)
702 joint-rotation
703 joint-rotation
704 )
707 (.setLimit (* (/ 10) Math/PI)
708 (* (/ 4) Math/PI)
709 0)))
710 [origin top bottom table]))
712 (defn test-joint [joint]
713 (let [[origin top bottom floor] (world-setup joint)
714 control (.getControl top RigidBodyControl)
715 move-up? (atom false)
716 move-down? (atom false)
717 move-left? (atom false)
718 move-right? (atom false)
719 roll-left? (atom false)
720 roll-right? (atom false)
721 timer (atom 0)]
723 (world
724 (nodify [top bottom floor origin])
725 (merge standard-debug-controls
726 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
727 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
728 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
729 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
730 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
731 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
733 (fn [world]
734 (light-up-everything world)
735 (enable-debug world)
736 (set-gravity world (Vector3f. 0 0 0))
737 )
739 (fn [world _]
740 (if (zero? (rem (swap! timer inc) 100))
741 (do
742 ;; (println-repl @timer)
743 (.attachChild (.getRootNode world)
744 (sphere 0.05 :color ColorRGBA/Yellow
745 :position (.getWorldTranslation top)
746 :physical? false))
747 (.attachChild (.getRootNode world)
748 (sphere 0.05 :color ColorRGBA/LightGray
749 :position (.getWorldTranslation bottom)
750 :physical? false))))
752 (if @move-up?
753 (.applyTorque control
754 (.mult (.getPhysicsRotation control)
755 (Vector3f. 0 0 10))))
756 (if @move-down?
757 (.applyTorque control
758 (.mult (.getPhysicsRotation control)
759 (Vector3f. 0 0 -10))))
760 (if @move-left?
761 (.applyTorque control
762 (.mult (.getPhysicsRotation control)
763 (Vector3f. 0 10 0))))
764 (if @move-right?
765 (.applyTorque control
766 (.mult (.getPhysicsRotation control)
767 (Vector3f. 0 -10 0))))
768 (if @roll-left?
769 (.applyTorque control
770 (.mult (.getPhysicsRotation control)
771 (Vector3f. -1 0 0))))
772 (if @roll-right?
773 (.applyTorque control
774 (.mult (.getPhysicsRotation control)
775 (Vector3f. 1 0 0))))))))
779 #+end_src
781 #+results: body-1
782 : #'cortex.silly/test-joint
785 * COMMENT purgatory
786 #+begin_src clojure
787 (defn bullet-trans []
788 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
789 :position (Vector3f. -10 5 0))
790 obj-b (sphere 0.5 :color ColorRGBA/Blue
791 :position (Vector3f. -10 -5 0)
792 :mass 0)
793 control-a (.getControl obj-a RigidBodyControl)
794 control-b (.getControl obj-b RigidBodyControl)
795 swivel
796 (.toRotationMatrix
797 (doto (Quaternion.)
798 (.fromAngleAxis (/ Math/PI 2)
799 Vector3f/UNIT_X)))]
800 (doto
801 (ConeJoint.
802 control-a control-b
803 (Vector3f. 0 5 0)
804 (Vector3f. 0 -5 0)
805 swivel swivel)
806 (.setLimit (* 0.6 (/ Math/PI 4))
807 (/ Math/PI 4)
808 (* Math/PI 0.8)))
809 (world (nodify
810 [obj-a obj-b])
811 standard-debug-controls
812 enable-debug
813 no-op)))
816 (defn bullet-trans* []
817 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
818 :position (Vector3f. 5 0 0)
819 :mass 90)
820 obj-b (sphere 0.5 :color ColorRGBA/Blue
821 :position (Vector3f. -5 0 0)
822 :mass 0)
823 control-a (.getControl obj-a RigidBodyControl)
824 control-b (.getControl obj-b RigidBodyControl)
825 move-up? (atom nil)
826 move-down? (atom nil)
827 move-left? (atom nil)
828 move-right? (atom nil)
829 roll-left? (atom nil)
830 roll-right? (atom nil)
831 force 100
832 swivel
833 (.toRotationMatrix
834 (doto (Quaternion.)
835 (.fromAngleAxis (/ Math/PI 2)
836 Vector3f/UNIT_X)))
837 x-move
838 (doto (Matrix3f.)
839 (.fromStartEndVectors Vector3f/UNIT_X
840 (.normalize (Vector3f. 1 1 0))))
842 timer (atom 0)]
843 (doto
844 (ConeJoint.
845 control-a control-b
846 (Vector3f. -8 0 0)
847 (Vector3f. 2 0 0)
848 ;;swivel swivel
849 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
850 x-move Matrix3f/IDENTITY
851 )
852 (.setCollisionBetweenLinkedBodys false)
853 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
854 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
855 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
856 (world (nodify
857 [obj-a obj-b])
858 (merge standard-debug-controls
859 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
860 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
861 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
862 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
863 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
864 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
866 (fn [world]
867 (enable-debug world)
868 (set-gravity world Vector3f/ZERO)
869 )
871 (fn [world _]
873 (if @move-up?
874 (.applyForce control-a
875 (Vector3f. force 0 0)
876 (Vector3f. 0 0 0)))
877 (if @move-down?
878 (.applyForce control-a
879 (Vector3f. (- force) 0 0)
880 (Vector3f. 0 0 0)))
881 (if @move-left?
882 (.applyForce control-a
883 (Vector3f. 0 force 0)
884 (Vector3f. 0 0 0)))
885 (if @move-right?
886 (.applyForce control-a
887 (Vector3f. 0 (- force) 0)
888 (Vector3f. 0 0 0)))
890 (if @roll-left?
891 (.applyForce control-a
892 (Vector3f. 0 0 force)
893 (Vector3f. 0 0 0)))
894 (if @roll-right?
895 (.applyForce control-a
896 (Vector3f. 0 0 (- force))
897 (Vector3f. 0 0 0)))
899 (if (zero? (rem (swap! timer inc) 100))
900 (.attachChild
901 (.getRootNode world)
902 (sphere 0.05 :color ColorRGBA/Yellow
903 :physical? false :position
904 (.getWorldTranslation obj-a)))))
905 )
906 ))
910 #+end_src
913 * COMMENT generate source
914 #+begin_src clojure :tangle ../src/cortex/silly.clj
915 <<body-1>>
916 #+end_src
922 (defn transform-trianglesdsd
923 "Transform that converts each vertex in the first triangle
924 into the corresponding vertex in the second triangle."
925 [#^Triangle tri-1 #^Triangle tri-2]
926 (let [in [(.get1 tri-1)
927 (.get2 tri-1)
928 (.get3 tri-1)]
929 out [(.get1 tri-2)
930 (.get2 tri-2)
931 (.get3 tri-2)]]
932 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
933 in* [(.mult translate (in 0))
934 (.mult translate (in 1))
935 (.mult translate (in 2))]
936 final-translation
937 (doto (Matrix4f.)
938 (.setTranslation (out 1)))
940 rotate-1
941 (doto (Matrix3f.)
942 (.fromStartEndVectors
943 (.normalize
944 (.subtract
945 (in* 1) (in* 0)))
946 (.normalize
947 (.subtract
948 (out 1) (out 0)))))
949 in** [(.mult rotate-1 (in* 0))
950 (.mult rotate-1 (in* 1))
951 (.mult rotate-1 (in* 2))]
952 scale-factor-1
953 (.mult
954 (.normalize
955 (.subtract
956 (out 1)
957 (out 0)))
958 (/ (.length
959 (.subtract (out 1)
960 (out 0)))
961 (.length
962 (.subtract (in** 1)
963 (in** 0)))))
964 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
965 in*** [(.mult scale-1 (in** 0))
966 (.mult scale-1 (in** 1))
967 (.mult scale-1 (in** 2))]
973 ]
975 (dorun (map println in))
976 (println)
977 (dorun (map println in*))
978 (println)
979 (dorun (map println in**))
980 (println)
981 (dorun (map println in***))
982 (println)
984 )))