view org/test-creature.org @ 106:40e72c6943d8

fixing out-of-bounds error
author Robert McIntyre <rlm@mit.edu>
date Sun, 15 Jan 2012 00:33:06 -0700
parents 3334bf15854b
children 53fb379ac678
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 * objectives
10 - [X] get an overall bitmap-like image for touch
11 - [X] write code to visuliaze this bitmap
12 - [ ] directly change the UV-pixels to show touch sensor activation
13 - [ ] write an explination for why b&w bitmaps for senses is appropiate
14 - [ ] clean up touch code and write visulazation test
15 - [ ] do the same for eyes
17 * Intro
18 So far, I've made the following senses --
19 - Vision
20 - Hearing
21 - Touch
22 - Proprioception
24 And one effector:
25 - Movement
27 However, the code so far has only enabled these senses, but has not
28 actually implemented them. For example, there is still a lot of work
29 to be done for vision. I need to be able to create an /eyeball/ in
30 simulation that can be moved around and see the world from different
31 angles. I also need to determine weather to use log-polar or cartesian
32 for the visual input, and I need to determine how/wether to
33 disceritise the visual input.
35 I also want to be able to visualize both the sensors and the
36 effectors in pretty pictures. This semi-retarted creature will be my
37 first attempt at bringing everything together.
39 * The creature's body
41 Still going to do an eve-like body in blender, but due to problems
42 importing the joints, etc into jMonkeyEngine3, I'm going to do all
43 the connecting here in clojure code, using the names of the individual
44 components and trial and error. Later, I'll maybe make some sort of
45 creature-building modifications to blender that support whatever
46 discreitized senses I'm going to make.
48 #+name: body-1
49 #+begin_src clojure
50 (ns cortex.silly
51 "let's play!"
52 {:author "Robert McIntyre"})
54 ;; TODO remove this!
55 (require 'cortex.import)
56 (cortex.import/mega-import-jme3)
57 (use '(cortex world util body hearing touch vision))
59 (rlm.rlm-commands/help)
60 (import java.awt.image.BufferedImage)
61 (import javax.swing.JPanel)
62 (import javax.swing.SwingUtilities)
63 (import java.awt.Dimension)
64 (import javax.swing.JFrame)
65 (import java.awt.Dimension)
66 (import com.aurellem.capture.RatchetTimer)
67 (declare joint-create)
69 (defn view-image
70 "Initailizes a JPanel on which you may draw a BufferedImage.
71 Returns a function that accepts a BufferedImage and draws it to the
72 JPanel."
73 []
74 (let [image
75 (atom
76 (BufferedImage. 1 1 BufferedImage/TYPE_4BYTE_ABGR))
77 panel
78 (proxy [JPanel] []
79 (paint
80 [graphics]
81 (proxy-super paintComponent graphics)
82 (.drawImage graphics @image 0 0 nil)))
83 frame (JFrame. "Display Image")]
84 (SwingUtilities/invokeLater
85 (fn []
86 (doto frame
87 (-> (.getContentPane) (.add panel))
88 (.pack)
89 (.setLocationRelativeTo nil)
90 (.setResizable true)
91 (.setVisible true))))
92 (fn [#^BufferedImage i]
93 (reset! image i)
94 (.setSize frame (+ 8 (.getWidth i)) (+ 28 (.getHeight i)))
95 (.repaint panel 0 0 (.getWidth i) (.getHeight i)))))
97 (defn points->image
98 "Take a sparse collection of points and visuliaze it as a
99 BufferedImage."
101 ;; TODO maybe parallelize this since it's easy
103 [points]
104 (if (empty? points)
105 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
106 (let [xs (vec (map first points))
107 ys (vec (map second points))
108 x0 (apply min xs)
109 y0 (apply min ys)
110 width (- (apply max xs) x0)
111 height (- (apply max ys) y0)
112 image (BufferedImage. (inc width) (inc height)
113 BufferedImage/TYPE_BYTE_BINARY)]
114 (dorun
115 (for [index (range (count points))]
116 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
118 image)))
120 (defn test-data
121 []
122 (vec
123 (for [a (range 0 1000 2)
124 b (range 0 1000 2)]
125 (vector a b))
126 ))
128 (defn average [coll]
129 (/ (reduce + coll) (count coll)))
131 (defn collapse-1d
132 "One dimensional analogue of collapse"
133 [center line]
134 (let [length (count line)
135 num-above (count (filter (partial < center) line))
136 num-below (- length num-above)]
137 (range (- center num-below)
138 (+ center num-above))
139 ))
141 (defn collapse
142 "Take a set of pairs of integers and collapse them into a
143 contigous bitmap."
144 [points]
145 (let
146 [num-points (count points)
147 center (vector
148 (int (average (map first points)))
149 (int (average (map first points))))
150 flattened
151 (reduce
152 concat
153 (map
154 (fn [column]
155 (map vector
156 (map first column)
157 (collapse-1d (second center)
158 (map second column))))
159 (partition-by first (sort-by first points))))
160 squeezed
161 (reduce
162 concat
163 (map
164 (fn [row]
165 (map vector
166 (collapse-1d (first center)
167 (map first row))
168 (map second row)))
169 (partition-by second (sort-by second flattened))))
170 relocate
171 (let [min-x (apply min (map first squeezed))
172 min-y (apply min (map second squeezed))]
173 (map (fn [[x y]]
174 [(- x min-x)
175 (- y min-y)])
176 squeezed))]
177 relocate
178 ))
180 (defn load-bullet []
181 (let [sim (world (Node.) {} no-op no-op)]
182 (doto sim
183 (.enqueue
184 (fn []
185 (.stop sim)))
186 (.start))))
188 (defn load-blender-model
189 "Load a .blend file using an asset folder relative path."
190 [^String model]
191 (.loadModel
192 (doto (asset-manager)
193 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
194 model))
196 (defn meta-data [blender-node key]
197 (if-let [data (.getUserData blender-node "properties")]
198 (.findValue data key)
199 nil))
201 (defn blender-to-jme
202 "Convert from Blender coordinates to JME coordinates"
203 [#^Vector3f in]
204 (Vector3f. (.getX in)
205 (.getZ in)
206 (- (.getY in))))
208 (defn jme-to-blender
209 "Convert from JME coordinates to Blender coordinates"
210 [#^Vector3f in]
211 (Vector3f. (.getX in)
212 (- (.getZ in))
213 (.getY in)))
215 (defn joint-targets
216 "Return the two closest two objects to the joint object, ordered
217 from bottom to top according to the joint's rotation."
218 [#^Node parts #^Node joint]
219 ;;(println (meta-data joint "joint"))
220 (.getWorldRotation joint)
221 (loop [radius (float 0.01)]
222 (let [results (CollisionResults.)]
223 (.collideWith
224 parts
225 (BoundingBox. (.getWorldTranslation joint)
226 radius radius radius)
227 results)
228 (let [targets
229 (distinct
230 (map #(.getGeometry %) results))]
231 (if (>= (count targets) 2)
232 (sort-by
233 #(let [v
234 (jme-to-blender
235 (.mult
236 (.inverse (.getWorldRotation joint))
237 (.subtract (.getWorldTranslation %)
238 (.getWorldTranslation joint))))]
239 (println-repl (.getName %) ":" v)
240 (.dot (Vector3f. 1 1 1)
241 v))
242 (take 2 targets))
243 (recur (float (* radius 2))))))))
245 (defn world-to-local
246 "Convert the world coordinates into coordinates relative to the
247 object (i.e. local coordinates), taking into account the rotation
248 of object."
249 [#^Spatial object world-coordinate]
250 (let [out (Vector3f.)]
251 (.worldToLocal object world-coordinate out) out))
253 (defn local-to-world
254 "Convert the local coordinates into coordinates into world relative
255 coordinates"
256 [#^Spatial object local-coordinate]
257 (let [world-coordinate (Vector3f.)]
258 (.localToWorld object local-coordinate world-coordinate)
259 world-coordinate))
262 (defmulti joint-dispatch
263 "Translate blender pseudo-joints into real JME joints."
264 (fn [constraints & _]
265 (:type constraints)))
267 (defmethod joint-dispatch :point
268 [constraints control-a control-b pivot-a pivot-b rotation]
269 (println-repl "creating POINT2POINT joint")
270 (Point2PointJoint.
271 control-a
272 control-b
273 pivot-a
274 pivot-b))
276 (defmethod joint-dispatch :hinge
277 [constraints control-a control-b pivot-a pivot-b rotation]
278 (println-repl "creating HINGE joint")
279 (let [axis
280 (if-let
281 [axis (:axis constraints)]
282 axis
283 Vector3f/UNIT_X)
284 [limit-1 limit-2] (:limit constraints)
285 hinge-axis
286 (.mult
287 rotation
288 (blender-to-jme axis))]
289 (doto
290 (HingeJoint.
291 control-a
292 control-b
293 pivot-a
294 pivot-b
295 hinge-axis
296 hinge-axis)
297 (.setLimit limit-1 limit-2))))
299 (defmethod joint-dispatch :cone
300 [constraints control-a control-b pivot-a pivot-b rotation]
301 (let [limit-xz (:limit-xz constraints)
302 limit-xy (:limit-xy constraints)
303 twist (:twist constraints)]
305 (println-repl "creating CONE joint")
306 (println-repl rotation)
307 (println-repl
308 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
309 (println-repl
310 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
311 (println-repl
312 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
313 (doto
314 (ConeJoint.
315 control-a
316 control-b
317 pivot-a
318 pivot-b
319 rotation
320 rotation)
321 (.setLimit (float limit-xz)
322 (float limit-xy)
323 (float twist)))))
325 (defn connect
326 "here are some examples:
327 {:type :point}
328 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
329 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
331 {:type :cone :limit-xz 0]
332 :limit-xy 0]
333 :twist 0]} (use XZY rotation mode in blender!)"
334 [#^Node obj-a #^Node obj-b #^Node joint]
335 (let [control-a (.getControl obj-a RigidBodyControl)
336 control-b (.getControl obj-b RigidBodyControl)
337 joint-center (.getWorldTranslation joint)
338 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
339 pivot-a (world-to-local obj-a joint-center)
340 pivot-b (world-to-local obj-b joint-center)]
342 (if-let [constraints
343 (map-vals
344 eval
345 (read-string
346 (meta-data joint "joint")))]
347 ;; A side-effect of creating a joint registers
348 ;; it with both physics objects which in turn
349 ;; will register the joint with the physics system
350 ;; when the simulation is started.
351 (do
352 (println-repl "creating joint between"
353 (.getName obj-a) "and" (.getName obj-b))
354 (joint-dispatch constraints
355 control-a control-b
356 pivot-a pivot-b
357 joint-rotation))
358 (println-repl "could not find joint meta-data!"))))
360 (defn assemble-creature [#^Node pieces joints]
361 (dorun
362 (map
363 (fn [geom]
364 (let [physics-control
365 (RigidBodyControl.
366 (HullCollisionShape.
367 (.getMesh geom))
368 (if-let [mass (meta-data geom "mass")]
369 (do
370 (println-repl
371 "setting" (.getName geom) "mass to" (float mass))
372 (float mass))
373 (float 1)))]
375 (.addControl geom physics-control)))
376 (filter #(isa? (class %) Geometry )
377 (node-seq pieces))))
378 (dorun
379 (map
380 (fn [joint]
381 (let [[obj-a obj-b]
382 (joint-targets pieces joint)]
383 (connect obj-a obj-b joint)))
384 joints))
385 pieces)
387 (defn blender-creature [blender-path]
388 (let [model (load-blender-model blender-path)
389 joints
390 (if-let [joint-node (.getChild model "joints")]
391 (seq (.getChildren joint-node))
392 (do (println-repl "could not find joints node")
393 []))]
394 (assemble-creature model joints)))
396 (def hand "Models/creature1/one.blend")
398 (def worm "Models/creature1/try-again.blend")
400 (def touch "Models/creature1/touch.blend")
402 (defn worm-model [] (load-blender-model worm))
404 (defn x-ray [#^ColorRGBA color]
405 (doto (Material. (asset-manager)
406 "Common/MatDefs/Misc/Unshaded.j3md")
407 (.setColor "Color" color)
408 (-> (.getAdditionalRenderState)
409 (.setDepthTest false))))
413 (defn colorful []
414 (.getChild (worm-model) "worm-21"))
416 (import jme3tools.converters.ImageToAwt)
418 (import ij.ImagePlus)
420 (defn triangle-indices
421 "Get the triangle vertex indices of a given triangle from a given
422 mesh."
423 [#^Mesh mesh triangle-index]
424 (let [indices (int-array 3)]
425 (.getTriangle mesh triangle-index indices)
426 (vec indices)))
428 (defn uv-coord
429 "Get the uv-coordinates of the vertex named by vertex-index"
430 [#^Mesh mesh vertex-index]
431 (let [UV-buffer
432 (.getData
433 (.getBuffer
434 mesh
435 VertexBuffer$Type/TexCoord))]
436 (Vector2f.
437 (.get UV-buffer (* vertex-index 2))
438 (.get UV-buffer (+ 1 (* vertex-index 2))))))
440 (defn tri-uv-coord
441 "Get the uv-cooridnates of the triangle's verticies."
442 [#^Mesh mesh #^Triangle triangle]
443 (map (partial uv-coord mesh)
444 (triangle-indices mesh (.getIndex triangle))))
446 (defn touch-receptor-image
447 "Return the touch-sensor distribution image in ImagePlus format, or
448 nil if it does not exist."
449 [#^Geometry obj]
450 (let [mat (.getMaterial obj)]
451 (if-let [texture-param
452 (.getTextureParam
453 mat
454 MaterialHelper/TEXTURE_TYPE_DIFFUSE)]
455 (let
456 [texture
457 (.getTextureValue texture-param)
458 im (.getImage texture)]
459 (ImagePlus.
460 "UV-map"
461 (ImageToAwt/convert im false false 0))))))
463 (import ij.process.ImageProcessor)
464 (import java.awt.image.BufferedImage)
466 (defprotocol Frame
467 (frame [this]))
469 (extend-type BufferedImage
470 Frame
471 (frame [image]
472 (merge
473 (apply
474 hash-map
475 (interleave
476 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
477 (vector x y)))
478 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
479 (let [data (.getRGB image x y)]
480 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
481 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
482 :b (bit-and 0x0000ff data)))))))
483 {:width (.getWidth image) :height (.getHeight image)})))
486 (extend-type ImagePlus
487 Frame
488 (frame [image+]
489 (frame (.getBufferedImage image+))))
492 (def white -1)
494 (defn filter-pixels
495 "List the coordinates of all pixels matching pred."
496 {:author "Dylan Holmes"}
497 [pred #^ImageProcessor ip]
498 (let
499 [width (.getWidth ip)
500 height (.getHeight ip)]
501 ((fn accumulate [x y matches]
502 (cond
503 (>= y height) matches
504 (>= x width) (recur 0 (inc y) matches)
505 (pred (.getPixel ip x y))
506 (recur (inc x) y (conj matches (Vector2f. x y)))
507 :else (recur (inc x) y matches)))
508 0 0 [])))
510 (defn white-coordinates
511 "List the coordinates of all the white pixels in an image."
512 [#^ImageProcessor ip]
513 (filter-pixels #(= % white) ip))
515 (defn same-side?
516 "Given the points p1 and p2 and the reference point ref, is point p
517 on the same side of the line that goes through p1 and p2 as ref is?"
518 [p1 p2 ref p]
519 (<=
520 0
521 (.dot
522 (.cross (.subtract p2 p1) (.subtract p p1))
523 (.cross (.subtract p2 p1) (.subtract ref p1)))))
525 (defn triangle->matrix4f
526 "Converts the triangle into a 4x4 matrix of vertices: The first
527 three columns contain the vertices of the triangle; the last
528 contains the unit normal of the triangle. The bottom row is filled
529 with 1s."
530 [#^Triangle t]
531 (let [mat (Matrix4f.)
532 [vert-1 vert-2 vert-3]
533 ((comp vec map) #(.get t %) (range 3))
534 unit-normal (do (.calculateNormal t)(.getNormal t))
535 vertices [vert-1 vert-2 vert-3 unit-normal]]
536 (dorun
537 (for [row (range 4) col (range 3)]
538 (do
539 (.set mat col row (.get (vertices row)col))
540 (.set mat 3 row 1))))
541 mat))
543 (defn triangle-transformation
544 "Returns the affine transformation that converts each vertex in the
545 first triangle into the corresponding vertex in the second
546 triangle."
547 [#^Triangle tri-1 #^Triangle tri-2]
548 (.mult
549 (triangle->matrix4f tri-2)
550 (.invert (triangle->matrix4f tri-1))))
552 (def death (Triangle.
553 (Vector3f. 1 1 1)
554 (Vector3f. 1 2 3)
555 (Vector3f. 5 6 7)))
557 (def death-2 (Triangle.
558 (Vector3f. 2 2 2)
559 (Vector3f. 1 1 1)
560 (Vector3f. 0 1 0)))
562 (defn vector2f->vector3f [v]
563 (Vector3f. (.getX v) (.getY v) 0))
565 (extend-type Triangle
566 Textual
567 (text [t]
568 (println "Triangle: " \newline (.get1 t) \newline
569 (.get2 t) \newline (.get3 t))))
571 (defn map-triangle [f #^Triangle tri]
572 (Triangle.
573 (f 0 (.get1 tri))
574 (f 1 (.get2 tri))
575 (f 2 (.get3 tri))))
577 (defn triangle-seq [#^Triangle tri]
578 [(.get1 tri) (.get2 tri) (.get3 tri)])
580 (defn vector3f-seq [#^Vector3f v]
581 [(.getX v) (.getY v) (.getZ v)])
583 (defn inside-triangle?
584 "Is the point inside the triangle? Now what do we do?
585 You might want to hold on there"
586 {:author "Dylan Holmes"}
587 [tri p]
588 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
589 (and
590 (same-side? vert-1 vert-2 vert-3 p)
591 (same-side? vert-2 vert-3 vert-1 p)
592 (same-side? vert-3 vert-1 vert-2 p))))
594 (defn uv-triangle
595 "Convert the mesh triangle into the cooresponding triangle in
596 UV-space. Z-component of these triangles is always zero."
597 [#^Mesh mesh #^Triangle tri]
598 (apply #(Triangle. %1 %2 %3)
599 (map vector2f->vector3f
600 (tri-uv-coord mesh tri))))
602 (defn pixel-triangle
603 "Convert the mesh triangle into the corresponding triangle in
604 UV-pixel-space. Z compenent will be zero."
605 [#^Mesh mesh #^Triangle tri width height]
606 (map-triangle (fn [_ v]
607 (Vector3f. (* width (.getX v))
608 (* height (.getY v))
609 0))
610 (uv-triangle mesh tri)))
612 (def rasterize pixel-triangle)
615 (defn triangle-bounds
616 "Dimensions of the bounding square of the triangle in the form
617 [x y width height].
618 Assumes that the triangle lies in the XY plane."
619 [#^Triangle tri]
620 (let [verts (map vector3f-seq (triangle-seq tri))
621 x (apply min (map first verts))
622 y (apply min (map second verts))]
623 [x y
624 (- (apply max (map first verts)) x)
625 (- (apply max (map second verts)) y)
626 ]))
629 (defn sensors-in-triangle
630 "find the locations of the sensors within a triangle"
631 [image tri]
632 )
635 (defn locate-feelers
636 "Search the geometry's tactile UV image for touch sensors, returning
637 their positions in geometry-relative coordinates."
638 [#^Geometry geo]
639 (if-let [image (touch-receptor-image geo)]
640 (let [mesh (.getMesh geo)
641 tris (triangles geo)
643 width (.getWidth image)
644 height (.getHeight image)
646 ;; for each triangle
647 sensor-coords
648 (fn [tri]
649 ;; translate triangle to uv-pixel-space
650 (let [uv-tri
651 (pixel-triangle mesh tri width height)
652 bounds (vec (triangle-bounds uv-tri))]
654 ;; get that part of the picture
656 (apply #(.setRoi image %1 %2 %3 %4) bounds)
657 (let [cutout (.crop (.getProcessor image))
658 ;; extract white pixels inside triangle
659 cutout-tri
660 (map-triangle
661 (fn [_ v]
662 (.subtract
663 v
664 (Vector3f. (bounds 0) (bounds 1) (float 0))))
665 uv-tri)
666 whites (filter (partial inside-triangle? cutout-tri)
667 (map vector2f->vector3f
668 (white-coordinates cutout)))
669 ;; translate pixel coordinates to world-space
670 transform (triangle-transformation cutout-tri tri)]
671 (map #(.mult transform %) whites))))]
672 (vec (map sensor-coords tris)))
673 (repeat (count (triangles geo)) [])))
675 (use 'clojure.contrib.def)
677 (defn-memo touch-topology [#^Gemoetry geo]
678 (if-let [image (touch-receptor-image geo)]
679 (let [feeler-coords
680 (map
681 #(vector (int (.getX %)) (int (.getY %)))
682 (white-coordinates
683 (.getProcessor image)))]
684 (vec (collapse feeler-coords)))
685 []))
687 (defn enable-touch [#^Geometry geo]
688 (let [feeler-coords (locate-feelers geo)
689 tris (triangles geo)
690 limit 0.1]
691 (fn [node]
692 (let [sensor-origins
693 (map
694 #(map (partial local-to-world geo) %)
695 feeler-coords)
696 triangle-normals
697 (map (partial get-ray-direction geo)
698 tris)
699 rays
700 (flatten
701 (map (fn [origins norm]
702 (map #(doto (Ray. % norm)
703 (.setLimit limit)) origins))
704 sensor-origins triangle-normals))]
705 (vector
706 (touch-topology geo)
707 (vec
708 (for [ray rays]
709 (do
710 (let [results (CollisionResults.)]
711 (.collideWith node ray results)
712 (let [touch-objects
713 (set
714 (filter #(not (= geo %))
715 (map #(.getGeometry %) results)))]
716 (if (> (count touch-objects) 0)
717 1 0)))))))))))
719 (defn touch [#^Node pieces]
720 (map enable-touch
721 (filter #(isa? (class %) Geometry)
722 (node-seq pieces))))
724 (defn debug-window
725 "creates function that offers a debug view of sensor data"
726 []
727 (let [vi (view-image)]
728 (fn
729 [[coords sensor-data]]
730 (let [image (points->image coords)]
731 (dorun
732 (for [i (range (count coords))]
733 (.setRGB image ((coords i) 0) ((coords i) 1)
734 ({0 -16777216
735 1 -1} (sensor-data i)))))
736 (vi image)))))
739 ;;(defn test-touch [world creature]
742 (defn test-creature [thing]
743 (let [x-axis
744 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
745 y-axis
746 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
747 z-axis
748 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
749 creature (blender-creature thing)
750 touch-nerves (touch creature)
751 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
752 ]
753 (world
754 (nodify [creature
755 (box 10 2 10 :position (Vector3f. 0 -9 0)
756 :color ColorRGBA/Gray :mass 0)
757 x-axis y-axis z-axis
758 ])
759 standard-debug-controls
760 (fn [world]
761 (light-up-everything world)
762 (enable-debug world)
763 ;;(com.aurellem.capture.Capture/captureVideo
764 ;; world (file-str "/home/r/proj/ai-videos/hand"))
765 (.setTimer world (RatchetTimer. 60))
766 ;;(set-gravity world (Vector3f. 0 0 0))
767 )
768 (fn [world tpf]
769 (dorun
770 (map #(%1 (%2 (.getRootNode world))) touch-debug-windows touch-nerves))
771 )
772 ;;(let [timer (atom 0)]
773 ;; (fn [_ _]
774 ;; (swap! timer inc)
775 ;; (if (= (rem @timer 60) 0)
776 ;; (println-repl (float (/ @timer 60))))))
777 )))
779 #+end_src
781 #+results: body-1
782 : #'cortex.silly/tactile-coords
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 ))
908 (defn transform-trianglesdsd
909 "Transform that converts each vertex in the first triangle
910 into the corresponding vertex in the second triangle."
911 [#^Triangle tri-1 #^Triangle tri-2]
912 (let [in [(.get1 tri-1)
913 (.get2 tri-1)
914 (.get3 tri-1)]
915 out [(.get1 tri-2)
916 (.get2 tri-2)
917 (.get3 tri-2)]]
918 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
919 in* [(.mult translate (in 0))
920 (.mult translate (in 1))
921 (.mult translate (in 2))]
922 final-translation
923 (doto (Matrix4f.)
924 (.setTranslation (out 1)))
926 rotate-1
927 (doto (Matrix3f.)
928 (.fromStartEndVectors
929 (.normalize
930 (.subtract
931 (in* 1) (in* 0)))
932 (.normalize
933 (.subtract
934 (out 1) (out 0)))))
935 in** [(.mult rotate-1 (in* 0))
936 (.mult rotate-1 (in* 1))
937 (.mult rotate-1 (in* 2))]
938 scale-factor-1
939 (.mult
940 (.normalize
941 (.subtract
942 (out 1)
943 (out 0)))
944 (/ (.length
945 (.subtract (out 1)
946 (out 0)))
947 (.length
948 (.subtract (in** 1)
949 (in** 0)))))
950 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
951 in*** [(.mult scale-1 (in** 0))
952 (.mult scale-1 (in** 1))
953 (.mult scale-1 (in** 2))]
959 ]
961 (dorun (map println in))
962 (println)
963 (dorun (map println in*))
964 (println)
965 (dorun (map println in**))
966 (println)
967 (dorun (map println in***))
968 (println)
970 ))))
973 (defn world-setup [joint]
974 (let [joint-position (Vector3f. 0 0 0)
975 joint-rotation
976 (.toRotationMatrix
977 (.mult
978 (doto (Quaternion.)
979 (.fromAngleAxis
980 (* 1 (/ Math/PI 4))
981 (Vector3f. -1 0 0)))
982 (doto (Quaternion.)
983 (.fromAngleAxis
984 (* 1 (/ Math/PI 2))
985 (Vector3f. 0 0 1)))))
986 top-position (.mult joint-rotation (Vector3f. 8 0 0))
988 origin (doto
989 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
990 :position top-position))
991 top (doto
992 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
993 :position top-position)
995 (.addControl
996 (RigidBodyControl.
997 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
998 bottom (doto
999 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1000 :position (Vector3f. 0 0 0))
1001 (.addControl
1002 (RigidBodyControl.
1003 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1004 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1005 :color ColorRGBA/Gray :mass 0)
1006 a (.getControl top RigidBodyControl)
1007 b (.getControl bottom RigidBodyControl)]
1009 (cond
1010 (= joint :cone)
1012 (doto (ConeJoint.
1013 a b
1014 (world-to-local top joint-position)
1015 (world-to-local bottom joint-position)
1016 joint-rotation
1017 joint-rotation
1021 (.setLimit (* (/ 10) Math/PI)
1022 (* (/ 4) Math/PI)
1023 0)))
1024 [origin top bottom table]))
1026 (defn test-joint [joint]
1027 (let [[origin top bottom floor] (world-setup joint)
1028 control (.getControl top RigidBodyControl)
1029 move-up? (atom false)
1030 move-down? (atom false)
1031 move-left? (atom false)
1032 move-right? (atom false)
1033 roll-left? (atom false)
1034 roll-right? (atom false)
1035 timer (atom 0)]
1037 (world
1038 (nodify [top bottom floor origin])
1039 (merge standard-debug-controls
1040 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1041 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1042 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1043 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1044 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1045 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1047 (fn [world]
1048 (light-up-everything world)
1049 (enable-debug world)
1050 (set-gravity world (Vector3f. 0 0 0))
1053 (fn [world _]
1054 (if (zero? (rem (swap! timer inc) 100))
1055 (do
1056 ;; (println-repl @timer)
1057 (.attachChild (.getRootNode world)
1058 (sphere 0.05 :color ColorRGBA/Yellow
1059 :position (.getWorldTranslation top)
1060 :physical? false))
1061 (.attachChild (.getRootNode world)
1062 (sphere 0.05 :color ColorRGBA/LightGray
1063 :position (.getWorldTranslation bottom)
1064 :physical? false))))
1066 (if @move-up?
1067 (.applyTorque control
1068 (.mult (.getPhysicsRotation control)
1069 (Vector3f. 0 0 10))))
1070 (if @move-down?
1071 (.applyTorque control
1072 (.mult (.getPhysicsRotation control)
1073 (Vector3f. 0 0 -10))))
1074 (if @move-left?
1075 (.applyTorque control
1076 (.mult (.getPhysicsRotation control)
1077 (Vector3f. 0 10 0))))
1078 (if @move-right?
1079 (.applyTorque control
1080 (.mult (.getPhysicsRotation control)
1081 (Vector3f. 0 -10 0))))
1082 (if @roll-left?
1083 (.applyTorque control
1084 (.mult (.getPhysicsRotation control)
1085 (Vector3f. -1 0 0))))
1086 (if @roll-right?
1087 (.applyTorque control
1088 (.mult (.getPhysicsRotation control)
1089 (Vector3f. 1 0 0))))))))
1093 #+end_src
1096 * COMMENT generate source
1097 #+begin_src clojure :tangle ../src/cortex/silly.clj
1098 <<body-1>>
1099 #+end_src