view org/test-creature.org @ 118:1261444da2c7

got rough vision pipeline working
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Jan 2012 01:08:35 -0700
parents 94c005f7f9dd
children ebfd62779ab4
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_4BYTE_ABGR)]
87 (dorun
88 (for [x (range (.getWidth image))
89 y (range (.getHeight image))]
90 (.setRGB image x y 0xFFFF0000)))
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 (bind-camera target cam)
753 cam))
756 (def presets
757 {:gray identity})
759 (defn enable-vision
760 "return [init-function sensor-functions] for a particular eye"
761 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
762 (let [retinal-map (retina-sensor-image eye)
763 vision-image (atom nil)
764 camera (attach-eye creature eye)]
765 [
766 (fn [world]
767 (add-eye
768 world camera
769 (let [counter (atom 0)]
770 (fn [r fb bb bi]
771 (if (zero? (rem (swap! counter inc) (inc skip)))
772 (reset! vision-image (BufferedImage! r fb bb bi)))))))
773 (vector
774 (let [whites (white-coordinates (:gray retinal-map))
775 topology (vec (collapse whites))]
776 (fn []
777 (vector
778 topology
779 (vec
780 (for [[x y] whites]
781 (.getRGB @vision-image x y)))))))
782 ]))
784 (defn vision
786 ;; need to create a camera based on UV image,
787 ;; update this camera every frame based on the position of this
788 ;; geometry. (maybe can get cam to follow the object)
790 ;; use a stack for the continuation to grab the image.
793 [#^Geometry eye]
798 )
801 (defn blender-creature
802 "Return a creature with all joints in place."
803 [blender-path]
804 (let [model (load-blender-model blender-path)
805 joints
806 (if-let [joint-node (.getChild model "joints")]
807 (seq (.getChildren joint-node))
808 (do (println-repl "could not find joints node") []))]
809 (assemble-creature model joints)))
816 (defn debug-window
817 "creates function that offers a debug view of sensor data"
818 []
819 (let [vi (view-image)]
820 (fn
821 [[coords sensor-data]]
822 (let [image (points->image coords)]
823 (dorun
824 (for [i (range (count coords))]
825 (.setRGB image ((coords i) 0) ((coords i) 1)
826 ({0 -16777216
827 1 -1} (sensor-data i)))))
828 (vi image)))))
830 (defn debug-vision-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 (sensor-data i))))
841 (vi image)))))
845 ;;(defn test-touch [world creature]
848 (defn test-creature [thing]
849 (let [x-axis
850 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
851 y-axis
852 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
853 z-axis
854 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
855 creature (blender-creature thing)
856 touch-nerves (touch creature)
857 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
858 [init-vision [vision-data]]
859 (enable-vision creature (test-eye))
860 vision-debug (debug-vision-window)
861 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
862 ]
863 (world
864 (nodify [creature
865 (box 10 2 10 :position (Vector3f. 0 -9 0)
866 :color ColorRGBA/Gray :mass 0)
867 x-axis y-axis z-axis
868 me
869 ])
870 standard-debug-controls
871 (fn [world]
872 (light-up-everything world)
873 (enable-debug world)
874 (init-vision world)
876 (add-eye world
877 (attach-eye creature (test-eye))
878 (comp (view-image) BufferedImage!))
880 (add-eye world (.getCamera world) no-op)
882 ;;(com.aurellem.capture.Capture/captureVideo
883 ;; world (file-str "/home/r/proj/ai-videos/hand"))
884 ;;(.setTimer world (RatchetTimer. 60))
885 ;;(speed-up world)
886 ;;(set-gravity world (Vector3f. 0 0 0))
887 )
888 (fn [world tpf]
889 ;;(dorun
890 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
892 (dorun
893 (map #(%1 (%2 (.getRootNode world)))
894 touch-debug-windows touch-nerves)
895 )
896 ;;(println-repl (vision-data))
897 (.setLocalTranslation me (.getLocation (.getCamera world)))
899 (vision-debug (vision-data))
900 )
901 ;;(let [timer (atom 0)]
902 ;; (fn [_ _]
903 ;; (swap! timer inc)
904 ;; (if (= (rem @timer 60) 0)
905 ;; (println-repl (float (/ @timer 60))))))
906 )))
916 ;;; experiments in collisions
920 (defn collision-test []
921 (let [b-radius 1
922 b-position (Vector3f. 0 0 0)
923 obj-b (box 1 1 1 :color ColorRGBA/Blue
924 :position b-position
925 :mass 0)
926 node (nodify [obj-b])
927 bounds-b
928 (doto (Picture.)
929 (.setHeight 50)
930 (.setWidth 50)
931 (.setImage (asset-manager)
932 "Models/creature1/hand.png"
933 false
934 ))
936 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
938 collisions
939 (let [cr (CollisionResults.)]
940 (.collideWith node bounds-b cr)
941 (println (map #(.getContactPoint %) cr))
942 cr)
944 ;;collision-points
945 ;;(map #(sphere 0.1 :position (.getContactPoint %))
946 ;; collisions)
948 ;;node (nodify (conj collision-points obj-b))
950 sim
951 (world node
952 {"key-space"
953 (fn [_ value]
954 (if value
955 (let [cr (CollisionResults.)]
956 (.collideWith node bounds-b cr)
957 (println-repl (map #(.getContactPoint %) cr))
958 cr)))}
959 no-op
960 no-op)
962 ]
963 sim
965 ))
968 ;; the camera will stay in its initial position/rotation with relation
969 ;; to the spatial.
972 (defn follow-test
973 "show a camera that stays in the same relative position to a blue cube."
974 []
975 (let [camera-pos (Vector3f. 0 30 0)
976 rock (box 1 1 1 :color ColorRGBA/Blue
977 :position (Vector3f. 0 10 0)
978 :mass 30
979 )
980 rot (.getWorldRotation rock)
982 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
983 :position (Vector3f. 0 -3 0))]
985 (world
986 (nodify [rock table])
987 standard-debug-controls
988 (fn [world]
989 (let
990 [cam (doto (.clone (.getCamera world))
991 (.setLocation camera-pos)
992 (.lookAt Vector3f/ZERO
993 Vector3f/UNIT_X))]
994 (bind-camera rock cam)
996 (.setTimer world (RatchetTimer. 60))
997 (add-eye world cam (comp (view-image) BufferedImage!))
998 (add-eye world (.getCamera world) no-op))
999 )
1000 (fn [_ _] (println-repl rot)))))
1003 #+end_src
1005 #+results: body-1
1006 : #'cortex.silly/test-creature
1009 * COMMENT purgatory
1010 #+begin_src clojure
1011 (defn bullet-trans []
1012 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1013 :position (Vector3f. -10 5 0))
1014 obj-b (sphere 0.5 :color ColorRGBA/Blue
1015 :position (Vector3f. -10 -5 0)
1016 :mass 0)
1017 control-a (.getControl obj-a RigidBodyControl)
1018 control-b (.getControl obj-b RigidBodyControl)
1019 swivel
1020 (.toRotationMatrix
1021 (doto (Quaternion.)
1022 (.fromAngleAxis (/ Math/PI 2)
1023 Vector3f/UNIT_X)))]
1024 (doto
1025 (ConeJoint.
1026 control-a control-b
1027 (Vector3f. 0 5 0)
1028 (Vector3f. 0 -5 0)
1029 swivel swivel)
1030 (.setLimit (* 0.6 (/ Math/PI 4))
1031 (/ Math/PI 4)
1032 (* Math/PI 0.8)))
1033 (world (nodify
1034 [obj-a obj-b])
1035 standard-debug-controls
1036 enable-debug
1037 no-op)))
1040 (defn bullet-trans* []
1041 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1042 :position (Vector3f. 5 0 0)
1043 :mass 90)
1044 obj-b (sphere 0.5 :color ColorRGBA/Blue
1045 :position (Vector3f. -5 0 0)
1046 :mass 0)
1047 control-a (.getControl obj-a RigidBodyControl)
1048 control-b (.getControl obj-b RigidBodyControl)
1049 move-up? (atom nil)
1050 move-down? (atom nil)
1051 move-left? (atom nil)
1052 move-right? (atom nil)
1053 roll-left? (atom nil)
1054 roll-right? (atom nil)
1055 force 100
1056 swivel
1057 (.toRotationMatrix
1058 (doto (Quaternion.)
1059 (.fromAngleAxis (/ Math/PI 2)
1060 Vector3f/UNIT_X)))
1061 x-move
1062 (doto (Matrix3f.)
1063 (.fromStartEndVectors Vector3f/UNIT_X
1064 (.normalize (Vector3f. 1 1 0))))
1066 timer (atom 0)]
1067 (doto
1068 (ConeJoint.
1069 control-a control-b
1070 (Vector3f. -8 0 0)
1071 (Vector3f. 2 0 0)
1072 ;;swivel swivel
1073 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1074 x-move Matrix3f/IDENTITY
1076 (.setCollisionBetweenLinkedBodys false)
1077 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1078 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1079 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1080 (world (nodify
1081 [obj-a obj-b])
1082 (merge standard-debug-controls
1083 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1084 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1085 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1086 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1087 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1088 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1090 (fn [world]
1091 (enable-debug world)
1092 (set-gravity world Vector3f/ZERO)
1095 (fn [world _]
1097 (if @move-up?
1098 (.applyForce control-a
1099 (Vector3f. force 0 0)
1100 (Vector3f. 0 0 0)))
1101 (if @move-down?
1102 (.applyForce control-a
1103 (Vector3f. (- force) 0 0)
1104 (Vector3f. 0 0 0)))
1105 (if @move-left?
1106 (.applyForce control-a
1107 (Vector3f. 0 force 0)
1108 (Vector3f. 0 0 0)))
1109 (if @move-right?
1110 (.applyForce control-a
1111 (Vector3f. 0 (- force) 0)
1112 (Vector3f. 0 0 0)))
1114 (if @roll-left?
1115 (.applyForce control-a
1116 (Vector3f. 0 0 force)
1117 (Vector3f. 0 0 0)))
1118 (if @roll-right?
1119 (.applyForce control-a
1120 (Vector3f. 0 0 (- force))
1121 (Vector3f. 0 0 0)))
1123 (if (zero? (rem (swap! timer inc) 100))
1124 (.attachChild
1125 (.getRootNode world)
1126 (sphere 0.05 :color ColorRGBA/Yellow
1127 :physical? false :position
1128 (.getWorldTranslation obj-a)))))
1130 ))
1132 (defn transform-trianglesdsd
1133 "Transform that converts each vertex in the first triangle
1134 into the corresponding vertex in the second triangle."
1135 [#^Triangle tri-1 #^Triangle tri-2]
1136 (let [in [(.get1 tri-1)
1137 (.get2 tri-1)
1138 (.get3 tri-1)]
1139 out [(.get1 tri-2)
1140 (.get2 tri-2)
1141 (.get3 tri-2)]]
1142 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1143 in* [(.mult translate (in 0))
1144 (.mult translate (in 1))
1145 (.mult translate (in 2))]
1146 final-translation
1147 (doto (Matrix4f.)
1148 (.setTranslation (out 1)))
1150 rotate-1
1151 (doto (Matrix3f.)
1152 (.fromStartEndVectors
1153 (.normalize
1154 (.subtract
1155 (in* 1) (in* 0)))
1156 (.normalize
1157 (.subtract
1158 (out 1) (out 0)))))
1159 in** [(.mult rotate-1 (in* 0))
1160 (.mult rotate-1 (in* 1))
1161 (.mult rotate-1 (in* 2))]
1162 scale-factor-1
1163 (.mult
1164 (.normalize
1165 (.subtract
1166 (out 1)
1167 (out 0)))
1168 (/ (.length
1169 (.subtract (out 1)
1170 (out 0)))
1171 (.length
1172 (.subtract (in** 1)
1173 (in** 0)))))
1174 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1175 in*** [(.mult scale-1 (in** 0))
1176 (.mult scale-1 (in** 1))
1177 (.mult scale-1 (in** 2))]
1185 (dorun (map println in))
1186 (println)
1187 (dorun (map println in*))
1188 (println)
1189 (dorun (map println in**))
1190 (println)
1191 (dorun (map println in***))
1192 (println)
1194 ))))
1197 (defn world-setup [joint]
1198 (let [joint-position (Vector3f. 0 0 0)
1199 joint-rotation
1200 (.toRotationMatrix
1201 (.mult
1202 (doto (Quaternion.)
1203 (.fromAngleAxis
1204 (* 1 (/ Math/PI 4))
1205 (Vector3f. -1 0 0)))
1206 (doto (Quaternion.)
1207 (.fromAngleAxis
1208 (* 1 (/ Math/PI 2))
1209 (Vector3f. 0 0 1)))))
1210 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1212 origin (doto
1213 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1214 :position top-position))
1215 top (doto
1216 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1217 :position top-position)
1219 (.addControl
1220 (RigidBodyControl.
1221 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1222 bottom (doto
1223 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1224 :position (Vector3f. 0 0 0))
1225 (.addControl
1226 (RigidBodyControl.
1227 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1228 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1229 :color ColorRGBA/Gray :mass 0)
1230 a (.getControl top RigidBodyControl)
1231 b (.getControl bottom RigidBodyControl)]
1233 (cond
1234 (= joint :cone)
1236 (doto (ConeJoint.
1237 a b
1238 (world-to-local top joint-position)
1239 (world-to-local bottom joint-position)
1240 joint-rotation
1241 joint-rotation
1245 (.setLimit (* (/ 10) Math/PI)
1246 (* (/ 4) Math/PI)
1247 0)))
1248 [origin top bottom table]))
1250 (defn test-joint [joint]
1251 (let [[origin top bottom floor] (world-setup joint)
1252 control (.getControl top RigidBodyControl)
1253 move-up? (atom false)
1254 move-down? (atom false)
1255 move-left? (atom false)
1256 move-right? (atom false)
1257 roll-left? (atom false)
1258 roll-right? (atom false)
1259 timer (atom 0)]
1261 (world
1262 (nodify [top bottom floor origin])
1263 (merge standard-debug-controls
1264 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1265 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1266 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1267 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1268 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1269 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1271 (fn [world]
1272 (light-up-everything world)
1273 (enable-debug world)
1274 (set-gravity world (Vector3f. 0 0 0))
1277 (fn [world _]
1278 (if (zero? (rem (swap! timer inc) 100))
1279 (do
1280 ;; (println-repl @timer)
1281 (.attachChild (.getRootNode world)
1282 (sphere 0.05 :color ColorRGBA/Yellow
1283 :position (.getWorldTranslation top)
1284 :physical? false))
1285 (.attachChild (.getRootNode world)
1286 (sphere 0.05 :color ColorRGBA/LightGray
1287 :position (.getWorldTranslation bottom)
1288 :physical? false))))
1290 (if @move-up?
1291 (.applyTorque control
1292 (.mult (.getPhysicsRotation control)
1293 (Vector3f. 0 0 10))))
1294 (if @move-down?
1295 (.applyTorque control
1296 (.mult (.getPhysicsRotation control)
1297 (Vector3f. 0 0 -10))))
1298 (if @move-left?
1299 (.applyTorque control
1300 (.mult (.getPhysicsRotation control)
1301 (Vector3f. 0 10 0))))
1302 (if @move-right?
1303 (.applyTorque control
1304 (.mult (.getPhysicsRotation control)
1305 (Vector3f. 0 -10 0))))
1306 (if @roll-left?
1307 (.applyTorque control
1308 (.mult (.getPhysicsRotation control)
1309 (Vector3f. -1 0 0))))
1310 (if @roll-right?
1311 (.applyTorque control
1312 (.mult (.getPhysicsRotation control)
1313 (Vector3f. 1 0 0))))))))
1317 (defprotocol Frame
1318 (frame [this]))
1320 (extend-type BufferedImage
1321 Frame
1322 (frame [image]
1323 (merge
1324 (apply
1325 hash-map
1326 (interleave
1327 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1328 (vector x y)))
1329 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1330 (let [data (.getRGB image x y)]
1331 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1332 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1333 :b (bit-and 0x0000ff data)))))))
1334 {:width (.getWidth image) :height (.getHeight image)})))
1337 (extend-type ImagePlus
1338 Frame
1339 (frame [image+]
1340 (frame (.getBufferedImage image+))))
1343 #+end_src
1346 * COMMENT generate source
1347 #+begin_src clojure :tangle ../src/cortex/silly.clj
1348 <<body-1>>
1349 #+end_src