view org/test-creature.org @ 148:511112c44b16

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