view org/test-creature.org @ 117:94c005f7f9dd

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