view org/test-creature.org @ 119:ebfd62779ab4

color selection enabled
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Jan 2012 08:30:28 -0700
parents 1261444da2c7
children 83e638955e89
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 (read-string
648 eye-map))))
650 (defn eye-dimensions
651 "returns the width and height specified in the metadata of the eye"
652 [#^Spatial eye]
653 (let [dimensions
654 (map #(vector (.getWidth %) (.getHeight %))
655 (vals (retina-sensor-image eye)))]
656 [(apply max (map first dimensions))
657 (apply max (map second dimensions))]))
660 (defn creature-eyes
661 "The eye nodes which are children of the \"eyes\" node in the
662 creature."
663 [#^Node creature]
664 (if-let [eye-node (.getChild creature "eyes")]
665 (seq (.getChildren eye-node))
666 (do (println-repl "could not find eyes node") [])))
669 ;; Here's how vision will work.
671 ;; Make the continuation in scene-processor take FrameBuffer,
672 ;; byte-buffer, BufferedImage already sized to the correct
673 ;; dimensions. the continuation will decide wether to "mix" them
674 ;; into the BufferedImage, lazily ignore them, or mix them halfway
675 ;; and call c/graphics card routines.
677 ;; (vision creature) will take an optional :skip argument which will
678 ;; inform the continuations in scene processor to skip the given
679 ;; number of cycles; 0 means that no cycles will be skipped.
681 ;; (vision creature) will return [init-functions sensor-functions].
682 ;; The init-functions are each single-arg functions that take the
683 ;; world and register the cameras and must each be called before the
684 ;; corresponding sensor-functions. Each init-function returns the
685 ;; viewport for that eye which can be manipulated, saved, etc. Each
686 ;; sensor-function is a thunk and will return data in the same
687 ;; format as the tactile-sensor functions; the structure is
688 ;; [topology, sensor-data]. Internally, these sensor-functions
689 ;; maintain a reference to sensor-data which is periodically updated
690 ;; by the continuation function established by its init-function.
691 ;; They can be queried every cycle, but their information may not
692 ;; necessairly be different every cycle.
694 ;; Each eye in the creature in blender will work the same way as
695 ;; joints -- a one dimensional object with no geometry whose local
696 ;; coordinate system determines the orientation of the resulting
697 ;; eye. All eyes will have a parent named "eyes" just as all joints
698 ;; have a parent named "joints". The resulting camera will be a
699 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
700 ;; the eye marker. The eye marker will contain the metadata for the
701 ;; eye, and will be moved by it's bound geometry. The dimensions of
702 ;; the eye's camera are equal to the dimensions of the eye's "UV"
703 ;; map.
705 (defn eye-target
706 "The closest object in creature to eye."
707 [#^Node creature #^Node eye]
708 (loop [radius (float 0.01)]
709 (let [results (CollisionResults.)]
710 (.collideWith
711 creature
712 (BoundingBox. (.getWorldTranslation eye)
713 radius radius radius)
714 results)
715 (if-let [target (first results)]
716 (.getGeometry target)
717 (recur (float (* 2 radius)))))))
719 (defn bind-camera
720 "Bind the camera to the Spatial such that it will maintain its
721 current position relative to the Spatial no matter how the spatial
722 moves."
723 [#^Spatial obj #^Camera cam]
724 (let [cam-offset (.subtract (.getLocation cam)
725 (.getWorldTranslation obj))
726 initial-cam-rotation (Quaternion. (.getRotation cam))
727 base-anti-rotation (.inverse (.getWorldRotation obj))]
728 (.addControl
729 obj
730 (proxy [AbstractControl] []
731 (controlUpdate [tpf]
732 (let [total-rotation
733 (.mult base-anti-rotation (.getWorldRotation obj))]
734 (.setLocation cam
735 (.add
736 (.mult total-rotation cam-offset)
737 (.getWorldTranslation obj)))
738 (.setRotation cam
739 (.mult total-rotation initial-cam-rotation))))
740 (controlRender [_ _])))))
743 (defn attach-eye
744 "Attach a Camera to the appropiate area and return the Camera."
745 [#^Node creature #^Spatial eye]
747 (let [target (eye-target creature eye)
748 [cam-width cam-height] (eye-dimensions eye)
749 cam (Camera. cam-width cam-height)]
750 (.setLocation cam (.getWorldTranslation eye))
751 (.setRotation cam (.getWorldRotation eye))
752 (.setFrustumPerspective
753 cam 45 (/ (.getWidth cam) (.getHeight cam))
754 1 1000)
756 (bind-camera target cam)
757 cam))
760 (def presets
761 {:all 0x000000
762 :red 0xFF0000
763 :blue 0x0000FF
764 :green 0x00FF00})
768 (defn enable-vision
769 "return [init-function sensor-functions] for a particular eye"
770 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
771 (let [retinal-map (retina-sensor-image eye)
772 vision-image (atom nil)
773 camera (attach-eye creature eye)]
774 [
775 (fn [world]
776 (add-eye
777 world camera
778 (let [counter (atom 0)]
779 (fn [r fb bb bi]
780 (if (zero? (rem (swap! counter inc) (inc skip)))
781 (reset! vision-image (BufferedImage! r fb bb bi)))))))
782 (vec
783 (map
784 (fn [[key image]]
785 (let [whites (white-coordinates image)
786 topology (vec (collapse whites))
787 mask (presets key)]
788 (fn []
789 (vector
790 topology
791 (vec
792 (for [[x y] whites]
793 (bit-xor
794 mask (.getRGB @vision-image x y))))))))
795 retinal-map))
796 ]))
798 (defn vision
800 ;; need to create a camera based on UV image,
801 ;; update this camera every frame based on the position of this
802 ;; geometry. (maybe can get cam to follow the object)
804 ;; use a stack for the continuation to grab the image.
807 [#^Geometry eye]
812 )
815 (defn blender-creature
816 "Return a creature with all joints in place."
817 [blender-path]
818 (let [model (load-blender-model blender-path)
819 joints
820 (if-let [joint-node (.getChild model "joints")]
821 (seq (.getChildren joint-node))
822 (do (println-repl "could not find joints node") []))]
823 (assemble-creature model joints)))
830 (defn debug-window
831 "creates function that offers a debug view of sensor data"
832 []
833 (let [vi (view-image)]
834 (fn
835 [[coords sensor-data]]
836 (let [image (points->image coords)]
837 (dorun
838 (for [i (range (count coords))]
839 (.setRGB image ((coords i) 0) ((coords i) 1)
840 ({0 -16777216
841 1 -1} (sensor-data i)))))
842 (vi image)))))
844 (defn debug-vision-window
845 "creates function that offers a debug view of sensor data"
846 []
847 (let [vi (view-image)]
848 (fn
849 [[coords sensor-data]]
850 (let [image (points->image coords)]
851 (dorun
852 (for [i (range (count coords))]
853 (.setRGB image ((coords i) 0) ((coords i) 1)
854 (sensor-data i))))
855 (vi image)))))
859 ;;(defn test-touch [world creature]
862 (defn test-creature [thing]
863 (let [x-axis
864 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
865 y-axis
866 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
867 z-axis
868 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
869 creature (blender-creature thing)
870 touch-nerves (touch creature)
871 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
872 [init-vision [vision-data]]
873 (enable-vision creature (test-eye))
874 vision-debug (debug-vision-window)
875 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
876 ]
877 (world
878 (nodify [creature
879 (box 10 2 10 :position (Vector3f. 0 -9 0)
880 :color ColorRGBA/Gray :mass 0)
881 x-axis y-axis z-axis
882 me
883 ])
884 standard-debug-controls
885 (fn [world]
886 (light-up-everything world)
887 (enable-debug world)
888 (init-vision world)
890 (add-eye world
891 (attach-eye creature (test-eye))
892 (comp (view-image) BufferedImage!))
894 (add-eye world (.getCamera world) no-op)
896 ;;(com.aurellem.capture.Capture/captureVideo
897 ;; world (file-str "/home/r/proj/ai-videos/hand"))
898 ;;(.setTimer world (RatchetTimer. 60))
899 (speed-up world)
900 ;;(set-gravity world (Vector3f. 0 0 0))
901 )
902 (fn [world tpf]
903 ;;(dorun
904 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
906 (dorun
907 (map #(%1 (%2 (.getRootNode world)))
908 touch-debug-windows touch-nerves)
909 )
910 ;;(println-repl (vision-data))
911 (.setLocalTranslation me (.getLocation (.getCamera world)))
913 (vision-debug (vision-data))
914 )
915 ;;(let [timer (atom 0)]
916 ;; (fn [_ _]
917 ;; (swap! timer inc)
918 ;; (if (= (rem @timer 60) 0)
919 ;; (println-repl (float (/ @timer 60))))))
920 )))
930 ;;; experiments in collisions
934 (defn collision-test []
935 (let [b-radius 1
936 b-position (Vector3f. 0 0 0)
937 obj-b (box 1 1 1 :color ColorRGBA/Blue
938 :position b-position
939 :mass 0)
940 node (nodify [obj-b])
941 bounds-b
942 (doto (Picture.)
943 (.setHeight 50)
944 (.setWidth 50)
945 (.setImage (asset-manager)
946 "Models/creature1/hand.png"
947 false
948 ))
950 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
952 collisions
953 (let [cr (CollisionResults.)]
954 (.collideWith node bounds-b cr)
955 (println (map #(.getContactPoint %) cr))
956 cr)
958 ;;collision-points
959 ;;(map #(sphere 0.1 :position (.getContactPoint %))
960 ;; collisions)
962 ;;node (nodify (conj collision-points obj-b))
964 sim
965 (world node
966 {"key-space"
967 (fn [_ value]
968 (if value
969 (let [cr (CollisionResults.)]
970 (.collideWith node bounds-b cr)
971 (println-repl (map #(.getContactPoint %) cr))
972 cr)))}
973 no-op
974 no-op)
976 ]
977 sim
979 ))
982 ;; the camera will stay in its initial position/rotation with relation
983 ;; to the spatial.
986 (defn follow-test
987 "show a camera that stays in the same relative position to a blue cube."
988 []
989 (let [camera-pos (Vector3f. 0 30 0)
990 rock (box 1 1 1 :color ColorRGBA/Blue
991 :position (Vector3f. 0 10 0)
992 :mass 30
993 )
994 rot (.getWorldRotation rock)
996 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
997 :position (Vector3f. 0 -3 0))]
999 (world
1000 (nodify [rock table])
1001 standard-debug-controls
1002 (fn [world]
1003 (let
1004 [cam (doto (.clone (.getCamera world))
1005 (.setLocation camera-pos)
1006 (.lookAt Vector3f/ZERO
1007 Vector3f/UNIT_X))]
1008 (bind-camera rock cam)
1010 (.setTimer world (RatchetTimer. 60))
1011 (add-eye world cam (comp (view-image) BufferedImage!))
1012 (add-eye world (.getCamera world) no-op))
1014 (fn [_ _] (println-repl rot)))))
1017 #+end_src
1019 #+results: body-1
1020 : #'cortex.silly/test-creature
1023 * COMMENT purgatory
1024 #+begin_src clojure
1025 (defn bullet-trans []
1026 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1027 :position (Vector3f. -10 5 0))
1028 obj-b (sphere 0.5 :color ColorRGBA/Blue
1029 :position (Vector3f. -10 -5 0)
1030 :mass 0)
1031 control-a (.getControl obj-a RigidBodyControl)
1032 control-b (.getControl obj-b RigidBodyControl)
1033 swivel
1034 (.toRotationMatrix
1035 (doto (Quaternion.)
1036 (.fromAngleAxis (/ Math/PI 2)
1037 Vector3f/UNIT_X)))]
1038 (doto
1039 (ConeJoint.
1040 control-a control-b
1041 (Vector3f. 0 5 0)
1042 (Vector3f. 0 -5 0)
1043 swivel swivel)
1044 (.setLimit (* 0.6 (/ Math/PI 4))
1045 (/ Math/PI 4)
1046 (* Math/PI 0.8)))
1047 (world (nodify
1048 [obj-a obj-b])
1049 standard-debug-controls
1050 enable-debug
1051 no-op)))
1054 (defn bullet-trans* []
1055 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1056 :position (Vector3f. 5 0 0)
1057 :mass 90)
1058 obj-b (sphere 0.5 :color ColorRGBA/Blue
1059 :position (Vector3f. -5 0 0)
1060 :mass 0)
1061 control-a (.getControl obj-a RigidBodyControl)
1062 control-b (.getControl obj-b RigidBodyControl)
1063 move-up? (atom nil)
1064 move-down? (atom nil)
1065 move-left? (atom nil)
1066 move-right? (atom nil)
1067 roll-left? (atom nil)
1068 roll-right? (atom nil)
1069 force 100
1070 swivel
1071 (.toRotationMatrix
1072 (doto (Quaternion.)
1073 (.fromAngleAxis (/ Math/PI 2)
1074 Vector3f/UNIT_X)))
1075 x-move
1076 (doto (Matrix3f.)
1077 (.fromStartEndVectors Vector3f/UNIT_X
1078 (.normalize (Vector3f. 1 1 0))))
1080 timer (atom 0)]
1081 (doto
1082 (ConeJoint.
1083 control-a control-b
1084 (Vector3f. -8 0 0)
1085 (Vector3f. 2 0 0)
1086 ;;swivel swivel
1087 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1088 x-move Matrix3f/IDENTITY
1090 (.setCollisionBetweenLinkedBodys false)
1091 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1092 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1093 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1094 (world (nodify
1095 [obj-a obj-b])
1096 (merge standard-debug-controls
1097 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1098 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1099 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1100 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1101 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1102 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1104 (fn [world]
1105 (enable-debug world)
1106 (set-gravity world Vector3f/ZERO)
1109 (fn [world _]
1111 (if @move-up?
1112 (.applyForce control-a
1113 (Vector3f. force 0 0)
1114 (Vector3f. 0 0 0)))
1115 (if @move-down?
1116 (.applyForce control-a
1117 (Vector3f. (- force) 0 0)
1118 (Vector3f. 0 0 0)))
1119 (if @move-left?
1120 (.applyForce control-a
1121 (Vector3f. 0 force 0)
1122 (Vector3f. 0 0 0)))
1123 (if @move-right?
1124 (.applyForce control-a
1125 (Vector3f. 0 (- force) 0)
1126 (Vector3f. 0 0 0)))
1128 (if @roll-left?
1129 (.applyForce control-a
1130 (Vector3f. 0 0 force)
1131 (Vector3f. 0 0 0)))
1132 (if @roll-right?
1133 (.applyForce control-a
1134 (Vector3f. 0 0 (- force))
1135 (Vector3f. 0 0 0)))
1137 (if (zero? (rem (swap! timer inc) 100))
1138 (.attachChild
1139 (.getRootNode world)
1140 (sphere 0.05 :color ColorRGBA/Yellow
1141 :physical? false :position
1142 (.getWorldTranslation obj-a)))))
1144 ))
1146 (defn transform-trianglesdsd
1147 "Transform that converts each vertex in the first triangle
1148 into the corresponding vertex in the second triangle."
1149 [#^Triangle tri-1 #^Triangle tri-2]
1150 (let [in [(.get1 tri-1)
1151 (.get2 tri-1)
1152 (.get3 tri-1)]
1153 out [(.get1 tri-2)
1154 (.get2 tri-2)
1155 (.get3 tri-2)]]
1156 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1157 in* [(.mult translate (in 0))
1158 (.mult translate (in 1))
1159 (.mult translate (in 2))]
1160 final-translation
1161 (doto (Matrix4f.)
1162 (.setTranslation (out 1)))
1164 rotate-1
1165 (doto (Matrix3f.)
1166 (.fromStartEndVectors
1167 (.normalize
1168 (.subtract
1169 (in* 1) (in* 0)))
1170 (.normalize
1171 (.subtract
1172 (out 1) (out 0)))))
1173 in** [(.mult rotate-1 (in* 0))
1174 (.mult rotate-1 (in* 1))
1175 (.mult rotate-1 (in* 2))]
1176 scale-factor-1
1177 (.mult
1178 (.normalize
1179 (.subtract
1180 (out 1)
1181 (out 0)))
1182 (/ (.length
1183 (.subtract (out 1)
1184 (out 0)))
1185 (.length
1186 (.subtract (in** 1)
1187 (in** 0)))))
1188 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1189 in*** [(.mult scale-1 (in** 0))
1190 (.mult scale-1 (in** 1))
1191 (.mult scale-1 (in** 2))]
1199 (dorun (map println in))
1200 (println)
1201 (dorun (map println in*))
1202 (println)
1203 (dorun (map println in**))
1204 (println)
1205 (dorun (map println in***))
1206 (println)
1208 ))))
1211 (defn world-setup [joint]
1212 (let [joint-position (Vector3f. 0 0 0)
1213 joint-rotation
1214 (.toRotationMatrix
1215 (.mult
1216 (doto (Quaternion.)
1217 (.fromAngleAxis
1218 (* 1 (/ Math/PI 4))
1219 (Vector3f. -1 0 0)))
1220 (doto (Quaternion.)
1221 (.fromAngleAxis
1222 (* 1 (/ Math/PI 2))
1223 (Vector3f. 0 0 1)))))
1224 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1226 origin (doto
1227 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1228 :position top-position))
1229 top (doto
1230 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1231 :position top-position)
1233 (.addControl
1234 (RigidBodyControl.
1235 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1236 bottom (doto
1237 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1238 :position (Vector3f. 0 0 0))
1239 (.addControl
1240 (RigidBodyControl.
1241 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1242 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1243 :color ColorRGBA/Gray :mass 0)
1244 a (.getControl top RigidBodyControl)
1245 b (.getControl bottom RigidBodyControl)]
1247 (cond
1248 (= joint :cone)
1250 (doto (ConeJoint.
1251 a b
1252 (world-to-local top joint-position)
1253 (world-to-local bottom joint-position)
1254 joint-rotation
1255 joint-rotation
1259 (.setLimit (* (/ 10) Math/PI)
1260 (* (/ 4) Math/PI)
1261 0)))
1262 [origin top bottom table]))
1264 (defn test-joint [joint]
1265 (let [[origin top bottom floor] (world-setup joint)
1266 control (.getControl top RigidBodyControl)
1267 move-up? (atom false)
1268 move-down? (atom false)
1269 move-left? (atom false)
1270 move-right? (atom false)
1271 roll-left? (atom false)
1272 roll-right? (atom false)
1273 timer (atom 0)]
1275 (world
1276 (nodify [top bottom floor origin])
1277 (merge standard-debug-controls
1278 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1279 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1280 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1281 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1282 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1283 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1285 (fn [world]
1286 (light-up-everything world)
1287 (enable-debug world)
1288 (set-gravity world (Vector3f. 0 0 0))
1291 (fn [world _]
1292 (if (zero? (rem (swap! timer inc) 100))
1293 (do
1294 ;; (println-repl @timer)
1295 (.attachChild (.getRootNode world)
1296 (sphere 0.05 :color ColorRGBA/Yellow
1297 :position (.getWorldTranslation top)
1298 :physical? false))
1299 (.attachChild (.getRootNode world)
1300 (sphere 0.05 :color ColorRGBA/LightGray
1301 :position (.getWorldTranslation bottom)
1302 :physical? false))))
1304 (if @move-up?
1305 (.applyTorque control
1306 (.mult (.getPhysicsRotation control)
1307 (Vector3f. 0 0 10))))
1308 (if @move-down?
1309 (.applyTorque control
1310 (.mult (.getPhysicsRotation control)
1311 (Vector3f. 0 0 -10))))
1312 (if @move-left?
1313 (.applyTorque control
1314 (.mult (.getPhysicsRotation control)
1315 (Vector3f. 0 10 0))))
1316 (if @move-right?
1317 (.applyTorque control
1318 (.mult (.getPhysicsRotation control)
1319 (Vector3f. 0 -10 0))))
1320 (if @roll-left?
1321 (.applyTorque control
1322 (.mult (.getPhysicsRotation control)
1323 (Vector3f. -1 0 0))))
1324 (if @roll-right?
1325 (.applyTorque control
1326 (.mult (.getPhysicsRotation control)
1327 (Vector3f. 1 0 0))))))))
1331 (defprotocol Frame
1332 (frame [this]))
1334 (extend-type BufferedImage
1335 Frame
1336 (frame [image]
1337 (merge
1338 (apply
1339 hash-map
1340 (interleave
1341 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1342 (vector x y)))
1343 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1344 (let [data (.getRGB image x y)]
1345 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1346 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1347 :b (bit-and 0x0000ff data)))))))
1348 {:width (.getWidth image) :height (.getHeight image)})))
1351 (extend-type ImagePlus
1352 Frame
1353 (frame [image+]
1354 (frame (.getBufferedImage image+))))
1357 #+end_src
1360 * COMMENT generate source
1361 #+begin_src clojure :tangle ../src/cortex/silly.clj
1362 <<body-1>>
1363 #+end_src