view org/test-creature.org @ 127:bc49d452c42a

saving progress
author Robert McIntyre <rlm@mit.edu>
date Thu, 26 Jan 2012 12:59:22 -0700
parents 0efe6f04bc26
children 4b38355ad6e3
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 "Dimensions of the smallest integer bounding square of the list of
557 2D verticies in the form: [x y width height]."
558 [uv-verts]
559 (let [xs (map first uv-verts)
560 ys (map second uv-verts)
561 x0 (Math/floor (apply min xs))
562 y0 (Math/floor (apply min ys))
563 x1 (Math/ceil (apply max xs))
564 y1 (Math/ceil (apply max ys))]
565 [x0 y0 (- x1 x0) (- y1 y0)]))
567 (defn sensors-in-triangle
568 "Find the locations of the touch sensors within a triangle in both
569 UV and gemoetry relative coordinates."
570 [image mesh tri-index]
571 (let [width (.getWidth image)
572 height (.getHeight image)
573 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
574 bounds (convex-bounds UV-vertex-coords)
576 cutout-triangle (points->triangle UV-vertex-coords)
577 UV-sensor-coords
578 (filter (comp (partial inside-triangle? cutout-triangle)
579 (fn [[u v]] (Vector3f. u v 0)))
580 (white-coordinates image bounds))
581 UV->geometry (triangle-transformation
582 cutout-triangle
583 (triangle mesh tri-index))
584 geometry-sensor-coords
585 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
586 UV-sensor-coords)]
587 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
589 (defn-memo locate-feelers
590 "Search the geometry's tactile UV image for touch sensors, returning
591 their positions in geometry-relative coordinates."
592 [#^Geometry geo]
593 (let [mesh (.getMesh geo)
594 num-triangles (.getTriangleCount mesh)]
595 (if-let [image (tactile-sensor-image geo)]
596 (map
597 (partial sensors-in-triangle image mesh)
598 (range num-triangles))
599 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
601 (use 'clojure.contrib.def)
603 (defn-memo touch-topology [#^Gemoetry geo]
604 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
606 (defn-memo feeler-coordinates [#^Geometry geo]
607 (vec (map :geometry (locate-feelers geo))))
609 (defn enable-touch [#^Geometry geo]
610 (let [feeler-coords (feeler-coordinates geo)
611 tris (triangles geo)
612 limit 0.1
613 ;;results (CollisionResults.)
614 ]
615 (if (empty? (touch-topology geo))
616 nil
617 (fn [node]
618 (let [sensor-origins
619 (map
620 #(map (partial local-to-world geo) %)
621 feeler-coords)
622 triangle-normals
623 (map (partial get-ray-direction geo)
624 tris)
625 rays
626 (flatten
627 (map (fn [origins norm]
628 (map #(doto (Ray. % norm)
629 (.setLimit limit)) origins))
630 sensor-origins triangle-normals))]
631 (vector
632 (touch-topology geo)
633 (vec
634 (for [ray rays]
635 (do
636 (let [results (CollisionResults.)]
637 (.collideWith node ray results)
638 (let [touch-objects
639 (filter #(not (= geo (.getGeometry %)))
640 results)]
641 (- 255
642 (if (empty? touch-objects) 255
643 (rem
644 (int
645 (* 255 (/ (.getDistance
646 (first touch-objects)) limit)))
647 256))))))))))))))
650 (defn touch [#^Node pieces]
651 (filter (comp not nil?)
652 (map enable-touch
653 (filter #(isa? (class %) Geometry)
654 (node-seq pieces)))))
657 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
658 ;; http://en.wikipedia.org/wiki/Retina
660 (defn test-eye []
661 (.getChild
662 (.getChild (worm-model) "eyes")
663 "eye"))
666 (defn retina-sensor-image
667 "Return a map of pixel selection functions to BufferedImages
668 describing the distribution of light-sensitive components on this
669 geometry's surface. Each function creates an integer from the rgb
670 values found in the pixel. :red, :green, :blue, :gray are already
671 defined as extracting the red green blue and average components
672 respectively."
673 [#^Spatial eye]
674 (if-let [eye-map (meta-data eye "eye")]
675 (map-vals
676 #(ImageToAwt/convert
677 (.getImage (.loadTexture (asset-manager) %))
678 false false 0)
679 (eval (read-string eye-map)))))
681 (defn eye-dimensions
682 "returns the width and height specified in the metadata of the eye"
683 [#^Spatial eye]
684 (let [dimensions
685 (map #(vector (.getWidth %) (.getHeight %))
686 (vals (retina-sensor-image eye)))]
687 [(apply max (map first dimensions))
688 (apply max (map second dimensions))]))
690 (defn creature-eyes
691 "The eye nodes which are children of the \"eyes\" node in the
692 creature."
693 [#^Node creature]
694 (if-let [eye-node (.getChild creature "eyes")]
695 (seq (.getChildren eye-node))
696 (do (println-repl "could not find eyes node") [])))
698 ;; Here's how vision will work.
700 ;; Make the continuation in scene-processor take FrameBuffer,
701 ;; byte-buffer, BufferedImage already sized to the correct
702 ;; dimensions. the continuation will decide wether to "mix" them
703 ;; into the BufferedImage, lazily ignore them, or mix them halfway
704 ;; and call c/graphics card routines.
706 ;; (vision creature) will take an optional :skip argument which will
707 ;; inform the continuations in scene processor to skip the given
708 ;; number of cycles; 0 means that no cycles will be skipped.
710 ;; (vision creature) will return [init-functions sensor-functions].
711 ;; The init-functions are each single-arg functions that take the
712 ;; world and register the cameras and must each be called before the
713 ;; corresponding sensor-functions. Each init-function returns the
714 ;; viewport for that eye which can be manipulated, saved, etc. Each
715 ;; sensor-function is a thunk and will return data in the same
716 ;; format as the tactile-sensor functions; the structure is
717 ;; [topology, sensor-data]. Internally, these sensor-functions
718 ;; maintain a reference to sensor-data which is periodically updated
719 ;; by the continuation function established by its init-function.
720 ;; They can be queried every cycle, but their information may not
721 ;; necessairly be different every cycle.
723 ;; Each eye in the creature in blender will work the same way as
724 ;; joints -- a zero dimensional object with no geometry whose local
725 ;; coordinate system determines the orientation of the resulting
726 ;; eye. All eyes will have a parent named "eyes" just as all joints
727 ;; have a parent named "joints". The resulting camera will be a
728 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
729 ;; the eye marker. The eye marker will contain the metadata for the
730 ;; eye, and will be moved by it's bound geometry. The dimensions of
731 ;; the eye's camera are equal to the dimensions of the eye's "UV"
732 ;; map.
735 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
737 ;; Ears work the same way as vision.
739 ;; (hearing creature) will return [init-functions
740 ;; sensor-functions]. The init functions each take the world and
741 ;; register a SoundProcessor that does foureier transforms on the
742 ;; incommong sound data, making it available to each sensor function.
744 (defn creature-ears
745 "The ear nodes which are children of the \"ears\" node in the
746 creature."
747 [#^Node creature]
748 (if-let [ear-node (.getChild creature "ears")]
749 (seq (.getChildren ear-node))
750 (do (println-repl "could not find ears node") [])))
752 (defn closest-node
753 "The closest object in creature to the given node."
754 [#^Node creature #^Node eye]
755 (loop [radius (float 0.01)]
756 (let [results (CollisionResults.)]
757 (.collideWith
758 creature
759 (BoundingBox. (.getWorldTranslation eye)
760 radius radius radius)
761 results)
762 (if-let [target (first results)]
763 (.getGeometry target)
764 (recur (float (* 2 radius)))))))
766 (defn bind-sense
767 "Bind the sense to the Spatial such that it will maintain its
768 current position relative to the Spatial no matter how the spatial
769 moves. 'sense can be either a Camera or Listener object."
770 [#^Spatial obj sense]
771 (let [sense-offset (.subtract (.getLocation sense)
772 (.getWorldTranslation obj))
773 initial-sense-rotation (Quaternion. (.getRotation sense))
774 base-anti-rotation (.inverse (.getWorldRotation obj))]
775 (.addControl
776 obj
777 (proxy [AbstractControl] []
778 (controlUpdate [tpf]
779 (let [total-rotation
780 (.mult base-anti-rotation (.getWorldRotation obj))]
781 (.setLocation sense
782 (.add
783 (.mult total-rotation sense-offset)
784 (.getWorldTranslation obj)))
785 (.setRotation sense
786 (.mult total-rotation initial-sense-rotation))))
787 (controlRender [_ _])))))
790 (defn update-listener-velocity
791 "Update the listener's velocity every update loop."
792 [#^Spatial obj #^Listener lis]
793 (let [old-position (atom (.getLocation lis))]
794 (.addControl
795 obj
796 (proxy [AbstractControl] []
797 (controlUpdate [tpf]
798 (let [new-position (.getLocation lis)]
799 (.setVelocity
800 lis
801 (.mult (.subtract new-position @old-position)
802 (float (/ tpf))))
803 (reset! old-position new-position)))
804 (controlRender [_ _])))))
806 (import com.aurellem.capture.audio.AudioSendRenderer)
808 (defn attach-ear
809 [#^Application world #^Node creature #^Spatial ear continuation]
810 (let [target (closest-node creature ear)
811 lis (Listener.)
812 audio-renderer (.getAudioRenderer world)
813 sp (sound-processor continuation)]
814 (.setLocation lis (.getWorldTranslation ear))
815 (.setRotation lis (.getWorldRotation ear))
816 (bind-sense target lis)
817 (update-listener-velocity target lis)
818 (.addListener audio-renderer lis)
819 (.registerSoundProcessor audio-renderer lis sp)))
821 (defn enable-hearing
822 [#^Node creature #^Spatial ear]
823 (let [hearing-data (atom [])]
824 [(fn [world]
825 (attach-ear world creature ear
826 (fn [data]
827 (reset! hearing-data (vec data)))))
828 [(fn []
829 (let [data @hearing-data
830 topology
831 (vec (map #(vector % 0) (range 0 (count data))))
832 scaled-data
833 (vec
834 (map
835 #(rem (int (* 255 (/ (+ 1 %) 2))) 256)
836 data))]
837 [topology scaled-data]))
838 ]]))
840 (defn hearing
841 [#^Node creature]
842 (reduce
843 (fn [[init-a senses-a]
844 [init-b senses-b]]
845 [(conj init-a init-b)
846 (into senses-a senses-b)])
847 [[][]]
848 (for [ear (creature-ears creature)]
849 (enable-hearing creature ear))))
851 (defn attach-eye
852 "Attach a Camera to the appropiate area and return the Camera."
853 [#^Node creature #^Spatial eye]
854 (let [target (closest-node creature eye)
855 [cam-width cam-height] (eye-dimensions eye)
856 cam (Camera. cam-width cam-height)]
857 (.setLocation cam (.getWorldTranslation eye))
858 (.setRotation cam (.getWorldRotation eye))
859 (.setFrustumPerspective
860 cam 45 (/ (.getWidth cam) (.getHeight cam))
861 1 1000)
862 (bind-sense target cam)
863 cam))
865 (def presets
866 {:all 0xFFFFFF
867 :red 0xFF0000
868 :blue 0x0000FF
869 :green 0x00FF00})
871 (defn enable-vision
872 "return [init-function sensor-functions] for a particular eye"
873 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
874 (let [retinal-map (retina-sensor-image eye)
875 camera (attach-eye creature eye)
876 vision-image
877 (atom
878 (BufferedImage. (.getWidth camera)
879 (.getHeight camera)
880 BufferedImage/TYPE_BYTE_BINARY))]
881 [(fn [world]
882 (add-eye
883 world camera
884 (let [counter (atom 0)]
885 (fn [r fb bb bi]
886 (if (zero? (rem (swap! counter inc) (inc skip)))
887 (reset! vision-image (BufferedImage! r fb bb bi)))))))
888 (vec
889 (map
890 (fn [[key image]]
891 (let [whites (white-coordinates image)
892 topology (vec (collapse whites))
893 mask (presets key)]
894 (fn []
895 (vector
896 topology
897 (vec
898 (for [[x y] whites]
899 (bit-and
900 mask (.getRGB @vision-image x y))))))))
901 retinal-map))]))
903 (defn vision
904 [#^Node creature & {skip :skip :or {skip 0}}]
905 (reduce
906 (fn [[init-a senses-a]
907 [init-b senses-b]]
908 [(conj init-a init-b)
909 (into senses-a senses-b)])
910 [[][]]
911 (for [eye (creature-eyes creature)]
912 (enable-vision creature eye))))
915 (defn blender-creature
916 "Return a creature with all joints in place."
917 [blender-path]
918 (let [model (load-blender-model blender-path)
919 joints
920 (if-let [joint-node (.getChild model "joints")]
921 (seq (.getChildren joint-node))
922 (do (println-repl "could not find joints node") []))]
923 (assemble-creature model joints)))
925 (defn gray-scale [num]
926 (+ num
927 (bit-shift-left num 8)
928 (bit-shift-left num 16)))
930 (defn debug-window
931 "creates function that offers a debug view of sensor data"
932 []
933 (let [vi (view-image)]
934 (fn
935 [[coords sensor-data]]
936 (let [image (points->image coords)]
937 (dorun
938 (for [i (range (count coords))]
939 (.setRGB image ((coords i) 0) ((coords i) 1)
940 (gray-scale (sensor-data i)))))
943 (vi image)))))
945 (defn debug-vision-window
946 "creates function that offers a debug view of sensor data"
947 []
948 (let [vi (view-image)]
949 (fn
950 [[coords sensor-data]]
951 (let [image (points->image coords)]
952 (dorun
953 (for [i (range (count coords))]
954 (.setRGB image ((coords i) 0) ((coords i) 1)
955 (sensor-data i))))
956 (vi image)))))
958 (defn debug-hearing-window
959 "view audio data"
960 [height]
961 (let [vi (view-image)]
962 (fn [[coords sensor-data]]
963 (let [image (BufferedImage. (count coords) height
964 BufferedImage/TYPE_INT_RGB)]
965 (dorun
966 (for [x (range (count coords))]
967 (dorun
968 (for [y (range height)]
969 (let [raw-sensor (sensor-data x)]
970 (.setRGB image x y (gray-scale raw-sensor)))))))
972 (vi image)))))
976 ;;(defn test-touch [world creature]
983 (defn test-creature [thing]
984 (let [x-axis
985 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
986 y-axis
987 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
988 z-axis
989 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
990 creature (blender-creature thing)
991 touch-nerves (touch creature)
992 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
993 [init-vision-fns vision-data] (vision creature)
994 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
995 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
996 [init-hearing-fns hearing-senses] (hearing creature)
997 hearing-windows (map (fn [_] (debug-hearing-window 50))
998 hearing-senses)
999 bell (AudioNode. (asset-manager)
1000 "Sounds/ear-and-eye.wav" false)
1001 ;; dream
1004 (world
1005 (nodify [creature
1006 (box 10 2 10 :position (Vector3f. 0 -9 0)
1007 :color ColorRGBA/Gray :mass 0)
1008 x-axis y-axis z-axis
1009 me
1010 ])
1011 (merge standard-debug-controls
1012 {"key-return"
1013 (fn [_ value]
1014 (if value
1015 (do
1016 (println-repl "play-sound")
1017 (.play bell))))})
1018 (fn [world]
1019 (light-up-everything world)
1020 (enable-debug world)
1021 (dorun (map #(% world) init-vision-fns))
1022 (dorun (map #(% world) init-hearing-fns))
1024 (add-eye world
1025 (attach-eye creature (test-eye))
1026 (comp (view-image) BufferedImage!))
1028 (add-eye world (.getCamera world) no-op)
1030 ;;(com.aurellem.capture.Capture/captureVideo
1031 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1032 ;;(.setTimer world (RatchetTimer. 60))
1033 (speed-up world)
1034 ;;(set-gravity world (Vector3f. 0 0 0))
1036 (fn [world tpf]
1037 ;;(dorun
1038 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1042 (dorun
1043 (map #(%1 (%2 (.getRootNode world)))
1044 touch-debug-windows touch-nerves))
1046 (dorun
1047 (map #(%1 (%2))
1048 vision-debug vision-data))
1049 (dorun
1050 (map #(%1 (%2)) hearing-windows hearing-senses))
1053 ;;(println-repl (vision-data))
1054 (.setLocalTranslation me (.getLocation (.getCamera world)))
1058 ;;(let [timer (atom 0)]
1059 ;; (fn [_ _]
1060 ;; (swap! timer inc)
1061 ;; (if (= (rem @timer 60) 0)
1062 ;; (println-repl (float (/ @timer 60))))))
1063 )))
1073 ;;; experiments in collisions
1077 (defn collision-test []
1078 (let [b-radius 1
1079 b-position (Vector3f. 0 0 0)
1080 obj-b (box 1 1 1 :color ColorRGBA/Blue
1081 :position b-position
1082 :mass 0)
1083 node (nodify [obj-b])
1084 bounds-b
1085 (doto (Picture.)
1086 (.setHeight 50)
1087 (.setWidth 50)
1088 (.setImage (asset-manager)
1089 "Models/creature1/hand.png"
1090 false
1091 ))
1093 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1095 collisions
1096 (let [cr (CollisionResults.)]
1097 (.collideWith node bounds-b cr)
1098 (println (map #(.getContactPoint %) cr))
1099 cr)
1101 ;;collision-points
1102 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1103 ;; collisions)
1105 ;;node (nodify (conj collision-points obj-b))
1107 sim
1108 (world node
1109 {"key-space"
1110 (fn [_ value]
1111 (if value
1112 (let [cr (CollisionResults.)]
1113 (.collideWith node bounds-b cr)
1114 (println-repl (map #(.getContactPoint %) cr))
1115 cr)))}
1116 no-op
1117 no-op)
1120 sim
1122 ))
1125 ;; the camera will stay in its initial position/rotation with relation
1126 ;; to the spatial.
1129 (defn follow-test
1130 "show a camera that stays in the same relative position to a blue cube."
1131 []
1132 (let [camera-pos (Vector3f. 0 30 0)
1133 rock (box 1 1 1 :color ColorRGBA/Blue
1134 :position (Vector3f. 0 10 0)
1135 :mass 30
1137 rot (.getWorldRotation rock)
1139 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1140 :position (Vector3f. 0 -3 0))]
1142 (world
1143 (nodify [rock table])
1144 standard-debug-controls
1145 (fn [world]
1146 (let
1147 [cam (doto (.clone (.getCamera world))
1148 (.setLocation camera-pos)
1149 (.lookAt Vector3f/ZERO
1150 Vector3f/UNIT_X))]
1151 (bind-sense rock cam)
1153 (.setTimer world (RatchetTimer. 60))
1154 (add-eye world cam (comp (view-image) BufferedImage!))
1155 (add-eye world (.getCamera world) no-op))
1157 (fn [_ _] (println-repl rot)))))
1161 #+end_src
1163 #+results: body-1
1164 : #'cortex.silly/test-creature
1167 * COMMENT purgatory
1168 #+begin_src clojure
1169 (defn bullet-trans []
1170 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1171 :position (Vector3f. -10 5 0))
1172 obj-b (sphere 0.5 :color ColorRGBA/Blue
1173 :position (Vector3f. -10 -5 0)
1174 :mass 0)
1175 control-a (.getControl obj-a RigidBodyControl)
1176 control-b (.getControl obj-b RigidBodyControl)
1177 swivel
1178 (.toRotationMatrix
1179 (doto (Quaternion.)
1180 (.fromAngleAxis (/ Math/PI 2)
1181 Vector3f/UNIT_X)))]
1182 (doto
1183 (ConeJoint.
1184 control-a control-b
1185 (Vector3f. 0 5 0)
1186 (Vector3f. 0 -5 0)
1187 swivel swivel)
1188 (.setLimit (* 0.6 (/ Math/PI 4))
1189 (/ Math/PI 4)
1190 (* Math/PI 0.8)))
1191 (world (nodify
1192 [obj-a obj-b])
1193 standard-debug-controls
1194 enable-debug
1195 no-op)))
1198 (defn bullet-trans* []
1199 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1200 :position (Vector3f. 5 0 0)
1201 :mass 90)
1202 obj-b (sphere 0.5 :color ColorRGBA/Blue
1203 :position (Vector3f. -5 0 0)
1204 :mass 0)
1205 control-a (.getControl obj-a RigidBodyControl)
1206 control-b (.getControl obj-b RigidBodyControl)
1207 move-up? (atom nil)
1208 move-down? (atom nil)
1209 move-left? (atom nil)
1210 move-right? (atom nil)
1211 roll-left? (atom nil)
1212 roll-right? (atom nil)
1213 force 100
1214 swivel
1215 (.toRotationMatrix
1216 (doto (Quaternion.)
1217 (.fromAngleAxis (/ Math/PI 2)
1218 Vector3f/UNIT_X)))
1219 x-move
1220 (doto (Matrix3f.)
1221 (.fromStartEndVectors Vector3f/UNIT_X
1222 (.normalize (Vector3f. 1 1 0))))
1224 timer (atom 0)]
1225 (doto
1226 (ConeJoint.
1227 control-a control-b
1228 (Vector3f. -8 0 0)
1229 (Vector3f. 2 0 0)
1230 ;;swivel swivel
1231 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1232 x-move Matrix3f/IDENTITY
1234 (.setCollisionBetweenLinkedBodys false)
1235 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1236 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1237 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1238 (world (nodify
1239 [obj-a obj-b])
1240 (merge standard-debug-controls
1241 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1242 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1243 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1244 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1245 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1246 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1248 (fn [world]
1249 (enable-debug world)
1250 (set-gravity world Vector3f/ZERO)
1253 (fn [world _]
1255 (if @move-up?
1256 (.applyForce control-a
1257 (Vector3f. force 0 0)
1258 (Vector3f. 0 0 0)))
1259 (if @move-down?
1260 (.applyForce control-a
1261 (Vector3f. (- force) 0 0)
1262 (Vector3f. 0 0 0)))
1263 (if @move-left?
1264 (.applyForce control-a
1265 (Vector3f. 0 force 0)
1266 (Vector3f. 0 0 0)))
1267 (if @move-right?
1268 (.applyForce control-a
1269 (Vector3f. 0 (- force) 0)
1270 (Vector3f. 0 0 0)))
1272 (if @roll-left?
1273 (.applyForce control-a
1274 (Vector3f. 0 0 force)
1275 (Vector3f. 0 0 0)))
1276 (if @roll-right?
1277 (.applyForce control-a
1278 (Vector3f. 0 0 (- force))
1279 (Vector3f. 0 0 0)))
1281 (if (zero? (rem (swap! timer inc) 100))
1282 (.attachChild
1283 (.getRootNode world)
1284 (sphere 0.05 :color ColorRGBA/Yellow
1285 :physical? false :position
1286 (.getWorldTranslation obj-a)))))
1288 ))
1290 (defn transform-trianglesdsd
1291 "Transform that converts each vertex in the first triangle
1292 into the corresponding vertex in the second triangle."
1293 [#^Triangle tri-1 #^Triangle tri-2]
1294 (let [in [(.get1 tri-1)
1295 (.get2 tri-1)
1296 (.get3 tri-1)]
1297 out [(.get1 tri-2)
1298 (.get2 tri-2)
1299 (.get3 tri-2)]]
1300 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1301 in* [(.mult translate (in 0))
1302 (.mult translate (in 1))
1303 (.mult translate (in 2))]
1304 final-translation
1305 (doto (Matrix4f.)
1306 (.setTranslation (out 1)))
1308 rotate-1
1309 (doto (Matrix3f.)
1310 (.fromStartEndVectors
1311 (.normalize
1312 (.subtract
1313 (in* 1) (in* 0)))
1314 (.normalize
1315 (.subtract
1316 (out 1) (out 0)))))
1317 in** [(.mult rotate-1 (in* 0))
1318 (.mult rotate-1 (in* 1))
1319 (.mult rotate-1 (in* 2))]
1320 scale-factor-1
1321 (.mult
1322 (.normalize
1323 (.subtract
1324 (out 1)
1325 (out 0)))
1326 (/ (.length
1327 (.subtract (out 1)
1328 (out 0)))
1329 (.length
1330 (.subtract (in** 1)
1331 (in** 0)))))
1332 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1333 in*** [(.mult scale-1 (in** 0))
1334 (.mult scale-1 (in** 1))
1335 (.mult scale-1 (in** 2))]
1343 (dorun (map println in))
1344 (println)
1345 (dorun (map println in*))
1346 (println)
1347 (dorun (map println in**))
1348 (println)
1349 (dorun (map println in***))
1350 (println)
1352 ))))
1355 (defn world-setup [joint]
1356 (let [joint-position (Vector3f. 0 0 0)
1357 joint-rotation
1358 (.toRotationMatrix
1359 (.mult
1360 (doto (Quaternion.)
1361 (.fromAngleAxis
1362 (* 1 (/ Math/PI 4))
1363 (Vector3f. -1 0 0)))
1364 (doto (Quaternion.)
1365 (.fromAngleAxis
1366 (* 1 (/ Math/PI 2))
1367 (Vector3f. 0 0 1)))))
1368 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1370 origin (doto
1371 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1372 :position top-position))
1373 top (doto
1374 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1375 :position top-position)
1377 (.addControl
1378 (RigidBodyControl.
1379 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1380 bottom (doto
1381 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1382 :position (Vector3f. 0 0 0))
1383 (.addControl
1384 (RigidBodyControl.
1385 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1386 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1387 :color ColorRGBA/Gray :mass 0)
1388 a (.getControl top RigidBodyControl)
1389 b (.getControl bottom RigidBodyControl)]
1391 (cond
1392 (= joint :cone)
1394 (doto (ConeJoint.
1395 a b
1396 (world-to-local top joint-position)
1397 (world-to-local bottom joint-position)
1398 joint-rotation
1399 joint-rotation
1403 (.setLimit (* (/ 10) Math/PI)
1404 (* (/ 4) Math/PI)
1405 0)))
1406 [origin top bottom table]))
1408 (defn test-joint [joint]
1409 (let [[origin top bottom floor] (world-setup joint)
1410 control (.getControl top RigidBodyControl)
1411 move-up? (atom false)
1412 move-down? (atom false)
1413 move-left? (atom false)
1414 move-right? (atom false)
1415 roll-left? (atom false)
1416 roll-right? (atom false)
1417 timer (atom 0)]
1419 (world
1420 (nodify [top bottom floor origin])
1421 (merge standard-debug-controls
1422 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1423 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1424 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1425 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1426 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1427 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1429 (fn [world]
1430 (light-up-everything world)
1431 (enable-debug world)
1432 (set-gravity world (Vector3f. 0 0 0))
1435 (fn [world _]
1436 (if (zero? (rem (swap! timer inc) 100))
1437 (do
1438 ;; (println-repl @timer)
1439 (.attachChild (.getRootNode world)
1440 (sphere 0.05 :color ColorRGBA/Yellow
1441 :position (.getWorldTranslation top)
1442 :physical? false))
1443 (.attachChild (.getRootNode world)
1444 (sphere 0.05 :color ColorRGBA/LightGray
1445 :position (.getWorldTranslation bottom)
1446 :physical? false))))
1448 (if @move-up?
1449 (.applyTorque control
1450 (.mult (.getPhysicsRotation control)
1451 (Vector3f. 0 0 10))))
1452 (if @move-down?
1453 (.applyTorque control
1454 (.mult (.getPhysicsRotation control)
1455 (Vector3f. 0 0 -10))))
1456 (if @move-left?
1457 (.applyTorque control
1458 (.mult (.getPhysicsRotation control)
1459 (Vector3f. 0 10 0))))
1460 (if @move-right?
1461 (.applyTorque control
1462 (.mult (.getPhysicsRotation control)
1463 (Vector3f. 0 -10 0))))
1464 (if @roll-left?
1465 (.applyTorque control
1466 (.mult (.getPhysicsRotation control)
1467 (Vector3f. -1 0 0))))
1468 (if @roll-right?
1469 (.applyTorque control
1470 (.mult (.getPhysicsRotation control)
1471 (Vector3f. 1 0 0))))))))
1475 (defprotocol Frame
1476 (frame [this]))
1478 (extend-type BufferedImage
1479 Frame
1480 (frame [image]
1481 (merge
1482 (apply
1483 hash-map
1484 (interleave
1485 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1486 (vector x y)))
1487 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1488 (let [data (.getRGB image x y)]
1489 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1490 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1491 :b (bit-and 0x0000ff data)))))))
1492 {:width (.getWidth image) :height (.getHeight image)})))
1495 (extend-type ImagePlus
1496 Frame
1497 (frame [image+]
1498 (frame (.getBufferedImage image+))))
1501 #+end_src
1504 * COMMENT generate source
1505 #+begin_src clojure :tangle ../src/cortex/silly.clj
1506 <<body-1>>
1507 #+end_src