view org/test-creature.org @ 122:b591da250afc

fixed bug in test code.
author Robert McIntyre <rlm@mit.edu>
date Sun, 22 Jan 2012 04:53:58 -0700
parents 05e60a0ed043
children 91773e8ec50f
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 points->image
71 "Take a sparse collection of points and visuliaze it as a
72 BufferedImage."
74 ;; TODO maybe parallelize this since it's easy
76 [points]
77 (if (empty? points)
78 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
79 (let [xs (vec (map first points))
80 ys (vec (map second points))
81 x0 (apply min xs)
82 y0 (apply min ys)
83 width (- (apply max xs) x0)
84 height (- (apply max ys) y0)
85 image (BufferedImage. (inc width) (inc height)
86 BufferedImage/TYPE_INT_RGB)]
87 (dorun
88 (for [x (range (.getWidth image))
89 y (range (.getHeight image))]
90 (.setRGB image x y 0xFF0000)))
91 (dorun
92 (for [index (range (count points))]
93 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
95 image)))
97 (defn average [coll]
98 (/ (reduce + coll) (count coll)))
100 (defn collapse-1d
101 "One dimensional analogue of collapse"
102 [center line]
103 (let [length (count line)
104 num-above (count (filter (partial < center) line))
105 num-below (- length num-above)]
106 (range (- center num-below)
107 (+ center num-above))))
109 (defn collapse
110 "Take a set of pairs of integers and collapse them into a
111 contigous bitmap."
112 [points]
113 (if (empty? points) []
114 (let
115 [num-points (count points)
116 center (vector
117 (int (average (map first points)))
118 (int (average (map first points))))
119 flattened
120 (reduce
121 concat
122 (map
123 (fn [column]
124 (map vector
125 (map first column)
126 (collapse-1d (second center)
127 (map second column))))
128 (partition-by first (sort-by first points))))
129 squeezed
130 (reduce
131 concat
132 (map
133 (fn [row]
134 (map vector
135 (collapse-1d (first center)
136 (map first row))
137 (map second row)))
138 (partition-by second (sort-by second flattened))))
139 relocate
140 (let [min-x (apply min (map first squeezed))
141 min-y (apply min (map second squeezed))]
142 (map (fn [[x y]]
143 [(- x min-x)
144 (- y min-y)])
145 squeezed))]
146 relocate)))
148 (defn load-bullet []
149 (let [sim (world (Node.) {} no-op no-op)]
150 (doto sim
151 (.enqueue
152 (fn []
153 (.stop sim)))
154 (.start))))
156 (defn load-blender-model
157 "Load a .blend file using an asset folder relative path."
158 [^String model]
159 (.loadModel
160 (doto (asset-manager)
161 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
162 model))
164 (defn meta-data [blender-node key]
165 (if-let [data (.getUserData blender-node "properties")]
166 (.findValue data key)
167 nil))
169 (defn blender-to-jme
170 "Convert from Blender coordinates to JME coordinates"
171 [#^Vector3f in]
172 (Vector3f. (.getX in)
173 (.getZ in)
174 (- (.getY in))))
176 (defn jme-to-blender
177 "Convert from JME coordinates to Blender coordinates"
178 [#^Vector3f in]
179 (Vector3f. (.getX in)
180 (- (.getZ in))
181 (.getY in)))
183 (defn joint-targets
184 "Return the two closest two objects to the joint object, ordered
185 from bottom to top according to the joint's rotation."
186 [#^Node parts #^Node joint]
187 (loop [radius (float 0.01)]
188 (let [results (CollisionResults.)]
189 (.collideWith
190 parts
191 (BoundingBox. (.getWorldTranslation joint)
192 radius radius radius)
193 results)
194 (let [targets
195 (distinct
196 (map #(.getGeometry %) results))]
197 (if (>= (count targets) 2)
198 (sort-by
199 #(let [v
200 (jme-to-blender
201 (.mult
202 (.inverse (.getWorldRotation joint))
203 (.subtract (.getWorldTranslation %)
204 (.getWorldTranslation joint))))]
205 (println-repl (.getName %) ":" v)
206 (.dot (Vector3f. 1 1 1)
207 v))
208 (take 2 targets))
209 (recur (float (* radius 2))))))))
211 (defn world-to-local
212 "Convert the world coordinates into coordinates relative to the
213 object (i.e. local coordinates), taking into account the rotation
214 of object."
215 [#^Spatial object world-coordinate]
216 (let [out (Vector3f.)]
217 (.worldToLocal object world-coordinate out) out))
219 (defn local-to-world
220 "Convert the local coordinates into coordinates into world relative
221 coordinates"
222 [#^Spatial object local-coordinate]
223 (let [world-coordinate (Vector3f.)]
224 (.localToWorld object local-coordinate world-coordinate)
225 world-coordinate))
227 (defmulti joint-dispatch
228 "Translate blender pseudo-joints into real JME joints."
229 (fn [constraints & _]
230 (:type constraints)))
232 (defmethod joint-dispatch :point
233 [constraints control-a control-b pivot-a pivot-b rotation]
234 (println-repl "creating POINT2POINT joint")
235 (Point2PointJoint.
236 control-a
237 control-b
238 pivot-a
239 pivot-b))
241 (defmethod joint-dispatch :hinge
242 [constraints control-a control-b pivot-a pivot-b rotation]
243 (println-repl "creating HINGE joint")
244 (let [axis
245 (if-let
246 [axis (:axis constraints)]
247 axis
248 Vector3f/UNIT_X)
249 [limit-1 limit-2] (:limit constraints)
250 hinge-axis
251 (.mult
252 rotation
253 (blender-to-jme axis))]
254 (doto
255 (HingeJoint.
256 control-a
257 control-b
258 pivot-a
259 pivot-b
260 hinge-axis
261 hinge-axis)
262 (.setLimit limit-1 limit-2))))
264 (defmethod joint-dispatch :cone
265 [constraints control-a control-b pivot-a pivot-b rotation]
266 (let [limit-xz (:limit-xz constraints)
267 limit-xy (:limit-xy constraints)
268 twist (:twist constraints)]
270 (println-repl "creating CONE joint")
271 (println-repl rotation)
272 (println-repl
273 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
274 (println-repl
275 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
276 (println-repl
277 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
278 (doto
279 (ConeJoint.
280 control-a
281 control-b
282 pivot-a
283 pivot-b
284 rotation
285 rotation)
286 (.setLimit (float limit-xz)
287 (float limit-xy)
288 (float twist)))))
290 (defn connect
291 "here are some examples:
292 {:type :point}
293 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
294 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
296 {:type :cone :limit-xz 0]
297 :limit-xy 0]
298 :twist 0]} (use XZY rotation mode in blender!)"
299 [#^Node obj-a #^Node obj-b #^Node joint]
300 (let [control-a (.getControl obj-a RigidBodyControl)
301 control-b (.getControl obj-b RigidBodyControl)
302 joint-center (.getWorldTranslation joint)
303 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
304 pivot-a (world-to-local obj-a joint-center)
305 pivot-b (world-to-local obj-b joint-center)]
307 (if-let [constraints
308 (map-vals
309 eval
310 (read-string
311 (meta-data joint "joint")))]
312 ;; A side-effect of creating a joint registers
313 ;; it with both physics objects which in turn
314 ;; will register the joint with the physics system
315 ;; when the simulation is started.
316 (do
317 (println-repl "creating joint between"
318 (.getName obj-a) "and" (.getName obj-b))
319 (joint-dispatch constraints
320 control-a control-b
321 pivot-a pivot-b
322 joint-rotation))
323 (println-repl "could not find joint meta-data!"))))
325 (defn assemble-creature [#^Node pieces joints]
326 (dorun
327 (map
328 (fn [geom]
329 (let [physics-control
330 (RigidBodyControl.
331 (HullCollisionShape.
332 (.getMesh geom))
333 (if-let [mass (meta-data geom "mass")]
334 (do
335 (println-repl
336 "setting" (.getName geom) "mass to" (float mass))
337 (float mass))
338 (float 1)))]
340 (.addControl geom physics-control)))
341 (filter #(isa? (class %) Geometry )
342 (node-seq pieces))))
343 (dorun
344 (map
345 (fn [joint]
346 (let [[obj-a obj-b]
347 (joint-targets pieces joint)]
348 (connect obj-a obj-b joint)))
349 joints))
350 pieces)
352 (declare blender-creature)
354 (def hand "Models/creature1/one.blend")
356 (def worm "Models/creature1/try-again.blend")
358 (def touch "Models/creature1/touch.blend")
360 (defn worm-model [] (load-blender-model worm))
362 (defn x-ray [#^ColorRGBA color]
363 (doto (Material. (asset-manager)
364 "Common/MatDefs/Misc/Unshaded.j3md")
365 (.setColor "Color" color)
366 (-> (.getAdditionalRenderState)
367 (.setDepthTest false))))
369 (defn colorful []
370 (.getChild (worm-model) "worm-21"))
372 (import jme3tools.converters.ImageToAwt)
374 (import ij.ImagePlus)
376 ;; Every Mesh has many triangles, each with its own index.
377 ;; Every vertex has its own index as well.
379 (defn tactile-sensor-image
380 "Return the touch-sensor distribution image in BufferedImage format,
381 or nil if it does not exist."
382 [#^Geometry obj]
383 (if-let [image-path (meta-data obj "touch")]
384 (ImageToAwt/convert
385 (.getImage
386 (.loadTexture
387 (asset-manager)
388 image-path))
389 false false 0)))
391 (import ij.process.ImageProcessor)
392 (import java.awt.image.BufferedImage)
394 (def white -1)
396 (defn filter-pixels
397 "List the coordinates of all pixels matching pred, within the bounds
398 provided. Bounds -> [x0 y0 width height]"
399 {:author "Dylan Holmes"}
400 ([pred #^BufferedImage image]
401 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
402 ([pred #^BufferedImage image [x0 y0 width height]]
403 ((fn accumulate [x y matches]
404 (cond
405 (>= y (+ height y0)) matches
406 (>= x (+ width x0)) (recur 0 (inc y) matches)
407 (pred (.getRGB image x y))
408 (recur (inc x) y (conj matches [x y]))
409 :else (recur (inc x) y matches)))
410 x0 y0 [])))
412 (defn white-coordinates
413 "Coordinates of all the white pixels in a subset of the image."
414 ([#^BufferedImage image bounds]
415 (filter-pixels #(= % white) image bounds))
416 ([#^BufferedImage image]
417 (filter-pixels #(= % white) image)))
419 (defn triangle
420 "Get the triangle specified by triangle-index from the mesh within
421 bounds."
422 [#^Mesh mesh triangle-index]
423 (let [scratch (Triangle.)]
424 (.getTriangle mesh triangle-index scratch)
425 scratch))
427 (defn triangle-vertex-indices
428 "Get the triangle vertex indices of a given triangle from a given
429 mesh."
430 [#^Mesh mesh triangle-index]
431 (let [indices (int-array 3)]
432 (.getTriangle mesh triangle-index indices)
433 (vec indices)))
435 (defn vertex-UV-coord
436 "Get the uv-coordinates of the vertex named by vertex-index"
437 [#^Mesh mesh vertex-index]
438 (let [UV-buffer
439 (.getData
440 (.getBuffer
441 mesh
442 VertexBuffer$Type/TexCoord))]
443 [(.get UV-buffer (* vertex-index 2))
444 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
446 (defn triangle-UV-coord
447 "Get the uv-cooridnates of the triangle's verticies."
448 [#^Mesh mesh width height triangle-index]
449 (map (fn [[u v]] (vector (* width u) (* height v)))
450 (map (partial vertex-UV-coord mesh)
451 (triangle-vertex-indices mesh triangle-index))))
453 (defn same-side?
454 "Given the points p1 and p2 and the reference point ref, is point p
455 on the same side of the line that goes through p1 and p2 as ref is?"
456 [p1 p2 ref p]
457 (<=
458 0
459 (.dot
460 (.cross (.subtract p2 p1) (.subtract p p1))
461 (.cross (.subtract p2 p1) (.subtract ref p1)))))
463 (defn triangle-seq [#^Triangle tri]
464 [(.get1 tri) (.get2 tri) (.get3 tri)])
466 (defn vector3f-seq [#^Vector3f v]
467 [(.getX v) (.getY v) (.getZ v)])
469 (defn inside-triangle?
470 "Is the point inside the triangle?"
471 {:author "Dylan Holmes"}
472 [#^Triangle tri #^Vector3f p]
473 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
474 (and
475 (same-side? vert-1 vert-2 vert-3 p)
476 (same-side? vert-2 vert-3 vert-1 p)
477 (same-side? vert-3 vert-1 vert-2 p))))
479 (defn triangle->matrix4f
480 "Converts the triangle into a 4x4 matrix: The first three columns
481 contain the vertices of the triangle; the last contains the unit
482 normal of the triangle. The bottom row is filled with 1s."
483 [#^Triangle t]
484 (let [mat (Matrix4f.)
485 [vert-1 vert-2 vert-3]
486 ((comp vec map) #(.get t %) (range 3))
487 unit-normal (do (.calculateNormal t)(.getNormal t))
488 vertices [vert-1 vert-2 vert-3 unit-normal]]
489 (dorun
490 (for [row (range 4) col (range 3)]
491 (do
492 (.set mat col row (.get (vertices row)col))
493 (.set mat 3 row 1))))
494 mat))
496 (defn triangle-transformation
497 "Returns the affine transformation that converts each vertex in the
498 first triangle into the corresponding vertex in the second
499 triangle."
500 [#^Triangle tri-1 #^Triangle tri-2]
501 (.mult
502 (triangle->matrix4f tri-2)
503 (.invert (triangle->matrix4f tri-1))))
505 (defn point->vector2f [[u v]]
506 (Vector2f. u v))
508 (defn vector2f->vector3f [v]
509 (Vector3f. (.getX v) (.getY v) 0))
511 (defn map-triangle [f #^Triangle tri]
512 (Triangle.
513 (f 0 (.get1 tri))
514 (f 1 (.get2 tri))
515 (f 2 (.get3 tri))))
517 (defn points->triangle
518 "Convert a list of points into a triangle."
519 [points]
520 (apply #(Triangle. %1 %2 %3)
521 (map (fn [point]
522 (let [point (vec point)]
523 (Vector3f. (get point 0 0)
524 (get point 1 0)
525 (get point 2 0))))
526 (take 3 points))))
528 (defn convex-bounds
529 "Dimensions of the smallest integer bounding square of the list of
530 2D verticies in the form: [x y width height]."
531 [uv-verts]
532 (let [xs (map first uv-verts)
533 ys (map second uv-verts)
534 x0 (Math/floor (apply min xs))
535 y0 (Math/floor (apply min ys))
536 x1 (Math/ceil (apply max xs))
537 y1 (Math/ceil (apply max ys))]
538 [x0 y0 (- x1 x0) (- y1 y0)]))
540 (defn sensors-in-triangle
541 "Find the locations of the touch sensors within a triangle in both
542 UV and gemoetry relative coordinates."
543 [image mesh tri-index]
544 (let [width (.getWidth image)
545 height (.getHeight image)
546 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
547 bounds (convex-bounds UV-vertex-coords)
549 cutout-triangle (points->triangle UV-vertex-coords)
550 UV-sensor-coords
551 (filter (comp (partial inside-triangle? cutout-triangle)
552 (fn [[u v]] (Vector3f. u v 0)))
553 (white-coordinates image bounds))
554 UV->geometry (triangle-transformation
555 cutout-triangle
556 (triangle mesh tri-index))
557 geometry-sensor-coords
558 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
559 UV-sensor-coords)]
560 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
562 (defn-memo locate-feelers
563 "Search the geometry's tactile UV image for touch sensors, returning
564 their positions in geometry-relative coordinates."
565 [#^Geometry geo]
566 (let [mesh (.getMesh geo)
567 num-triangles (.getTriangleCount mesh)]
568 (if-let [image (tactile-sensor-image geo)]
569 (map
570 (partial sensors-in-triangle image mesh)
571 (range num-triangles))
572 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
574 (use 'clojure.contrib.def)
576 (defn-memo touch-topology [#^Gemoetry geo]
577 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
579 (defn-memo feeler-coordinates [#^Geometry geo]
580 (vec (map :geometry (locate-feelers geo))))
582 (defn enable-touch [#^Geometry geo]
583 (let [feeler-coords (feeler-coordinates geo)
584 tris (triangles geo)
585 limit 0.1
586 ;;results (CollisionResults.)
587 ]
588 (if (empty? (touch-topology geo))
589 nil
590 (fn [node]
591 (let [sensor-origins
592 (map
593 #(map (partial local-to-world geo) %)
594 feeler-coords)
595 triangle-normals
596 (map (partial get-ray-direction geo)
597 tris)
598 rays
599 (flatten
600 (map (fn [origins norm]
601 (map #(doto (Ray. % norm)
602 (.setLimit limit)) origins))
603 sensor-origins triangle-normals))]
604 (vector
605 (touch-topology geo)
606 (vec
607 (for [ray rays]
608 (do
609 (let [results (CollisionResults.)]
610 (.collideWith node ray results)
611 (let [touch-objects
612 (set
613 (filter #(not (= geo %))
614 (map #(.getGeometry %) results)))]
615 (if (> (count touch-objects) 0)
616 1 0))))))))))))
618 (defn touch [#^Node pieces]
619 (filter (comp not nil?)
620 (map enable-touch
621 (filter #(isa? (class %) Geometry)
622 (node-seq pieces)))))
625 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
626 ;; http://en.wikipedia.org/wiki/Retina
628 (defn test-eye []
629 (.getChild
630 (.getChild (worm-model) "eyes")
631 "eye"))
634 (defn retina-sensor-image
635 "Return a map of pixel selection functions to BufferedImages
636 describing the distribution of light-sensitive components on this
637 geometry's surface. Each function creates an integer from the rgb
638 values found in the pixel. :red, :green, :blue, :gray are already
639 defined as extracting the red green blue and average components
640 respectively."
641 [#^Spatial eye]
642 (if-let [eye-map (meta-data eye "eye")]
643 (map-vals
644 #(ImageToAwt/convert
645 (.getImage (.loadTexture (asset-manager) %))
646 false false 0)
647 (eval (read-string eye-map)))))
649 (defn eye-dimensions
650 "returns the width and height specified in the metadata of the eye"
651 [#^Spatial eye]
652 (let [dimensions
653 (map #(vector (.getWidth %) (.getHeight %))
654 (vals (retina-sensor-image eye)))]
655 [(apply max (map first dimensions))
656 (apply max (map second dimensions))]))
659 (defn creature-eyes
660 "The eye nodes which are children of the \"eyes\" node in the
661 creature."
662 [#^Node creature]
663 (if-let [eye-node (.getChild creature "eyes")]
664 (seq (.getChildren eye-node))
665 (do (println-repl "could not find eyes node") [])))
668 ;; Here's how vision will work.
670 ;; Make the continuation in scene-processor take FrameBuffer,
671 ;; byte-buffer, BufferedImage already sized to the correct
672 ;; dimensions. the continuation will decide wether to "mix" them
673 ;; into the BufferedImage, lazily ignore them, or mix them halfway
674 ;; and call c/graphics card routines.
676 ;; (vision creature) will take an optional :skip argument which will
677 ;; inform the continuations in scene processor to skip the given
678 ;; number of cycles; 0 means that no cycles will be skipped.
680 ;; (vision creature) will return [init-functions sensor-functions].
681 ;; The init-functions are each single-arg functions that take the
682 ;; world and register the cameras and must each be called before the
683 ;; corresponding sensor-functions. Each init-function returns the
684 ;; viewport for that eye which can be manipulated, saved, etc. Each
685 ;; sensor-function is a thunk and will return data in the same
686 ;; format as the tactile-sensor functions; the structure is
687 ;; [topology, sensor-data]. Internally, these sensor-functions
688 ;; maintain a reference to sensor-data which is periodically updated
689 ;; by the continuation function established by its init-function.
690 ;; They can be queried every cycle, but their information may not
691 ;; necessairly be different every cycle.
693 ;; Each eye in the creature in blender will work the same way as
694 ;; joints -- a one dimensional object with no geometry whose local
695 ;; coordinate system determines the orientation of the resulting
696 ;; eye. All eyes will have a parent named "eyes" just as all joints
697 ;; have a parent named "joints". The resulting camera will be a
698 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
699 ;; the eye marker. The eye marker will contain the metadata for the
700 ;; eye, and will be moved by it's bound geometry. The dimensions of
701 ;; the eye's camera are equal to the dimensions of the eye's "UV"
702 ;; map.
704 (defn eye-target
705 "The closest object in creature to eye."
706 [#^Node creature #^Node eye]
707 (loop [radius (float 0.01)]
708 (let [results (CollisionResults.)]
709 (.collideWith
710 creature
711 (BoundingBox. (.getWorldTranslation eye)
712 radius radius radius)
713 results)
714 (if-let [target (first results)]
715 (.getGeometry target)
716 (recur (float (* 2 radius)))))))
718 (defn bind-camera
719 "Bind the camera to the Spatial such that it will maintain its
720 current position relative to the Spatial no matter how the spatial
721 moves."
722 [#^Spatial obj #^Camera cam]
723 (let [cam-offset (.subtract (.getLocation cam)
724 (.getWorldTranslation obj))
725 initial-cam-rotation (Quaternion. (.getRotation cam))
726 base-anti-rotation (.inverse (.getWorldRotation obj))]
727 (.addControl
728 obj
729 (proxy [AbstractControl] []
730 (controlUpdate [tpf]
731 (let [total-rotation
732 (.mult base-anti-rotation (.getWorldRotation obj))]
733 (.setLocation cam
734 (.add
735 (.mult total-rotation cam-offset)
736 (.getWorldTranslation obj)))
737 (.setRotation cam
738 (.mult total-rotation initial-cam-rotation))))
739 (controlRender [_ _])))))
742 (defn attach-eye
743 "Attach a Camera to the appropiate area and return the Camera."
744 [#^Node creature #^Spatial eye]
746 (let [target (eye-target creature eye)
747 [cam-width cam-height] (eye-dimensions eye)
748 cam (Camera. cam-width cam-height)]
749 (.setLocation cam (.getWorldTranslation eye))
750 (.setRotation cam (.getWorldRotation eye))
751 (.setFrustumPerspective
752 cam 45 (/ (.getWidth cam) (.getHeight cam))
753 1 1000)
755 (bind-camera target cam)
756 cam))
759 (def presets
760 {:all 0xFFFFFF
761 :red 0xFF0000
762 :blue 0x0000FF
763 :green 0x00FF00})
767 (defn enable-vision
768 "return [init-function sensor-functions] for a particular eye"
769 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
770 (let [retinal-map (retina-sensor-image eye)
771 vision-image (atom nil)
772 camera (attach-eye creature eye)]
773 [
774 (fn [world]
775 (add-eye
776 world camera
777 (let [counter (atom 0)]
778 (fn [r fb bb bi]
779 (if (zero? (rem (swap! counter inc) (inc skip)))
780 (reset! vision-image (BufferedImage! r fb bb bi)))))))
781 (vec
782 (map
783 (fn [[key image]]
784 (let [whites (white-coordinates image)
785 topology (vec (collapse whites))
786 mask (presets key)]
787 (fn []
788 (vector
789 topology
790 (vec
791 (for [[x y] whites]
792 (bit-and
793 mask (.getRGB @vision-image x y))))))))
794 retinal-map))
795 ]))
797 (defn vision
798 [#^Node creature & {skip :skip :or {skip 0}}]
800 (reduce
801 (fn [[init-a senses-a]
802 [init-b senses-b]]
803 [(conj init-a init-b)
804 (into senses-a senses-b)])
805 [[][]]
806 (for [eye (creature-eyes creature)]
807 (enable-vision creature eye))))
810 (defn blender-creature
811 "Return a creature with all joints in place."
812 [blender-path]
813 (let [model (load-blender-model blender-path)
814 joints
815 (if-let [joint-node (.getChild model "joints")]
816 (seq (.getChildren joint-node))
817 (do (println-repl "could not find joints node") []))]
818 (assemble-creature model joints)))
820 (defn debug-window
821 "creates function that offers a debug view of sensor data"
822 []
823 (let [vi (view-image)]
824 (fn
825 [[coords sensor-data]]
826 (let [image (points->image coords)]
827 (dorun
828 (for [i (range (count coords))]
829 (.setRGB image ((coords i) 0) ((coords i) 1)
830 ({0 -16777216
831 1 -1} (sensor-data i)))))
832 (vi image)))))
834 (defn debug-vision-window
835 "creates function that offers a debug view of sensor data"
836 []
837 (let [vi (view-image)]
838 (fn
839 [[coords sensor-data]]
840 (let [image (points->image coords)]
841 (dorun
842 (for [i (range (count coords))]
843 (.setRGB image ((coords i) 0) ((coords i) 1)
844 (sensor-data i))))
845 (vi image)))))
847 ;;(defn test-touch [world creature]
850 (defn test-creature [thing]
851 (let [x-axis
852 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
853 y-axis
854 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
855 z-axis
856 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
857 creature (blender-creature thing)
858 touch-nerves (touch creature)
859 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
860 [init-vision-fns vision-data] (vision creature)
861 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
862 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
863 ]
864 (world
865 (nodify [creature
866 (box 10 2 10 :position (Vector3f. 0 -9 0)
867 :color ColorRGBA/Gray :mass 0)
868 x-axis y-axis z-axis
869 me
870 ])
871 standard-debug-controls
872 (fn [world]
873 (light-up-everything world)
874 (enable-debug world)
875 (dorun (map #(% world) init-vision-fns))
877 (add-eye world
878 (attach-eye creature (test-eye))
879 (comp (view-image) BufferedImage!))
881 (add-eye world (.getCamera world) no-op)
883 ;;(com.aurellem.capture.Capture/captureVideo
884 ;; world (file-str "/home/r/proj/ai-videos/hand"))
885 ;;(.setTimer world (RatchetTimer. 60))
886 (speed-up world)
887 ;;(set-gravity world (Vector3f. 0 0 0))
888 )
889 (fn [world tpf]
890 ;;(dorun
891 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
893 (dorun
894 (map #(%1 (%2 (.getRootNode world)))
895 touch-debug-windows touch-nerves))
896 (dorun
897 (map #(%1 (%2))
898 vision-debug vision-data))
900 ;;(println-repl (vision-data))
901 (.setLocalTranslation me (.getLocation (.getCamera world)))
904 )
905 ;;(let [timer (atom 0)]
906 ;; (fn [_ _]
907 ;; (swap! timer inc)
908 ;; (if (= (rem @timer 60) 0)
909 ;; (println-repl (float (/ @timer 60))))))
910 )))
920 ;;; experiments in collisions
924 (defn collision-test []
925 (let [b-radius 1
926 b-position (Vector3f. 0 0 0)
927 obj-b (box 1 1 1 :color ColorRGBA/Blue
928 :position b-position
929 :mass 0)
930 node (nodify [obj-b])
931 bounds-b
932 (doto (Picture.)
933 (.setHeight 50)
934 (.setWidth 50)
935 (.setImage (asset-manager)
936 "Models/creature1/hand.png"
937 false
938 ))
940 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
942 collisions
943 (let [cr (CollisionResults.)]
944 (.collideWith node bounds-b cr)
945 (println (map #(.getContactPoint %) cr))
946 cr)
948 ;;collision-points
949 ;;(map #(sphere 0.1 :position (.getContactPoint %))
950 ;; collisions)
952 ;;node (nodify (conj collision-points obj-b))
954 sim
955 (world node
956 {"key-space"
957 (fn [_ value]
958 (if value
959 (let [cr (CollisionResults.)]
960 (.collideWith node bounds-b cr)
961 (println-repl (map #(.getContactPoint %) cr))
962 cr)))}
963 no-op
964 no-op)
966 ]
967 sim
969 ))
972 ;; the camera will stay in its initial position/rotation with relation
973 ;; to the spatial.
976 (defn follow-test
977 "show a camera that stays in the same relative position to a blue cube."
978 []
979 (let [camera-pos (Vector3f. 0 30 0)
980 rock (box 1 1 1 :color ColorRGBA/Blue
981 :position (Vector3f. 0 10 0)
982 :mass 30
983 )
984 rot (.getWorldRotation rock)
986 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
987 :position (Vector3f. 0 -3 0))]
989 (world
990 (nodify [rock table])
991 standard-debug-controls
992 (fn [world]
993 (let
994 [cam (doto (.clone (.getCamera world))
995 (.setLocation camera-pos)
996 (.lookAt Vector3f/ZERO
997 Vector3f/UNIT_X))]
998 (bind-camera rock cam)
1000 (.setTimer world (RatchetTimer. 60))
1001 (add-eye world cam (comp (view-image) BufferedImage!))
1002 (add-eye world (.getCamera world) no-op))
1004 (fn [_ _] (println-repl rot)))))
1007 #+end_src
1009 #+results: body-1
1010 : #'cortex.silly/test-creature
1013 * COMMENT purgatory
1014 #+begin_src clojure
1015 (defn bullet-trans []
1016 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1017 :position (Vector3f. -10 5 0))
1018 obj-b (sphere 0.5 :color ColorRGBA/Blue
1019 :position (Vector3f. -10 -5 0)
1020 :mass 0)
1021 control-a (.getControl obj-a RigidBodyControl)
1022 control-b (.getControl obj-b RigidBodyControl)
1023 swivel
1024 (.toRotationMatrix
1025 (doto (Quaternion.)
1026 (.fromAngleAxis (/ Math/PI 2)
1027 Vector3f/UNIT_X)))]
1028 (doto
1029 (ConeJoint.
1030 control-a control-b
1031 (Vector3f. 0 5 0)
1032 (Vector3f. 0 -5 0)
1033 swivel swivel)
1034 (.setLimit (* 0.6 (/ Math/PI 4))
1035 (/ Math/PI 4)
1036 (* Math/PI 0.8)))
1037 (world (nodify
1038 [obj-a obj-b])
1039 standard-debug-controls
1040 enable-debug
1041 no-op)))
1044 (defn bullet-trans* []
1045 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1046 :position (Vector3f. 5 0 0)
1047 :mass 90)
1048 obj-b (sphere 0.5 :color ColorRGBA/Blue
1049 :position (Vector3f. -5 0 0)
1050 :mass 0)
1051 control-a (.getControl obj-a RigidBodyControl)
1052 control-b (.getControl obj-b RigidBodyControl)
1053 move-up? (atom nil)
1054 move-down? (atom nil)
1055 move-left? (atom nil)
1056 move-right? (atom nil)
1057 roll-left? (atom nil)
1058 roll-right? (atom nil)
1059 force 100
1060 swivel
1061 (.toRotationMatrix
1062 (doto (Quaternion.)
1063 (.fromAngleAxis (/ Math/PI 2)
1064 Vector3f/UNIT_X)))
1065 x-move
1066 (doto (Matrix3f.)
1067 (.fromStartEndVectors Vector3f/UNIT_X
1068 (.normalize (Vector3f. 1 1 0))))
1070 timer (atom 0)]
1071 (doto
1072 (ConeJoint.
1073 control-a control-b
1074 (Vector3f. -8 0 0)
1075 (Vector3f. 2 0 0)
1076 ;;swivel swivel
1077 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1078 x-move Matrix3f/IDENTITY
1080 (.setCollisionBetweenLinkedBodys false)
1081 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1082 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1083 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1084 (world (nodify
1085 [obj-a obj-b])
1086 (merge standard-debug-controls
1087 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1088 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1089 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1090 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1091 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1092 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1094 (fn [world]
1095 (enable-debug world)
1096 (set-gravity world Vector3f/ZERO)
1099 (fn [world _]
1101 (if @move-up?
1102 (.applyForce control-a
1103 (Vector3f. force 0 0)
1104 (Vector3f. 0 0 0)))
1105 (if @move-down?
1106 (.applyForce control-a
1107 (Vector3f. (- force) 0 0)
1108 (Vector3f. 0 0 0)))
1109 (if @move-left?
1110 (.applyForce control-a
1111 (Vector3f. 0 force 0)
1112 (Vector3f. 0 0 0)))
1113 (if @move-right?
1114 (.applyForce control-a
1115 (Vector3f. 0 (- force) 0)
1116 (Vector3f. 0 0 0)))
1118 (if @roll-left?
1119 (.applyForce control-a
1120 (Vector3f. 0 0 force)
1121 (Vector3f. 0 0 0)))
1122 (if @roll-right?
1123 (.applyForce control-a
1124 (Vector3f. 0 0 (- force))
1125 (Vector3f. 0 0 0)))
1127 (if (zero? (rem (swap! timer inc) 100))
1128 (.attachChild
1129 (.getRootNode world)
1130 (sphere 0.05 :color ColorRGBA/Yellow
1131 :physical? false :position
1132 (.getWorldTranslation obj-a)))))
1134 ))
1136 (defn transform-trianglesdsd
1137 "Transform that converts each vertex in the first triangle
1138 into the corresponding vertex in the second triangle."
1139 [#^Triangle tri-1 #^Triangle tri-2]
1140 (let [in [(.get1 tri-1)
1141 (.get2 tri-1)
1142 (.get3 tri-1)]
1143 out [(.get1 tri-2)
1144 (.get2 tri-2)
1145 (.get3 tri-2)]]
1146 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1147 in* [(.mult translate (in 0))
1148 (.mult translate (in 1))
1149 (.mult translate (in 2))]
1150 final-translation
1151 (doto (Matrix4f.)
1152 (.setTranslation (out 1)))
1154 rotate-1
1155 (doto (Matrix3f.)
1156 (.fromStartEndVectors
1157 (.normalize
1158 (.subtract
1159 (in* 1) (in* 0)))
1160 (.normalize
1161 (.subtract
1162 (out 1) (out 0)))))
1163 in** [(.mult rotate-1 (in* 0))
1164 (.mult rotate-1 (in* 1))
1165 (.mult rotate-1 (in* 2))]
1166 scale-factor-1
1167 (.mult
1168 (.normalize
1169 (.subtract
1170 (out 1)
1171 (out 0)))
1172 (/ (.length
1173 (.subtract (out 1)
1174 (out 0)))
1175 (.length
1176 (.subtract (in** 1)
1177 (in** 0)))))
1178 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1179 in*** [(.mult scale-1 (in** 0))
1180 (.mult scale-1 (in** 1))
1181 (.mult scale-1 (in** 2))]
1189 (dorun (map println in))
1190 (println)
1191 (dorun (map println in*))
1192 (println)
1193 (dorun (map println in**))
1194 (println)
1195 (dorun (map println in***))
1196 (println)
1198 ))))
1201 (defn world-setup [joint]
1202 (let [joint-position (Vector3f. 0 0 0)
1203 joint-rotation
1204 (.toRotationMatrix
1205 (.mult
1206 (doto (Quaternion.)
1207 (.fromAngleAxis
1208 (* 1 (/ Math/PI 4))
1209 (Vector3f. -1 0 0)))
1210 (doto (Quaternion.)
1211 (.fromAngleAxis
1212 (* 1 (/ Math/PI 2))
1213 (Vector3f. 0 0 1)))))
1214 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1216 origin (doto
1217 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1218 :position top-position))
1219 top (doto
1220 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1221 :position top-position)
1223 (.addControl
1224 (RigidBodyControl.
1225 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1226 bottom (doto
1227 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1228 :position (Vector3f. 0 0 0))
1229 (.addControl
1230 (RigidBodyControl.
1231 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1232 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1233 :color ColorRGBA/Gray :mass 0)
1234 a (.getControl top RigidBodyControl)
1235 b (.getControl bottom RigidBodyControl)]
1237 (cond
1238 (= joint :cone)
1240 (doto (ConeJoint.
1241 a b
1242 (world-to-local top joint-position)
1243 (world-to-local bottom joint-position)
1244 joint-rotation
1245 joint-rotation
1249 (.setLimit (* (/ 10) Math/PI)
1250 (* (/ 4) Math/PI)
1251 0)))
1252 [origin top bottom table]))
1254 (defn test-joint [joint]
1255 (let [[origin top bottom floor] (world-setup joint)
1256 control (.getControl top RigidBodyControl)
1257 move-up? (atom false)
1258 move-down? (atom false)
1259 move-left? (atom false)
1260 move-right? (atom false)
1261 roll-left? (atom false)
1262 roll-right? (atom false)
1263 timer (atom 0)]
1265 (world
1266 (nodify [top bottom floor origin])
1267 (merge standard-debug-controls
1268 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1269 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1270 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1271 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1272 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1273 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1275 (fn [world]
1276 (light-up-everything world)
1277 (enable-debug world)
1278 (set-gravity world (Vector3f. 0 0 0))
1281 (fn [world _]
1282 (if (zero? (rem (swap! timer inc) 100))
1283 (do
1284 ;; (println-repl @timer)
1285 (.attachChild (.getRootNode world)
1286 (sphere 0.05 :color ColorRGBA/Yellow
1287 :position (.getWorldTranslation top)
1288 :physical? false))
1289 (.attachChild (.getRootNode world)
1290 (sphere 0.05 :color ColorRGBA/LightGray
1291 :position (.getWorldTranslation bottom)
1292 :physical? false))))
1294 (if @move-up?
1295 (.applyTorque control
1296 (.mult (.getPhysicsRotation control)
1297 (Vector3f. 0 0 10))))
1298 (if @move-down?
1299 (.applyTorque control
1300 (.mult (.getPhysicsRotation control)
1301 (Vector3f. 0 0 -10))))
1302 (if @move-left?
1303 (.applyTorque control
1304 (.mult (.getPhysicsRotation control)
1305 (Vector3f. 0 10 0))))
1306 (if @move-right?
1307 (.applyTorque control
1308 (.mult (.getPhysicsRotation control)
1309 (Vector3f. 0 -10 0))))
1310 (if @roll-left?
1311 (.applyTorque control
1312 (.mult (.getPhysicsRotation control)
1313 (Vector3f. -1 0 0))))
1314 (if @roll-right?
1315 (.applyTorque control
1316 (.mult (.getPhysicsRotation control)
1317 (Vector3f. 1 0 0))))))))
1321 (defprotocol Frame
1322 (frame [this]))
1324 (extend-type BufferedImage
1325 Frame
1326 (frame [image]
1327 (merge
1328 (apply
1329 hash-map
1330 (interleave
1331 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1332 (vector x y)))
1333 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1334 (let [data (.getRGB image x y)]
1335 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1336 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1337 :b (bit-and 0x0000ff data)))))))
1338 {:width (.getWidth image) :height (.getHeight image)})))
1341 (extend-type ImagePlus
1342 Frame
1343 (frame [image+]
1344 (frame (.getBufferedImage image+))))
1347 #+end_src
1350 * COMMENT generate source
1351 #+begin_src clojure :tangle ../src/cortex/silly.clj
1352 <<body-1>>
1353 #+end_src