view org/test-creature.org @ 128:4b38355ad6e3

modifications to docstrings by dylan
author Robert McIntyre <rlm@mit.edu>
date Sun, 29 Jan 2012 23:34:12 -0700
parents bc49d452c42a
children bab47091534e
line wrap: on
line source
1 #+title: First attempt at a creature!
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description:
5 #+keywords: simulation, jMonkeyEngine3, clojure
6 #+SETUPFILE: ../../aurellem/org/setup.org
7 #+INCLUDE: ../../aurellem/org/level-0.org
9 * ideas
11 ** have to get done before winston
12 - [ ] write an explination for why greyscale bitmaps for senses is
13 appropiate -- 1/2 day
14 - [ ] muscle control -- day
15 - [ ] proprioception sensor map in the style of the other senses -- day
16 - [ ] refactor integration code to distribute to each of the senses
17 -- day
18 - [ ] create video showing all the senses for Winston -- 2 days
19 - [ ] write summary of project for Winston \
20 - [ ] project proposals for Winston \
21 - [ ] additional senses to be implemented for Winston | -- 2 days
22 - [ ] send Winston package /
24 ** would be cool to get done before winston
25 - [X] enable greyscale bitmaps for touch -- 2 hours
26 - [X] use sawfish to auto-tile sense windows -- 6 hours
27 - [X] sawfish keybinding to automatically delete all sense windows
28 - [ ] directly change the UV-pixels to show sensor activation -- 2
29 days
30 - [ ] proof of concept C sense manipulation -- 2 days
31 - [ ] proof of concept GPU sense manipulation -- week
32 - [ ] fourier view of sound -- 2 or 3 days
33 - [ ] dancing music generator -- 1 day, depends on fourier
35 ** don't have to get done before winston
36 - [ ] write tests for integration -- 3 days
37 - [ ] usertime/gametime clock HUD display -- day
38 - [ ] find papers for each of the senses justifying my own
39 representation -- week
40 - [ ] show sensor maps in HUD display? -- 4 days
41 - [ ] show sensor maps in AWT display? -- 2 days
44 * Intro
45 So far, I've made the following senses --
46 - Vision
47 - Hearing
48 - Touch
49 - Proprioception
51 And one effector:
52 - Movement
54 However, the code so far has only enabled these senses, but has not
55 actually implemented them. For example, there is still a lot of work
56 to be done for vision. I need to be able to create an /eyeball/ in
57 simulation that can be moved around and see the world from different
58 angles. I also need to determine weather to use log-polar or cartesian
59 for the visual input, and I need to determine how/wether to
60 disceritise the visual input.
62 I also want to be able to visualize both the sensors and the
63 effectors in pretty pictures. This semi-retarted creature will be my
64 first attempt at bringing everything together.
66 * The creature's body
68 Still going to do an eve-like body in blender, but due to problems
69 importing the joints, etc into jMonkeyEngine3, I'm going to do all
70 the connecting here in clojure code, using the names of the individual
71 components and trial and error. Later, I'll maybe make some sort of
72 creature-building modifications to blender that support whatever
73 discreitized senses I'm going to make.
75 #+name: body-1
76 #+begin_src clojure
77 (ns cortex.silly
78 "let's play!"
79 {:author "Robert McIntyre"})
81 ;; TODO remove this!
82 (require 'cortex.import)
83 (cortex.import/mega-import-jme3)
84 (use '(cortex world util body hearing touch vision))
86 (rlm.rlm-commands/help)
87 (import java.awt.image.BufferedImage)
88 (import javax.swing.JPanel)
89 (import javax.swing.SwingUtilities)
90 (import java.awt.Dimension)
91 (import javax.swing.JFrame)
92 (import java.awt.Dimension)
93 (import com.aurellem.capture.RatchetTimer)
94 (declare joint-create)
95 (use 'clojure.contrib.def)
97 (defn points->image
98 "Take a sparse collection of points and visuliaze it as a
99 BufferedImage."
101 ;; TODO maybe parallelize this since it's easy
103 [points]
104 (if (empty? points)
105 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
106 (let [xs (vec (map first points))
107 ys (vec (map second points))
108 x0 (apply min xs)
109 y0 (apply min ys)
110 width (- (apply max xs) x0)
111 height (- (apply max ys) y0)
112 image (BufferedImage. (inc width) (inc height)
113 BufferedImage/TYPE_INT_RGB)]
114 (dorun
115 (for [x (range (.getWidth image))
116 y (range (.getHeight image))]
117 (.setRGB image x y 0xFF0000)))
118 (dorun
119 (for [index (range (count points))]
120 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
122 image)))
124 (defn average [coll]
125 (/ (reduce + coll) (count coll)))
127 (defn collapse-1d
128 "One dimensional analogue of collapse"
129 [center line]
130 (let [length (count line)
131 num-above (count (filter (partial < center) line))
132 num-below (- length num-above)]
133 (range (- center num-below)
134 (+ center num-above))))
136 (defn collapse
137 "Take a set of pairs of integers and collapse them into a
138 contigous bitmap."
139 [points]
140 (if (empty? points) []
141 (let
142 [num-points (count points)
143 center (vector
144 (int (average (map first points)))
145 (int (average (map first points))))
146 flattened
147 (reduce
148 concat
149 (map
150 (fn [column]
151 (map vector
152 (map first column)
153 (collapse-1d (second center)
154 (map second column))))
155 (partition-by first (sort-by first points))))
156 squeezed
157 (reduce
158 concat
159 (map
160 (fn [row]
161 (map vector
162 (collapse-1d (first center)
163 (map first row))
164 (map second row)))
165 (partition-by second (sort-by second flattened))))
166 relocate
167 (let [min-x (apply min (map first squeezed))
168 min-y (apply min (map second squeezed))]
169 (map (fn [[x y]]
170 [(- x min-x)
171 (- y min-y)])
172 squeezed))]
173 relocate)))
175 (defn load-bullet []
176 (let [sim (world (Node.) {} no-op no-op)]
177 (doto sim
178 (.enqueue
179 (fn []
180 (.stop sim)))
181 (.start))))
183 (defn load-blender-model
184 "Load a .blend file using an asset folder relative path."
185 [^String model]
186 (.loadModel
187 (doto (asset-manager)
188 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
189 model))
191 (defn meta-data [blender-node key]
192 (if-let [data (.getUserData blender-node "properties")]
193 (.findValue data key)
194 nil))
196 (defn blender-to-jme
197 "Convert from Blender coordinates to JME coordinates"
198 [#^Vector3f in]
199 (Vector3f. (.getX in)
200 (.getZ in)
201 (- (.getY in))))
203 (defn jme-to-blender
204 "Convert from JME coordinates to Blender coordinates"
205 [#^Vector3f in]
206 (Vector3f. (.getX in)
207 (- (.getZ in))
208 (.getY in)))
210 (defn joint-targets
211 "Return the two closest two objects to the joint object, ordered
212 from bottom to top according to the joint's rotation."
213 [#^Node parts #^Node joint]
214 (loop [radius (float 0.01)]
215 (let [results (CollisionResults.)]
216 (.collideWith
217 parts
218 (BoundingBox. (.getWorldTranslation joint)
219 radius radius radius)
220 results)
221 (let [targets
222 (distinct
223 (map #(.getGeometry %) results))]
224 (if (>= (count targets) 2)
225 (sort-by
226 #(let [v
227 (jme-to-blender
228 (.mult
229 (.inverse (.getWorldRotation joint))
230 (.subtract (.getWorldTranslation %)
231 (.getWorldTranslation joint))))]
232 (println-repl (.getName %) ":" v)
233 (.dot (Vector3f. 1 1 1)
234 v))
235 (take 2 targets))
236 (recur (float (* radius 2))))))))
238 (defn world-to-local
239 "Convert the world coordinates into coordinates relative to the
240 object (i.e. local coordinates), taking into account the rotation
241 of object."
242 [#^Spatial object world-coordinate]
243 (let [out (Vector3f.)]
244 (.worldToLocal object world-coordinate out) out))
246 (defn local-to-world
247 "Convert the local coordinates into coordinates into world relative
248 coordinates"
249 [#^Spatial object local-coordinate]
250 (let [world-coordinate (Vector3f.)]
251 (.localToWorld object local-coordinate world-coordinate)
252 world-coordinate))
254 (defmulti joint-dispatch
255 "Translate blender pseudo-joints into real JME joints."
256 (fn [constraints & _]
257 (:type constraints)))
259 (defmethod joint-dispatch :point
260 [constraints control-a control-b pivot-a pivot-b rotation]
261 (println-repl "creating POINT2POINT joint")
262 (Point2PointJoint.
263 control-a
264 control-b
265 pivot-a
266 pivot-b))
268 (defmethod joint-dispatch :hinge
269 [constraints control-a control-b pivot-a pivot-b rotation]
270 (println-repl "creating HINGE joint")
271 (let [axis
272 (if-let
273 [axis (:axis constraints)]
274 axis
275 Vector3f/UNIT_X)
276 [limit-1 limit-2] (:limit constraints)
277 hinge-axis
278 (.mult
279 rotation
280 (blender-to-jme axis))]
281 (doto
282 (HingeJoint.
283 control-a
284 control-b
285 pivot-a
286 pivot-b
287 hinge-axis
288 hinge-axis)
289 (.setLimit limit-1 limit-2))))
291 (defmethod joint-dispatch :cone
292 [constraints control-a control-b pivot-a pivot-b rotation]
293 (let [limit-xz (:limit-xz constraints)
294 limit-xy (:limit-xy constraints)
295 twist (:twist constraints)]
297 (println-repl "creating CONE joint")
298 (println-repl rotation)
299 (println-repl
300 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
301 (println-repl
302 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
303 (println-repl
304 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
305 (doto
306 (ConeJoint.
307 control-a
308 control-b
309 pivot-a
310 pivot-b
311 rotation
312 rotation)
313 (.setLimit (float limit-xz)
314 (float limit-xy)
315 (float twist)))))
317 (defn connect
318 "here are some examples:
319 {:type :point}
320 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
321 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
323 {:type :cone :limit-xz 0]
324 :limit-xy 0]
325 :twist 0]} (use XZY rotation mode in blender!)"
326 [#^Node obj-a #^Node obj-b #^Node joint]
327 (let [control-a (.getControl obj-a RigidBodyControl)
328 control-b (.getControl obj-b RigidBodyControl)
329 joint-center (.getWorldTranslation joint)
330 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
331 pivot-a (world-to-local obj-a joint-center)
332 pivot-b (world-to-local obj-b joint-center)]
334 (if-let [constraints
335 (map-vals
336 eval
337 (read-string
338 (meta-data joint "joint")))]
339 ;; A side-effect of creating a joint registers
340 ;; it with both physics objects which in turn
341 ;; will register the joint with the physics system
342 ;; when the simulation is started.
343 (do
344 (println-repl "creating joint between"
345 (.getName obj-a) "and" (.getName obj-b))
346 (joint-dispatch constraints
347 control-a control-b
348 pivot-a pivot-b
349 joint-rotation))
350 (println-repl "could not find joint meta-data!"))))
352 (defn assemble-creature [#^Node pieces joints]
353 (dorun
354 (map
355 (fn [geom]
356 (let [physics-control
357 (RigidBodyControl.
358 (HullCollisionShape.
359 (.getMesh geom))
360 (if-let [mass (meta-data geom "mass")]
361 (do
362 (println-repl
363 "setting" (.getName geom) "mass to" (float mass))
364 (float mass))
365 (float 1)))]
367 (.addControl geom physics-control)))
368 (filter #(isa? (class %) Geometry )
369 (node-seq pieces))))
370 (dorun
371 (map
372 (fn [joint]
373 (let [[obj-a obj-b]
374 (joint-targets pieces joint)]
375 (connect obj-a obj-b joint)))
376 joints))
377 pieces)
379 (declare blender-creature)
381 (def hand "Models/creature1/one.blend")
383 (def worm "Models/creature1/try-again.blend")
385 (def touch "Models/creature1/touch.blend")
387 (defn worm-model [] (load-blender-model worm))
389 (defn x-ray [#^ColorRGBA color]
390 (doto (Material. (asset-manager)
391 "Common/MatDefs/Misc/Unshaded.j3md")
392 (.setColor "Color" color)
393 (-> (.getAdditionalRenderState)
394 (.setDepthTest false))))
396 (defn colorful []
397 (.getChild (worm-model) "worm-21"))
399 (import jme3tools.converters.ImageToAwt)
401 (import ij.ImagePlus)
403 ;; Every Mesh has many triangles, each with its own index.
404 ;; Every vertex has its own index as well.
406 (defn tactile-sensor-image
407 "Return the touch-sensor distribution image in BufferedImage format,
408 or nil if it does not exist."
409 [#^Geometry obj]
410 (if-let [image-path (meta-data obj "touch")]
411 (ImageToAwt/convert
412 (.getImage
413 (.loadTexture
414 (asset-manager)
415 image-path))
416 false false 0)))
418 (import ij.process.ImageProcessor)
419 (import java.awt.image.BufferedImage)
421 (def white -1)
423 (defn filter-pixels
424 "List the coordinates of all pixels matching pred, within the bounds
425 provided. Bounds -> [x0 y0 width height]"
426 {:author "Dylan Holmes"}
427 ([pred #^BufferedImage image]
428 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
429 ([pred #^BufferedImage image [x0 y0 width height]]
430 ((fn accumulate [x y matches]
431 (cond
432 (>= y (+ height y0)) matches
433 (>= x (+ width x0)) (recur 0 (inc y) matches)
434 (pred (.getRGB image x y))
435 (recur (inc x) y (conj matches [x y]))
436 :else (recur (inc x) y matches)))
437 x0 y0 [])))
439 (defn white-coordinates
440 "Coordinates of all the white pixels in a subset of the image."
441 ([#^BufferedImage image bounds]
442 (filter-pixels #(= % white) image bounds))
443 ([#^BufferedImage image]
444 (filter-pixels #(= % white) image)))
446 (defn triangle
447 "Get the triangle specified by triangle-index from the mesh within
448 bounds."
449 [#^Mesh mesh triangle-index]
450 (let [scratch (Triangle.)]
451 (.getTriangle mesh triangle-index scratch)
452 scratch))
454 (defn triangle-vertex-indices
455 "Get the triangle vertex indices of a given triangle from a given
456 mesh."
457 [#^Mesh mesh triangle-index]
458 (let [indices (int-array 3)]
459 (.getTriangle mesh triangle-index indices)
460 (vec indices)))
462 (defn vertex-UV-coord
463 "Get the uv-coordinates of the vertex named by vertex-index"
464 [#^Mesh mesh vertex-index]
465 (let [UV-buffer
466 (.getData
467 (.getBuffer
468 mesh
469 VertexBuffer$Type/TexCoord))]
470 [(.get UV-buffer (* vertex-index 2))
471 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
473 (defn triangle-UV-coord
474 "Get the uv-cooridnates of the triangle's verticies."
475 [#^Mesh mesh width height triangle-index]
476 (map (fn [[u v]] (vector (* width u) (* height v)))
477 (map (partial vertex-UV-coord mesh)
478 (triangle-vertex-indices mesh triangle-index))))
480 (defn same-side?
481 "Given the points p1 and p2 and the reference point ref, is point p
482 on the same side of the line that goes through p1 and p2 as ref is?"
483 [p1 p2 ref p]
484 (<=
485 0
486 (.dot
487 (.cross (.subtract p2 p1) (.subtract p p1))
488 (.cross (.subtract p2 p1) (.subtract ref p1)))))
490 (defn triangle-seq [#^Triangle tri]
491 [(.get1 tri) (.get2 tri) (.get3 tri)])
493 (defn vector3f-seq [#^Vector3f v]
494 [(.getX v) (.getY v) (.getZ v)])
496 (defn inside-triangle?
497 "Is the point inside the triangle?"
498 {:author "Dylan Holmes"}
499 [#^Triangle tri #^Vector3f p]
500 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
501 (and
502 (same-side? vert-1 vert-2 vert-3 p)
503 (same-side? vert-2 vert-3 vert-1 p)
504 (same-side? vert-3 vert-1 vert-2 p))))
506 (defn triangle->matrix4f
507 "Converts the triangle into a 4x4 matrix: The first three columns
508 contain the vertices of the triangle; the last contains the unit
509 normal of the triangle. The bottom row is filled with 1s."
510 [#^Triangle t]
511 (let [mat (Matrix4f.)
512 [vert-1 vert-2 vert-3]
513 ((comp vec map) #(.get t %) (range 3))
514 unit-normal (do (.calculateNormal t)(.getNormal t))
515 vertices [vert-1 vert-2 vert-3 unit-normal]]
516 (dorun
517 (for [row (range 4) col (range 3)]
518 (do
519 (.set mat col row (.get (vertices row)col))
520 (.set mat 3 row 1))))
521 mat))
523 (defn triangle-transformation
524 "Returns the affine transformation that converts each vertex in the
525 first triangle into the corresponding vertex in the second
526 triangle."
527 [#^Triangle tri-1 #^Triangle tri-2]
528 (.mult
529 (triangle->matrix4f tri-2)
530 (.invert (triangle->matrix4f tri-1))))
532 (defn point->vector2f [[u v]]
533 (Vector2f. u v))
535 (defn vector2f->vector3f [v]
536 (Vector3f. (.getX v) (.getY v) 0))
538 (defn map-triangle [f #^Triangle tri]
539 (Triangle.
540 (f 0 (.get1 tri))
541 (f 1 (.get2 tri))
542 (f 2 (.get3 tri))))
544 (defn points->triangle
545 "Convert a list of points into a triangle."
546 [points]
547 (apply #(Triangle. %1 %2 %3)
548 (map (fn [point]
549 (let [point (vec point)]
550 (Vector3f. (get point 0 0)
551 (get point 1 0)
552 (get point 2 0))))
553 (take 3 points))))
555 (defn convex-bounds
556 ;;dylan
557 "Returns the smallest square containing the given
558 vertices, as a vector of integers [left top width height]."
559 ;; "Dimensions of the smallest integer bounding square of the list of
560 ;; 2D verticies in the form: [x y width height]."
561 [uv-verts]
562 (let [xs (map first uv-verts)
563 ys (map second uv-verts)
564 x0 (Math/floor (apply min xs))
565 y0 (Math/floor (apply min ys))
566 x1 (Math/ceil (apply max xs))
567 y1 (Math/ceil (apply max ys))]
568 [x0 y0 (- x1 x0) (- y1 y0)]))
570 (defn sensors-in-triangle
571 ;;dylan
572 "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
573 ;;"Find the locations of the touch sensors within a triangle in both
574 ;; UV and gemoetry relative coordinates."
575 [image mesh tri-index]
576 (let [width (.getWidth image)
577 height (.getHeight image)
578 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
579 bounds (convex-bounds UV-vertex-coords)
581 cutout-triangle (points->triangle UV-vertex-coords)
582 UV-sensor-coords
583 (filter (comp (partial inside-triangle? cutout-triangle)
584 (fn [[u v]] (Vector3f. u v 0)))
585 (white-coordinates image bounds))
586 UV->geometry (triangle-transformation
587 cutout-triangle
588 (triangle mesh tri-index))
589 geometry-sensor-coords
590 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
591 UV-sensor-coords)]
592 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
594 (defn-memo locate-feelers
595 "Search the geometry's tactile UV image for touch sensors, returning
596 their positions in geometry-relative coordinates."
597 [#^Geometry geo]
598 (let [mesh (.getMesh geo)
599 num-triangles (.getTriangleCount mesh)]
600 (if-let [image (tactile-sensor-image geo)]
601 (map
602 (partial sensors-in-triangle image mesh)
603 (range num-triangles))
604 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
606 (use 'clojure.contrib.def)
608 (defn-memo touch-topology [#^Gemoetry geo]
609 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
611 (defn-memo feeler-coordinates [#^Geometry geo]
612 (vec (map :geometry (locate-feelers geo))))
614 (defn enable-touch [#^Geometry geo]
615 (let [feeler-coords (feeler-coordinates geo)
616 tris (triangles geo)
617 limit 0.1
618 ;;results (CollisionResults.)
619 ]
620 (if (empty? (touch-topology geo))
621 nil
622 (fn [node]
623 (let [sensor-origins
624 (map
625 #(map (partial local-to-world geo) %)
626 feeler-coords)
627 triangle-normals
628 (map (partial get-ray-direction geo)
629 tris)
630 rays
631 (flatten
632 (map (fn [origins norm]
633 (map #(doto (Ray. % norm)
634 (.setLimit limit)) origins))
635 sensor-origins triangle-normals))]
636 (vector
637 (touch-topology geo)
638 (vec
639 (for [ray rays]
640 (do
641 (let [results (CollisionResults.)]
642 (.collideWith node ray results)
643 (let [touch-objects
644 (filter #(not (= geo (.getGeometry %)))
645 results)]
646 (- 255
647 (if (empty? touch-objects) 255
648 (rem
649 (int
650 (* 255 (/ (.getDistance
651 (first touch-objects)) limit)))
652 256))))))))))))))
655 (defn touch [#^Node pieces]
656 (filter (comp not nil?)
657 (map enable-touch
658 (filter #(isa? (class %) Geometry)
659 (node-seq pieces)))))
662 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
663 ;; http://en.wikipedia.org/wiki/Retina
665 (defn test-eye []
666 (.getChild
667 (.getChild (worm-model) "eyes")
668 "eye"))
671 (defn retina-sensor-image
672 "Return a map of pixel selection functions to BufferedImages
673 describing the distribution of light-sensitive components on this
674 geometry's surface. Each function creates an integer from the rgb
675 values found in the pixel. :red, :green, :blue, :gray are already
676 defined as extracting the red green blue and average components
677 respectively."
678 [#^Spatial eye]
679 (if-let [eye-map (meta-data eye "eye")]
680 (map-vals
681 #(ImageToAwt/convert
682 (.getImage (.loadTexture (asset-manager) %))
683 false false 0)
684 (eval (read-string eye-map)))))
686 (defn eye-dimensions
687 "returns the width and height specified in the metadata of the eye"
688 [#^Spatial eye]
689 (let [dimensions
690 (map #(vector (.getWidth %) (.getHeight %))
691 (vals (retina-sensor-image eye)))]
692 [(apply max (map first dimensions))
693 (apply max (map second dimensions))]))
695 (defn creature-eyes
696 ;;dylan
697 "Return the children of the creature's \"eyes\" node."
698 ;;"The eye nodes which are children of the \"eyes\" node in the
699 ;;creature."
700 [#^Node creature]
701 (if-let [eye-node (.getChild creature "eyes")]
702 (seq (.getChildren eye-node))
703 (do (println-repl "could not find eyes node") [])))
705 ;; Here's how vision will work.
707 ;; Make the continuation in scene-processor take FrameBuffer,
708 ;; byte-buffer, BufferedImage already sized to the correct
709 ;; dimensions. the continuation will decide wether to "mix" them
710 ;; into the BufferedImage, lazily ignore them, or mix them halfway
711 ;; and call c/graphics card routines.
713 ;; (vision creature) will take an optional :skip argument which will
714 ;; inform the continuations in scene processor to skip the given
715 ;; number of cycles; 0 means that no cycles will be skipped.
717 ;; (vision creature) will return [init-functions sensor-functions].
718 ;; The init-functions are each single-arg functions that take the
719 ;; world and register the cameras and must each be called before the
720 ;; corresponding sensor-functions. Each init-function returns the
721 ;; viewport for that eye which can be manipulated, saved, etc. Each
722 ;; sensor-function is a thunk and will return data in the same
723 ;; format as the tactile-sensor functions; the structure is
724 ;; [topology, sensor-data]. Internally, these sensor-functions
725 ;; maintain a reference to sensor-data which is periodically updated
726 ;; by the continuation function established by its init-function.
727 ;; They can be queried every cycle, but their information may not
728 ;; necessairly be different every cycle.
730 ;; Each eye in the creature in blender will work the same way as
731 ;; joints -- a zero dimensional object with no geometry whose local
732 ;; coordinate system determines the orientation of the resulting
733 ;; eye. All eyes will have a parent named "eyes" just as all joints
734 ;; have a parent named "joints". The resulting camera will be a
735 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
736 ;; the eye marker. The eye marker will contain the metadata for the
737 ;; eye, and will be moved by it's bound geometry. The dimensions of
738 ;; the eye's camera are equal to the dimensions of the eye's "UV"
739 ;; map.
742 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
744 ;; Ears work the same way as vision.
746 ;; (hearing creature) will return [init-functions
747 ;; sensor-functions]. The init functions each take the world and
748 ;; register a SoundProcessor that does foureier transforms on the
749 ;; incommong sound data, making it available to each sensor function.
751 (defn creature-ears
752 "Return the children of the creature's \"ears\" node."
753 ;;dylan
754 ;;"The ear nodes which are children of the \"ears\" node in the
755 ;;creature."
756 [#^Node creature]
757 (if-let [ear-node (.getChild creature "ears")]
758 (seq (.getChildren ear-node))
759 (do (println-repl "could not find ears node") [])))
761 (defn closest-node
762 "Return the object in creature which is closest to the given node."
763 ;;dylan"The closest object in creature to the given node."
764 [#^Node creature #^Node eye]
765 (loop [radius (float 0.01)]
766 (let [results (CollisionResults.)]
767 (.collideWith
768 creature
769 (BoundingBox. (.getWorldTranslation eye)
770 radius radius radius)
771 results)
772 (if-let [target (first results)]
773 (.getGeometry target)
774 (recur (float (* 2 radius)))))))
776 ;;dylan (defn follow-sense, adjoin-sense, attach-stimuli,
777 ;;anchor-qualia, augment-organ, with-organ
778 (defn bind-sense
779 "Bind the sense to the Spatial such that it will maintain its
780 current position relative to the Spatial no matter how the spatial
781 moves. 'sense can be either a Camera or Listener object."
782 [#^Spatial obj sense]
783 (let [sense-offset (.subtract (.getLocation sense)
784 (.getWorldTranslation obj))
785 initial-sense-rotation (Quaternion. (.getRotation sense))
786 base-anti-rotation (.inverse (.getWorldRotation obj))]
787 (.addControl
788 obj
789 (proxy [AbstractControl] []
790 (controlUpdate [tpf]
791 (let [total-rotation
792 (.mult base-anti-rotation (.getWorldRotation obj))]
793 (.setLocation sense
794 (.add
795 (.mult total-rotation sense-offset)
796 (.getWorldTranslation obj)))
797 (.setRotation sense
798 (.mult total-rotation initial-sense-rotation))))
799 (controlRender [_ _])))))
802 (defn update-listener-velocity
803 "Update the listener's velocity every update loop."
804 [#^Spatial obj #^Listener lis]
805 (let [old-position (atom (.getLocation lis))]
806 (.addControl
807 obj
808 (proxy [AbstractControl] []
809 (controlUpdate [tpf]
810 (let [new-position (.getLocation lis)]
811 (.setVelocity
812 lis
813 (.mult (.subtract new-position @old-position)
814 (float (/ tpf))))
815 (reset! old-position new-position)))
816 (controlRender [_ _])))))
818 (import com.aurellem.capture.audio.AudioSendRenderer)
820 (defn attach-ear
821 [#^Application world #^Node creature #^Spatial ear continuation]
822 (let [target (closest-node creature ear)
823 lis (Listener.)
824 audio-renderer (.getAudioRenderer world)
825 sp (sound-processor continuation)]
826 (.setLocation lis (.getWorldTranslation ear))
827 (.setRotation lis (.getWorldRotation ear))
828 (bind-sense target lis)
829 (update-listener-velocity target lis)
830 (.addListener audio-renderer lis)
831 (.registerSoundProcessor audio-renderer lis sp)))
833 (defn enable-hearing
834 [#^Node creature #^Spatial ear]
835 (let [hearing-data (atom [])]
836 [(fn [world]
837 (attach-ear world creature ear
838 (fn [data]
839 (reset! hearing-data (vec data)))))
840 [(fn []
841 (let [data @hearing-data
842 topology
843 (vec (map #(vector % 0) (range 0 (count data))))
844 scaled-data
845 (vec
846 (map
847 #(rem (int (* 255 (/ (+ 1 %) 2))) 256)
848 data))]
849 [topology scaled-data]))
850 ]]))
852 (defn hearing
853 [#^Node creature]
854 (reduce
855 (fn [[init-a senses-a]
856 [init-b senses-b]]
857 [(conj init-a init-b)
858 (into senses-a senses-b)])
859 [[][]]
860 (for [ear (creature-ears creature)]
861 (enable-hearing creature ear))))
863 (defn attach-eye
864 "Attach a Camera to the appropiate area and return the Camera."
865 [#^Node creature #^Spatial eye]
866 (let [target (closest-node creature eye)
867 [cam-width cam-height] (eye-dimensions eye)
868 cam (Camera. cam-width cam-height)]
869 (.setLocation cam (.getWorldTranslation eye))
870 (.setRotation cam (.getWorldRotation eye))
871 (.setFrustumPerspective
872 cam 45 (/ (.getWidth cam) (.getHeight cam))
873 1 1000)
874 (bind-sense target cam)
875 cam))
877 (def presets
878 {:all 0xFFFFFF
879 :red 0xFF0000
880 :blue 0x0000FF
881 :green 0x00FF00})
883 (defn enable-vision
884 "return [init-function sensor-functions] for a particular eye"
885 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
886 (let [retinal-map (retina-sensor-image eye)
887 camera (attach-eye creature eye)
888 vision-image
889 (atom
890 (BufferedImage. (.getWidth camera)
891 (.getHeight camera)
892 BufferedImage/TYPE_BYTE_BINARY))]
893 [(fn [world]
894 (add-eye
895 world camera
896 (let [counter (atom 0)]
897 (fn [r fb bb bi]
898 (if (zero? (rem (swap! counter inc) (inc skip)))
899 (reset! vision-image (BufferedImage! r fb bb bi)))))))
900 (vec
901 (map
902 (fn [[key image]]
903 (let [whites (white-coordinates image)
904 topology (vec (collapse whites))
905 mask (presets key)]
906 (fn []
907 (vector
908 topology
909 (vec
910 (for [[x y] whites]
911 (bit-and
912 mask (.getRGB @vision-image x y))))))))
913 retinal-map))]))
915 (defn vision
916 [#^Node creature & {skip :skip :or {skip 0}}]
917 (reduce
918 (fn [[init-a senses-a]
919 [init-b senses-b]]
920 [(conj init-a init-b)
921 (into senses-a senses-b)])
922 [[][]]
923 (for [eye (creature-eyes creature)]
924 (enable-vision creature eye))))
930 ;; lower level --- nodes
931 ;; closest-node "parse/compile-x" -> makes organ, which is spatial, fn pair
933 ;; higher level -- organs
934 ;;
936 ;; higher level --- sense/effector
937 ;; these are the functions that provide world i/o, chinese-room style
941 (defn blender-creature
942 "Return a creature with all joints in place."
943 [blender-path]
944 (let [model (load-blender-model blender-path)
945 joints
946 (if-let [joint-node (.getChild model "joints")]
947 (seq (.getChildren joint-node))
948 (do (println-repl "could not find joints node") []))]
949 (assemble-creature model joints)))
951 (defn gray-scale [num]
952 (+ num
953 (bit-shift-left num 8)
954 (bit-shift-left num 16)))
956 (defn debug-window
957 "creates function that offers a debug view of sensor data"
958 []
959 (let [vi (view-image)]
960 (fn
961 [[coords sensor-data]]
962 (let [image (points->image coords)]
963 (dorun
964 (for [i (range (count coords))]
965 (.setRGB image ((coords i) 0) ((coords i) 1)
966 (gray-scale (sensor-data i)))))
969 (vi image)))))
971 (defn debug-vision-window
972 "creates function that offers a debug view of sensor data"
973 []
974 (let [vi (view-image)]
975 (fn
976 [[coords sensor-data]]
977 (let [image (points->image coords)]
978 (dorun
979 (for [i (range (count coords))]
980 (.setRGB image ((coords i) 0) ((coords i) 1)
981 (sensor-data i))))
982 (vi image)))))
984 (defn debug-hearing-window
985 "view audio data"
986 [height]
987 (let [vi (view-image)]
988 (fn [[coords sensor-data]]
989 (let [image (BufferedImage. (count coords) height
990 BufferedImage/TYPE_INT_RGB)]
991 (dorun
992 (for [x (range (count coords))]
993 (dorun
994 (for [y (range height)]
995 (let [raw-sensor (sensor-data x)]
996 (.setRGB image x y (gray-scale raw-sensor)))))))
998 (vi image)))))
1002 ;;(defn test-touch [world creature]
1009 (defn test-creature [thing]
1010 (let [x-axis
1011 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
1012 y-axis
1013 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
1014 z-axis
1015 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
1016 creature (blender-creature thing)
1017 touch-nerves (touch creature)
1018 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
1019 [init-vision-fns vision-data] (vision creature)
1020 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
1021 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
1022 [init-hearing-fns hearing-senses] (hearing creature)
1023 hearing-windows (map (fn [_] (debug-hearing-window 50))
1024 hearing-senses)
1025 bell (AudioNode. (asset-manager)
1026 "Sounds/pure.wav" false)
1027 ;; dream
1030 (world
1031 (nodify [creature
1032 (box 10 2 10 :position (Vector3f. 0 -9 0)
1033 :color ColorRGBA/Gray :mass 0)
1034 x-axis y-axis z-axis
1035 me
1036 ])
1037 (merge standard-debug-controls
1038 {"key-return"
1039 (fn [_ value]
1040 (if value
1041 (do
1042 (println-repl "play-sound")
1043 (.play bell))))})
1044 (fn [world]
1045 (light-up-everything world)
1046 (enable-debug world)
1047 (dorun (map #(% world) init-vision-fns))
1048 (dorun (map #(% world) init-hearing-fns))
1050 (add-eye world
1051 (attach-eye creature (test-eye))
1052 (comp (view-image) BufferedImage!))
1054 (add-eye world (.getCamera world) no-op)
1056 ;;(com.aurellem.capture.Capture/captureVideo
1057 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1058 ;;(.setTimer world (RatchetTimer. 60))
1059 (speed-up world)
1060 ;;(set-gravity world (Vector3f. 0 0 0))
1062 (fn [world tpf]
1063 ;;(dorun
1064 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1068 (dorun
1069 (map #(%1 (%2 (.getRootNode world)))
1070 touch-debug-windows touch-nerves))
1072 (dorun
1073 (map #(%1 (%2))
1074 vision-debug vision-data))
1075 (dorun
1076 (map #(%1 (%2)) hearing-windows hearing-senses))
1079 ;;(println-repl (vision-data))
1080 (.setLocalTranslation me (.getLocation (.getCamera world)))
1084 ;;(let [timer (atom 0)]
1085 ;; (fn [_ _]
1086 ;; (swap! timer inc)
1087 ;; (if (= (rem @timer 60) 0)
1088 ;; (println-repl (float (/ @timer 60))))))
1089 )))
1099 ;;; experiments in collisions
1103 (defn collision-test []
1104 (let [b-radius 1
1105 b-position (Vector3f. 0 0 0)
1106 obj-b (box 1 1 1 :color ColorRGBA/Blue
1107 :position b-position
1108 :mass 0)
1109 node (nodify [obj-b])
1110 bounds-b
1111 (doto (Picture.)
1112 (.setHeight 50)
1113 (.setWidth 50)
1114 (.setImage (asset-manager)
1115 "Models/creature1/hand.png"
1116 false
1117 ))
1119 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1121 collisions
1122 (let [cr (CollisionResults.)]
1123 (.collideWith node bounds-b cr)
1124 (println (map #(.getContactPoint %) cr))
1125 cr)
1127 ;;collision-points
1128 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1129 ;; collisions)
1131 ;;node (nodify (conj collision-points obj-b))
1133 sim
1134 (world node
1135 {"key-space"
1136 (fn [_ value]
1137 (if value
1138 (let [cr (CollisionResults.)]
1139 (.collideWith node bounds-b cr)
1140 (println-repl (map #(.getContactPoint %) cr))
1141 cr)))}
1142 no-op
1143 no-op)
1146 sim
1148 ))
1151 ;; the camera will stay in its initial position/rotation with relation
1152 ;; to the spatial.
1155 (defn follow-test
1156 "show a camera that stays in the same relative position to a blue cube."
1157 []
1158 (let [camera-pos (Vector3f. 0 30 0)
1159 rock (box 1 1 1 :color ColorRGBA/Blue
1160 :position (Vector3f. 0 10 0)
1161 :mass 30
1163 rot (.getWorldRotation rock)
1165 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1166 :position (Vector3f. 0 -3 0))]
1168 (world
1169 (nodify [rock table])
1170 standard-debug-controls
1171 (fn [world]
1172 (let
1173 [cam (doto (.clone (.getCamera world))
1174 (.setLocation camera-pos)
1175 (.lookAt Vector3f/ZERO
1176 Vector3f/UNIT_X))]
1177 (bind-sense rock cam)
1179 (.setTimer world (RatchetTimer. 60))
1180 (add-eye world cam (comp (view-image) BufferedImage!))
1181 (add-eye world (.getCamera world) no-op))
1183 (fn [_ _] (println-repl rot)))))
1187 #+end_src
1189 #+results: body-1
1190 : #'cortex.silly/test-creature
1193 * COMMENT purgatory
1194 #+begin_src clojure
1195 (defn bullet-trans []
1196 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1197 :position (Vector3f. -10 5 0))
1198 obj-b (sphere 0.5 :color ColorRGBA/Blue
1199 :position (Vector3f. -10 -5 0)
1200 :mass 0)
1201 control-a (.getControl obj-a RigidBodyControl)
1202 control-b (.getControl obj-b RigidBodyControl)
1203 swivel
1204 (.toRotationMatrix
1205 (doto (Quaternion.)
1206 (.fromAngleAxis (/ Math/PI 2)
1207 Vector3f/UNIT_X)))]
1208 (doto
1209 (ConeJoint.
1210 control-a control-b
1211 (Vector3f. 0 5 0)
1212 (Vector3f. 0 -5 0)
1213 swivel swivel)
1214 (.setLimit (* 0.6 (/ Math/PI 4))
1215 (/ Math/PI 4)
1216 (* Math/PI 0.8)))
1217 (world (nodify
1218 [obj-a obj-b])
1219 standard-debug-controls
1220 enable-debug
1221 no-op)))
1224 (defn bullet-trans* []
1225 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1226 :position (Vector3f. 5 0 0)
1227 :mass 90)
1228 obj-b (sphere 0.5 :color ColorRGBA/Blue
1229 :position (Vector3f. -5 0 0)
1230 :mass 0)
1231 control-a (.getControl obj-a RigidBodyControl)
1232 control-b (.getControl obj-b RigidBodyControl)
1233 move-up? (atom nil)
1234 move-down? (atom nil)
1235 move-left? (atom nil)
1236 move-right? (atom nil)
1237 roll-left? (atom nil)
1238 roll-right? (atom nil)
1239 force 100
1240 swivel
1241 (.toRotationMatrix
1242 (doto (Quaternion.)
1243 (.fromAngleAxis (/ Math/PI 2)
1244 Vector3f/UNIT_X)))
1245 x-move
1246 (doto (Matrix3f.)
1247 (.fromStartEndVectors Vector3f/UNIT_X
1248 (.normalize (Vector3f. 1 1 0))))
1250 timer (atom 0)]
1251 (doto
1252 (ConeJoint.
1253 control-a control-b
1254 (Vector3f. -8 0 0)
1255 (Vector3f. 2 0 0)
1256 ;;swivel swivel
1257 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1258 x-move Matrix3f/IDENTITY
1260 (.setCollisionBetweenLinkedBodys false)
1261 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1262 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1263 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1264 (world (nodify
1265 [obj-a obj-b])
1266 (merge standard-debug-controls
1267 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1268 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1269 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1270 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1271 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1272 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1274 (fn [world]
1275 (enable-debug world)
1276 (set-gravity world Vector3f/ZERO)
1279 (fn [world _]
1281 (if @move-up?
1282 (.applyForce control-a
1283 (Vector3f. force 0 0)
1284 (Vector3f. 0 0 0)))
1285 (if @move-down?
1286 (.applyForce control-a
1287 (Vector3f. (- force) 0 0)
1288 (Vector3f. 0 0 0)))
1289 (if @move-left?
1290 (.applyForce control-a
1291 (Vector3f. 0 force 0)
1292 (Vector3f. 0 0 0)))
1293 (if @move-right?
1294 (.applyForce control-a
1295 (Vector3f. 0 (- force) 0)
1296 (Vector3f. 0 0 0)))
1298 (if @roll-left?
1299 (.applyForce control-a
1300 (Vector3f. 0 0 force)
1301 (Vector3f. 0 0 0)))
1302 (if @roll-right?
1303 (.applyForce control-a
1304 (Vector3f. 0 0 (- force))
1305 (Vector3f. 0 0 0)))
1307 (if (zero? (rem (swap! timer inc) 100))
1308 (.attachChild
1309 (.getRootNode world)
1310 (sphere 0.05 :color ColorRGBA/Yellow
1311 :physical? false :position
1312 (.getWorldTranslation obj-a)))))
1314 ))
1316 (defn transform-trianglesdsd
1317 "Transform that converts each vertex in the first triangle
1318 into the corresponding vertex in the second triangle."
1319 [#^Triangle tri-1 #^Triangle tri-2]
1320 (let [in [(.get1 tri-1)
1321 (.get2 tri-1)
1322 (.get3 tri-1)]
1323 out [(.get1 tri-2)
1324 (.get2 tri-2)
1325 (.get3 tri-2)]]
1326 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1327 in* [(.mult translate (in 0))
1328 (.mult translate (in 1))
1329 (.mult translate (in 2))]
1330 final-translation
1331 (doto (Matrix4f.)
1332 (.setTranslation (out 1)))
1334 rotate-1
1335 (doto (Matrix3f.)
1336 (.fromStartEndVectors
1337 (.normalize
1338 (.subtract
1339 (in* 1) (in* 0)))
1340 (.normalize
1341 (.subtract
1342 (out 1) (out 0)))))
1343 in** [(.mult rotate-1 (in* 0))
1344 (.mult rotate-1 (in* 1))
1345 (.mult rotate-1 (in* 2))]
1346 scale-factor-1
1347 (.mult
1348 (.normalize
1349 (.subtract
1350 (out 1)
1351 (out 0)))
1352 (/ (.length
1353 (.subtract (out 1)
1354 (out 0)))
1355 (.length
1356 (.subtract (in** 1)
1357 (in** 0)))))
1358 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1359 in*** [(.mult scale-1 (in** 0))
1360 (.mult scale-1 (in** 1))
1361 (.mult scale-1 (in** 2))]
1369 (dorun (map println in))
1370 (println)
1371 (dorun (map println in*))
1372 (println)
1373 (dorun (map println in**))
1374 (println)
1375 (dorun (map println in***))
1376 (println)
1378 ))))
1381 (defn world-setup [joint]
1382 (let [joint-position (Vector3f. 0 0 0)
1383 joint-rotation
1384 (.toRotationMatrix
1385 (.mult
1386 (doto (Quaternion.)
1387 (.fromAngleAxis
1388 (* 1 (/ Math/PI 4))
1389 (Vector3f. -1 0 0)))
1390 (doto (Quaternion.)
1391 (.fromAngleAxis
1392 (* 1 (/ Math/PI 2))
1393 (Vector3f. 0 0 1)))))
1394 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1396 origin (doto
1397 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1398 :position top-position))
1399 top (doto
1400 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1401 :position top-position)
1403 (.addControl
1404 (RigidBodyControl.
1405 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1406 bottom (doto
1407 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1408 :position (Vector3f. 0 0 0))
1409 (.addControl
1410 (RigidBodyControl.
1411 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1412 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1413 :color ColorRGBA/Gray :mass 0)
1414 a (.getControl top RigidBodyControl)
1415 b (.getControl bottom RigidBodyControl)]
1417 (cond
1418 (= joint :cone)
1420 (doto (ConeJoint.
1421 a b
1422 (world-to-local top joint-position)
1423 (world-to-local bottom joint-position)
1424 joint-rotation
1425 joint-rotation
1429 (.setLimit (* (/ 10) Math/PI)
1430 (* (/ 4) Math/PI)
1431 0)))
1432 [origin top bottom table]))
1434 (defn test-joint [joint]
1435 (let [[origin top bottom floor] (world-setup joint)
1436 control (.getControl top RigidBodyControl)
1437 move-up? (atom false)
1438 move-down? (atom false)
1439 move-left? (atom false)
1440 move-right? (atom false)
1441 roll-left? (atom false)
1442 roll-right? (atom false)
1443 timer (atom 0)]
1445 (world
1446 (nodify [top bottom floor origin])
1447 (merge standard-debug-controls
1448 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1449 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1450 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1451 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1452 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1453 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1455 (fn [world]
1456 (light-up-everything world)
1457 (enable-debug world)
1458 (set-gravity world (Vector3f. 0 0 0))
1461 (fn [world _]
1462 (if (zero? (rem (swap! timer inc) 100))
1463 (do
1464 ;; (println-repl @timer)
1465 (.attachChild (.getRootNode world)
1466 (sphere 0.05 :color ColorRGBA/Yellow
1467 :position (.getWorldTranslation top)
1468 :physical? false))
1469 (.attachChild (.getRootNode world)
1470 (sphere 0.05 :color ColorRGBA/LightGray
1471 :position (.getWorldTranslation bottom)
1472 :physical? false))))
1474 (if @move-up?
1475 (.applyTorque control
1476 (.mult (.getPhysicsRotation control)
1477 (Vector3f. 0 0 10))))
1478 (if @move-down?
1479 (.applyTorque control
1480 (.mult (.getPhysicsRotation control)
1481 (Vector3f. 0 0 -10))))
1482 (if @move-left?
1483 (.applyTorque control
1484 (.mult (.getPhysicsRotation control)
1485 (Vector3f. 0 10 0))))
1486 (if @move-right?
1487 (.applyTorque control
1488 (.mult (.getPhysicsRotation control)
1489 (Vector3f. 0 -10 0))))
1490 (if @roll-left?
1491 (.applyTorque control
1492 (.mult (.getPhysicsRotation control)
1493 (Vector3f. -1 0 0))))
1494 (if @roll-right?
1495 (.applyTorque control
1496 (.mult (.getPhysicsRotation control)
1497 (Vector3f. 1 0 0))))))))
1501 (defprotocol Frame
1502 (frame [this]))
1504 (extend-type BufferedImage
1505 Frame
1506 (frame [image]
1507 (merge
1508 (apply
1509 hash-map
1510 (interleave
1511 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1512 (vector x y)))
1513 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1514 (let [data (.getRGB image x y)]
1515 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1516 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1517 :b (bit-and 0x0000ff data)))))))
1518 {:width (.getWidth image) :height (.getHeight image)})))
1521 (extend-type ImagePlus
1522 Frame
1523 (frame [image+]
1524 (frame (.getBufferedImage image+))))
1527 #+end_src
1530 * COMMENT generate source
1531 #+begin_src clojure :tangle ../src/cortex/silly.clj
1532 <<body-1>>
1533 #+end_src