view org/test-creature.org @ 111:61d9c0e8d188

don't create useless touch-maps, add some eye stuf
author Robert McIntyre <rlm@mit.edu>
date Thu, 19 Jan 2012 08:09:15 -0700
parents f89f0b9ed2fe
children 128fa71ee188
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)
68 (use 'clojure.contrib.def)
70 (defn view-image
71 "Initailizes a JPanel on which you may draw a BufferedImage.
72 Returns a function that accepts a BufferedImage and draws it to the
73 JPanel."
74 []
75 (let [image
76 (atom
77 (BufferedImage. 1 1 BufferedImage/TYPE_4BYTE_ABGR))
78 panel
79 (proxy [JPanel] []
80 (paint
81 [graphics]
82 (proxy-super paintComponent graphics)
83 (.drawImage graphics @image 0 0 nil)))
84 frame (JFrame. "Display Image")]
85 (SwingUtilities/invokeLater
86 (fn []
87 (doto frame
88 (-> (.getContentPane) (.add panel))
89 (.pack)
90 (.setLocationRelativeTo nil)
91 (.setResizable true)
92 (.setVisible true))))
93 (fn [#^BufferedImage i]
94 (reset! image i)
95 (.setSize frame (+ 8 (.getWidth i)) (+ 28 (.getHeight i)))
96 (.repaint panel 0 0 (.getWidth i) (.getHeight i)))))
98 (defn points->image
99 "Take a sparse collection of points and visuliaze it as a
100 BufferedImage."
102 ;; TODO maybe parallelize this since it's easy
104 [points]
105 (if (empty? points)
106 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
107 (let [xs (vec (map first points))
108 ys (vec (map second points))
109 x0 (apply min xs)
110 y0 (apply min ys)
111 width (- (apply max xs) x0)
112 height (- (apply max ys) y0)
113 image (BufferedImage. (inc width) (inc height)
114 BufferedImage/TYPE_BYTE_BINARY)]
115 (dorun
116 (for [index (range (count points))]
117 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
119 image)))
121 (defn test-data
122 []
123 (vec
124 (for [a (range 0 1000 2)
125 b (range 0 1000 2)]
126 (vector a b))
127 ))
129 (defn average [coll]
130 (/ (reduce + coll) (count coll)))
132 (defn collapse-1d
133 "One dimensional analogue of collapse"
134 [center line]
135 (let [length (count line)
136 num-above (count (filter (partial < center) line))
137 num-below (- length num-above)]
138 (range (- center num-below)
139 (+ center num-above))
140 ))
142 (defn collapse
143 "Take a set of pairs of integers and collapse them into a
144 contigous bitmap."
145 [points]
146 (if (empty? points) []
147 (let
148 [num-points (count points)
149 center (vector
150 (int (average (map first points)))
151 (int (average (map first points))))
152 flattened
153 (reduce
154 concat
155 (map
156 (fn [column]
157 (map vector
158 (map first column)
159 (collapse-1d (second center)
160 (map second column))))
161 (partition-by first (sort-by first points))))
162 squeezed
163 (reduce
164 concat
165 (map
166 (fn [row]
167 (map vector
168 (collapse-1d (first center)
169 (map first row))
170 (map second row)))
171 (partition-by second (sort-by second flattened))))
172 relocate
173 (let [min-x (apply min (map first squeezed))
174 min-y (apply min (map second squeezed))]
175 (map (fn [[x y]]
176 [(- x min-x)
177 (- y min-y)])
178 squeezed))]
179 relocate
180 )))
182 (defn load-bullet []
183 (let [sim (world (Node.) {} no-op no-op)]
184 (doto sim
185 (.enqueue
186 (fn []
187 (.stop sim)))
188 (.start))))
190 (defn load-blender-model
191 "Load a .blend file using an asset folder relative path."
192 [^String model]
193 (.loadModel
194 (doto (asset-manager)
195 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
196 model))
198 (defn meta-data [blender-node key]
199 (if-let [data (.getUserData blender-node "properties")]
200 (.findValue data key)
201 nil))
203 (defn blender-to-jme
204 "Convert from Blender coordinates to JME coordinates"
205 [#^Vector3f in]
206 (Vector3f. (.getX in)
207 (.getZ in)
208 (- (.getY in))))
210 (defn jme-to-blender
211 "Convert from JME coordinates to Blender coordinates"
212 [#^Vector3f in]
213 (Vector3f. (.getX in)
214 (- (.getZ in))
215 (.getY in)))
217 (defn joint-targets
218 "Return the two closest two objects to the joint object, ordered
219 from bottom to top according to the joint's rotation."
220 [#^Node parts #^Node joint]
221 ;;(println (meta-data joint "joint"))
222 (.getWorldRotation joint)
223 (loop [radius (float 0.01)]
224 (let [results (CollisionResults.)]
225 (.collideWith
226 parts
227 (BoundingBox. (.getWorldTranslation joint)
228 radius radius radius)
229 results)
230 (let [targets
231 (distinct
232 (map #(.getGeometry %) results))]
233 (if (>= (count targets) 2)
234 (sort-by
235 #(let [v
236 (jme-to-blender
237 (.mult
238 (.inverse (.getWorldRotation joint))
239 (.subtract (.getWorldTranslation %)
240 (.getWorldTranslation joint))))]
241 (println-repl (.getName %) ":" v)
242 (.dot (Vector3f. 1 1 1)
243 v))
244 (take 2 targets))
245 (recur (float (* radius 2))))))))
247 (defn world-to-local
248 "Convert the world coordinates into coordinates relative to the
249 object (i.e. local coordinates), taking into account the rotation
250 of object."
251 [#^Spatial object world-coordinate]
252 (let [out (Vector3f.)]
253 (.worldToLocal object world-coordinate out) out))
255 (defn local-to-world
256 "Convert the local coordinates into coordinates into world relative
257 coordinates"
258 [#^Spatial object local-coordinate]
259 (let [world-coordinate (Vector3f.)]
260 (.localToWorld object local-coordinate world-coordinate)
261 world-coordinate))
264 (defmulti joint-dispatch
265 "Translate blender pseudo-joints into real JME joints."
266 (fn [constraints & _]
267 (:type constraints)))
269 (defmethod joint-dispatch :point
270 [constraints control-a control-b pivot-a pivot-b rotation]
271 (println-repl "creating POINT2POINT joint")
272 (Point2PointJoint.
273 control-a
274 control-b
275 pivot-a
276 pivot-b))
278 (defmethod joint-dispatch :hinge
279 [constraints control-a control-b pivot-a pivot-b rotation]
280 (println-repl "creating HINGE joint")
281 (let [axis
282 (if-let
283 [axis (:axis constraints)]
284 axis
285 Vector3f/UNIT_X)
286 [limit-1 limit-2] (:limit constraints)
287 hinge-axis
288 (.mult
289 rotation
290 (blender-to-jme axis))]
291 (doto
292 (HingeJoint.
293 control-a
294 control-b
295 pivot-a
296 pivot-b
297 hinge-axis
298 hinge-axis)
299 (.setLimit limit-1 limit-2))))
301 (defmethod joint-dispatch :cone
302 [constraints control-a control-b pivot-a pivot-b rotation]
303 (let [limit-xz (:limit-xz constraints)
304 limit-xy (:limit-xy constraints)
305 twist (:twist constraints)]
307 (println-repl "creating CONE joint")
308 (println-repl rotation)
309 (println-repl
310 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
311 (println-repl
312 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
313 (println-repl
314 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
315 (doto
316 (ConeJoint.
317 control-a
318 control-b
319 pivot-a
320 pivot-b
321 rotation
322 rotation)
323 (.setLimit (float limit-xz)
324 (float limit-xy)
325 (float twist)))))
327 (defn connect
328 "here are some examples:
329 {:type :point}
330 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
331 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
333 {:type :cone :limit-xz 0]
334 :limit-xy 0]
335 :twist 0]} (use XZY rotation mode in blender!)"
336 [#^Node obj-a #^Node obj-b #^Node joint]
337 (let [control-a (.getControl obj-a RigidBodyControl)
338 control-b (.getControl obj-b RigidBodyControl)
339 joint-center (.getWorldTranslation joint)
340 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
341 pivot-a (world-to-local obj-a joint-center)
342 pivot-b (world-to-local obj-b joint-center)]
344 (if-let [constraints
345 (map-vals
346 eval
347 (read-string
348 (meta-data joint "joint")))]
349 ;; A side-effect of creating a joint registers
350 ;; it with both physics objects which in turn
351 ;; will register the joint with the physics system
352 ;; when the simulation is started.
353 (do
354 (println-repl "creating joint between"
355 (.getName obj-a) "and" (.getName obj-b))
356 (joint-dispatch constraints
357 control-a control-b
358 pivot-a pivot-b
359 joint-rotation))
360 (println-repl "could not find joint meta-data!"))))
362 (defn assemble-creature [#^Node pieces joints]
363 (dorun
364 (map
365 (fn [geom]
366 (let [physics-control
367 (RigidBodyControl.
368 (HullCollisionShape.
369 (.getMesh geom))
370 (if-let [mass (meta-data geom "mass")]
371 (do
372 (println-repl
373 "setting" (.getName geom) "mass to" (float mass))
374 (float mass))
375 (float 1)))]
377 (.addControl geom physics-control)))
378 (filter #(isa? (class %) Geometry )
379 (node-seq pieces))))
380 (dorun
381 (map
382 (fn [joint]
383 (let [[obj-a obj-b]
384 (joint-targets pieces joint)]
385 (connect obj-a obj-b joint)))
386 joints))
387 pieces)
389 (defn blender-creature [blender-path]
390 (let [model (load-blender-model blender-path)
391 joints
392 (if-let [joint-node (.getChild model "joints")]
393 (seq (.getChildren joint-node))
394 (do (println-repl "could not find joints node")
395 []))]
396 (assemble-creature model joints)))
398 (def hand "Models/creature1/one.blend")
400 (def worm "Models/creature1/try-again.blend")
402 (def touch "Models/creature1/touch.blend")
404 (defn worm-model [] (load-blender-model worm))
406 (defn x-ray [#^ColorRGBA color]
407 (doto (Material. (asset-manager)
408 "Common/MatDefs/Misc/Unshaded.j3md")
409 (.setColor "Color" color)
410 (-> (.getAdditionalRenderState)
411 (.setDepthTest false))))
413 (defn colorful []
414 (.getChild (worm-model) "worm-21"))
416 (import jme3tools.converters.ImageToAwt)
418 (import ij.ImagePlus)
420 ;; Every Mesh has many triangles, each with its own index.
421 ;; Every vertex has its own index as well.
423 (defn tactile-sensor-image
424 "Return the touch-sensor distribution image in BufferedImage format,
425 or nil if it does not exist."
426 [#^Geometry obj]
427 (if-let [image-path (meta-data obj "touch")]
428 (ImageToAwt/convert
429 (.getImage
430 (.loadTexture
431 (asset-manager)
432 image-path))
433 false false 0)))
435 (import ij.process.ImageProcessor)
436 (import java.awt.image.BufferedImage)
438 (def white -1)
440 (defn filter-pixels
441 "List the coordinates of all pixels matching pred, within the bounds
442 provided. Bounds -> [x0 y0 width height]"
443 {:author "Dylan Holmes"}
444 ([pred #^BufferedImage image]
445 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
446 ([pred #^BufferedImage image [x0 y0 width height]]
447 ((fn accumulate [x y matches]
448 (cond
449 (>= y (+ height y0)) matches
450 (>= x (+ width x0)) (recur 0 (inc y) matches)
451 (pred (.getRGB image x y))
452 (recur (inc x) y (conj matches [x y]))
453 :else (recur (inc x) y matches)))
454 x0 y0 [])))
456 (defn white-coordinates
457 "Coordinates of all the white pixels in a subset of the image."
458 [#^BufferedImage image bounds]
459 (filter-pixels #(= % white) image bounds))
461 (defn triangle
462 "Get the triangle specified by triangle-index from the mesh"
463 [#^Mesh mesh triangle-index]
464 (let [scratch (Triangle.)]
465 (.getTriangle mesh triangle-index scratch)
466 scratch))
468 (defn triangle-vertex-indices
469 "Get the triangle vertex indices of a given triangle from a given
470 mesh."
471 [#^Mesh mesh triangle-index]
472 (let [indices (int-array 3)]
473 (.getTriangle mesh triangle-index indices)
474 (vec indices)))
476 (defn vertex-UV-coord
477 "Get the uv-coordinates of the vertex named by vertex-index"
478 [#^Mesh mesh vertex-index]
479 (let [UV-buffer
480 (.getData
481 (.getBuffer
482 mesh
483 VertexBuffer$Type/TexCoord))]
484 [(.get UV-buffer (* vertex-index 2))
485 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
487 (defn triangle-UV-coord
488 "Get the uv-cooridnates of the triangle's verticies."
489 [#^Mesh mesh width height triangle-index]
490 (map (fn [[u v]] (vector (* width u) (* height v)))
491 (map (partial vertex-UV-coord mesh)
492 (triangle-vertex-indices mesh triangle-index))))
494 (defn same-side?
495 "Given the points p1 and p2 and the reference point ref, is point p
496 on the same side of the line that goes through p1 and p2 as ref is?"
497 [p1 p2 ref p]
498 (<=
499 0
500 (.dot
501 (.cross (.subtract p2 p1) (.subtract p p1))
502 (.cross (.subtract p2 p1) (.subtract ref p1)))))
504 (defn triangle-seq [#^Triangle tri]
505 [(.get1 tri) (.get2 tri) (.get3 tri)])
507 (defn vector3f-seq [#^Vector3f v]
508 [(.getX v) (.getY v) (.getZ v)])
510 (defn inside-triangle?
511 "Is the point inside the triangle?"
512 {:author "Dylan Holmes"}
513 [#^Triangle tri #^Vector3f p]
514 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
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))))
520 (defn triangle->matrix4f
521 "Converts the triangle into a 4x4 matrix: The first three columns
522 contain the vertices of the triangle; the last contains the unit
523 normal of the triangle. The bottom row is filled with 1s."
524 [#^Triangle t]
525 (let [mat (Matrix4f.)
526 [vert-1 vert-2 vert-3]
527 ((comp vec map) #(.get t %) (range 3))
528 unit-normal (do (.calculateNormal t)(.getNormal t))
529 vertices [vert-1 vert-2 vert-3 unit-normal]]
530 (dorun
531 (for [row (range 4) col (range 3)]
532 (do
533 (.set mat col row (.get (vertices row)col))
534 (.set mat 3 row 1))))
535 mat))
537 (defn triangle-transformation
538 "Returns the affine transformation that converts each vertex in the
539 first triangle into the corresponding vertex in the second
540 triangle."
541 [#^Triangle tri-1 #^Triangle tri-2]
542 (.mult
543 (triangle->matrix4f tri-2)
544 (.invert (triangle->matrix4f tri-1))))
546 (defn point->vector2f [[u v]]
547 (Vector2f. u v))
549 (defn vector2f->vector3f [v]
550 (Vector3f. (.getX v) (.getY v) 0))
552 (defn map-triangle [f #^Triangle tri]
553 (Triangle.
554 (f 0 (.get1 tri))
555 (f 1 (.get2 tri))
556 (f 2 (.get3 tri))))
558 (defn points->triangle
559 "Convert a list of points into a triangle."
560 [points]
561 (apply #(Triangle. %1 %2 %3)
562 (map (fn [point]
563 (let [point (vec point)]
564 (Vector3f. (get point 0 0)
565 (get point 1 0)
566 (get point 2 0))))
567 (take 3 points))))
569 (defn convex-bounds
570 "Dimensions of the smallest integer bounding square of the list of
571 2D verticies in the form: [x y width height]."
572 [uv-verts]
573 (let [xs (map first uv-verts)
574 ys (map second uv-verts)
575 x0 (Math/floor (apply min xs))
576 y0 (Math/floor (apply min ys))
577 x1 (Math/ceil (apply max xs))
578 y1 (Math/ceil (apply max ys))]
579 [x0 y0 (- x1 x0) (- y1 y0)]))
581 (defn sensors-in-triangle
582 "Find the locations of the touch sensors within a triangle in both
583 UV and gemoetry relative coordinates."
584 [image mesh tri-index]
585 (let [width (.getWidth image)
586 height (.getHeight image)
587 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
588 bounds (convex-bounds UV-vertex-coords)
590 cutout-triangle (points->triangle UV-vertex-coords)
591 UV-sensor-coords
592 (filter (comp (partial inside-triangle? cutout-triangle)
593 (fn [[u v]] (Vector3f. u v 0)))
594 (white-coordinates image bounds))
595 UV->geometry (triangle-transformation
596 cutout-triangle
597 (triangle mesh tri-index))
598 geometry-sensor-coords
599 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
600 UV-sensor-coords)]
601 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
603 (defn-memo locate-feelers
604 "Search the geometry's tactile UV image for touch sensors, returning
605 their positions in geometry-relative coordinates."
606 [#^Geometry geo]
607 (let [mesh (.getMesh geo)
608 num-triangles (.getTriangleCount mesh)]
609 (if-let [image (tactile-sensor-image geo)]
610 (map
611 (partial sensors-in-triangle image mesh)
612 (range num-triangles))
613 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
615 (use 'clojure.contrib.def)
617 (defn-memo touch-topology [#^Gemoetry geo]
618 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
620 (defn-memo feeler-coordinates [#^Geometry geo]
621 (vec (map :geometry (locate-feelers geo))))
623 (defn enable-touch [#^Geometry geo]
624 (let [feeler-coords (feeler-coordinates geo)
625 tris (triangles geo)
626 limit 0.1
627 ;;results (CollisionResults.)
628 ]
629 (if (empty? (touch-topology geo))
630 nil
631 (fn [node]
632 (let [sensor-origins
633 (map
634 #(map (partial local-to-world geo) %)
635 feeler-coords)
636 triangle-normals
637 (map (partial get-ray-direction geo)
638 tris)
639 rays
640 (flatten
641 (map (fn [origins norm]
642 (map #(doto (Ray. % norm)
643 (.setLimit limit)) origins))
644 sensor-origins triangle-normals))]
645 (vector
646 (touch-topology geo)
647 (vec
648 (for [ray rays]
649 (do
650 (let [results (CollisionResults.)]
651 (.collideWith node ray results)
652 (let [touch-objects
653 (set
654 (filter #(not (= geo %))
655 (map #(.getGeometry %) results)))]
656 (if (> (count touch-objects) 0)
657 1 0))))))))))))
659 (defn touch [#^Node pieces]
660 (filter (comp not nil?)
661 (map enable-touch
662 (filter #(isa? (class %) Geometry)
663 (node-seq pieces)))))
666 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
667 ;; http://en.wikipedia.org/wiki/Retina
669 (defn test-eye []
670 (.getChild (worm-model) "worm-11"))
673 (defn retina-sensor-image
674 "Return a map of pixel selection functions to BufferedImages
675 describing the distribution of light-sensitive components on this
676 geometry's surface. Each function creates an integer from the rgb
677 values found in the pixel. :red, :green, :blue, :gray are already
678 defined as extracting the red green blue and average components
679 respectively."
680 [#^Geometry eye]
681 (if-let [eye-map (meta-data eye "eye")]
682 (map-vals
683 #(ImageToAwt/convert
684 (.getImage (.loadTexture (asset-manager) %))
685 false false 0)
686 (read-string
687 eye-map))))
693 (defn debug-window
694 "creates function that offers a debug view of sensor data"
695 []
696 (let [vi (view-image)]
697 (fn
698 [[coords sensor-data]]
699 (let [image (points->image coords)]
700 (dorun
701 (for [i (range (count coords))]
702 (.setRGB image ((coords i) 0) ((coords i) 1)
703 ({0 -16777216
704 1 -1} (sensor-data i)))))
705 (vi image)))))
708 ;;(defn test-touch [world creature]
711 (defn test-creature [thing]
712 (let [x-axis
713 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
714 y-axis
715 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
716 z-axis
717 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
718 creature (blender-creature thing)
719 touch-nerves (touch creature)
720 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
721 ]
722 (world
723 (nodify [creature
724 (box 10 2 10 :position (Vector3f. 0 -9 0)
725 :color ColorRGBA/Gray :mass 0)
726 x-axis y-axis z-axis
727 ])
728 standard-debug-controls
729 (fn [world]
730 (light-up-everything world)
731 (enable-debug world)
732 ;;(com.aurellem.capture.Capture/captureVideo
733 ;; world (file-str "/home/r/proj/ai-videos/hand"))
734 ;;(.setTimer world (RatchetTimer. 60))
735 ;;(speed-up world)
736 ;;(set-gravity world (Vector3f. 0 0 0))
737 )
738 (fn [world tpf]
739 ;;(dorun
740 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
742 (dorun
743 (map #(%1 (%2 (.getRootNode world)))
744 touch-debug-windows touch-nerves)
745 )
747 )
748 ;;(let [timer (atom 0)]
749 ;; (fn [_ _]
750 ;; (swap! timer inc)
751 ;; (if (= (rem @timer 60) 0)
752 ;; (println-repl (float (/ @timer 60))))))
753 )))
763 ;;; experiments in collisions
767 (defn collision-test []
768 (let [b-radius 1
769 b-position (Vector3f. 0 0 0)
770 obj-b (box 1 1 1 :color ColorRGBA/Blue
771 :position b-position
772 :mass 0)
773 node (nodify [obj-b])
774 bounds-b
775 (doto (Picture.)
776 (.setHeight 50)
777 (.setWidth 50)
778 (.setImage (asset-manager)
779 "Models/creature1/hand.png"
780 false
781 ))
783 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
785 collisions
786 (let [cr (CollisionResults.)]
787 (.collideWith node bounds-b cr)
788 (println (map #(.getContactPoint %) cr))
789 cr)
791 ;;collision-points
792 ;;(map #(sphere 0.1 :position (.getContactPoint %))
793 ;; collisions)
795 ;;node (nodify (conj collision-points obj-b))
797 sim
798 (world node
799 {"key-space"
800 (fn [_ value]
801 (if value
802 (let [cr (CollisionResults.)]
803 (.collideWith node bounds-b cr)
804 (println-repl (map #(.getContactPoint %) cr))
805 cr)))}
806 no-op
807 no-op)
809 ]
810 sim
812 ))
817 #+end_src
819 #+results: body-1
820 : #'cortex.silly/test-creature
823 * COMMENT purgatory
824 #+begin_src clojure
825 (defn bullet-trans []
826 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
827 :position (Vector3f. -10 5 0))
828 obj-b (sphere 0.5 :color ColorRGBA/Blue
829 :position (Vector3f. -10 -5 0)
830 :mass 0)
831 control-a (.getControl obj-a RigidBodyControl)
832 control-b (.getControl obj-b RigidBodyControl)
833 swivel
834 (.toRotationMatrix
835 (doto (Quaternion.)
836 (.fromAngleAxis (/ Math/PI 2)
837 Vector3f/UNIT_X)))]
838 (doto
839 (ConeJoint.
840 control-a control-b
841 (Vector3f. 0 5 0)
842 (Vector3f. 0 -5 0)
843 swivel swivel)
844 (.setLimit (* 0.6 (/ Math/PI 4))
845 (/ Math/PI 4)
846 (* Math/PI 0.8)))
847 (world (nodify
848 [obj-a obj-b])
849 standard-debug-controls
850 enable-debug
851 no-op)))
854 (defn bullet-trans* []
855 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
856 :position (Vector3f. 5 0 0)
857 :mass 90)
858 obj-b (sphere 0.5 :color ColorRGBA/Blue
859 :position (Vector3f. -5 0 0)
860 :mass 0)
861 control-a (.getControl obj-a RigidBodyControl)
862 control-b (.getControl obj-b RigidBodyControl)
863 move-up? (atom nil)
864 move-down? (atom nil)
865 move-left? (atom nil)
866 move-right? (atom nil)
867 roll-left? (atom nil)
868 roll-right? (atom nil)
869 force 100
870 swivel
871 (.toRotationMatrix
872 (doto (Quaternion.)
873 (.fromAngleAxis (/ Math/PI 2)
874 Vector3f/UNIT_X)))
875 x-move
876 (doto (Matrix3f.)
877 (.fromStartEndVectors Vector3f/UNIT_X
878 (.normalize (Vector3f. 1 1 0))))
880 timer (atom 0)]
881 (doto
882 (ConeJoint.
883 control-a control-b
884 (Vector3f. -8 0 0)
885 (Vector3f. 2 0 0)
886 ;;swivel swivel
887 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
888 x-move Matrix3f/IDENTITY
889 )
890 (.setCollisionBetweenLinkedBodys false)
891 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
892 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
893 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
894 (world (nodify
895 [obj-a obj-b])
896 (merge standard-debug-controls
897 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
898 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
899 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
900 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
901 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
902 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
904 (fn [world]
905 (enable-debug world)
906 (set-gravity world Vector3f/ZERO)
907 )
909 (fn [world _]
911 (if @move-up?
912 (.applyForce control-a
913 (Vector3f. force 0 0)
914 (Vector3f. 0 0 0)))
915 (if @move-down?
916 (.applyForce control-a
917 (Vector3f. (- force) 0 0)
918 (Vector3f. 0 0 0)))
919 (if @move-left?
920 (.applyForce control-a
921 (Vector3f. 0 force 0)
922 (Vector3f. 0 0 0)))
923 (if @move-right?
924 (.applyForce control-a
925 (Vector3f. 0 (- force) 0)
926 (Vector3f. 0 0 0)))
928 (if @roll-left?
929 (.applyForce control-a
930 (Vector3f. 0 0 force)
931 (Vector3f. 0 0 0)))
932 (if @roll-right?
933 (.applyForce control-a
934 (Vector3f. 0 0 (- force))
935 (Vector3f. 0 0 0)))
937 (if (zero? (rem (swap! timer inc) 100))
938 (.attachChild
939 (.getRootNode world)
940 (sphere 0.05 :color ColorRGBA/Yellow
941 :physical? false :position
942 (.getWorldTranslation obj-a)))))
943 )
944 ))
946 (defn transform-trianglesdsd
947 "Transform that converts each vertex in the first triangle
948 into the corresponding vertex in the second triangle."
949 [#^Triangle tri-1 #^Triangle tri-2]
950 (let [in [(.get1 tri-1)
951 (.get2 tri-1)
952 (.get3 tri-1)]
953 out [(.get1 tri-2)
954 (.get2 tri-2)
955 (.get3 tri-2)]]
956 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
957 in* [(.mult translate (in 0))
958 (.mult translate (in 1))
959 (.mult translate (in 2))]
960 final-translation
961 (doto (Matrix4f.)
962 (.setTranslation (out 1)))
964 rotate-1
965 (doto (Matrix3f.)
966 (.fromStartEndVectors
967 (.normalize
968 (.subtract
969 (in* 1) (in* 0)))
970 (.normalize
971 (.subtract
972 (out 1) (out 0)))))
973 in** [(.mult rotate-1 (in* 0))
974 (.mult rotate-1 (in* 1))
975 (.mult rotate-1 (in* 2))]
976 scale-factor-1
977 (.mult
978 (.normalize
979 (.subtract
980 (out 1)
981 (out 0)))
982 (/ (.length
983 (.subtract (out 1)
984 (out 0)))
985 (.length
986 (.subtract (in** 1)
987 (in** 0)))))
988 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
989 in*** [(.mult scale-1 (in** 0))
990 (.mult scale-1 (in** 1))
991 (.mult scale-1 (in** 2))]
997 ]
999 (dorun (map println in))
1000 (println)
1001 (dorun (map println in*))
1002 (println)
1003 (dorun (map println in**))
1004 (println)
1005 (dorun (map println in***))
1006 (println)
1008 ))))
1011 (defn world-setup [joint]
1012 (let [joint-position (Vector3f. 0 0 0)
1013 joint-rotation
1014 (.toRotationMatrix
1015 (.mult
1016 (doto (Quaternion.)
1017 (.fromAngleAxis
1018 (* 1 (/ Math/PI 4))
1019 (Vector3f. -1 0 0)))
1020 (doto (Quaternion.)
1021 (.fromAngleAxis
1022 (* 1 (/ Math/PI 2))
1023 (Vector3f. 0 0 1)))))
1024 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1026 origin (doto
1027 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1028 :position top-position))
1029 top (doto
1030 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1031 :position top-position)
1033 (.addControl
1034 (RigidBodyControl.
1035 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1036 bottom (doto
1037 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1038 :position (Vector3f. 0 0 0))
1039 (.addControl
1040 (RigidBodyControl.
1041 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1042 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1043 :color ColorRGBA/Gray :mass 0)
1044 a (.getControl top RigidBodyControl)
1045 b (.getControl bottom RigidBodyControl)]
1047 (cond
1048 (= joint :cone)
1050 (doto (ConeJoint.
1051 a b
1052 (world-to-local top joint-position)
1053 (world-to-local bottom joint-position)
1054 joint-rotation
1055 joint-rotation
1059 (.setLimit (* (/ 10) Math/PI)
1060 (* (/ 4) Math/PI)
1061 0)))
1062 [origin top bottom table]))
1064 (defn test-joint [joint]
1065 (let [[origin top bottom floor] (world-setup joint)
1066 control (.getControl top RigidBodyControl)
1067 move-up? (atom false)
1068 move-down? (atom false)
1069 move-left? (atom false)
1070 move-right? (atom false)
1071 roll-left? (atom false)
1072 roll-right? (atom false)
1073 timer (atom 0)]
1075 (world
1076 (nodify [top bottom floor origin])
1077 (merge standard-debug-controls
1078 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1079 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1080 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1081 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1082 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1083 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1085 (fn [world]
1086 (light-up-everything world)
1087 (enable-debug world)
1088 (set-gravity world (Vector3f. 0 0 0))
1091 (fn [world _]
1092 (if (zero? (rem (swap! timer inc) 100))
1093 (do
1094 ;; (println-repl @timer)
1095 (.attachChild (.getRootNode world)
1096 (sphere 0.05 :color ColorRGBA/Yellow
1097 :position (.getWorldTranslation top)
1098 :physical? false))
1099 (.attachChild (.getRootNode world)
1100 (sphere 0.05 :color ColorRGBA/LightGray
1101 :position (.getWorldTranslation bottom)
1102 :physical? false))))
1104 (if @move-up?
1105 (.applyTorque control
1106 (.mult (.getPhysicsRotation control)
1107 (Vector3f. 0 0 10))))
1108 (if @move-down?
1109 (.applyTorque control
1110 (.mult (.getPhysicsRotation control)
1111 (Vector3f. 0 0 -10))))
1112 (if @move-left?
1113 (.applyTorque control
1114 (.mult (.getPhysicsRotation control)
1115 (Vector3f. 0 10 0))))
1116 (if @move-right?
1117 (.applyTorque control
1118 (.mult (.getPhysicsRotation control)
1119 (Vector3f. 0 -10 0))))
1120 (if @roll-left?
1121 (.applyTorque control
1122 (.mult (.getPhysicsRotation control)
1123 (Vector3f. -1 0 0))))
1124 (if @roll-right?
1125 (.applyTorque control
1126 (.mult (.getPhysicsRotation control)
1127 (Vector3f. 1 0 0))))))))
1131 (defprotocol Frame
1132 (frame [this]))
1134 (extend-type BufferedImage
1135 Frame
1136 (frame [image]
1137 (merge
1138 (apply
1139 hash-map
1140 (interleave
1141 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1142 (vector x y)))
1143 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1144 (let [data (.getRGB image x y)]
1145 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1146 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1147 :b (bit-and 0x0000ff data)))))))
1148 {:width (.getWidth image) :height (.getHeight image)})))
1151 (extend-type ImagePlus
1152 Frame
1153 (frame [image+]
1154 (frame (.getBufferedImage image+))))
1157 #+end_src
1160 * COMMENT generate source
1161 #+begin_src clojure :tangle ../src/cortex/silly.clj
1162 <<body-1>>
1163 #+end_src