view org/test-creature.org @ 139:ffbab4199c0d

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