view org/test-creature.org @ 133:2ed7e60d3821

FINALLY got proprioception working
author Robert McIntyre <rlm@mit.edu>
date Wed, 01 Feb 2012 02:27:18 -0700
parents b26017d1fe9a
children ac350a0ac6b0
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
1062 (defn blender-creature
1063 "Return a creature with all joints in place."
1064 [blender-path]
1065 (let [model (load-blender-model blender-path)
1066 joints
1067 (if-let [joint-node (.getChild model "joints")]
1068 (seq (.getChildren joint-node))
1069 (do (println-repl "could not find joints node") []))]
1070 (assemble-creature model joints)))
1072 (defn gray-scale [num]
1073 (+ num
1074 (bit-shift-left num 8)
1075 (bit-shift-left num 16)))
1077 (defn debug-touch-window
1078 "creates function that offers a debug view of sensor data"
1079 []
1080 (let [vi (view-image)]
1081 (fn
1082 [[coords sensor-data]]
1083 (let [image (points->image coords)]
1084 (dorun
1085 (for [i (range (count coords))]
1086 (.setRGB image ((coords i) 0) ((coords i) 1)
1087 (gray-scale (sensor-data i)))))
1090 (vi image)))))
1092 (defn debug-vision-window
1093 "creates function that offers a debug view of sensor data"
1094 []
1095 (let [vi (view-image)]
1096 (fn
1097 [[coords sensor-data]]
1098 (let [image (points->image coords)]
1099 (dorun
1100 (for [i (range (count coords))]
1101 (.setRGB image ((coords i) 0) ((coords i) 1)
1102 (sensor-data i))))
1103 (vi image)))))
1105 (defn debug-hearing-window
1106 "view audio data"
1107 [height]
1108 (let [vi (view-image)]
1109 (fn [[coords sensor-data]]
1110 (let [image (BufferedImage. (count coords) height
1111 BufferedImage/TYPE_INT_RGB)]
1112 (dorun
1113 (for [x (range (count coords))]
1114 (dorun
1115 (for [y (range height)]
1116 (let [raw-sensor (sensor-data x)]
1117 (.setRGB image x y (gray-scale raw-sensor)))))))
1119 (vi image)))))
1123 ;;(defn test-touch [world creature]
1128 ;; here's how motor-control/ proprioception will work: Each muscle is
1129 ;; defined by a 1-D array of numbers (the "motor pool") each of which
1130 ;; represent muscle fibers. A muscle also has a scalar :strength
1131 ;; factor which determines how strong the muscle as a whole is.
1132 ;; The effector function for a muscle takes a number < (count
1133 ;; motor-pool) and that number is said to "activate" all the muscle
1134 ;; fibers whose index is lower than the number. Each fiber will apply
1135 ;; force in proportion to its value in the array. Lower values cause
1136 ;; less force. The lower values can be put at the "beginning" of the
1137 ;; 1-D array to simulate the layout of actual human muscles, which are
1138 ;; capable of more percise movements when exerting less force.
1140 ;; I don't know how to encode proprioception, so for now, just return
1141 ;; a function for each joint that returns a triplet of floats which
1142 ;; represent relative roll, pitch, and yaw. Write display code for
1143 ;; this though.
1145 (defn muscle-fibre-values
1146 "Take the first row of the image and return the low-order bytes."
1147 [#^BufferedImage image]
1148 (let [width (.getWidth image)]
1149 (for [x (range width)]
1150 (bit-and
1151 0xFF
1152 (.getRGB image x 0)))))
1155 (defn rad->deg [rad]
1156 (* 180 (/ Math/PI) rad))
1159 (defn debug-prop-window
1160 "create a debug view for proprioception"
1161 []
1162 (let [vi (view-image)]
1163 (fn [sensor-data]
1164 (println-repl
1165 (map
1166 (fn [[yaw pitch roll]]
1167 [(rad->deg yaw)
1168 (rad->deg pitch)
1169 (rad->deg roll)])
1170 sensor-data)))))
1177 (defn test-creature [thing]
1178 (let [x-axis
1179 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
1180 y-axis
1181 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
1182 z-axis
1183 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
1184 creature (blender-creature thing)
1185 touch-nerves (touch creature)
1186 touch-debug-windows (map (fn [_] (debug-touch-window)) touch-nerves)
1187 [init-vision-fns vision-data] (vision creature)
1188 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
1189 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
1190 [init-hearing-fns hearing-senses] (hearing creature)
1191 hearing-windows (map (fn [_] (debug-hearing-window 50))
1192 hearing-senses)
1193 bell (AudioNode. (asset-manager)
1194 "Sounds/pure.wav" false)
1195 prop (proprioception creature)
1196 prop-debug (debug-prop-window)
1197 ;; dream
1200 (world
1201 (nodify [creature
1202 (box 10 2 10 :position (Vector3f. 0 -9 0)
1203 :color ColorRGBA/Gray :mass 0)
1204 x-axis y-axis z-axis
1205 me
1206 ])
1207 (merge standard-debug-controls
1208 {"key-return"
1209 (fn [_ value]
1210 (if value
1211 (do
1212 (println-repl "play-sound")
1213 (.play bell))))})
1214 (fn [world]
1215 (light-up-everything world)
1216 (enable-debug world)
1217 (dorun (map #(% world) init-vision-fns))
1218 (dorun (map #(% world) init-hearing-fns))
1220 (add-eye world
1221 (attach-eye creature (test-eye))
1222 (comp (view-image) BufferedImage!))
1224 (add-eye world (.getCamera world) no-op)
1225 ;;(set-gravity world (Vector3f. 0 0 0))
1226 ;;(com.aurellem.capture.Capture/captureVideo
1227 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1228 ;;(.setTimer world (RatchetTimer. 60))
1229 (speed-up world)
1230 ;;(set-gravity world (Vector3f. 0 0 0))
1232 (fn [world tpf]
1233 ;;(dorun
1234 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1236 (prop-debug (prop))
1238 (dorun
1239 (map #(%1 (%2 (.getRootNode world)))
1240 touch-debug-windows touch-nerves))
1242 (dorun
1243 (map #(%1 (%2))
1244 vision-debug vision-data))
1245 (dorun
1246 (map #(%1 (%2)) hearing-windows hearing-senses))
1249 ;;(println-repl (vision-data))
1250 (.setLocalTranslation me (.getLocation (.getCamera world)))
1254 ;;(let [timer (atom 0)]
1255 ;; (fn [_ _]
1256 ;; (swap! timer inc)
1257 ;; (if (= (rem @timer 60) 0)
1258 ;; (println-repl (float (/ @timer 60))))))
1259 )))
1269 ;;; experiments in collisions
1273 (defn collision-test []
1274 (let [b-radius 1
1275 b-position (Vector3f. 0 0 0)
1276 obj-b (box 1 1 1 :color ColorRGBA/Blue
1277 :position b-position
1278 :mass 0)
1279 node (nodify [obj-b])
1280 bounds-b
1281 (doto (Picture.)
1282 (.setHeight 50)
1283 (.setWidth 50)
1284 (.setImage (asset-manager)
1285 "Models/creature1/hand.png"
1286 false
1287 ))
1289 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1291 collisions
1292 (let [cr (CollisionResults.)]
1293 (.collideWith node bounds-b cr)
1294 (println (map #(.getContactPoint %) cr))
1295 cr)
1297 ;;collision-points
1298 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1299 ;; collisions)
1301 ;;node (nodify (conj collision-points obj-b))
1303 sim
1304 (world node
1305 {"key-space"
1306 (fn [_ value]
1307 (if value
1308 (let [cr (CollisionResults.)]
1309 (.collideWith node bounds-b cr)
1310 (println-repl (map #(.getContactPoint %) cr))
1311 cr)))}
1312 no-op
1313 no-op)
1316 sim
1318 ))
1321 ;; the camera will stay in its initial position/rotation with relation
1322 ;; to the spatial.
1325 (defn follow-test
1326 "show a camera that stays in the same relative position to a blue cube."
1327 []
1328 (let [camera-pos (Vector3f. 0 30 0)
1329 rock (box 1 1 1 :color ColorRGBA/Blue
1330 :position (Vector3f. 0 10 0)
1331 :mass 30
1333 rot (.getWorldRotation rock)
1335 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1336 :position (Vector3f. 0 -3 0))]
1338 (world
1339 (nodify [rock table])
1340 standard-debug-controls
1341 (fn [world]
1342 (let
1343 [cam (doto (.clone (.getCamera world))
1344 (.setLocation camera-pos)
1345 (.lookAt Vector3f/ZERO
1346 Vector3f/UNIT_X))]
1347 (bind-sense rock cam)
1349 (.setTimer world (RatchetTimer. 60))
1350 (add-eye world cam (comp (view-image) BufferedImage!))
1351 (add-eye world (.getCamera world) no-op))
1353 (fn [_ _] (println-repl rot)))))
1357 #+end_src
1359 #+results: body-1
1360 : #'cortex.silly/follow-test
1363 * COMMENT purgatory
1364 #+begin_src clojure
1365 (defn bullet-trans []
1366 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1367 :position (Vector3f. -10 5 0))
1368 obj-b (sphere 0.5 :color ColorRGBA/Blue
1369 :position (Vector3f. -10 -5 0)
1370 :mass 0)
1371 control-a (.getControl obj-a RigidBodyControl)
1372 control-b (.getControl obj-b RigidBodyControl)
1373 swivel
1374 (.toRotationMatrix
1375 (doto (Quaternion.)
1376 (.fromAngleAxis (/ Math/PI 2)
1377 Vector3f/UNIT_X)))]
1378 (doto
1379 (ConeJoint.
1380 control-a control-b
1381 (Vector3f. 0 5 0)
1382 (Vector3f. 0 -5 0)
1383 swivel swivel)
1384 (.setLimit (* 0.6 (/ Math/PI 4))
1385 (/ Math/PI 4)
1386 (* Math/PI 0.8)))
1387 (world (nodify
1388 [obj-a obj-b])
1389 standard-debug-controls
1390 enable-debug
1391 no-op)))
1394 (defn bullet-trans* []
1395 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1396 :position (Vector3f. 5 0 0)
1397 :mass 90)
1398 obj-b (sphere 0.5 :color ColorRGBA/Blue
1399 :position (Vector3f. -5 0 0)
1400 :mass 0)
1401 control-a (.getControl obj-a RigidBodyControl)
1402 control-b (.getControl obj-b RigidBodyControl)
1403 move-up? (atom nil)
1404 move-down? (atom nil)
1405 move-left? (atom nil)
1406 move-right? (atom nil)
1407 roll-left? (atom nil)
1408 roll-right? (atom nil)
1409 force 100
1410 swivel
1411 (.toRotationMatrix
1412 (doto (Quaternion.)
1413 (.fromAngleAxis (/ Math/PI 2)
1414 Vector3f/UNIT_X)))
1415 x-move
1416 (doto (Matrix3f.)
1417 (.fromStartEndVectors Vector3f/UNIT_X
1418 (.normalize (Vector3f. 1 1 0))))
1420 timer (atom 0)]
1421 (doto
1422 (ConeJoint.
1423 control-a control-b
1424 (Vector3f. -8 0 0)
1425 (Vector3f. 2 0 0)
1426 ;;swivel swivel
1427 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1428 x-move Matrix3f/IDENTITY
1430 (.setCollisionBetweenLinkedBodys false)
1431 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1432 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1433 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1434 (world (nodify
1435 [obj-a obj-b])
1436 (merge standard-debug-controls
1437 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1438 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1439 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1440 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1441 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1442 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1444 (fn [world]
1445 (enable-debug world)
1446 (set-gravity world Vector3f/ZERO)
1449 (fn [world _]
1451 (if @move-up?
1452 (.applyForce control-a
1453 (Vector3f. force 0 0)
1454 (Vector3f. 0 0 0)))
1455 (if @move-down?
1456 (.applyForce control-a
1457 (Vector3f. (- force) 0 0)
1458 (Vector3f. 0 0 0)))
1459 (if @move-left?
1460 (.applyForce control-a
1461 (Vector3f. 0 force 0)
1462 (Vector3f. 0 0 0)))
1463 (if @move-right?
1464 (.applyForce control-a
1465 (Vector3f. 0 (- force) 0)
1466 (Vector3f. 0 0 0)))
1468 (if @roll-left?
1469 (.applyForce control-a
1470 (Vector3f. 0 0 force)
1471 (Vector3f. 0 0 0)))
1472 (if @roll-right?
1473 (.applyForce control-a
1474 (Vector3f. 0 0 (- force))
1475 (Vector3f. 0 0 0)))
1477 (if (zero? (rem (swap! timer inc) 100))
1478 (.attachChild
1479 (.getRootNode world)
1480 (sphere 0.05 :color ColorRGBA/Yellow
1481 :physical? false :position
1482 (.getWorldTranslation obj-a)))))
1484 ))
1486 (defn transform-trianglesdsd
1487 "Transform that converts each vertex in the first triangle
1488 into the corresponding vertex in the second triangle."
1489 [#^Triangle tri-1 #^Triangle tri-2]
1490 (let [in [(.get1 tri-1)
1491 (.get2 tri-1)
1492 (.get3 tri-1)]
1493 out [(.get1 tri-2)
1494 (.get2 tri-2)
1495 (.get3 tri-2)]]
1496 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1497 in* [(.mult translate (in 0))
1498 (.mult translate (in 1))
1499 (.mult translate (in 2))]
1500 final-translation
1501 (doto (Matrix4f.)
1502 (.setTranslation (out 1)))
1504 rotate-1
1505 (doto (Matrix3f.)
1506 (.fromStartEndVectors
1507 (.normalize
1508 (.subtract
1509 (in* 1) (in* 0)))
1510 (.normalize
1511 (.subtract
1512 (out 1) (out 0)))))
1513 in** [(.mult rotate-1 (in* 0))
1514 (.mult rotate-1 (in* 1))
1515 (.mult rotate-1 (in* 2))]
1516 scale-factor-1
1517 (.mult
1518 (.normalize
1519 (.subtract
1520 (out 1)
1521 (out 0)))
1522 (/ (.length
1523 (.subtract (out 1)
1524 (out 0)))
1525 (.length
1526 (.subtract (in** 1)
1527 (in** 0)))))
1528 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1529 in*** [(.mult scale-1 (in** 0))
1530 (.mult scale-1 (in** 1))
1531 (.mult scale-1 (in** 2))]
1539 (dorun (map println in))
1540 (println)
1541 (dorun (map println in*))
1542 (println)
1543 (dorun (map println in**))
1544 (println)
1545 (dorun (map println in***))
1546 (println)
1548 ))))
1551 (defn world-setup [joint]
1552 (let [joint-position (Vector3f. 0 0 0)
1553 joint-rotation
1554 (.toRotationMatrix
1555 (.mult
1556 (doto (Quaternion.)
1557 (.fromAngleAxis
1558 (* 1 (/ Math/PI 4))
1559 (Vector3f. -1 0 0)))
1560 (doto (Quaternion.)
1561 (.fromAngleAxis
1562 (* 1 (/ Math/PI 2))
1563 (Vector3f. 0 0 1)))))
1564 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1566 origin (doto
1567 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1568 :position top-position))
1569 top (doto
1570 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1571 :position top-position)
1573 (.addControl
1574 (RigidBodyControl.
1575 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1576 bottom (doto
1577 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1578 :position (Vector3f. 0 0 0))
1579 (.addControl
1580 (RigidBodyControl.
1581 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1582 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1583 :color ColorRGBA/Gray :mass 0)
1584 a (.getControl top RigidBodyControl)
1585 b (.getControl bottom RigidBodyControl)]
1587 (cond
1588 (= joint :cone)
1590 (doto (ConeJoint.
1591 a b
1592 (world-to-local top joint-position)
1593 (world-to-local bottom joint-position)
1594 joint-rotation
1595 joint-rotation
1599 (.setLimit (* (/ 10) Math/PI)
1600 (* (/ 4) Math/PI)
1601 0)))
1602 [origin top bottom table]))
1604 (defn test-joint [joint]
1605 (let [[origin top bottom floor] (world-setup joint)
1606 control (.getControl top RigidBodyControl)
1607 move-up? (atom false)
1608 move-down? (atom false)
1609 move-left? (atom false)
1610 move-right? (atom false)
1611 roll-left? (atom false)
1612 roll-right? (atom false)
1613 timer (atom 0)]
1615 (world
1616 (nodify [top bottom floor origin])
1617 (merge standard-debug-controls
1618 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1619 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1620 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1621 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1622 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1623 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1625 (fn [world]
1626 (light-up-everything world)
1627 (enable-debug world)
1628 (set-gravity world (Vector3f. 0 0 0))
1631 (fn [world _]
1632 (if (zero? (rem (swap! timer inc) 100))
1633 (do
1634 ;; (println-repl @timer)
1635 (.attachChild (.getRootNode world)
1636 (sphere 0.05 :color ColorRGBA/Yellow
1637 :position (.getWorldTranslation top)
1638 :physical? false))
1639 (.attachChild (.getRootNode world)
1640 (sphere 0.05 :color ColorRGBA/LightGray
1641 :position (.getWorldTranslation bottom)
1642 :physical? false))))
1644 (if @move-up?
1645 (.applyTorque control
1646 (.mult (.getPhysicsRotation control)
1647 (Vector3f. 0 0 10))))
1648 (if @move-down?
1649 (.applyTorque control
1650 (.mult (.getPhysicsRotation control)
1651 (Vector3f. 0 0 -10))))
1652 (if @move-left?
1653 (.applyTorque control
1654 (.mult (.getPhysicsRotation control)
1655 (Vector3f. 0 10 0))))
1656 (if @move-right?
1657 (.applyTorque control
1658 (.mult (.getPhysicsRotation control)
1659 (Vector3f. 0 -10 0))))
1660 (if @roll-left?
1661 (.applyTorque control
1662 (.mult (.getPhysicsRotation control)
1663 (Vector3f. -1 0 0))))
1664 (if @roll-right?
1665 (.applyTorque control
1666 (.mult (.getPhysicsRotation control)
1667 (Vector3f. 1 0 0))))))))
1671 (defprotocol Frame
1672 (frame [this]))
1674 (extend-type BufferedImage
1675 Frame
1676 (frame [image]
1677 (merge
1678 (apply
1679 hash-map
1680 (interleave
1681 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1682 (vector x y)))
1683 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1684 (let [data (.getRGB image x y)]
1685 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1686 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1687 :b (bit-and 0x0000ff data)))))))
1688 {:width (.getWidth image) :height (.getHeight image)})))
1691 (extend-type ImagePlus
1692 Frame
1693 (frame [image+]
1694 (frame (.getBufferedImage image+))))
1697 #+end_src
1700 * COMMENT generate source
1701 #+begin_src clojure :tangle ../src/cortex/silly.clj
1702 <<body-1>>
1703 #+end_src