view org/test-creature.org @ 129:bab47091534e

add some ideas
author Robert McIntyre <rlm@mit.edu>
date Mon, 30 Jan 2012 00:25:11 -0700
parents 4b38355ad6e3
children b26017d1fe9a
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))))))))
300 (defn world-to-local
301 "Convert the world coordinates into coordinates relative to the
302 object (i.e. local coordinates), taking into account the rotation
303 of object."
304 [#^Spatial object world-coordinate]
305 (let [out (Vector3f.)]
306 (.worldToLocal object world-coordinate out) out))
308 (defn local-to-world
309 "Convert the local coordinates into coordinates into world relative
310 coordinates"
311 [#^Spatial object local-coordinate]
312 (let [world-coordinate (Vector3f.)]
313 (.localToWorld object local-coordinate world-coordinate)
314 world-coordinate))
316 (defmulti joint-dispatch
317 "Translate blender pseudo-joints into real JME joints."
318 (fn [constraints & _]
319 (:type constraints)))
321 (defmethod joint-dispatch :point
322 [constraints control-a control-b pivot-a pivot-b rotation]
323 (println-repl "creating POINT2POINT joint")
324 (Point2PointJoint.
325 control-a
326 control-b
327 pivot-a
328 pivot-b))
330 (defmethod joint-dispatch :hinge
331 [constraints control-a control-b pivot-a pivot-b rotation]
332 (println-repl "creating HINGE joint")
333 (let [axis
334 (if-let
335 [axis (:axis constraints)]
336 axis
337 Vector3f/UNIT_X)
338 [limit-1 limit-2] (:limit constraints)
339 hinge-axis
340 (.mult
341 rotation
342 (blender-to-jme axis))]
343 (doto
344 (HingeJoint.
345 control-a
346 control-b
347 pivot-a
348 pivot-b
349 hinge-axis
350 hinge-axis)
351 (.setLimit limit-1 limit-2))))
353 (defmethod joint-dispatch :cone
354 [constraints control-a control-b pivot-a pivot-b rotation]
355 (let [limit-xz (:limit-xz constraints)
356 limit-xy (:limit-xy constraints)
357 twist (:twist constraints)]
359 (println-repl "creating CONE joint")
360 (println-repl rotation)
361 (println-repl
362 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
363 (println-repl
364 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
365 (println-repl
366 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
367 (doto
368 (ConeJoint.
369 control-a
370 control-b
371 pivot-a
372 pivot-b
373 rotation
374 rotation)
375 (.setLimit (float limit-xz)
376 (float limit-xy)
377 (float twist)))))
379 (defn connect
380 "here are some examples:
381 {:type :point}
382 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
383 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
385 {:type :cone :limit-xz 0]
386 :limit-xy 0]
387 :twist 0]} (use XZY rotation mode in blender!)"
388 [#^Node obj-a #^Node obj-b #^Node joint]
389 (let [control-a (.getControl obj-a RigidBodyControl)
390 control-b (.getControl obj-b RigidBodyControl)
391 joint-center (.getWorldTranslation joint)
392 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
393 pivot-a (world-to-local obj-a joint-center)
394 pivot-b (world-to-local obj-b joint-center)]
396 (if-let [constraints
397 (map-vals
398 eval
399 (read-string
400 (meta-data joint "joint")))]
401 ;; A side-effect of creating a joint registers
402 ;; it with both physics objects which in turn
403 ;; will register the joint with the physics system
404 ;; when the simulation is started.
405 (do
406 (println-repl "creating joint between"
407 (.getName obj-a) "and" (.getName obj-b))
408 (joint-dispatch constraints
409 control-a control-b
410 pivot-a pivot-b
411 joint-rotation))
412 (println-repl "could not find joint meta-data!"))))
414 (defn assemble-creature [#^Node pieces joints]
415 (dorun
416 (map
417 (fn [geom]
418 (let [physics-control
419 (RigidBodyControl.
420 (HullCollisionShape.
421 (.getMesh geom))
422 (if-let [mass (meta-data geom "mass")]
423 (do
424 (println-repl
425 "setting" (.getName geom) "mass to" (float mass))
426 (float mass))
427 (float 1)))]
429 (.addControl geom physics-control)))
430 (filter #(isa? (class %) Geometry )
431 (node-seq pieces))))
432 (dorun
433 (map
434 (fn [joint]
435 (let [[obj-a obj-b]
436 (joint-targets pieces joint)]
437 (connect obj-a obj-b joint)))
438 joints))
439 pieces)
441 (declare blender-creature)
443 (def hand "Models/creature1/one.blend")
445 (def worm "Models/creature1/try-again.blend")
447 (def touch "Models/creature1/touch.blend")
449 (defn worm-model [] (load-blender-model worm))
451 (defn x-ray [#^ColorRGBA color]
452 (doto (Material. (asset-manager)
453 "Common/MatDefs/Misc/Unshaded.j3md")
454 (.setColor "Color" color)
455 (-> (.getAdditionalRenderState)
456 (.setDepthTest false))))
458 (defn colorful []
459 (.getChild (worm-model) "worm-21"))
461 (import jme3tools.converters.ImageToAwt)
463 (import ij.ImagePlus)
465 ;; Every Mesh has many triangles, each with its own index.
466 ;; Every vertex has its own index as well.
468 (defn tactile-sensor-image
469 "Return the touch-sensor distribution image in BufferedImage format,
470 or nil if it does not exist."
471 [#^Geometry obj]
472 (if-let [image-path (meta-data obj "touch")]
473 (ImageToAwt/convert
474 (.getImage
475 (.loadTexture
476 (asset-manager)
477 image-path))
478 false false 0)))
480 (import ij.process.ImageProcessor)
481 (import java.awt.image.BufferedImage)
483 (def white -1)
485 (defn filter-pixels
486 "List the coordinates of all pixels matching pred, within the bounds
487 provided. Bounds -> [x0 y0 width height]"
488 {:author "Dylan Holmes"}
489 ([pred #^BufferedImage image]
490 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
491 ([pred #^BufferedImage image [x0 y0 width height]]
492 ((fn accumulate [x y matches]
493 (cond
494 (>= y (+ height y0)) matches
495 (>= x (+ width x0)) (recur 0 (inc y) matches)
496 (pred (.getRGB image x y))
497 (recur (inc x) y (conj matches [x y]))
498 :else (recur (inc x) y matches)))
499 x0 y0 [])))
501 (defn white-coordinates
502 "Coordinates of all the white pixels in a subset of the image."
503 ([#^BufferedImage image bounds]
504 (filter-pixels #(= % white) image bounds))
505 ([#^BufferedImage image]
506 (filter-pixels #(= % white) image)))
508 (defn triangle
509 "Get the triangle specified by triangle-index from the mesh within
510 bounds."
511 [#^Mesh mesh triangle-index]
512 (let [scratch (Triangle.)]
513 (.getTriangle mesh triangle-index scratch)
514 scratch))
516 (defn triangle-vertex-indices
517 "Get the triangle vertex indices of a given triangle from a given
518 mesh."
519 [#^Mesh mesh triangle-index]
520 (let [indices (int-array 3)]
521 (.getTriangle mesh triangle-index indices)
522 (vec indices)))
524 (defn vertex-UV-coord
525 "Get the uv-coordinates of the vertex named by vertex-index"
526 [#^Mesh mesh vertex-index]
527 (let [UV-buffer
528 (.getData
529 (.getBuffer
530 mesh
531 VertexBuffer$Type/TexCoord))]
532 [(.get UV-buffer (* vertex-index 2))
533 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
535 (defn triangle-UV-coord
536 "Get the uv-cooridnates of the triangle's verticies."
537 [#^Mesh mesh width height triangle-index]
538 (map (fn [[u v]] (vector (* width u) (* height v)))
539 (map (partial vertex-UV-coord mesh)
540 (triangle-vertex-indices mesh triangle-index))))
542 (defn same-side?
543 "Given the points p1 and p2 and the reference point ref, is point p
544 on the same side of the line that goes through p1 and p2 as ref is?"
545 [p1 p2 ref p]
546 (<=
547 0
548 (.dot
549 (.cross (.subtract p2 p1) (.subtract p p1))
550 (.cross (.subtract p2 p1) (.subtract ref p1)))))
552 (defn triangle-seq [#^Triangle tri]
553 [(.get1 tri) (.get2 tri) (.get3 tri)])
555 (defn vector3f-seq [#^Vector3f v]
556 [(.getX v) (.getY v) (.getZ v)])
558 (defn inside-triangle?
559 "Is the point inside the triangle?"
560 {:author "Dylan Holmes"}
561 [#^Triangle tri #^Vector3f p]
562 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
563 (and
564 (same-side? vert-1 vert-2 vert-3 p)
565 (same-side? vert-2 vert-3 vert-1 p)
566 (same-side? vert-3 vert-1 vert-2 p))))
568 (defn triangle->matrix4f
569 "Converts the triangle into a 4x4 matrix: The first three columns
570 contain the vertices of the triangle; the last contains the unit
571 normal of the triangle. The bottom row is filled with 1s."
572 [#^Triangle t]
573 (let [mat (Matrix4f.)
574 [vert-1 vert-2 vert-3]
575 ((comp vec map) #(.get t %) (range 3))
576 unit-normal (do (.calculateNormal t)(.getNormal t))
577 vertices [vert-1 vert-2 vert-3 unit-normal]]
578 (dorun
579 (for [row (range 4) col (range 3)]
580 (do
581 (.set mat col row (.get (vertices row)col))
582 (.set mat 3 row 1))))
583 mat))
585 (defn triangle-transformation
586 "Returns the affine transformation that converts each vertex in the
587 first triangle into the corresponding vertex in the second
588 triangle."
589 [#^Triangle tri-1 #^Triangle tri-2]
590 (.mult
591 (triangle->matrix4f tri-2)
592 (.invert (triangle->matrix4f tri-1))))
594 (defn point->vector2f [[u v]]
595 (Vector2f. u v))
597 (defn vector2f->vector3f [v]
598 (Vector3f. (.getX v) (.getY v) 0))
600 (defn map-triangle [f #^Triangle tri]
601 (Triangle.
602 (f 0 (.get1 tri))
603 (f 1 (.get2 tri))
604 (f 2 (.get3 tri))))
606 (defn points->triangle
607 "Convert a list of points into a triangle."
608 [points]
609 (apply #(Triangle. %1 %2 %3)
610 (map (fn [point]
611 (let [point (vec point)]
612 (Vector3f. (get point 0 0)
613 (get point 1 0)
614 (get point 2 0))))
615 (take 3 points))))
617 (defn convex-bounds
618 ;;dylan
619 "Returns the smallest square containing the given
620 vertices, as a vector of integers [left top width height]."
621 ;; "Dimensions of the smallest integer bounding square of the list of
622 ;; 2D verticies in the form: [x y width height]."
623 [uv-verts]
624 (let [xs (map first uv-verts)
625 ys (map second uv-verts)
626 x0 (Math/floor (apply min xs))
627 y0 (Math/floor (apply min ys))
628 x1 (Math/ceil (apply max xs))
629 y1 (Math/ceil (apply max ys))]
630 [x0 y0 (- x1 x0) (- y1 y0)]))
632 (defn sensors-in-triangle
633 ;;dylan
634 "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
635 ;;"Find the locations of the touch sensors within a triangle in both
636 ;; UV and gemoetry relative coordinates."
637 [image mesh tri-index]
638 (let [width (.getWidth image)
639 height (.getHeight image)
640 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
641 bounds (convex-bounds UV-vertex-coords)
643 cutout-triangle (points->triangle UV-vertex-coords)
644 UV-sensor-coords
645 (filter (comp (partial inside-triangle? cutout-triangle)
646 (fn [[u v]] (Vector3f. u v 0)))
647 (white-coordinates image bounds))
648 UV->geometry (triangle-transformation
649 cutout-triangle
650 (triangle mesh tri-index))
651 geometry-sensor-coords
652 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
653 UV-sensor-coords)]
654 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
656 (defn-memo locate-feelers
657 "Search the geometry's tactile UV image for touch sensors, returning
658 their positions in geometry-relative coordinates."
659 [#^Geometry geo]
660 (let [mesh (.getMesh geo)
661 num-triangles (.getTriangleCount mesh)]
662 (if-let [image (tactile-sensor-image geo)]
663 (map
664 (partial sensors-in-triangle image mesh)
665 (range num-triangles))
666 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
668 (use 'clojure.contrib.def)
670 (defn-memo touch-topology [#^Gemoetry geo]
671 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
673 (defn-memo feeler-coordinates [#^Geometry geo]
674 (vec (map :geometry (locate-feelers geo))))
676 (defn enable-touch [#^Geometry geo]
677 (let [feeler-coords (feeler-coordinates geo)
678 tris (triangles geo)
679 limit 0.1
680 ;;results (CollisionResults.)
681 ]
682 (if (empty? (touch-topology geo))
683 nil
684 (fn [node]
685 (let [sensor-origins
686 (map
687 #(map (partial local-to-world geo) %)
688 feeler-coords)
689 triangle-normals
690 (map (partial get-ray-direction geo)
691 tris)
692 rays
693 (flatten
694 (map (fn [origins norm]
695 (map #(doto (Ray. % norm)
696 (.setLimit limit)) origins))
697 sensor-origins triangle-normals))]
698 (vector
699 (touch-topology geo)
700 (vec
701 (for [ray rays]
702 (do
703 (let [results (CollisionResults.)]
704 (.collideWith node ray results)
705 (let [touch-objects
706 (filter #(not (= geo (.getGeometry %)))
707 results)]
708 (- 255
709 (if (empty? touch-objects) 255
710 (rem
711 (int
712 (* 255 (/ (.getDistance
713 (first touch-objects)) limit)))
714 256))))))))))))))
717 (defn touch [#^Node pieces]
718 (filter (comp not nil?)
719 (map enable-touch
720 (filter #(isa? (class %) Geometry)
721 (node-seq pieces)))))
724 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
725 ;; http://en.wikipedia.org/wiki/Retina
727 (defn test-eye []
728 (.getChild
729 (.getChild (worm-model) "eyes")
730 "eye"))
733 (defn retina-sensor-image
734 "Return a map of pixel selection functions to BufferedImages
735 describing the distribution of light-sensitive components on this
736 geometry's surface. Each function creates an integer from the rgb
737 values found in the pixel. :red, :green, :blue, :gray are already
738 defined as extracting the red green blue and average components
739 respectively."
740 [#^Spatial eye]
741 (if-let [eye-map (meta-data eye "eye")]
742 (map-vals
743 #(ImageToAwt/convert
744 (.getImage (.loadTexture (asset-manager) %))
745 false false 0)
746 (eval (read-string eye-map)))))
748 (defn eye-dimensions
749 "returns the width and height specified in the metadata of the eye"
750 [#^Spatial eye]
751 (let [dimensions
752 (map #(vector (.getWidth %) (.getHeight %))
753 (vals (retina-sensor-image eye)))]
754 [(apply max (map first dimensions))
755 (apply max (map second dimensions))]))
757 (defn creature-eyes
758 ;;dylan
759 "Return the children of the creature's \"eyes\" node."
760 ;;"The eye nodes which are children of the \"eyes\" node in the
761 ;;creature."
762 [#^Node creature]
763 (if-let [eye-node (.getChild creature "eyes")]
764 (seq (.getChildren eye-node))
765 (do (println-repl "could not find eyes node") [])))
767 ;; Here's how vision will work.
769 ;; Make the continuation in scene-processor take FrameBuffer,
770 ;; byte-buffer, BufferedImage already sized to the correct
771 ;; dimensions. the continuation will decide wether to "mix" them
772 ;; into the BufferedImage, lazily ignore them, or mix them halfway
773 ;; and call c/graphics card routines.
775 ;; (vision creature) will take an optional :skip argument which will
776 ;; inform the continuations in scene processor to skip the given
777 ;; number of cycles; 0 means that no cycles will be skipped.
779 ;; (vision creature) will return [init-functions sensor-functions].
780 ;; The init-functions are each single-arg functions that take the
781 ;; world and register the cameras and must each be called before the
782 ;; corresponding sensor-functions. Each init-function returns the
783 ;; viewport for that eye which can be manipulated, saved, etc. Each
784 ;; sensor-function is a thunk and will return data in the same
785 ;; format as the tactile-sensor functions; the structure is
786 ;; [topology, sensor-data]. Internally, these sensor-functions
787 ;; maintain a reference to sensor-data which is periodically updated
788 ;; by the continuation function established by its init-function.
789 ;; They can be queried every cycle, but their information may not
790 ;; necessairly be different every cycle.
792 ;; Each eye in the creature in blender will work the same way as
793 ;; joints -- a zero dimensional object with no geometry whose local
794 ;; coordinate system determines the orientation of the resulting
795 ;; eye. All eyes will have a parent named "eyes" just as all joints
796 ;; have a parent named "joints". The resulting camera will be a
797 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
798 ;; the eye marker. The eye marker will contain the metadata for the
799 ;; eye, and will be moved by it's bound geometry. The dimensions of
800 ;; the eye's camera are equal to the dimensions of the eye's "UV"
801 ;; map.
804 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
806 ;; Ears work the same way as vision.
808 ;; (hearing creature) will return [init-functions
809 ;; sensor-functions]. The init functions each take the world and
810 ;; register a SoundProcessor that does foureier transforms on the
811 ;; incommong sound data, making it available to each sensor function.
813 (defn creature-ears
814 "Return the children of the creature's \"ears\" node."
815 ;;dylan
816 ;;"The ear nodes which are children of the \"ears\" node in the
817 ;;creature."
818 [#^Node creature]
819 (if-let [ear-node (.getChild creature "ears")]
820 (seq (.getChildren ear-node))
821 (do (println-repl "could not find ears node") [])))
823 (defn closest-node
824 "Return the object in creature which is closest to the given node."
825 ;;dylan"The closest object in creature to the given node."
826 [#^Node creature #^Node eye]
827 (loop [radius (float 0.01)]
828 (let [results (CollisionResults.)]
829 (.collideWith
830 creature
831 (BoundingBox. (.getWorldTranslation eye)
832 radius radius radius)
833 results)
834 (if-let [target (first results)]
835 (.getGeometry target)
836 (recur (float (* 2 radius)))))))
838 ;;dylan (defn follow-sense, adjoin-sense, attach-stimuli,
839 ;;anchor-qualia, augment-organ, with-organ
840 (defn bind-sense
841 "Bind the sense to the Spatial such that it will maintain its
842 current position relative to the Spatial no matter how the spatial
843 moves. 'sense can be either a Camera or Listener object."
844 [#^Spatial obj sense]
845 (let [sense-offset (.subtract (.getLocation sense)
846 (.getWorldTranslation obj))
847 initial-sense-rotation (Quaternion. (.getRotation sense))
848 base-anti-rotation (.inverse (.getWorldRotation obj))]
849 (.addControl
850 obj
851 (proxy [AbstractControl] []
852 (controlUpdate [tpf]
853 (let [total-rotation
854 (.mult base-anti-rotation (.getWorldRotation obj))]
855 (.setLocation sense
856 (.add
857 (.mult total-rotation sense-offset)
858 (.getWorldTranslation obj)))
859 (.setRotation sense
860 (.mult total-rotation initial-sense-rotation))))
861 (controlRender [_ _])))))
864 (defn update-listener-velocity
865 "Update the listener's velocity every update loop."
866 [#^Spatial obj #^Listener lis]
867 (let [old-position (atom (.getLocation lis))]
868 (.addControl
869 obj
870 (proxy [AbstractControl] []
871 (controlUpdate [tpf]
872 (let [new-position (.getLocation lis)]
873 (.setVelocity
874 lis
875 (.mult (.subtract new-position @old-position)
876 (float (/ tpf))))
877 (reset! old-position new-position)))
878 (controlRender [_ _])))))
880 (import com.aurellem.capture.audio.AudioSendRenderer)
882 (defn attach-ear
883 [#^Application world #^Node creature #^Spatial ear continuation]
884 (let [target (closest-node creature ear)
885 lis (Listener.)
886 audio-renderer (.getAudioRenderer world)
887 sp (sound-processor continuation)]
888 (.setLocation lis (.getWorldTranslation ear))
889 (.setRotation lis (.getWorldRotation ear))
890 (bind-sense target lis)
891 (update-listener-velocity target lis)
892 (.addListener audio-renderer lis)
893 (.registerSoundProcessor audio-renderer lis sp)))
895 (defn enable-hearing
896 [#^Node creature #^Spatial ear]
897 (let [hearing-data (atom [])]
898 [(fn [world]
899 (attach-ear world creature ear
900 (fn [data]
901 (reset! hearing-data (vec data)))))
902 [(fn []
903 (let [data @hearing-data
904 topology
905 (vec (map #(vector % 0) (range 0 (count data))))
906 scaled-data
907 (vec
908 (map
909 #(rem (int (* 255 (/ (+ 1 %) 2))) 256)
910 data))]
911 [topology scaled-data]))
912 ]]))
914 (defn hearing
915 [#^Node creature]
916 (reduce
917 (fn [[init-a senses-a]
918 [init-b senses-b]]
919 [(conj init-a init-b)
920 (into senses-a senses-b)])
921 [[][]]
922 (for [ear (creature-ears creature)]
923 (enable-hearing creature ear))))
925 (defn attach-eye
926 "Attach a Camera to the appropiate area and return the Camera."
927 [#^Node creature #^Spatial eye]
928 (let [target (closest-node creature eye)
929 [cam-width cam-height] (eye-dimensions eye)
930 cam (Camera. cam-width cam-height)]
931 (.setLocation cam (.getWorldTranslation eye))
932 (.setRotation cam (.getWorldRotation eye))
933 (.setFrustumPerspective
934 cam 45 (/ (.getWidth cam) (.getHeight cam))
935 1 1000)
936 (bind-sense target cam)
937 cam))
939 (def presets
940 {:all 0xFFFFFF
941 :red 0xFF0000
942 :blue 0x0000FF
943 :green 0x00FF00})
945 (defn enable-vision
946 "return [init-function sensor-functions] for a particular eye"
947 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
948 (let [retinal-map (retina-sensor-image eye)
949 camera (attach-eye creature eye)
950 vision-image
951 (atom
952 (BufferedImage. (.getWidth camera)
953 (.getHeight camera)
954 BufferedImage/TYPE_BYTE_BINARY))]
955 [(fn [world]
956 (add-eye
957 world camera
958 (let [counter (atom 0)]
959 (fn [r fb bb bi]
960 (if (zero? (rem (swap! counter inc) (inc skip)))
961 (reset! vision-image (BufferedImage! r fb bb bi)))))))
962 (vec
963 (map
964 (fn [[key image]]
965 (let [whites (white-coordinates image)
966 topology (vec (collapse whites))
967 mask (presets key)]
968 (fn []
969 (vector
970 topology
971 (vec
972 (for [[x y] whites]
973 (bit-and
974 mask (.getRGB @vision-image x y))))))))
975 retinal-map))]))
977 (defn vision
978 [#^Node creature & {skip :skip :or {skip 0}}]
979 (reduce
980 (fn [[init-a senses-a]
981 [init-b senses-b]]
982 [(conj init-a init-b)
983 (into senses-a senses-b)])
984 [[][]]
985 (for [eye (creature-eyes creature)]
986 (enable-vision creature eye))))
992 ;; lower level --- nodes
993 ;; closest-node "parse/compile-x" -> makes organ, which is spatial, fn pair
995 ;; higher level -- organs
996 ;;
998 ;; higher level --- sense/effector
999 ;; these are the functions that provide world i/o, chinese-room style
1003 (defn blender-creature
1004 "Return a creature with all joints in place."
1005 [blender-path]
1006 (let [model (load-blender-model blender-path)
1007 joints
1008 (if-let [joint-node (.getChild model "joints")]
1009 (seq (.getChildren joint-node))
1010 (do (println-repl "could not find joints node") []))]
1011 (assemble-creature model joints)))
1013 (defn gray-scale [num]
1014 (+ num
1015 (bit-shift-left num 8)
1016 (bit-shift-left num 16)))
1018 (defn debug-window
1019 "creates function that offers a debug view of sensor data"
1020 []
1021 (let [vi (view-image)]
1022 (fn
1023 [[coords sensor-data]]
1024 (let [image (points->image coords)]
1025 (dorun
1026 (for [i (range (count coords))]
1027 (.setRGB image ((coords i) 0) ((coords i) 1)
1028 (gray-scale (sensor-data i)))))
1031 (vi image)))))
1033 (defn debug-vision-window
1034 "creates function that offers a debug view of sensor data"
1035 []
1036 (let [vi (view-image)]
1037 (fn
1038 [[coords sensor-data]]
1039 (let [image (points->image coords)]
1040 (dorun
1041 (for [i (range (count coords))]
1042 (.setRGB image ((coords i) 0) ((coords i) 1)
1043 (sensor-data i))))
1044 (vi image)))))
1046 (defn debug-hearing-window
1047 "view audio data"
1048 [height]
1049 (let [vi (view-image)]
1050 (fn [[coords sensor-data]]
1051 (let [image (BufferedImage. (count coords) height
1052 BufferedImage/TYPE_INT_RGB)]
1053 (dorun
1054 (for [x (range (count coords))]
1055 (dorun
1056 (for [y (range height)]
1057 (let [raw-sensor (sensor-data x)]
1058 (.setRGB image x y (gray-scale raw-sensor)))))))
1060 (vi image)))))
1064 ;;(defn test-touch [world creature]
1069 ;; here's how motor-control/ proprioception will work:
1077 (defn test-creature [thing]
1078 (let [x-axis
1079 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
1080 y-axis
1081 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
1082 z-axis
1083 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
1084 creature (blender-creature thing)
1085 touch-nerves (touch creature)
1086 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
1087 [init-vision-fns vision-data] (vision creature)
1088 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
1089 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
1090 [init-hearing-fns hearing-senses] (hearing creature)
1091 hearing-windows (map (fn [_] (debug-hearing-window 50))
1092 hearing-senses)
1093 bell (AudioNode. (asset-manager)
1094 "Sounds/pure.wav" false)
1095 ;; dream
1098 (world
1099 (nodify [creature
1100 (box 10 2 10 :position (Vector3f. 0 -9 0)
1101 :color ColorRGBA/Gray :mass 0)
1102 x-axis y-axis z-axis
1103 me
1104 ])
1105 (merge standard-debug-controls
1106 {"key-return"
1107 (fn [_ value]
1108 (if value
1109 (do
1110 (println-repl "play-sound")
1111 (.play bell))))})
1112 (fn [world]
1113 (light-up-everything world)
1114 (enable-debug world)
1115 (dorun (map #(% world) init-vision-fns))
1116 (dorun (map #(% world) init-hearing-fns))
1118 (add-eye world
1119 (attach-eye creature (test-eye))
1120 (comp (view-image) BufferedImage!))
1122 (add-eye world (.getCamera world) no-op)
1124 ;;(com.aurellem.capture.Capture/captureVideo
1125 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1126 ;;(.setTimer world (RatchetTimer. 60))
1127 (speed-up world)
1128 ;;(set-gravity world (Vector3f. 0 0 0))
1130 (fn [world tpf]
1131 ;;(dorun
1132 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1136 (dorun
1137 (map #(%1 (%2 (.getRootNode world)))
1138 touch-debug-windows touch-nerves))
1140 (dorun
1141 (map #(%1 (%2))
1142 vision-debug vision-data))
1143 (dorun
1144 (map #(%1 (%2)) hearing-windows hearing-senses))
1147 ;;(println-repl (vision-data))
1148 (.setLocalTranslation me (.getLocation (.getCamera world)))
1152 ;;(let [timer (atom 0)]
1153 ;; (fn [_ _]
1154 ;; (swap! timer inc)
1155 ;; (if (= (rem @timer 60) 0)
1156 ;; (println-repl (float (/ @timer 60))))))
1157 )))
1167 ;;; experiments in collisions
1171 (defn collision-test []
1172 (let [b-radius 1
1173 b-position (Vector3f. 0 0 0)
1174 obj-b (box 1 1 1 :color ColorRGBA/Blue
1175 :position b-position
1176 :mass 0)
1177 node (nodify [obj-b])
1178 bounds-b
1179 (doto (Picture.)
1180 (.setHeight 50)
1181 (.setWidth 50)
1182 (.setImage (asset-manager)
1183 "Models/creature1/hand.png"
1184 false
1185 ))
1187 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1189 collisions
1190 (let [cr (CollisionResults.)]
1191 (.collideWith node bounds-b cr)
1192 (println (map #(.getContactPoint %) cr))
1193 cr)
1195 ;;collision-points
1196 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1197 ;; collisions)
1199 ;;node (nodify (conj collision-points obj-b))
1201 sim
1202 (world node
1203 {"key-space"
1204 vvvvvv (fn [_ value]
1205 (if value
1206 (let [cr (CollisionResults.)]
1207 (.collideWith node bounds-b cr)
1208 (println-repl (map #(.getContactPoint %) cr))
1209 cr)))}
1210 no-op
1211 no-op)
1214 sim
1216 ))
1219 ;; the camera will stay in its initial position/rotation with relation
1220 ;; to the spatial.
1223 (defn follow-test
1224 "show a camera that stays in the same relative position to a blue cube."
1225 []
1226 (let [camera-pos (Vector3f. 0 30 0)
1227 rock (box 1 1 1 :color ColorRGBA/Blue
1228 :position (Vector3f. 0 10 0)
1229 :mass 30
1231 rot (.getWorldRotation rock)
1233 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1234 :position (Vector3f. 0 -3 0))]
1236 (world
1237 (nodify [rock table])
1238 standard-debug-controls
1239 (fn [world]
1240 (let
1241 [cam (doto (.clone (.getCamera world))
1242 (.setLocation camera-pos)
1243 (.lookAt Vector3f/ZERO
1244 Vector3f/UNIT_X))]
1245 (bind-sense rock cam)
1247 (.setTimer world (RatchetTimer. 60))
1248 (add-eye world cam (comp (view-image) BufferedImage!))
1249 (add-eye world (.getCamera world) no-op))
1251 (fn [_ _] (println-repl rot)))))
1255 #+end_src
1257 #+results: body-1
1258 : #'cortex.silly/test-creature
1261 * COMMENT purgatory
1262 #+begin_src clojure
1263 (defn bullet-trans []
1264 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1265 :position (Vector3f. -10 5 0))
1266 obj-b (sphere 0.5 :color ColorRGBA/Blue
1267 :position (Vector3f. -10 -5 0)
1268 :mass 0)
1269 control-a (.getControl obj-a RigidBodyControl)
1270 control-b (.getControl obj-b RigidBodyControl)
1271 swivel
1272 (.toRotationMatrix
1273 (doto (Quaternion.)
1274 (.fromAngleAxis (/ Math/PI 2)
1275 Vector3f/UNIT_X)))]
1276 (doto
1277 (ConeJoint.
1278 control-a control-b
1279 (Vector3f. 0 5 0)
1280 (Vector3f. 0 -5 0)
1281 swivel swivel)
1282 (.setLimit (* 0.6 (/ Math/PI 4))
1283 (/ Math/PI 4)
1284 (* Math/PI 0.8)))
1285 (world (nodify
1286 [obj-a obj-b])
1287 standard-debug-controls
1288 enable-debug
1289 no-op)))
1292 (defn bullet-trans* []
1293 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1294 :position (Vector3f. 5 0 0)
1295 :mass 90)
1296 obj-b (sphere 0.5 :color ColorRGBA/Blue
1297 :position (Vector3f. -5 0 0)
1298 :mass 0)
1299 control-a (.getControl obj-a RigidBodyControl)
1300 control-b (.getControl obj-b RigidBodyControl)
1301 move-up? (atom nil)
1302 move-down? (atom nil)
1303 move-left? (atom nil)
1304 move-right? (atom nil)
1305 roll-left? (atom nil)
1306 roll-right? (atom nil)
1307 force 100
1308 swivel
1309 (.toRotationMatrix
1310 (doto (Quaternion.)
1311 (.fromAngleAxis (/ Math/PI 2)
1312 Vector3f/UNIT_X)))
1313 x-move
1314 (doto (Matrix3f.)
1315 (.fromStartEndVectors Vector3f/UNIT_X
1316 (.normalize (Vector3f. 1 1 0))))
1318 timer (atom 0)]
1319 (doto
1320 (ConeJoint.
1321 control-a control-b
1322 (Vector3f. -8 0 0)
1323 (Vector3f. 2 0 0)
1324 ;;swivel swivel
1325 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1326 x-move Matrix3f/IDENTITY
1328 (.setCollisionBetweenLinkedBodys false)
1329 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1330 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1331 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1332 (world (nodify
1333 [obj-a obj-b])
1334 (merge standard-debug-controls
1335 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1336 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1337 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1338 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1339 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1340 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1342 (fn [world]
1343 (enable-debug world)
1344 (set-gravity world Vector3f/ZERO)
1347 (fn [world _]
1349 (if @move-up?
1350 (.applyForce control-a
1351 (Vector3f. force 0 0)
1352 (Vector3f. 0 0 0)))
1353 (if @move-down?
1354 (.applyForce control-a
1355 (Vector3f. (- force) 0 0)
1356 (Vector3f. 0 0 0)))
1357 (if @move-left?
1358 (.applyForce control-a
1359 (Vector3f. 0 force 0)
1360 (Vector3f. 0 0 0)))
1361 (if @move-right?
1362 (.applyForce control-a
1363 (Vector3f. 0 (- force) 0)
1364 (Vector3f. 0 0 0)))
1366 (if @roll-left?
1367 (.applyForce control-a
1368 (Vector3f. 0 0 force)
1369 (Vector3f. 0 0 0)))
1370 (if @roll-right?
1371 (.applyForce control-a
1372 (Vector3f. 0 0 (- force))
1373 (Vector3f. 0 0 0)))
1375 (if (zero? (rem (swap! timer inc) 100))
1376 (.attachChild
1377 (.getRootNode world)
1378 (sphere 0.05 :color ColorRGBA/Yellow
1379 :physical? false :position
1380 (.getWorldTranslation obj-a)))))
1382 ))
1384 (defn transform-trianglesdsd
1385 "Transform that converts each vertex in the first triangle
1386 into the corresponding vertex in the second triangle."
1387 [#^Triangle tri-1 #^Triangle tri-2]
1388 (let [in [(.get1 tri-1)
1389 (.get2 tri-1)
1390 (.get3 tri-1)]
1391 out [(.get1 tri-2)
1392 (.get2 tri-2)
1393 (.get3 tri-2)]]
1394 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1395 in* [(.mult translate (in 0))
1396 (.mult translate (in 1))
1397 (.mult translate (in 2))]
1398 final-translation
1399 (doto (Matrix4f.)
1400 (.setTranslation (out 1)))
1402 rotate-1
1403 (doto (Matrix3f.)
1404 (.fromStartEndVectors
1405 (.normalize
1406 (.subtract
1407 (in* 1) (in* 0)))
1408 (.normalize
1409 (.subtract
1410 (out 1) (out 0)))))
1411 in** [(.mult rotate-1 (in* 0))
1412 (.mult rotate-1 (in* 1))
1413 (.mult rotate-1 (in* 2))]
1414 scale-factor-1
1415 (.mult
1416 (.normalize
1417 (.subtract
1418 (out 1)
1419 (out 0)))
1420 (/ (.length
1421 (.subtract (out 1)
1422 (out 0)))
1423 (.length
1424 (.subtract (in** 1)
1425 (in** 0)))))
1426 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1427 in*** [(.mult scale-1 (in** 0))
1428 (.mult scale-1 (in** 1))
1429 (.mult scale-1 (in** 2))]
1437 (dorun (map println in))
1438 (println)
1439 (dorun (map println in*))
1440 (println)
1441 (dorun (map println in**))
1442 (println)
1443 (dorun (map println in***))
1444 (println)
1446 ))))
1449 (defn world-setup [joint]
1450 (let [joint-position (Vector3f. 0 0 0)
1451 joint-rotation
1452 (.toRotationMatrix
1453 (.mult
1454 (doto (Quaternion.)
1455 (.fromAngleAxis
1456 (* 1 (/ Math/PI 4))
1457 (Vector3f. -1 0 0)))
1458 (doto (Quaternion.)
1459 (.fromAngleAxis
1460 (* 1 (/ Math/PI 2))
1461 (Vector3f. 0 0 1)))))
1462 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1464 origin (doto
1465 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1466 :position top-position))
1467 top (doto
1468 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1469 :position top-position)
1471 (.addControl
1472 (RigidBodyControl.
1473 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1474 bottom (doto
1475 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1476 :position (Vector3f. 0 0 0))
1477 (.addControl
1478 (RigidBodyControl.
1479 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1480 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1481 :color ColorRGBA/Gray :mass 0)
1482 a (.getControl top RigidBodyControl)
1483 b (.getControl bottom RigidBodyControl)]
1485 (cond
1486 (= joint :cone)
1488 (doto (ConeJoint.
1489 a b
1490 (world-to-local top joint-position)
1491 (world-to-local bottom joint-position)
1492 joint-rotation
1493 joint-rotation
1497 (.setLimit (* (/ 10) Math/PI)
1498 (* (/ 4) Math/PI)
1499 0)))
1500 [origin top bottom table]))
1502 (defn test-joint [joint]
1503 (let [[origin top bottom floor] (world-setup joint)
1504 control (.getControl top RigidBodyControl)
1505 move-up? (atom false)
1506 move-down? (atom false)
1507 move-left? (atom false)
1508 move-right? (atom false)
1509 roll-left? (atom false)
1510 roll-right? (atom false)
1511 timer (atom 0)]
1513 (world
1514 (nodify [top bottom floor origin])
1515 (merge standard-debug-controls
1516 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1517 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1518 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1519 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1520 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1521 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1523 (fn [world]
1524 (light-up-everything world)
1525 (enable-debug world)
1526 (set-gravity world (Vector3f. 0 0 0))
1529 (fn [world _]
1530 (if (zero? (rem (swap! timer inc) 100))
1531 (do
1532 ;; (println-repl @timer)
1533 (.attachChild (.getRootNode world)
1534 (sphere 0.05 :color ColorRGBA/Yellow
1535 :position (.getWorldTranslation top)
1536 :physical? false))
1537 (.attachChild (.getRootNode world)
1538 (sphere 0.05 :color ColorRGBA/LightGray
1539 :position (.getWorldTranslation bottom)
1540 :physical? false))))
1542 (if @move-up?
1543 (.applyTorque control
1544 (.mult (.getPhysicsRotation control)
1545 (Vector3f. 0 0 10))))
1546 (if @move-down?
1547 (.applyTorque control
1548 (.mult (.getPhysicsRotation control)
1549 (Vector3f. 0 0 -10))))
1550 (if @move-left?
1551 (.applyTorque control
1552 (.mult (.getPhysicsRotation control)
1553 (Vector3f. 0 10 0))))
1554 (if @move-right?
1555 (.applyTorque control
1556 (.mult (.getPhysicsRotation control)
1557 (Vector3f. 0 -10 0))))
1558 (if @roll-left?
1559 (.applyTorque control
1560 (.mult (.getPhysicsRotation control)
1561 (Vector3f. -1 0 0))))
1562 (if @roll-right?
1563 (.applyTorque control
1564 (.mult (.getPhysicsRotation control)
1565 (Vector3f. 1 0 0))))))))
1569 (defprotocol Frame
1570 (frame [this]))
1572 (extend-type BufferedImage
1573 Frame
1574 (frame [image]
1575 (merge
1576 (apply
1577 hash-map
1578 (interleave
1579 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1580 (vector x y)))
1581 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1582 (let [data (.getRGB image x y)]
1583 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1584 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1585 :b (bit-and 0x0000ff data)))))))
1586 {:width (.getWidth image) :height (.getHeight image)})))
1589 (extend-type ImagePlus
1590 Frame
1591 (frame [image+]
1592 (frame (.getBufferedImage image+))))
1595 #+end_src
1598 * COMMENT generate source
1599 #+begin_src clojure :tangle ../src/cortex/silly.clj
1600 <<body-1>>
1601 #+end_src