view org/test-creature.org @ 132:3206d5e20bee

still trying to fix proprioception
author Robert McIntyre <rlm@mit.edu>
date Tue, 31 Jan 2012 01:40:47 -0700
parents b26017d1fe9a
children 2ed7e60d3821
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 ;; bullet's point2point joints are BROKEN, so we must use the
325 ;; generic 6DOF joint instead of an actual Point2Point joint!
327 ;; should be able to do this:
328 (comment
329 (Point2PointJoint.
330 control-a
331 control-b
332 pivot-a
333 pivot-b))
335 ;; but instead we must do this:
336 (println-repl "substuting 6DOF joint for POINT2POINT joint!")
337 (doto
338 (SixDofJoint.
339 control-a
340 control-b
341 pivot-a
342 pivot-b
343 false)
344 (.setLinearLowerLimit Vector3f/ZERO)
345 (.setLinearUpperLimit Vector3f/ZERO)
346 ;;(.setAngularLowerLimit (Vector3f. 1 1 1))
347 ;;(.setAngularUpperLimit (Vector3f. 0 0 0))
349 ))
352 (defmethod joint-dispatch :hinge
353 [constraints control-a control-b pivot-a pivot-b rotation]
354 (println-repl "creating HINGE joint")
355 (let [axis
356 (if-let
357 [axis (:axis constraints)]
358 axis
359 Vector3f/UNIT_X)
360 [limit-1 limit-2] (:limit constraints)
361 hinge-axis
362 (.mult
363 rotation
364 (blender-to-jme axis))]
365 (doto
366 (HingeJoint.
367 control-a
368 control-b
369 pivot-a
370 pivot-b
371 hinge-axis
372 hinge-axis)
373 (.setLimit limit-1 limit-2))))
375 (defmethod joint-dispatch :cone
376 [constraints control-a control-b pivot-a pivot-b rotation]
377 (let [limit-xz (:limit-xz constraints)
378 limit-xy (:limit-xy constraints)
379 twist (:twist constraints)]
381 (println-repl "creating CONE joint")
382 (println-repl rotation)
383 (println-repl
384 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
385 (println-repl
386 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
387 (println-repl
388 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
389 (doto
390 (ConeJoint.
391 control-a
392 control-b
393 pivot-a
394 pivot-b
395 rotation
396 rotation)
397 (.setLimit (float limit-xz)
398 (float limit-xy)
399 (float twist)))))
401 (defn connect
402 "here are some examples:
403 {:type :point}
404 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
405 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
407 {:type :cone :limit-xz 0]
408 :limit-xy 0]
409 :twist 0]} (use XZY rotation mode in blender!)"
410 [#^Node obj-a #^Node obj-b #^Node joint]
411 (let [control-a (.getControl obj-a RigidBodyControl)
412 control-b (.getControl obj-b RigidBodyControl)
413 joint-center (.getWorldTranslation joint)
414 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
415 pivot-a (world-to-local obj-a joint-center)
416 pivot-b (world-to-local obj-b joint-center)]
418 (if-let [constraints
419 (map-vals
420 eval
421 (read-string
422 (meta-data joint "joint")))]
423 ;; A side-effect of creating a joint registers
424 ;; it with both physics objects which in turn
425 ;; will register the joint with the physics system
426 ;; when the simulation is started.
427 (do
428 (println-repl "creating joint between"
429 (.getName obj-a) "and" (.getName obj-b))
430 (joint-dispatch constraints
431 control-a control-b
432 pivot-a pivot-b
433 joint-rotation))
434 (println-repl "could not find joint meta-data!"))))
439 (defn assemble-creature [#^Node pieces joints]
440 (dorun
441 (map
442 (fn [geom]
443 (let [physics-control
444 (RigidBodyControl.
445 (HullCollisionShape.
446 (.getMesh geom))
447 (if-let [mass (meta-data geom "mass")]
448 (do
449 (println-repl
450 "setting" (.getName geom) "mass to" (float mass))
451 (float mass))
452 (float 1)))]
454 (.addControl geom physics-control)))
455 (filter #(isa? (class %) Geometry )
456 (node-seq pieces))))
457 (dorun
458 (map
459 (fn [joint]
460 (let [[obj-a obj-b]
461 (joint-targets pieces joint)]
462 (connect obj-a obj-b joint)))
463 joints))
464 pieces)
466 (declare blender-creature)
468 (def hand "Models/creature1/one.blend")
470 (def worm "Models/creature1/try-again.blend")
472 (def touch "Models/creature1/touch.blend")
474 (defn worm-model [] (load-blender-model worm))
476 (defn x-ray [#^ColorRGBA color]
477 (doto (Material. (asset-manager)
478 "Common/MatDefs/Misc/Unshaded.j3md")
479 (.setColor "Color" color)
480 (-> (.getAdditionalRenderState)
481 (.setDepthTest false))))
483 (defn colorful []
484 (.getChild (worm-model) "worm-21"))
486 (import jme3tools.converters.ImageToAwt)
488 (import ij.ImagePlus)
490 ;; Every Mesh has many triangles, each with its own index.
491 ;; Every vertex has its own index as well.
493 (defn tactile-sensor-image
494 "Return the touch-sensor distribution image in BufferedImage format,
495 or nil if it does not exist."
496 [#^Geometry obj]
497 (if-let [image-path (meta-data obj "touch")]
498 (ImageToAwt/convert
499 (.getImage
500 (.loadTexture
501 (asset-manager)
502 image-path))
503 false false 0)))
505 (import ij.process.ImageProcessor)
506 (import java.awt.image.BufferedImage)
508 (def white -1)
510 (defn filter-pixels
511 "List the coordinates of all pixels matching pred, within the bounds
512 provided. Bounds -> [x0 y0 width height]"
513 {:author "Dylan Holmes"}
514 ([pred #^BufferedImage image]
515 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
516 ([pred #^BufferedImage image [x0 y0 width height]]
517 ((fn accumulate [x y matches]
518 (cond
519 (>= y (+ height y0)) matches
520 (>= x (+ width x0)) (recur 0 (inc y) matches)
521 (pred (.getRGB image x y))
522 (recur (inc x) y (conj matches [x y]))
523 :else (recur (inc x) y matches)))
524 x0 y0 [])))
526 (defn white-coordinates
527 "Coordinates of all the white pixels in a subset of the image."
528 ([#^BufferedImage image bounds]
529 (filter-pixels #(= % white) image bounds))
530 ([#^BufferedImage image]
531 (filter-pixels #(= % white) image)))
533 (defn triangle
534 "Get the triangle specified by triangle-index from the mesh within
535 bounds."
536 [#^Mesh mesh triangle-index]
537 (let [scratch (Triangle.)]
538 (.getTriangle mesh triangle-index scratch)
539 scratch))
541 (defn triangle-vertex-indices
542 "Get the triangle vertex indices of a given triangle from a given
543 mesh."
544 [#^Mesh mesh triangle-index]
545 (let [indices (int-array 3)]
546 (.getTriangle mesh triangle-index indices)
547 (vec indices)))
549 (defn vertex-UV-coord
550 "Get the uv-coordinates of the vertex named by vertex-index"
551 [#^Mesh mesh vertex-index]
552 (let [UV-buffer
553 (.getData
554 (.getBuffer
555 mesh
556 VertexBuffer$Type/TexCoord))]
557 [(.get UV-buffer (* vertex-index 2))
558 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
560 (defn triangle-UV-coord
561 "Get the uv-cooridnates of the triangle's verticies."
562 [#^Mesh mesh width height triangle-index]
563 (map (fn [[u v]] (vector (* width u) (* height v)))
564 (map (partial vertex-UV-coord mesh)
565 (triangle-vertex-indices mesh triangle-index))))
567 (defn same-side?
568 "Given the points p1 and p2 and the reference point ref, is point p
569 on the same side of the line that goes through p1 and p2 as ref is?"
570 [p1 p2 ref p]
571 (<=
572 0
573 (.dot
574 (.cross (.subtract p2 p1) (.subtract p p1))
575 (.cross (.subtract p2 p1) (.subtract ref p1)))))
577 (defn triangle-seq [#^Triangle tri]
578 [(.get1 tri) (.get2 tri) (.get3 tri)])
580 (defn vector3f-seq [#^Vector3f v]
581 [(.getX v) (.getY v) (.getZ v)])
583 (defn inside-triangle?
584 "Is the point inside the triangle?"
585 {:author "Dylan Holmes"}
586 [#^Triangle tri #^Vector3f p]
587 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
588 (and
589 (same-side? vert-1 vert-2 vert-3 p)
590 (same-side? vert-2 vert-3 vert-1 p)
591 (same-side? vert-3 vert-1 vert-2 p))))
593 (defn triangle->matrix4f
594 "Converts the triangle into a 4x4 matrix: The first three columns
595 contain the vertices of the triangle; the last contains the unit
596 normal of the triangle. The bottom row is filled with 1s."
597 [#^Triangle t]
598 (let [mat (Matrix4f.)
599 [vert-1 vert-2 vert-3]
600 ((comp vec map) #(.get t %) (range 3))
601 unit-normal (do (.calculateNormal t)(.getNormal t))
602 vertices [vert-1 vert-2 vert-3 unit-normal]]
603 (dorun
604 (for [row (range 4) col (range 3)]
605 (do
606 (.set mat col row (.get (vertices row)col))
607 (.set mat 3 row 1))))
608 mat))
610 (defn triangle-transformation
611 "Returns the affine transformation that converts each vertex in the
612 first triangle into the corresponding vertex in the second
613 triangle."
614 [#^Triangle tri-1 #^Triangle tri-2]
615 (.mult
616 (triangle->matrix4f tri-2)
617 (.invert (triangle->matrix4f tri-1))))
619 (defn point->vector2f [[u v]]
620 (Vector2f. u v))
622 (defn vector2f->vector3f [v]
623 (Vector3f. (.getX v) (.getY v) 0))
625 (defn map-triangle [f #^Triangle tri]
626 (Triangle.
627 (f 0 (.get1 tri))
628 (f 1 (.get2 tri))
629 (f 2 (.get3 tri))))
631 (defn points->triangle
632 "Convert a list of points into a triangle."
633 [points]
634 (apply #(Triangle. %1 %2 %3)
635 (map (fn [point]
636 (let [point (vec point)]
637 (Vector3f. (get point 0 0)
638 (get point 1 0)
639 (get point 2 0))))
640 (take 3 points))))
642 (defn convex-bounds
643 ;;dylan
644 "Returns the smallest square containing the given
645 vertices, as a vector of integers [left top width height]."
646 ;; "Dimensions of the smallest integer bounding square of the list of
647 ;; 2D verticies in the form: [x y width height]."
648 [uv-verts]
649 (let [xs (map first uv-verts)
650 ys (map second uv-verts)
651 x0 (Math/floor (apply min xs))
652 y0 (Math/floor (apply min ys))
653 x1 (Math/ceil (apply max xs))
654 y1 (Math/ceil (apply max ys))]
655 [x0 y0 (- x1 x0) (- y1 y0)]))
657 (defn sensors-in-triangle
658 ;;dylan
659 "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
660 ;;"Find the locations of the touch sensors within a triangle in both
661 ;; UV and gemoetry relative coordinates."
662 [image mesh tri-index]
663 (let [width (.getWidth image)
664 height (.getHeight image)
665 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
666 bounds (convex-bounds UV-vertex-coords)
668 cutout-triangle (points->triangle UV-vertex-coords)
669 UV-sensor-coords
670 (filter (comp (partial inside-triangle? cutout-triangle)
671 (fn [[u v]] (Vector3f. u v 0)))
672 (white-coordinates image bounds))
673 UV->geometry (triangle-transformation
674 cutout-triangle
675 (triangle mesh tri-index))
676 geometry-sensor-coords
677 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
678 UV-sensor-coords)]
679 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
681 (defn-memo locate-feelers
682 "Search the geometry's tactile UV image for touch sensors, returning
683 their positions in geometry-relative coordinates."
684 [#^Geometry geo]
685 (let [mesh (.getMesh geo)
686 num-triangles (.getTriangleCount mesh)]
687 (if-let [image (tactile-sensor-image geo)]
688 (map
689 (partial sensors-in-triangle image mesh)
690 (range num-triangles))
691 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
693 (use 'clojure.contrib.def)
695 (defn-memo touch-topology [#^Gemoetry geo]
696 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
698 (defn-memo feeler-coordinates [#^Geometry geo]
699 (vec (map :geometry (locate-feelers geo))))
701 (defn enable-touch [#^Geometry geo]
702 (let [feeler-coords (feeler-coordinates geo)
703 tris (triangles geo)
704 limit 0.1
705 ;;results (CollisionResults.)
706 ]
707 (if (empty? (touch-topology geo))
708 nil
709 (fn [node]
710 (let [sensor-origins
711 (map
712 #(map (partial local-to-world geo) %)
713 feeler-coords)
714 triangle-normals
715 (map (partial get-ray-direction geo)
716 tris)
717 rays
718 (flatten
719 (map (fn [origins norm]
720 (map #(doto (Ray. % norm)
721 (.setLimit limit)) origins))
722 sensor-origins triangle-normals))]
723 (vector
724 (touch-topology geo)
725 (vec
726 (for [ray rays]
727 (do
728 (let [results (CollisionResults.)]
729 (.collideWith node ray results)
730 (let [touch-objects
731 (filter #(not (= geo (.getGeometry %)))
732 results)]
733 (- 255
734 (if (empty? touch-objects) 255
735 (rem
736 (int
737 (* 255 (/ (.getDistance
738 (first touch-objects)) limit)))
739 256))))))))))))))
742 (defn touch [#^Node pieces]
743 (filter (comp not nil?)
744 (map enable-touch
745 (filter #(isa? (class %) Geometry)
746 (node-seq pieces)))))
749 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s
750 ;; http://en.wikipedia.org/wiki/Retina
752 (defn test-eye []
753 (.getChild
754 (.getChild (worm-model) "eyes")
755 "eye"))
758 (defn retina-sensor-image
759 "Return a map of pixel selection functions to BufferedImages
760 describing the distribution of light-sensitive components on this
761 geometry's surface. Each function creates an integer from the rgb
762 values found in the pixel. :red, :green, :blue, :gray are already
763 defined as extracting the red green blue and average components
764 respectively."
765 [#^Spatial eye]
766 (if-let [eye-map (meta-data eye "eye")]
767 (map-vals
768 #(ImageToAwt/convert
769 (.getImage (.loadTexture (asset-manager) %))
770 false false 0)
771 (eval (read-string eye-map)))))
773 (defn eye-dimensions
774 "returns the width and height specified in the metadata of the eye"
775 [#^Spatial eye]
776 (let [dimensions
777 (map #(vector (.getWidth %) (.getHeight %))
778 (vals (retina-sensor-image eye)))]
779 [(apply max (map first dimensions))
780 (apply max (map second dimensions))]))
782 (defn creature-eyes
783 ;;dylan
784 "Return the children of the creature's \"eyes\" node."
785 ;;"The eye nodes which are children of the \"eyes\" node in the
786 ;;creature."
787 [#^Node creature]
788 (if-let [eye-node (.getChild creature "eyes")]
789 (seq (.getChildren eye-node))
790 (do (println-repl "could not find eyes node") [])))
792 ;; Here's how vision will work.
794 ;; Make the continuation in scene-processor take FrameBuffer,
795 ;; byte-buffer, BufferedImage already sized to the correct
796 ;; dimensions. the continuation will decide wether to "mix" them
797 ;; into the BufferedImage, lazily ignore them, or mix them halfway
798 ;; and call c/graphics card routines.
800 ;; (vision creature) will take an optional :skip argument which will
801 ;; inform the continuations in scene processor to skip the given
802 ;; number of cycles; 0 means that no cycles will be skipped.
804 ;; (vision creature) will return [init-functions sensor-functions].
805 ;; The init-functions are each single-arg functions that take the
806 ;; world and register the cameras and must each be called before the
807 ;; corresponding sensor-functions. Each init-function returns the
808 ;; viewport for that eye which can be manipulated, saved, etc. Each
809 ;; sensor-function is a thunk and will return data in the same
810 ;; format as the tactile-sensor functions; the structure is
811 ;; [topology, sensor-data]. Internally, these sensor-functions
812 ;; maintain a reference to sensor-data which is periodically updated
813 ;; by the continuation function established by its init-function.
814 ;; They can be queried every cycle, but their information may not
815 ;; necessairly be different every cycle.
817 ;; Each eye in the creature in blender will work the same way as
818 ;; joints -- a zero dimensional object with no geometry whose local
819 ;; coordinate system determines the orientation of the resulting
820 ;; eye. All eyes will have a parent named "eyes" just as all joints
821 ;; have a parent named "joints". The resulting camera will be a
822 ;; ChaseCamera or a CameraNode bound to the geo that is closest to
823 ;; the eye marker. The eye marker will contain the metadata for the
824 ;; eye, and will be moved by it's bound geometry. The dimensions of
825 ;; the eye's camera are equal to the dimensions of the eye's "UV"
826 ;; map.
829 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
831 ;; Ears work the same way as vision.
833 ;; (hearing creature) will return [init-functions
834 ;; sensor-functions]. The init functions each take the world and
835 ;; register a SoundProcessor that does foureier transforms on the
836 ;; incommong sound data, making it available to each sensor function.
838 (defn creature-ears
839 "Return the children of the creature's \"ears\" node."
840 ;;dylan
841 ;;"The ear nodes which are children of the \"ears\" node in the
842 ;;creature."
843 [#^Node creature]
844 (if-let [ear-node (.getChild creature "ears")]
845 (seq (.getChildren ear-node))
846 (do (println-repl "could not find ears node") [])))
848 (defn closest-node
849 "Return the object in creature which is closest to the given node."
850 ;;dylan"The closest object in creature to the given node."
851 [#^Node creature #^Node eye]
852 (loop [radius (float 0.01)]
853 (let [results (CollisionResults.)]
854 (.collideWith
855 creature
856 (BoundingBox. (.getWorldTranslation eye)
857 radius radius radius)
858 results)
859 (if-let [target (first results)]
860 (.getGeometry target)
861 (recur (float (* 2 radius)))))))
863 ;;dylan (defn follow-sense, adjoin-sense, attach-stimuli,
864 ;;anchor-qualia, augment-organ, with-organ
865 (defn bind-sense
866 "Bind the sense to the Spatial such that it will maintain its
867 current position relative to the Spatial no matter how the spatial
868 moves. 'sense can be either a Camera or Listener object."
869 [#^Spatial obj sense]
870 (let [sense-offset (.subtract (.getLocation sense)
871 (.getWorldTranslation obj))
872 initial-sense-rotation (Quaternion. (.getRotation sense))
873 base-anti-rotation (.inverse (.getWorldRotation obj))]
874 (.addControl
875 obj
876 (proxy [AbstractControl] []
877 (controlUpdate [tpf]
878 (let [total-rotation
879 (.mult base-anti-rotation (.getWorldRotation obj))]
880 (.setLocation sense
881 (.add
882 (.mult total-rotation sense-offset)
883 (.getWorldTranslation obj)))
884 (.setRotation sense
885 (.mult total-rotation initial-sense-rotation))))
886 (controlRender [_ _])))))
889 (defn update-listener-velocity
890 "Update the listener's velocity every update loop."
891 [#^Spatial obj #^Listener lis]
892 (let [old-position (atom (.getLocation lis))]
893 (.addControl
894 obj
895 (proxy [AbstractControl] []
896 (controlUpdate [tpf]
897 (let [new-position (.getLocation lis)]
898 (.setVelocity
899 lis
900 (.mult (.subtract new-position @old-position)
901 (float (/ tpf))))
902 (reset! old-position new-position)))
903 (controlRender [_ _])))))
905 (import com.aurellem.capture.audio.AudioSendRenderer)
907 (defn attach-ear
908 [#^Application world #^Node creature #^Spatial ear continuation]
909 (let [target (closest-node creature ear)
910 lis (Listener.)
911 audio-renderer (.getAudioRenderer world)
912 sp (sound-processor continuation)]
913 (.setLocation lis (.getWorldTranslation ear))
914 (.setRotation lis (.getWorldRotation ear))
915 (bind-sense target lis)
916 (update-listener-velocity target lis)
917 (.addListener audio-renderer lis)
918 (.registerSoundProcessor audio-renderer lis sp)))
920 (defn enable-hearing
921 [#^Node creature #^Spatial ear]
922 (let [hearing-data (atom [])]
923 [(fn [world]
924 (attach-ear world creature ear
925 (fn [data]
926 (reset! hearing-data (vec data)))))
927 [(fn []
928 (let [data @hearing-data
929 topology
930 (vec (map #(vector % 0) (range 0 (count data))))
931 scaled-data
932 (vec
933 (map
934 #(rem (int (* 255 (/ (+ 1 %) 2))) 256)
935 data))]
936 [topology scaled-data]))
937 ]]))
939 (defn hearing
940 [#^Node creature]
941 (reduce
942 (fn [[init-a senses-a]
943 [init-b senses-b]]
944 [(conj init-a init-b)
945 (into senses-a senses-b)])
946 [[][]]
947 (for [ear (creature-ears creature)]
948 (enable-hearing creature ear))))
950 (defn attach-eye
951 "Attach a Camera to the appropiate area and return the Camera."
952 [#^Node creature #^Spatial eye]
953 (let [target (closest-node creature eye)
954 [cam-width cam-height] (eye-dimensions eye)
955 cam (Camera. cam-width cam-height)]
956 (.setLocation cam (.getWorldTranslation eye))
957 (.setRotation cam (.getWorldRotation eye))
958 (.setFrustumPerspective
959 cam 45 (/ (.getWidth cam) (.getHeight cam))
960 1 1000)
961 (bind-sense target cam)
962 cam))
964 (def presets
965 {:all 0xFFFFFF
966 :red 0xFF0000
967 :blue 0x0000FF
968 :green 0x00FF00})
970 (defn enable-vision
971 "return [init-function sensor-functions] for a particular eye"
972 [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]
973 (let [retinal-map (retina-sensor-image eye)
974 camera (attach-eye creature eye)
975 vision-image
976 (atom
977 (BufferedImage. (.getWidth camera)
978 (.getHeight camera)
979 BufferedImage/TYPE_BYTE_BINARY))]
980 [(fn [world]
981 (add-eye
982 world camera
983 (let [counter (atom 0)]
984 (fn [r fb bb bi]
985 (if (zero? (rem (swap! counter inc) (inc skip)))
986 (reset! vision-image (BufferedImage! r fb bb bi)))))))
987 (vec
988 (map
989 (fn [[key image]]
990 (let [whites (white-coordinates image)
991 topology (vec (collapse whites))
992 mask (presets key)]
993 (fn []
994 (vector
995 topology
996 (vec
997 (for [[x y] whites]
998 (bit-and
999 mask (.getRGB @vision-image x y))))))))
1000 retinal-map))]))
1002 (defn vision
1003 [#^Node creature & {skip :skip :or {skip 0}}]
1004 (reduce
1005 (fn [[init-a senses-a]
1006 [init-b senses-b]]
1007 [(conj init-a init-b)
1008 (into senses-a senses-b)])
1009 [[][]]
1010 (for [eye (creature-eyes creature)]
1011 (enable-vision creature eye))))
1017 ;; lower level --- nodes
1018 ;; closest-node "parse/compile-x" -> makes organ, which is spatial, fn pair
1020 ;; higher level -- organs
1021 ;;
1023 ;; higher level --- sense/effector
1024 ;; these are the functions that provide world i/o, chinese-room style
1028 (defn blender-creature
1029 "Return a creature with all joints in place."
1030 [blender-path]
1031 (let [model (load-blender-model blender-path)
1032 joints
1033 (if-let [joint-node (.getChild model "joints")]
1034 (seq (.getChildren joint-node))
1035 (do (println-repl "could not find joints node") []))]
1036 (assemble-creature model joints)))
1038 (defn gray-scale [num]
1039 (+ num
1040 (bit-shift-left num 8)
1041 (bit-shift-left num 16)))
1043 (defn debug-touch-window
1044 "creates function that offers a debug view of sensor data"
1045 []
1046 (let [vi (view-image)]
1047 (fn
1048 [[coords sensor-data]]
1049 (let [image (points->image coords)]
1050 (dorun
1051 (for [i (range (count coords))]
1052 (.setRGB image ((coords i) 0) ((coords i) 1)
1053 (gray-scale (sensor-data i)))))
1056 (vi image)))))
1058 (defn debug-vision-window
1059 "creates function that offers a debug view of sensor data"
1060 []
1061 (let [vi (view-image)]
1062 (fn
1063 [[coords sensor-data]]
1064 (let [image (points->image coords)]
1065 (dorun
1066 (for [i (range (count coords))]
1067 (.setRGB image ((coords i) 0) ((coords i) 1)
1068 (sensor-data i))))
1069 (vi image)))))
1071 (defn debug-hearing-window
1072 "view audio data"
1073 [height]
1074 (let [vi (view-image)]
1075 (fn [[coords sensor-data]]
1076 (let [image (BufferedImage. (count coords) height
1077 BufferedImage/TYPE_INT_RGB)]
1078 (dorun
1079 (for [x (range (count coords))]
1080 (dorun
1081 (for [y (range height)]
1082 (let [raw-sensor (sensor-data x)]
1083 (.setRGB image x y (gray-scale raw-sensor)))))))
1085 (vi image)))))
1089 ;;(defn test-touch [world creature]
1094 ;; here's how motor-control/ proprioception will work: Each muscle is
1095 ;; defined by a 1-D array of numbers (the "motor pool") each of which
1096 ;; represent muscle fibers. A muscle also has a scalar :strength
1097 ;; factor which determines how strong the muscle as a whole is.
1098 ;; The effector function for a muscle takes a number < (count
1099 ;; motor-pool) and that number is said to "activate" all the muscle
1100 ;; fibers whose index is lower than the number. Each fiber will apply
1101 ;; force in proportion to its value in the array. Lower values cause
1102 ;; less force. The lower values can be put at the "beginning" of the
1103 ;; 1-D array to simulate the layout of actual human muscles, which are
1104 ;; capable of more percise movements when exerting less force.
1106 ;; I don't know how to encode proprioception, so for now, just return
1107 ;; a function for each joint that returns a triplet of floats which
1108 ;; represent relative roll, pitch, and yaw. Write display code for
1109 ;; this though.
1111 (defn muscle-fibre-values
1112 "Take the first row of the image and return the low-order bytes."
1113 [#^BufferedImage image]
1114 (let [width (.getWidth image)]
1115 (for [x (range width)]
1116 (bit-and
1117 0xFF
1118 (.getRGB image x 0)))))
1121 (defn rad->deg [rad]
1122 (* 180 (/ Math/PI) rad))
1125 (defn debug-prop-window
1126 "create a debug view for proprioception"
1127 []
1128 (let [vi (view-image)]
1129 (fn [sensor-data]
1130 (println-repl
1131 (map
1132 (fn [[yaw pitch roll]]
1133 [(rad->deg yaw)
1134 (rad->deg pitch)
1135 (rad->deg roll)])
1136 sensor-data)))))
1143 (defn test-creature [thing]
1144 (let [x-axis
1145 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
1146 y-axis
1147 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
1148 z-axis
1149 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
1150 creature (blender-creature thing)
1151 touch-nerves (touch creature)
1152 touch-debug-windows (map (fn [_] (debug-touch-window)) touch-nerves)
1153 [init-vision-fns vision-data] (vision creature)
1154 vision-debug (map (fn [_] (debug-vision-window)) vision-data)
1155 me (sphere 0.5 :color ColorRGBA/Blue :physical? false)
1156 [init-hearing-fns hearing-senses] (hearing creature)
1157 hearing-windows (map (fn [_] (debug-hearing-window 50))
1158 hearing-senses)
1159 bell (AudioNode. (asset-manager)
1160 "Sounds/pure.wav" false)
1161 prop (proprioception creature)
1162 prop-debug (debug-prop-window)
1163 ;; dream
1166 (world
1167 (nodify [creature
1168 (box 10 2 10 :position (Vector3f. 0 -9 0)
1169 :color ColorRGBA/Gray :mass 0)
1170 x-axis y-axis z-axis
1171 me
1172 ])
1173 (merge standard-debug-controls
1174 {"key-return"
1175 (fn [_ value]
1176 (if value
1177 (do
1178 (println-repl "play-sound")
1179 (.play bell))))})
1180 (fn [world]
1181 (light-up-everything world)
1182 (enable-debug world)
1183 (dorun (map #(% world) init-vision-fns))
1184 (dorun (map #(% world) init-hearing-fns))
1186 (add-eye world
1187 (attach-eye creature (test-eye))
1188 (comp (view-image) BufferedImage!))
1190 (add-eye world (.getCamera world) no-op)
1192 ;;(com.aurellem.capture.Capture/captureVideo
1193 ;; world (file-str "/home/r/proj/ai-videos/hand"))
1194 ;;(.setTimer world (RatchetTimer. 60))
1195 (speed-up world)
1196 ;;(set-gravity world (Vector3f. 0 0 0))
1198 (fn [world tpf]
1199 ;;(dorun
1200 ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))
1202 (prop-debug (prop))
1204 (dorun
1205 (map #(%1 (%2 (.getRootNode world)))
1206 touch-debug-windows touch-nerves))
1208 (dorun
1209 (map #(%1 (%2))
1210 vision-debug vision-data))
1211 (dorun
1212 (map #(%1 (%2)) hearing-windows hearing-senses))
1215 ;;(println-repl (vision-data))
1216 (.setLocalTranslation me (.getLocation (.getCamera world)))
1220 ;;(let [timer (atom 0)]
1221 ;; (fn [_ _]
1222 ;; (swap! timer inc)
1223 ;; (if (= (rem @timer 60) 0)
1224 ;; (println-repl (float (/ @timer 60))))))
1225 )))
1235 ;;; experiments in collisions
1239 (defn collision-test []
1240 (let [b-radius 1
1241 b-position (Vector3f. 0 0 0)
1242 obj-b (box 1 1 1 :color ColorRGBA/Blue
1243 :position b-position
1244 :mass 0)
1245 node (nodify [obj-b])
1246 bounds-b
1247 (doto (Picture.)
1248 (.setHeight 50)
1249 (.setWidth 50)
1250 (.setImage (asset-manager)
1251 "Models/creature1/hand.png"
1252 false
1253 ))
1255 ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))
1257 collisions
1258 (let [cr (CollisionResults.)]
1259 (.collideWith node bounds-b cr)
1260 (println (map #(.getContactPoint %) cr))
1261 cr)
1263 ;;collision-points
1264 ;;(map #(sphere 0.1 :position (.getContactPoint %))
1265 ;; collisions)
1267 ;;node (nodify (conj collision-points obj-b))
1269 sim
1270 (world node
1271 {"key-space"
1272 (fn [_ value]
1273 (if value
1274 (let [cr (CollisionResults.)]
1275 (.collideWith node bounds-b cr)
1276 (println-repl (map #(.getContactPoint %) cr))
1277 cr)))}
1278 no-op
1279 no-op)
1282 sim
1284 ))
1287 ;; the camera will stay in its initial position/rotation with relation
1288 ;; to the spatial.
1291 (defn follow-test
1292 "show a camera that stays in the same relative position to a blue cube."
1293 []
1294 (let [camera-pos (Vector3f. 0 30 0)
1295 rock (box 1 1 1 :color ColorRGBA/Blue
1296 :position (Vector3f. 0 10 0)
1297 :mass 30
1299 rot (.getWorldRotation rock)
1301 table (box 3 1 10 :color ColorRGBA/Gray :mass 0
1302 :position (Vector3f. 0 -3 0))]
1304 (world
1305 (nodify [rock table])
1306 standard-debug-controls
1307 (fn [world]
1308 (let
1309 [cam (doto (.clone (.getCamera world))
1310 (.setLocation camera-pos)
1311 (.lookAt Vector3f/ZERO
1312 Vector3f/UNIT_X))]
1313 (bind-sense rock cam)
1315 (.setTimer world (RatchetTimer. 60))
1316 (add-eye world cam (comp (view-image) BufferedImage!))
1317 (add-eye world (.getCamera world) no-op))
1319 (fn [_ _] (println-repl rot)))))
1323 #+end_src
1325 #+results: body-1
1326 : #'cortex.silly/test-creature
1329 * COMMENT purgatory
1330 #+begin_src clojure
1331 (defn bullet-trans []
1332 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
1333 :position (Vector3f. -10 5 0))
1334 obj-b (sphere 0.5 :color ColorRGBA/Blue
1335 :position (Vector3f. -10 -5 0)
1336 :mass 0)
1337 control-a (.getControl obj-a RigidBodyControl)
1338 control-b (.getControl obj-b RigidBodyControl)
1339 swivel
1340 (.toRotationMatrix
1341 (doto (Quaternion.)
1342 (.fromAngleAxis (/ Math/PI 2)
1343 Vector3f/UNIT_X)))]
1344 (doto
1345 (ConeJoint.
1346 control-a control-b
1347 (Vector3f. 0 5 0)
1348 (Vector3f. 0 -5 0)
1349 swivel swivel)
1350 (.setLimit (* 0.6 (/ Math/PI 4))
1351 (/ Math/PI 4)
1352 (* Math/PI 0.8)))
1353 (world (nodify
1354 [obj-a obj-b])
1355 standard-debug-controls
1356 enable-debug
1357 no-op)))
1360 (defn bullet-trans* []
1361 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
1362 :position (Vector3f. 5 0 0)
1363 :mass 90)
1364 obj-b (sphere 0.5 :color ColorRGBA/Blue
1365 :position (Vector3f. -5 0 0)
1366 :mass 0)
1367 control-a (.getControl obj-a RigidBodyControl)
1368 control-b (.getControl obj-b RigidBodyControl)
1369 move-up? (atom nil)
1370 move-down? (atom nil)
1371 move-left? (atom nil)
1372 move-right? (atom nil)
1373 roll-left? (atom nil)
1374 roll-right? (atom nil)
1375 force 100
1376 swivel
1377 (.toRotationMatrix
1378 (doto (Quaternion.)
1379 (.fromAngleAxis (/ Math/PI 2)
1380 Vector3f/UNIT_X)))
1381 x-move
1382 (doto (Matrix3f.)
1383 (.fromStartEndVectors Vector3f/UNIT_X
1384 (.normalize (Vector3f. 1 1 0))))
1386 timer (atom 0)]
1387 (doto
1388 (ConeJoint.
1389 control-a control-b
1390 (Vector3f. -8 0 0)
1391 (Vector3f. 2 0 0)
1392 ;;swivel swivel
1393 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
1394 x-move Matrix3f/IDENTITY
1396 (.setCollisionBetweenLinkedBodys false)
1397 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
1398 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
1399 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
1400 (world (nodify
1401 [obj-a obj-b])
1402 (merge standard-debug-controls
1403 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1404 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1405 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1406 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1407 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1408 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1410 (fn [world]
1411 (enable-debug world)
1412 (set-gravity world Vector3f/ZERO)
1415 (fn [world _]
1417 (if @move-up?
1418 (.applyForce control-a
1419 (Vector3f. force 0 0)
1420 (Vector3f. 0 0 0)))
1421 (if @move-down?
1422 (.applyForce control-a
1423 (Vector3f. (- force) 0 0)
1424 (Vector3f. 0 0 0)))
1425 (if @move-left?
1426 (.applyForce control-a
1427 (Vector3f. 0 force 0)
1428 (Vector3f. 0 0 0)))
1429 (if @move-right?
1430 (.applyForce control-a
1431 (Vector3f. 0 (- force) 0)
1432 (Vector3f. 0 0 0)))
1434 (if @roll-left?
1435 (.applyForce control-a
1436 (Vector3f. 0 0 force)
1437 (Vector3f. 0 0 0)))
1438 (if @roll-right?
1439 (.applyForce control-a
1440 (Vector3f. 0 0 (- force))
1441 (Vector3f. 0 0 0)))
1443 (if (zero? (rem (swap! timer inc) 100))
1444 (.attachChild
1445 (.getRootNode world)
1446 (sphere 0.05 :color ColorRGBA/Yellow
1447 :physical? false :position
1448 (.getWorldTranslation obj-a)))))
1450 ))
1452 (defn transform-trianglesdsd
1453 "Transform that converts each vertex in the first triangle
1454 into the corresponding vertex in the second triangle."
1455 [#^Triangle tri-1 #^Triangle tri-2]
1456 (let [in [(.get1 tri-1)
1457 (.get2 tri-1)
1458 (.get3 tri-1)]
1459 out [(.get1 tri-2)
1460 (.get2 tri-2)
1461 (.get3 tri-2)]]
1462 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1463 in* [(.mult translate (in 0))
1464 (.mult translate (in 1))
1465 (.mult translate (in 2))]
1466 final-translation
1467 (doto (Matrix4f.)
1468 (.setTranslation (out 1)))
1470 rotate-1
1471 (doto (Matrix3f.)
1472 (.fromStartEndVectors
1473 (.normalize
1474 (.subtract
1475 (in* 1) (in* 0)))
1476 (.normalize
1477 (.subtract
1478 (out 1) (out 0)))))
1479 in** [(.mult rotate-1 (in* 0))
1480 (.mult rotate-1 (in* 1))
1481 (.mult rotate-1 (in* 2))]
1482 scale-factor-1
1483 (.mult
1484 (.normalize
1485 (.subtract
1486 (out 1)
1487 (out 0)))
1488 (/ (.length
1489 (.subtract (out 1)
1490 (out 0)))
1491 (.length
1492 (.subtract (in** 1)
1493 (in** 0)))))
1494 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1495 in*** [(.mult scale-1 (in** 0))
1496 (.mult scale-1 (in** 1))
1497 (.mult scale-1 (in** 2))]
1505 (dorun (map println in))
1506 (println)
1507 (dorun (map println in*))
1508 (println)
1509 (dorun (map println in**))
1510 (println)
1511 (dorun (map println in***))
1512 (println)
1514 ))))
1517 (defn world-setup [joint]
1518 (let [joint-position (Vector3f. 0 0 0)
1519 joint-rotation
1520 (.toRotationMatrix
1521 (.mult
1522 (doto (Quaternion.)
1523 (.fromAngleAxis
1524 (* 1 (/ Math/PI 4))
1525 (Vector3f. -1 0 0)))
1526 (doto (Quaternion.)
1527 (.fromAngleAxis
1528 (* 1 (/ Math/PI 2))
1529 (Vector3f. 0 0 1)))))
1530 top-position (.mult joint-rotation (Vector3f. 8 0 0))
1532 origin (doto
1533 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
1534 :position top-position))
1535 top (doto
1536 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
1537 :position top-position)
1539 (.addControl
1540 (RigidBodyControl.
1541 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
1542 bottom (doto
1543 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
1544 :position (Vector3f. 0 0 0))
1545 (.addControl
1546 (RigidBodyControl.
1547 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
1548 table (box 10 2 10 :position (Vector3f. 0 -20 0)
1549 :color ColorRGBA/Gray :mass 0)
1550 a (.getControl top RigidBodyControl)
1551 b (.getControl bottom RigidBodyControl)]
1553 (cond
1554 (= joint :cone)
1556 (doto (ConeJoint.
1557 a b
1558 (world-to-local top joint-position)
1559 (world-to-local bottom joint-position)
1560 joint-rotation
1561 joint-rotation
1565 (.setLimit (* (/ 10) Math/PI)
1566 (* (/ 4) Math/PI)
1567 0)))
1568 [origin top bottom table]))
1570 (defn test-joint [joint]
1571 (let [[origin top bottom floor] (world-setup joint)
1572 control (.getControl top RigidBodyControl)
1573 move-up? (atom false)
1574 move-down? (atom false)
1575 move-left? (atom false)
1576 move-right? (atom false)
1577 roll-left? (atom false)
1578 roll-right? (atom false)
1579 timer (atom 0)]
1581 (world
1582 (nodify [top bottom floor origin])
1583 (merge standard-debug-controls
1584 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1585 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1586 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1587 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1588 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1589 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1591 (fn [world]
1592 (light-up-everything world)
1593 (enable-debug world)
1594 (set-gravity world (Vector3f. 0 0 0))
1597 (fn [world _]
1598 (if (zero? (rem (swap! timer inc) 100))
1599 (do
1600 ;; (println-repl @timer)
1601 (.attachChild (.getRootNode world)
1602 (sphere 0.05 :color ColorRGBA/Yellow
1603 :position (.getWorldTranslation top)
1604 :physical? false))
1605 (.attachChild (.getRootNode world)
1606 (sphere 0.05 :color ColorRGBA/LightGray
1607 :position (.getWorldTranslation bottom)
1608 :physical? false))))
1610 (if @move-up?
1611 (.applyTorque control
1612 (.mult (.getPhysicsRotation control)
1613 (Vector3f. 0 0 10))))
1614 (if @move-down?
1615 (.applyTorque control
1616 (.mult (.getPhysicsRotation control)
1617 (Vector3f. 0 0 -10))))
1618 (if @move-left?
1619 (.applyTorque control
1620 (.mult (.getPhysicsRotation control)
1621 (Vector3f. 0 10 0))))
1622 (if @move-right?
1623 (.applyTorque control
1624 (.mult (.getPhysicsRotation control)
1625 (Vector3f. 0 -10 0))))
1626 (if @roll-left?
1627 (.applyTorque control
1628 (.mult (.getPhysicsRotation control)
1629 (Vector3f. -1 0 0))))
1630 (if @roll-right?
1631 (.applyTorque control
1632 (.mult (.getPhysicsRotation control)
1633 (Vector3f. 1 0 0))))))))
1637 (defprotocol Frame
1638 (frame [this]))
1640 (extend-type BufferedImage
1641 Frame
1642 (frame [image]
1643 (merge
1644 (apply
1645 hash-map
1646 (interleave
1647 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1648 (vector x y)))
1649 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1650 (let [data (.getRGB image x y)]
1651 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1652 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1653 :b (bit-and 0x0000ff data)))))))
1654 {:width (.getWidth image) :height (.getHeight image)})))
1657 (extend-type ImagePlus
1658 Frame
1659 (frame [image+]
1660 (frame (.getBufferedImage image+))))
1663 #+end_src
1666 * COMMENT generate source
1667 #+begin_src clojure :tangle ../src/cortex/silly.clj
1668 <<body-1>>
1669 #+end_src