view org/test-creature.org @ 134:ac350a0ac6b0

proprioception refrence frame is wrong, trying to fix...
author Robert McIntyre <rlm@mit.edu>
date Wed, 01 Feb 2012 02:44:07 -0700
parents 2ed7e60d3821
children 421cc43441ae
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
11 * Brainstorming different sensors and effectors.
13 Every sense that we have should have an effector that changes what
14 that sense (or others who have that sense) experiences.
16 ** Classic Senses
17 | Sense | Effector |
18 |------------------------------+---------------------------------|
19 | Vision | Variable Coloration |
20 | Hearing | Speech |
21 | Proprioception | Movement |
22 | Smell/Taste (Chemoreception) | Pheremones |
23 | Touch | Movement / Controllable Texture |
24 | Acceleration | Movement |
25 | Balance (sense gravity) | Movement |
26 | | |
28 - New Senses/Effectors
29 - Levitation
30 - Telekenesis
32 - Symbol Sense
33 Where objects in the world can be queried for description /
34 symbols.
36 - Symbol Marking
37 The ability to mark objects in the world with your own descriptions
38 and symbols.
40 - Vision
41 Distinguish the polarization of light
42 Color
43 Movement
45 * project ideas
46 - HACKER for writing muscle-control programs : Presented with
47 low-level muscle control/ sense API, generate higher level programs
48 for accomplishing various stated goals. Example goals might be
49 "extend all your fingers" or "move your hand into the area with
50 blue light" or "decrease the angle of this joint". It would be
51 like Sussman's HACKER, except it would operate with much more data
52 in a more realistic world. Start off with "calestanthics" to
53 develop subrouitines over the motor control API. This would be the
54 "spinal chord" of a more intelligent creature. The low level
55 programming code might be a turning machine that could develop
56 programs to iterate over a "tape" where each entry in the tape
57 could control recruitment of the fibers in a muscle.
58 - Make a virtual computer in the virtual world which with which the
59 creature interacts using its fingers to press keys on a virtual
60 keyboard. The creature can access the internet, watch videos, take
61 over the world, anything it wants.
62 - Make virtual insturments like pianos, drumbs, etc that it learns to
63 play.
64 - make a joint that figures out what type of joint it is (range of
65 motion)
71 * goals
73 ** have to get done before winston
74 - [ ] write an explination for why greyscale bitmaps for senses is
75 appropiate -- 1/2 day
76 - [ ] muscle control -- day
77 - [ ] proprioception sensor map in the style of the other senses -- day
78 - [ ] refactor integration code to distribute to each of the senses
79 -- day
80 - [ ] create video showing all the senses for Winston -- 2 days
81 - [ ] write summary of project for Winston \
82 - [ ] project proposals for Winston \
83 - [ ] additional senses to be implemented for Winston | -- 2 days
84 - [ ] send Winston package /
86 ** would be cool to get done before winston
87 - [X] enable greyscale bitmaps for touch -- 2 hours
88 - [X] use sawfish to auto-tile sense windows -- 6 hours
89 - [X] sawfish keybinding to automatically delete all sense windows
90 - [ ] directly change the UV-pixels to show sensor activation -- 2
91 days
92 - [ ] proof of concept C sense manipulation -- 2 days
93 - [ ] proof of concept GPU sense manipulation -- week
94 - [ ] fourier view of sound -- 2 or 3 days
95 - [ ] dancing music generator -- 1 day, depends on fourier
97 ** don't have to get done before winston
98 - [ ] write tests for integration -- 3 days
99 - [ ] usertime/gametime clock HUD display -- day
100 - [ ] find papers for each of the senses justifying my own
101 representation -- week
102 - [ ] show sensor maps in HUD display? -- 4 days
103 - [ ] show sensor maps in AWT display? -- 2 days
106 * Intro
107 So far, I've made the following senses --
108 - Vision
109 - Hearing
110 - Touch
111 - Proprioception
113 And one effector:
114 - Movement
116 However, the code so far has only enabled these senses, but has not
117 actually implemented them. For example, there is still a lot of work
118 to be done for vision. I need to be able to create an /eyeball/ in
119 simulation that can be moved around and see the world from different
120 angles. I also need to determine weather to use log-polar or cartesian
121 for the visual input, and I need to determine how/wether to
122 disceritise the visual input.
124 I also want to be able to visualize both the sensors and the
125 effectors in pretty pictures. This semi-retarted creature will be my
126 first attempt at bringing everything together.
128 * The creature's body
130 Still going to do an eve-like body in blender, but due to problems
131 importing the joints, etc into jMonkeyEngine3, I'm going to do all
132 the connecting here in clojure code, using the names of the individual
133 components and trial and error. Later, I'll maybe make some sort of
134 creature-building modifications to blender that support whatever
135 discreitized senses I'm going to make.
137 #+name: body-1
138 #+begin_src clojure
139 (ns cortex.silly
140 "let's play!"
141 {:author "Robert McIntyre"})
143 ;; TODO remove this!
144 (require 'cortex.import)
145 (cortex.import/mega-import-jme3)
146 (use '(cortex world util body hearing touch vision))
148 (rlm.rlm-commands/help)
149 (import java.awt.image.BufferedImage)
150 (import javax.swing.JPanel)
151 (import javax.swing.SwingUtilities)
152 (import java.awt.Dimension)
153 (import javax.swing.JFrame)
154 (import java.awt.Dimension)
155 (import com.aurellem.capture.RatchetTimer)
156 (declare joint-create)
157 (use 'clojure.contrib.def)
159 (defn points->image
160 "Take a sparse collection of points and visuliaze it as a
161 BufferedImage."
163 ;; TODO maybe parallelize this since it's easy
165 [points]
166 (if (empty? points)
167 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
168 (let [xs (vec (map first points))
169 ys (vec (map second points))
170 x0 (apply min xs)
171 y0 (apply min ys)
172 width (- (apply max xs) x0)
173 height (- (apply max ys) y0)
174 image (BufferedImage. (inc width) (inc height)
175 BufferedImage/TYPE_INT_RGB)]
176 (dorun
177 (for [x (range (.getWidth image))
178 y (range (.getHeight image))]
179 (.setRGB image x y 0xFF0000)))
180 (dorun
181 (for [index (range (count points))]
182 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
184 image)))
186 (defn average [coll]
187 (/ (reduce + coll) (count coll)))
189 (defn collapse-1d
190 "One dimensional analogue of collapse"
191 [center line]
192 (let [length (count line)
193 num-above (count (filter (partial < center) line))
194 num-below (- length num-above)]
195 (range (- center num-below)
196 (+ center num-above))))
198 (defn collapse
199 "Take a set of pairs of integers and collapse them into a
200 contigous bitmap."
201 [points]
202 (if (empty? points) []
203 (let
204 [num-points (count points)
205 center (vector
206 (int (average (map first points)))
207 (int (average (map first points))))
208 flattened
209 (reduce
210 concat
211 (map
212 (fn [column]
213 (map vector
214 (map first column)
215 (collapse-1d (second center)
216 (map second column))))
217 (partition-by first (sort-by first points))))
218 squeezed
219 (reduce
220 concat
221 (map
222 (fn [row]
223 (map vector
224 (collapse-1d (first center)
225 (map first row))
226 (map second row)))
227 (partition-by second (sort-by second flattened))))
228 relocate
229 (let [min-x (apply min (map first squeezed))
230 min-y (apply min (map second squeezed))]
231 (map (fn [[x y]]
232 [(- x min-x)
233 (- y min-y)])
234 squeezed))]
235 relocate)))
237 (defn load-bullet []
238 (let [sim (world (Node.) {} no-op no-op)]
239 (doto sim
240 (.enqueue
241 (fn []
242 (.stop sim)))
243 (.start))))
245 (defn load-blender-model
246 "Load a .blend file using an asset folder relative path."
247 [^String model]
248 (.loadModel
249 (doto (asset-manager)
250 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
251 model))
253 (defn meta-data [blender-node key]
254 (if-let [data (.getUserData blender-node "properties")]
255 (.findValue data key)
256 nil))
258 (defn blender-to-jme
259 "Convert from Blender coordinates to JME coordinates"
260 [#^Vector3f in]
261 (Vector3f. (.getX in)
262 (.getZ in)
263 (- (.getY in))))
265 (defn jme-to-blender
266 "Convert from JME coordinates to Blender coordinates"
267 [#^Vector3f in]
268 (Vector3f. (.getX in)
269 (- (.getZ in))
270 (.getY in)))
272 (defn joint-targets
273 "Return the two closest two objects to the joint object, ordered
274 from bottom to top according to the joint's rotation."
275 [#^Node parts #^Node joint]
276 (loop [radius (float 0.01)]
277 (let [results (CollisionResults.)]
278 (.collideWith
279 parts
280 (BoundingBox. (.getWorldTranslation joint)
281 radius radius radius)
282 results)
283 (let [targets
284 (distinct
285 (map #(.getGeometry %) results))]
286 (if (>= (count targets) 2)
287 (sort-by
288 #(let [v
289 (jme-to-blender
290 (.mult
291 (.inverse (.getWorldRotation joint))
292 (.subtract (.getWorldTranslation %)
293 (.getWorldTranslation joint))))]
294 (println-repl (.getName %) ":" v)
295 (.dot (Vector3f. 1 1 1)
296 v))
297 (take 2 targets))
298 (recur (float (* radius 2))))))))
301 (defn proprio-joint [#^Node parts #^Node joint]
302 (let [[obj-a obj-b] (joint-targets parts joint)
303 joint-rot (.getWorldRotation joint)
304 x (.mult joint-rot Vector3f/UNIT_X)
305 y (.mult joint-rot Vector3f/UNIT_Y)
306 z (.mult joint-rot Vector3f/UNIT_Z)]
307 ;; this function will report proprioceptive information for the
308 ;; joint
309 (fn []
310 ;; x is the "twist" axis, y and z are the "bend" axes
311 (let [rot-a (.getWorldRotation obj-a)
312 rot-b (.getWorldRotation obj-b)
313 relative (.mult (.inverse rot-a) rot-b)
314 basis (doto (Matrix3f.)
315 (.setColumn 0 y)
316 (.setColumn 1 z)
317 (.setColumn 2 x))
318 rotation-about-joint
319 (doto (Quaternion.)
320 (.fromRotationMatrix
321 (.mult (.inverse basis)
322 (.toRotationMatrix relative))))
324 confirm-axes
325 (let [temp-axes (make-array Vector3f 3)]
326 (.toAxes rotation-about-joint temp-axes)
327 (seq temp-axes))
328 euler-angles
329 (seq (.toAngles rotation-about-joint nil))]
330 ;;return euler angles of the quaternion around the new basis
331 euler-angles))))
335 (defn world-to-local
336 "Convert the world coordinates into coordinates relative to the
337 object (i.e. local coordinates), taking into account the rotation
338 of object."
339 [#^Spatial object world-coordinate]
340 (let [out (Vector3f.)]
341 (.worldToLocal object world-coordinate out) out))
343 (defn local-to-world
344 "Convert the local coordinates into coordinates into world relative
345 coordinates"
346 [#^Spatial object local-coordinate]
347 (let [world-coordinate (Vector3f.)]
348 (.localToWorld object local-coordinate world-coordinate)
349 world-coordinate))
351 (defmulti joint-dispatch
352 "Translate blender pseudo-joints into real JME joints."
353 (fn [constraints & _]
354 (:type constraints)))
356 (defmethod joint-dispatch :point
357 [constraints control-a control-b pivot-a pivot-b rotation]
358 (println-repl "creating POINT2POINT joint")
359 ;; bullet's point2point joints are BROKEN, so we must use the
360 ;; generic 6DOF joint instead of an actual Point2Point joint!
362 ;; should be able to do this:
363 (comment
364 (Point2PointJoint.
365 control-a
366 control-b
367 pivot-a
368 pivot-b))
370 ;; but instead we must do this:
371 (println-repl "substuting 6DOF joint for POINT2POINT joint!")
372 (doto
373 (SixDofJoint.
374 control-a
375 control-b
376 pivot-a
377 pivot-b
378 false)
379 (.setLinearLowerLimit Vector3f/ZERO)
380 (.setLinearUpperLimit Vector3f/ZERO)
381 ;;(.setAngularLowerLimit (Vector3f. 1 1 1))
382 ;;(.setAngularUpperLimit (Vector3f. 0 0 0))
384 ))
387 (defmethod joint-dispatch :hinge
388 [constraints control-a control-b pivot-a pivot-b rotation]
389 (println-repl "creating HINGE joint")
390 (let [axis
391 (if-let
392 [axis (:axis constraints)]
393 axis
394 Vector3f/UNIT_X)
395 [limit-1 limit-2] (:limit constraints)
396 hinge-axis
397 (.mult
398 rotation
399 (blender-to-jme axis))]
400 (doto
401 (HingeJoint.
402 control-a
403 control-b
404 pivot-a
405 pivot-b
406 hinge-axis
407 hinge-axis)
408 (.setLimit limit-1 limit-2))))
410 (defmethod joint-dispatch :cone
411 [constraints control-a control-b pivot-a pivot-b rotation]
412 (let [limit-xz (:limit-xz constraints)
413 limit-xy (:limit-xy constraints)
414 twist (:twist constraints)]
416 (println-repl "creating CONE joint")
417 (println-repl rotation)
418 (println-repl
419 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
420 (println-repl
421 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
422 (println-repl
423 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
424 (doto
425 (ConeJoint.
426 control-a
427 control-b
428 pivot-a
429 pivot-b
430 rotation
431 rotation)
432 (.setLimit (float limit-xz)
433 (float limit-xy)
434 (float twist)))))
436 (defn connect
437 "here are some examples:
438 {:type :point}
439 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
440 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
442 {:type :cone :limit-xz 0]
443 :limit-xy 0]
444 :twist 0]} (use XZY rotation mode in blender!)"
445 [#^Node obj-a #^Node obj-b #^Node joint]
446 (let [control-a (.getControl obj-a RigidBodyControl)
447 control-b (.getControl obj-b RigidBodyControl)
448 joint-center (.getWorldTranslation joint)
449 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
450 pivot-a (world-to-local obj-a joint-center)
451 pivot-b (world-to-local obj-b joint-center)]
453 (if-let [constraints
454 (map-vals
455 eval
456 (read-string
457 (meta-data joint "joint")))]
458 ;; A side-effect of creating a joint registers
459 ;; it with both physics objects which in turn
460 ;; will register the joint with the physics system
461 ;; when the simulation is started.
462 (do
463 (println-repl "creating joint between"
464 (.getName obj-a) "and" (.getName obj-b))
465 (joint-dispatch constraints
466 control-a control-b
467 pivot-a pivot-b
468 joint-rotation))
469 (println-repl "could not find joint meta-data!"))))
474 (defn assemble-creature [#^Node pieces joints]
475 (dorun
476 (map
477 (fn [geom]
478 (let [physics-control
479 (RigidBodyControl.
480 (HullCollisionShape.
481 (.getMesh geom))
482 (if-let [mass (meta-data geom "mass")]
483 (do
484 (println-repl
485 "setting" (.getName geom) "mass to" (float mass))
486 (float mass))
487 (float 1)))]
489 (.addControl geom physics-control)))
490 (filter #(isa? (class %) Geometry )
491 (node-seq pieces))))
492 (dorun
493 (map
494 (fn [joint]
495 (let [[obj-a obj-b] (joint-targets pieces joint)]
496 (connect obj-a obj-b joint)))
497 joints))
498 pieces)
500 (declare blender-creature)
502 (def hand "Models/creature1/one.blend")
504 (def worm "Models/creature1/try-again.blend")
506 (def touch "Models/creature1/touch.blend")
508 (defn worm-model [] (load-blender-model worm))
510 (defn x-ray [#^ColorRGBA color]
511 (doto (Material. (asset-manager)
512 "Common/MatDefs/Misc/Unshaded.j3md")
513 (.setColor "Color" color)
514 (-> (.getAdditionalRenderState)
515 (.setDepthTest false))))
517 (defn colorful []
518 (.getChild (worm-model) "worm-21"))
520 (import jme3tools.converters.ImageToAwt)
522 (import ij.ImagePlus)
524 ;; Every Mesh has many triangles, each with its own index.
525 ;; Every vertex has its own index as well.
527 (defn tactile-sensor-image
528 "Return the touch-sensor distribution image in BufferedImage format,
529 or nil if it does not exist."
530 [#^Geometry obj]
531 (if-let [image-path (meta-data obj "touch")]
532 (ImageToAwt/convert
533 (.getImage
534 (.loadTexture
535 (asset-manager)
536 image-path))
537 false false 0)))
539 (import ij.process.ImageProcessor)
540 (import java.awt.image.BufferedImage)
542 (def white -1)
544 (defn filter-pixels
545 "List the coordinates of all pixels matching pred, within the bounds
546 provided. Bounds -> [x0 y0 width height]"
547 {:author "Dylan Holmes"}
548 ([pred #^BufferedImage image]
549 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
550 ([pred #^BufferedImage image [x0 y0 width height]]
551 ((fn accumulate [x y matches]
552 (cond
553 (>= y (+ height y0)) matches
554 (>= x (+ width x0)) (recur 0 (inc y) matches)
555 (pred (.getRGB image x y))
556 (recur (inc x) y (conj matches [x y]))
557 :else (recur (inc x) y matches)))
558 x0 y0 [])))
560 (defn white-coordinates
561 "Coordinates of all the white pixels in a subset of the image."
562 ([#^BufferedImage image bounds]
563 (filter-pixels #(= % white) image bounds))
564 ([#^BufferedImage image]
565 (filter-pixels #(= % white) image)))
567 (defn triangle
568 "Get the triangle specified by triangle-index from the mesh within
569 bounds."
570 [#^Mesh mesh triangle-index]
571 (let [scratch (Triangle.)]
572 (.getTriangle mesh triangle-index scratch)
573 scratch))
575 (defn triangle-vertex-indices
576 "Get the triangle vertex indices of a given triangle from a given
577 mesh."
578 [#^Mesh mesh triangle-index]
579 (let [indices (int-array 3)]
580 (.getTriangle mesh triangle-index indices)
581 (vec indices)))
583 (defn vertex-UV-coord
584 "Get the uv-coordinates of the vertex named by vertex-index"
585 [#^Mesh mesh vertex-index]
586 (let [UV-buffer
587 (.getData
588 (.getBuffer
589 mesh
590 VertexBuffer$Type/TexCoord))]
591 [(.get UV-buffer (* vertex-index 2))
592 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
594 (defn triangle-UV-coord
595 "Get the uv-cooridnates of the triangle's verticies."
596 [#^Mesh mesh width height triangle-index]
597 (map (fn [[u v]] (vector (* width u) (* height v)))
598 (map (partial vertex-UV-coord mesh)
599 (triangle-vertex-indices mesh triangle-index))))
601 (defn same-side?
602 "Given the points p1 and p2 and the reference point ref, is point p
603 on the same side of the line that goes through p1 and p2 as ref is?"
604 [p1 p2 ref p]
605 (<=
606 0
607 (.dot
608 (.cross (.subtract p2 p1) (.subtract p p1))
609 (.cross (.subtract p2 p1) (.subtract ref p1)))))
611 (defn triangle-seq [#^Triangle tri]
612 [(.get1 tri) (.get2 tri) (.get3 tri)])
614 (defn vector3f-seq [#^Vector3f v]
615 [(.getX v) (.getY v) (.getZ v)])
617 (defn inside-triangle?
618 "Is the point inside the triangle?"
619 {:author "Dylan Holmes"}
620 [#^Triangle tri #^Vector3f p]
621 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
622 (and
623 (same-side? vert-1 vert-2 vert-3 p)
624 (same-side? vert-2 vert-3 vert-1 p)
625 (same-side? vert-3 vert-1 vert-2 p))))
627 (defn triangle->matrix4f
628 "Converts the triangle into a 4x4 matrix: The first three columns
629 contain the vertices of the triangle; the last contains the unit
630 normal of the triangle. The bottom row is filled with 1s."
631 [#^Triangle t]
632 (let [mat (Matrix4f.)
633 [vert-1 vert-2 vert-3]
634 ((comp vec map) #(.get t %) (range 3))
635 unit-normal (do (.calculateNormal t)(.getNormal t))
636 vertices [vert-1 vert-2 vert-3 unit-normal]]
637 (dorun
638 (for [row (range 4) col (range 3)]
639 (do
640 (.set mat col row (.get (vertices row)col))
641 (.set mat 3 row 1))))
642 mat))
644 (defn triangle-transformation
645 "Returns the affine transformation that converts each vertex in the
646 first triangle into the corresponding vertex in the second
647 triangle."
648 [#^Triangle tri-1 #^Triangle tri-2]
649 (.mult
650 (triangle->matrix4f tri-2)
651 (.invert (triangle->matrix4f tri-1))))
653 (defn point->vector2f [[u v]]
654 (Vector2f. u v))
656 (defn vector2f->vector3f [v]
657 (Vector3f. (.getX v) (.getY v) 0))
659 (defn map-triangle [f #^Triangle tri]
660 (Triangle.
661 (f 0 (.get1 tri))
662 (f 1 (.get2 tri))
663 (f 2 (.get3 tri))))
665 (defn points->triangle
666 "Convert a list of points into a triangle."
667 [points]
668 (apply #(Triangle. %1 %2 %3)
669 (map (fn [point]
670 (let [point (vec point)]
671 (Vector3f. (get point 0 0)
672 (get point 1 0)
673 (get point 2 0))))
674 (take 3 points))))
676 (defn convex-bounds
677 ;;dylan
678 "Returns the smallest square containing the given
679 vertices, as a vector of integers [left top width height]."
680 ;; "Dimensions of the smallest integer bounding square of the list of
681 ;; 2D verticies in the form: [x y width height]."
682 [uv-verts]
683 (let [xs (map first uv-verts)
684 ys (map second uv-verts)
685 x0 (Math/floor (apply min xs))
686 y0 (Math/floor (apply min ys))
687 x1 (Math/ceil (apply max xs))
688 y1 (Math/ceil (apply max ys))]
689 [x0 y0 (- x1 x0) (- y1 y0)]))
691 (defn sensors-in-triangle
692 ;;dylan
693 "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
694 ;;"Find the locations of the touch sensors within a triangle in both
695 ;; UV and gemoetry relative coordinates."
696 [image mesh tri-index]
697 (let [width (.getWidth image)
698 height (.getHeight image)
699 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
700 bounds (convex-bounds UV-vertex-coords)
702 cutout-triangle (points->triangle UV-vertex-coords)
703 UV-sensor-coords
704 (filter (comp (partial inside-triangle? cutout-triangle)
705 (fn [[u v]] (Vector3f. u v 0)))
706 (white-coordinates image bounds))
707 UV->geometry (triangle-transformation
708 cutout-triangle
709 (triangle mesh tri-index))
710 geometry-sensor-coords
711 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
712 UV-sensor-coords)]
713 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
715 (defn-memo locate-feelers
716 "Search the geometry's tactile UV image for touch sensors, returning
717 their positions in geometry-relative coordinates."
718 [#^Geometry geo]
719 (let [mesh (.getMesh geo)
720 num-triangles (.getTriangleCount mesh)]
721 (if-let [image (tactile-sensor-image geo)]
722 (map
723 (partial sensors-in-triangle image mesh)
724 (range num-triangles))
725 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
727 (use 'clojure.contrib.def)
729 (defn-memo touch-topology [#^Gemoetry geo]
730 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
732 (defn-memo feeler-coordinates [#^Geometry geo]
733 (vec (map :geometry (locate-feelers geo))))
735 (defn enable-touch [#^Geometry geo]
736 (let [feeler-coords (feeler-coordinates geo)
737 tris (triangles geo)
738 limit 0.1
739 ;;results (CollisionResults.)
740 ]
741 (if (empty? (touch-topology geo))
742 nil
743 (fn [node]
744 (let [sensor-origins
745 (map
746 #(map (partial local-to-world geo) %)
747 feeler-coords)
748 triangle-normals
749 (map (partial get-ray-direction geo)
750 tris)
751 rays
752 (flatten
753 (map (fn [origins norm]
754 (map #(doto (Ray. % norm)
755 (.setLimit limit)) origins))
756 sensor-origins triangle-normals))]
757 (vector
758 (touch-topology geo)
759 (vec
760 (for [ray rays]
761 (do
762 (let [results (CollisionResults.)]
763 (.collideWith node ray results)
764 (let [touch-objects
765 (filter #(not (= geo (.getGeometry %)))
766 results)]
767 (- 255
768 (if (empty? touch-objects) 255
769 (rem
770 (int
771 (* 255 (/ (.getDistance
772 (first touch-objects)) limit)))
773 256))))))))))))))
776 (defn touch [#^Node pieces]
777 (filter (comp not nil?)
778 (map enable-touch
779 (filter #(isa? (class %) Geometry)
780 (node-seq pieces)))))
783 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
784 ;; http://en.wikipedia.org/wiki/Retina
786 (defn test-eye []
787 (.getChild
788 (.getChild (worm-model) "eyes")
789 "eye"))
792 (defn retina-sensor-image
793 "Return a map of pixel selection functions to BufferedImages
794 describing the distribution of light-sensitive components on this
795 geometry's surface. Each function creates an integer from the rgb
796 values found in the pixel. :red, :green, :blue, :gray are already
797 defined as extracting the red green blue and average components
798 respectively."
799 [#^Spatial eye]
800 (if-let [eye-map (meta-data eye "eye")]
801 (map-vals
802 #(ImageToAwt/convert
803 (.getImage (.loadTexture (asset-manager) %))
804 false false 0)
805 (eval (read-string eye-map)))))
807 (defn eye-dimensions
808 "returns the width and height specified in the metadata of the eye"
809 [#^Spatial eye]
810 (let [dimensions
811 (map #(vector (.getWidth %) (.getHeight %))
812 (vals (retina-sensor-image eye)))]
813 [(apply max (map first dimensions))
814 (apply max (map second dimensions))]))
816 (defn creature-eyes
817 ;;dylan
818 "Return the children of the creature's \"eyes\" node."
819 ;;"The eye nodes which are children of the \"eyes\" node in the
820 ;;creature."
821 [#^Node creature]
822 (if-let [eye-node (.getChild creature "eyes")]
823 (seq (.getChildren eye-node))
824 (do (println-repl "could not find eyes node") [])))
826 ;; Here's how vision will work.
828 ;; Make the continuation in scene-processor take FrameBuffer,
829 ;; byte-buffer, BufferedImage already sized to the correct
830 ;; dimensions. the continuation will decide wether to "mix" them
831 ;; into the BufferedImage, lazily ignore them, or mix them halfway
832 ;; and call c/graphics card routines.
834 ;; (vision creature) will take an optional :skip argument which will
835 ;; inform the continuations in scene processor to skip the given
836 ;; number of cycles; 0 means that no cycles will be skipped.
838 ;; (vision creature) will return [init-functions sensor-functions].
839 ;; The init-functions are each single-arg functions that take the
840 ;; world and register the cameras and must each be called before the
841 ;; corresponding sensor-functions. Each init-function returns the
842 ;; viewport for that eye which can be manipulated, saved, etc. Each
843 ;; sensor-function is a thunk and will return data in the same
844 ;; format as the tactile-sensor functions; the structure is
845 ;; [topology, sensor-data]. Internally, these sensor-functions
846 ;; maintain a reference to sensor-data which is periodically updated
847 ;; by the continuation function established by its init-function.
848 ;; They can be queried every cycle, but their information may not
849 ;; necessairly be different every cycle.
851 ;; Each eye in the creature in blender will work the same way as
852 ;; joints -- a zero dimensional object with no geometry whose local
853 ;; coordinate system determines the orientation of the resulting
854 ;; eye. All eyes will have a parent named "eyes" just as all joints
855 ;; have a parent named "joints". The resulting camera will be a
856 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
857 ;; the eye marker. The eye marker will contain the metadata for the
858 ;; eye, and will be moved by it's bound geometry. The dimensions of
859 ;; the eye's camera are equal to the dimensions of the eye's "UV"
860 ;; map.
863 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
865 ;; Ears work the same way as vision.
867 ;; (hearing creature) will return [init-functions
868 ;; sensor-functions]. The init functions each take the world and
869 ;; register a SoundProcessor that does foureier transforms on the
870 ;; incommong sound data, making it available to each sensor function.
872 (defn creature-ears
873 "Return the children of the creature's \"ears\" node."
874 ;;dylan
875 ;;"The ear nodes which are children of the \"ears\" node in the
876 ;;creature."
877 [#^Node creature]
878 (if-let [ear-node (.getChild creature "ears")]
879 (seq (.getChildren ear-node))
880 (do (println-repl "could not find ears node") [])))
882 (defn closest-node
883 "Return the object in creature which is closest to the given node."
884 ;;dylan"The closest object in creature to the given node."
885 [#^Node creature #^Node eye]
886 (loop [radius (float 0.01)]
887 (let [results (CollisionResults.)]
888 (.collideWith
889 creature
890 (BoundingBox. (.getWorldTranslation eye)
891 radius radius radius)
892 results)
893 (if-let [target (first results)]
894 (.getGeometry target)
895 (recur (float (* 2 radius)))))))
897 ;;dylan (defn follow-sense, adjoin-sense, attach-stimuli,
898 ;;anchor-qualia, augment-organ, with-organ
899 (defn bind-sense
900 "Bind the sense to the Spatial such that it will maintain its
901 current position relative to the Spatial no matter how the spatial
902 moves. 'sense can be either a Camera or Listener object."
903 [#^Spatial obj sense]
904 (let [sense-offset (.subtract (.getLocation sense)
905 (.getWorldTranslation obj))
906 initial-sense-rotation (Quaternion. (.getRotation sense))
907 base-anti-rotation (.inverse (.getWorldRotation obj))]
908 (.addControl
909 obj
910 (proxy [AbstractControl] []
911 (controlUpdate [tpf]
912 (let [total-rotation
913 (.mult base-anti-rotation (.getWorldRotation obj))]
914 (.setLocation sense
915 (.add
916 (.mult total-rotation sense-offset)
917 (.getWorldTranslation obj)))
918 (.setRotation sense
919 (.mult total-rotation initial-sense-rotation))))
920 (controlRender [_ _])))))
923 (defn update-listener-velocity
924 "Update the listener's velocity every update loop."
925 [#^Spatial obj #^Listener lis]
926 (let [old-position (atom (.getLocation lis))]
927 (.addControl
928 obj
929 (proxy [AbstractControl] []
930 (controlUpdate [tpf]
931 (let [new-position (.getLocation lis)]
932 (.setVelocity
933 lis
934 (.mult (.subtract new-position @old-position)
935 (float (/ tpf))))
936 (reset! old-position new-position)))
937 (controlRender [_ _])))))
939 (import com.aurellem.capture.audio.AudioSendRenderer)
941 (defn attach-ear
942 [#^Application world #^Node creature #^Spatial ear continuation]
943 (let [target (closest-node creature ear)
944 lis (Listener.)
945 audio-renderer (.getAudioRenderer world)
946 sp (sound-processor continuation)]
947 (.setLocation lis (.getWorldTranslation ear))
948 (.setRotation lis (.getWorldRotation ear))
949 (bind-sense target lis)
950 (update-listener-velocity target lis)
951 (.addListener audio-renderer lis)
952 (.registerSoundProcessor audio-renderer lis sp)))
954 (defn enable-hearing
955 [#^Node creature #^Spatial ear]
956 (let [hearing-data (atom [])]
957 [(fn [world]
958 (attach-ear world creature ear
959 (fn [data]
960 (reset! hearing-data (vec data)))))
961 [(fn []
962 (let [data @hearing-data
963 topology
964 (vec (map #(vector % 0) (range 0 (count data))))
965 scaled-data
966 (vec
967 (map
968 #(rem (int (* 255 (/ (+ 1 %) 2))) 256)
969 data))]
970 [topology scaled-data]))
971 ]]))
973 (defn hearing
974 [#^Node creature]
975 (reduce
976 (fn [[init-a senses-a]
977 [init-b senses-b]]
978 [(conj init-a init-b)
979 (into senses-a senses-b)])
980 [[][]]
981 (for [ear (creature-ears creature)]
982 (enable-hearing creature ear))))
984 (defn attach-eye
985 "Attach a Camera to the appropiate area and return the Camera."
986 [#^Node creature #^Spatial eye]
987 (let [target (closest-node creature eye)
988 [cam-width cam-height] (eye-dimensions eye)
989 cam (Camera. cam-width cam-height)]
990 (.setLocation cam (.getWorldTranslation eye))
991 (.setRotation cam (.getWorldRotation eye))
992 (.setFrustumPerspective
993 cam 45 (/ (.getWidth cam) (.getHeight cam))
994 1 1000)
995 (bind-sense target cam)
996 cam))
998 (def presets
999 {:all 0xFFFFFF
1000 :red 0xFF0000
1001 :blue 0x0000FF
1002 :green 0x00FF00})
1004 (defn enable-vision
1005 "return [init-function sensor-functions] for a particular eye"
1006 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
1007 (let [retinal-map (retina-sensor-image eye)
1008 camera (attach-eye creature eye)
1009 vision-image
1010 (atom
1011 (BufferedImage. (.getWidth camera)
1012 (.getHeight camera)
1013 BufferedImage/TYPE_BYTE_BINARY))]
1014 [(fn [world]
1015 (add-eye
1016 world camera
1017 (let [counter (atom 0)]
1018 (fn [r fb bb bi]
1019 (if (zero? (rem (swap! counter inc) (inc skip)))
1020 (reset! vision-image (BufferedImage! r fb bb bi)))))))
1021 (vec
1022 (map
1023 (fn [[key image]]
1024 (let [whites (white-coordinates image)
1025 topology (vec (collapse whites))
1026 mask (presets key)]
1027 (fn []
1028 (vector
1029 topology
1030 (vec
1031 (for [[x y] whites]
1032 (bit-and
1033 mask (.getRGB @vision-image x y))))))))
1034 retinal-map))]))
1036 (defn vision
1037 [#^Node creature & {skip :skip :or {skip 0}}]
1038 (reduce
1039 (fn [[init-a senses-a]
1040 [init-b senses-b]]
1041 [(conj init-a init-b)
1042 (into senses-a senses-b)])
1043 [[][]]
1044 (for [eye (creature-eyes creature)]
1045 (enable-vision creature eye))))
1051 ;; lower level --- nodes
1052 ;; closest-node "parse/compile-x" -> makes organ, which is spatial, fn pair
1054 ;; higher level -- organs
1055 ;;
1057 ;; higher level --- sense/effector
1058 ;; these are the functions that provide world i/o, chinese-room style
1061 (defn creature-joints
1062 "Return the children of the creature's \"joints\" node."
1063 [#^Node creature]
1064 (if-let [joint-node (.getChild creature "joints")]
1065 (seq (.getChildren joint-node))
1066 (do (println-repl "could not find JOINTS node") [])))
1069 (defn blender-creature
1070 "Return a creature with all joints in place."
1071 [blender-path]
1072 (let [model (load-blender-model blender-path)
1073 joints (creature-joints model)]
1074 (assemble-creature model joints)))
1076 (defn gray-scale [num]
1077 (+ num
1078 (bit-shift-left num 8)
1079 (bit-shift-left num 16)))
1081 (defn debug-touch-window
1082 "creates function that offers a debug view of sensor data"
1083 []
1084 (let [vi (view-image)]
1085 (fn
1086 [[coords sensor-data]]
1087 (let [image (points->image coords)]
1088 (dorun
1089 (for [i (range (count coords))]
1090 (.setRGB image ((coords i) 0) ((coords i) 1)
1091 (gray-scale (sensor-data i)))))
1094 (vi image)))))
1096 (defn debug-vision-window
1097 "creates function that offers a debug view of sensor data"
1098 []
1099 (let [vi (view-image)]
1100 (fn
1101 [[coords sensor-data]]
1102 (let [image (points->image coords)]
1103 (dorun
1104 (for [i (range (count coords))]
1105 (.setRGB image ((coords i) 0) ((coords i) 1)
1106 (sensor-data i))))
1107 (vi image)))))
1109 (defn debug-hearing-window
1110 "view audio data"
1111 [height]
1112 (let [vi (view-image)]
1113 (fn [[coords sensor-data]]
1114 (let [image (BufferedImage. (count coords) height
1115 BufferedImage/TYPE_INT_RGB)]
1116 (dorun
1117 (for [x (range (count coords))]
1118 (dorun
1119 (for [y (range height)]
1120 (let [raw-sensor (sensor-data x)]
1121 (.setRGB image x y (gray-scale raw-sensor)))))))
1123 (vi image)))))
1127 ;;(defn test-touch [world creature]
1132 ;; here's how motor-control/ proprioception will work: Each muscle is
1133 ;; defined by a 1-D array of numbers (the "motor pool") each of which
1134 ;; represent muscle fibers. A muscle also has a scalar :strength
1135 ;; factor which determines how strong the muscle as a whole is.
1136 ;; The effector function for a muscle takes a number < (count
1137 ;; motor-pool) and that number is said to "activate" all the muscle
1138 ;; fibers whose index is lower than the number. Each fiber will apply
1139 ;; force in proportion to its value in the array. Lower values cause
1140 ;; less force. The lower values can be put at the "beginning" of the
1141 ;; 1-D array to simulate the layout of actual human muscles, which are
1142 ;; capable of more percise movements when exerting less force.
1144 ;; I don't know how to encode proprioception, so for now, just return
1145 ;; a function for each joint that returns a triplet of floats which
1146 ;; represent relative roll, pitch, and yaw. Write display code for
1147 ;; this though.
1149 (defn muscle-fibre-values
1150 "Take the first row of the image and return the low-order bytes."
1151 [#^BufferedImage image]
1152 (let [width (.getWidth image)]
1153 (for [x (range width)]
1154 (bit-and
1155 0xFF
1156 (.getRGB image x 0)))))
1159 (defn rad->deg [rad]
1160 (* 180 (/ Math/PI) rad))
1163 (defn debug-prop-window
1164 "create a debug view for proprioception"
1165 []
1166 (let [vi (view-image)]
1167 (fn [sensor-data]
1168 (println-repl
1169 (map
1170 (fn [[yaw pitch roll]]
1171 [(rad->deg yaw)
1172 (rad->deg pitch)
1173 (rad->deg roll)])
1174 sensor-data)))))
1177 (defn draw-sprite [image sprite x y color ]
1178 (dorun
1179 (for [[u v] sprite]
1180 (.setRGB image (+ u x) (+ v y) color))))
1182 (defn view-angle
1183 "create a debug view of an angle"
1184 [color]
1185 (let [image (BufferedImage. 50 50 BufferedImage/TYPE_INT_RGB)
1186 previous (atom [25 25])
1187 sprite [[0 0] [0 1]
1188 [0 -1] [-1 0] [1 0]]]
1189 (fn [angle]
1190 (let [angle (float angle)]
1191 (let [position
1192 [(+ 25 (int (* 20 (Math/cos angle))))
1193 (+ 25 (int (* 20(Math/sin angle))))]]
1194 (draw-sprite image sprite (@previous 0) (@previous 1) 0x000000)
1195 (draw-sprite image sprite (position 0) (position 1) color)
1196 (reset! previous position))
1197 image))))
1199 (defn proprioception-debug-window
1200 []
1201 (let [yaw (view-angle 0xFF0000)
1202 roll (view-angle 0x00FF00)
1203 pitch (view-angle 0xFFFFFF)
1204 v-yaw (view-image)
1205 v-roll (view-image)
1206 v-pitch (view-image)
1208 (fn [prop-data]
1209 (dorun
1210 (map
1211 (fn [[y r p]]
1212 (v-yaw (yaw y))
1213 (v-roll (roll r))
1214 (v-pitch (pitch p)))
1215 prop-data)))))
1223 (defn test-creature [thing]
1224 (let [x-axis
1225 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
1226 y-axis
1227 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
1228 z-axis
1229 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
1230 creature (blender-creature thing)
1231 touch-nerves (touch creature)
1232 touch-debug-windows (map (fn [_] (debug-touch-window)) touch-nerves)
1233 [init-vision-fns vision-data] (vision creature)
1234 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
1235 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
1236 [init-hearing-fns hearing-senses] (hearing creature)
1237 hearing-windows (map (fn [_] (debug-hearing-window 50))
1238 hearing-senses)
1239 bell (AudioNode. (asset-manager)
1240 "Sounds/pure.wav" false)
1241 prop (proprioception creature)
1242 prop-debug (debug-prop-window)
1243 ;; dream
1246 (world
1247 (nodify [creature
1248 (box 10 2 10 :position (Vector3f. 0 -9 0)
1249 :color ColorRGBA/Gray :mass 0)
1250 x-axis y-axis z-axis
1251 me
1252 ])
1253 (merge standard-debug-controls
1254 {"key-return"
1255 (fn [_ value]
1256 (if value
1257 (do
1258 (println-repl "play-sound")
1259 (.play bell))))})
1260 (fn [world]
1261 (light-up-everything world)
1262 (enable-debug world)
1263 (dorun (map #(% world) init-vision-fns))
1264 (dorun (map #(% world) init-hearing-fns))
1266 (add-eye world
1267 (attach-eye creature (test-eye))
1268 (comp (view-image) BufferedImage!))
1270 (add-eye world (.getCamera world) no-op)
1271 ;;(set-gravity world (Vector3f. 0 0 0))
1272 ;;(com.aurellem.capture.Capture/captureVideo
1273 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1274 ;;(.setTimer world (RatchetTimer. 60))
1275 (speed-up world)
1276 ;;(set-gravity world (Vector3f. 0 0 0))
1278 (fn [world tpf]
1279 ;;(dorun
1280 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1282 (prop-debug (prop))
1284 (dorun
1285 (map #(%1 (%2 (.getRootNode world)))
1286 touch-debug-windows touch-nerves))
1288 (dorun
1289 (map #(%1 (%2))
1290 vision-debug vision-data))
1291 (dorun
1292 (map #(%1 (%2)) hearing-windows hearing-senses))
1295 ;;(println-repl (vision-data))
1296 (.setLocalTranslation me (.getLocation (.getCamera world)))
1300 ;;(let [timer (atom 0)]
1301 ;; (fn [_ _]
1302 ;; (swap! timer inc)
1303 ;; (if (= (rem @timer 60) 0)
1304 ;; (println-repl (float (/ @timer 60))))))
1305 )))
1315 ;;; experiments in collisions
1319 (defn collision-test []
1320 (let [b-radius 1
1321 b-position (Vector3f. 0 0 0)
1322 obj-b (box 1 1 1 :color ColorRGBA/Blue
1323 :position b-position
1324 :mass 0)
1325 node (nodify [obj-b])
1326 bounds-b
1327 (doto (Picture.)
1328 (.setHeight 50)
1329 (.setWidth 50)
1330 (.setImage (asset-manager)
1331 "Models/creature1/hand.png"
1332 false
1333 ))
1335 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1337 collisions
1338 (let [cr (CollisionResults.)]
1339 (.collideWith node bounds-b cr)
1340 (println (map #(.getContactPoint %) cr))
1341 cr)
1343 ;;collision-points
1344 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1345 ;; collisions)
1347 ;;node (nodify (conj collision-points obj-b))
1349 sim
1350 (world node
1351 {"key-space"
1352 (fn [_ value]
1353 (if value
1354 (let [cr (CollisionResults.)]
1355 (.collideWith node bounds-b cr)
1356 (println-repl (map #(.getContactPoint %) cr))
1357 cr)))}
1358 no-op
1359 no-op)
1362 sim
1364 ))
1367 ;; the camera will stay in its initial position/rotation with relation
1368 ;; to the spatial.
1371 (defn follow-test
1372 "show a camera that stays in the same relative position to a blue cube."
1373 []
1374 (let [camera-pos (Vector3f. 0 30 0)
1375 rock (box 1 1 1 :color ColorRGBA/Blue
1376 :position (Vector3f. 0 10 0)
1377 :mass 30
1379 rot (.getWorldRotation rock)
1381 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1382 :position (Vector3f. 0 -3 0))]
1384 (world
1385 (nodify [rock table])
1386 standard-debug-controls
1387 (fn [world]
1388 (let
1389 [cam (doto (.clone (.getCamera world))
1390 (.setLocation camera-pos)
1391 (.lookAt Vector3f/ZERO
1392 Vector3f/UNIT_X))]
1393 (bind-sense rock cam)
1395 (.setTimer world (RatchetTimer. 60))
1396 (add-eye world cam (comp (view-image) BufferedImage!))
1397 (add-eye world (.getCamera world) no-op))
1399 (fn [_ _] (println-repl rot)))))
1403 #+end_src
1405 #+results: body-1
1406 : #'cortex.silly/follow-test
1409 * COMMENT purgatory
1410 #+begin_src clojure
1411 (defn bullet-trans []
1412 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1413 :position (Vector3f. -10 5 0))
1414 obj-b (sphere 0.5 :color ColorRGBA/Blue
1415 :position (Vector3f. -10 -5 0)
1416 :mass 0)
1417 control-a (.getControl obj-a RigidBodyControl)
1418 control-b (.getControl obj-b RigidBodyControl)
1419 swivel
1420 (.toRotationMatrix
1421 (doto (Quaternion.)
1422 (.fromAngleAxis (/ Math/PI 2)
1423 Vector3f/UNIT_X)))]
1424 (doto
1425 (ConeJoint.
1426 control-a control-b
1427 (Vector3f. 0 5 0)
1428 (Vector3f. 0 -5 0)
1429 swivel swivel)
1430 (.setLimit (* 0.6 (/ Math/PI 4))
1431 (/ Math/PI 4)
1432 (* Math/PI 0.8)))
1433 (world (nodify
1434 [obj-a obj-b])
1435 standard-debug-controls
1436 enable-debug
1437 no-op)))
1440 (defn bullet-trans* []
1441 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1442 :position (Vector3f. 5 0 0)
1443 :mass 90)
1444 obj-b (sphere 0.5 :color ColorRGBA/Blue
1445 :position (Vector3f. -5 0 0)
1446 :mass 0)
1447 control-a (.getControl obj-a RigidBodyControl)
1448 control-b (.getControl obj-b RigidBodyControl)
1449 move-up? (atom nil)
1450 move-down? (atom nil)
1451 move-left? (atom nil)
1452 move-right? (atom nil)
1453 roll-left? (atom nil)
1454 roll-right? (atom nil)
1455 force 100
1456 swivel
1457 (.toRotationMatrix
1458 (doto (Quaternion.)
1459 (.fromAngleAxis (/ Math/PI 2)
1460 Vector3f/UNIT_X)))
1461 x-move
1462 (doto (Matrix3f.)
1463 (.fromStartEndVectors Vector3f/UNIT_X
1464 (.normalize (Vector3f. 1 1 0))))
1466 timer (atom 0)]
1467 (doto
1468 (ConeJoint.
1469 control-a control-b
1470 (Vector3f. -8 0 0)
1471 (Vector3f. 2 0 0)
1472 ;;swivel swivel
1473 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1474 x-move Matrix3f/IDENTITY
1476 (.setCollisionBetweenLinkedBodys false)
1477 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1478 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1479 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1480 (world (nodify
1481 [obj-a obj-b])
1482 (merge standard-debug-controls
1483 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1484 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1485 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1486 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1487 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1488 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1490 (fn [world]
1491 (enable-debug world)
1492 (set-gravity world Vector3f/ZERO)
1495 (fn [world _]
1497 (if @move-up?
1498 (.applyForce control-a
1499 (Vector3f. force 0 0)
1500 (Vector3f. 0 0 0)))
1501 (if @move-down?
1502 (.applyForce control-a
1503 (Vector3f. (- force) 0 0)
1504 (Vector3f. 0 0 0)))
1505 (if @move-left?
1506 (.applyForce control-a
1507 (Vector3f. 0 force 0)
1508 (Vector3f. 0 0 0)))
1509 (if @move-right?
1510 (.applyForce control-a
1511 (Vector3f. 0 (- force) 0)
1512 (Vector3f. 0 0 0)))
1514 (if @roll-left?
1515 (.applyForce control-a
1516 (Vector3f. 0 0 force)
1517 (Vector3f. 0 0 0)))
1518 (if @roll-right?
1519 (.applyForce control-a
1520 (Vector3f. 0 0 (- force))
1521 (Vector3f. 0 0 0)))
1523 (if (zero? (rem (swap! timer inc) 100))
1524 (.attachChild
1525 (.getRootNode world)
1526 (sphere 0.05 :color ColorRGBA/Yellow
1527 :physical? false :position
1528 (.getWorldTranslation obj-a)))))
1530 ))
1532 (defn transform-trianglesdsd
1533 "Transform that converts each vertex in the first triangle
1534 into the corresponding vertex in the second triangle."
1535 [#^Triangle tri-1 #^Triangle tri-2]
1536 (let [in [(.get1 tri-1)
1537 (.get2 tri-1)
1538 (.get3 tri-1)]
1539 out [(.get1 tri-2)
1540 (.get2 tri-2)
1541 (.get3 tri-2)]]
1542 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1543 in* [(.mult translate (in 0))
1544 (.mult translate (in 1))
1545 (.mult translate (in 2))]
1546 final-translation
1547 (doto (Matrix4f.)
1548 (.setTranslation (out 1)))
1550 rotate-1
1551 (doto (Matrix3f.)
1552 (.fromStartEndVectors
1553 (.normalize
1554 (.subtract
1555 (in* 1) (in* 0)))
1556 (.normalize
1557 (.subtract
1558 (out 1) (out 0)))))
1559 in** [(.mult rotate-1 (in* 0))
1560 (.mult rotate-1 (in* 1))
1561 (.mult rotate-1 (in* 2))]
1562 scale-factor-1
1563 (.mult
1564 (.normalize
1565 (.subtract
1566 (out 1)
1567 (out 0)))
1568 (/ (.length
1569 (.subtract (out 1)
1570 (out 0)))
1571 (.length
1572 (.subtract (in** 1)
1573 (in** 0)))))
1574 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1575 in*** [(.mult scale-1 (in** 0))
1576 (.mult scale-1 (in** 1))
1577 (.mult scale-1 (in** 2))]
1585 (dorun (map println in))
1586 (println)
1587 (dorun (map println in*))
1588 (println)
1589 (dorun (map println in**))
1590 (println)
1591 (dorun (map println in***))
1592 (println)
1594 ))))
1597 (defn world-setup [joint]
1598 (let [joint-position (Vector3f. 0 0 0)
1599 joint-rotation
1600 (.toRotationMatrix
1601 (.mult
1602 (doto (Quaternion.)
1603 (.fromAngleAxis
1604 (* 1 (/ Math/PI 4))
1605 (Vector3f. -1 0 0)))
1606 (doto (Quaternion.)
1607 (.fromAngleAxis
1608 (* 1 (/ Math/PI 2))
1609 (Vector3f. 0 0 1)))))
1610 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1612 origin (doto
1613 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1614 :position top-position))
1615 top (doto
1616 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1617 :position top-position)
1619 (.addControl
1620 (RigidBodyControl.
1621 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1622 bottom (doto
1623 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1624 :position (Vector3f. 0 0 0))
1625 (.addControl
1626 (RigidBodyControl.
1627 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1628 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1629 :color ColorRGBA/Gray :mass 0)
1630 a (.getControl top RigidBodyControl)
1631 b (.getControl bottom RigidBodyControl)]
1633 (cond
1634 (= joint :cone)
1636 (doto (ConeJoint.
1637 a b
1638 (world-to-local top joint-position)
1639 (world-to-local bottom joint-position)
1640 joint-rotation
1641 joint-rotation
1645 (.setLimit (* (/ 10) Math/PI)
1646 (* (/ 4) Math/PI)
1647 0)))
1648 [origin top bottom table]))
1650 (defn test-joint [joint]
1651 (let [[origin top bottom floor] (world-setup joint)
1652 control (.getControl top RigidBodyControl)
1653 move-up? (atom false)
1654 move-down? (atom false)
1655 move-left? (atom false)
1656 move-right? (atom false)
1657 roll-left? (atom false)
1658 roll-right? (atom false)
1659 timer (atom 0)]
1661 (world
1662 (nodify [top bottom floor origin])
1663 (merge standard-debug-controls
1664 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1665 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1666 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1667 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1668 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1669 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1671 (fn [world]
1672 (light-up-everything world)
1673 (enable-debug world)
1674 (set-gravity world (Vector3f. 0 0 0))
1677 (fn [world _]
1678 (if (zero? (rem (swap! timer inc) 100))
1679 (do
1680 ;; (println-repl @timer)
1681 (.attachChild (.getRootNode world)
1682 (sphere 0.05 :color ColorRGBA/Yellow
1683 :position (.getWorldTranslation top)
1684 :physical? false))
1685 (.attachChild (.getRootNode world)
1686 (sphere 0.05 :color ColorRGBA/LightGray
1687 :position (.getWorldTranslation bottom)
1688 :physical? false))))
1690 (if @move-up?
1691 (.applyTorque control
1692 (.mult (.getPhysicsRotation control)
1693 (Vector3f. 0 0 10))))
1694 (if @move-down?
1695 (.applyTorque control
1696 (.mult (.getPhysicsRotation control)
1697 (Vector3f. 0 0 -10))))
1698 (if @move-left?
1699 (.applyTorque control
1700 (.mult (.getPhysicsRotation control)
1701 (Vector3f. 0 10 0))))
1702 (if @move-right?
1703 (.applyTorque control
1704 (.mult (.getPhysicsRotation control)
1705 (Vector3f. 0 -10 0))))
1706 (if @roll-left?
1707 (.applyTorque control
1708 (.mult (.getPhysicsRotation control)
1709 (Vector3f. -1 0 0))))
1710 (if @roll-right?
1711 (.applyTorque control
1712 (.mult (.getPhysicsRotation control)
1713 (Vector3f. 1 0 0))))))))
1717 (defprotocol Frame
1718 (frame [this]))
1720 (extend-type BufferedImage
1721 Frame
1722 (frame [image]
1723 (merge
1724 (apply
1725 hash-map
1726 (interleave
1727 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1728 (vector x y)))
1729 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1730 (let [data (.getRGB image x y)]
1731 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1732 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1733 :b (bit-and 0x0000ff data)))))))
1734 {:width (.getWidth image) :height (.getHeight image)})))
1737 (extend-type ImagePlus
1738 Frame
1739 (frame [image+]
1740 (frame (.getBufferedImage image+))))
1743 #+end_src
1746 * COMMENT generate source
1747 #+begin_src clojure :tangle ../src/cortex/silly.clj
1748 <<body-1>>
1749 #+end_src