view org/test-creature.org @ 107:53fb379ac678

saving progress
author Robert McIntyre <rlm@mit.edu>
date Sun, 15 Jan 2012 00:40:49 -0700
parents 40e72c6943d8
children 92b857b6145d
line wrap: on
line source
1 #+title: First attempt at a creature!
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description:
5 #+keywords: simulation, jMonkeyEngine3, clojure
6 #+SETUPFILE: ../../aurellem/org/setup.org
7 #+INCLUDE: ../../aurellem/org/level-0.org
9 * objectives
10 - [X] get an overall bitmap-like image for touch
11 - [X] write code to visuliaze this bitmap
12 - [ ] directly change the UV-pixels to show touch sensor activation
13 - [ ] write an explination for why b&w bitmaps for senses is appropiate
14 - [ ] clean up touch code and write visulazation test
15 - [ ] do the same for eyes
17 * Intro
18 So far, I've made the following senses --
19 - Vision
20 - Hearing
21 - Touch
22 - Proprioception
24 And one effector:
25 - Movement
27 However, the code so far has only enabled these senses, but has not
28 actually implemented them. For example, there is still a lot of work
29 to be done for vision. I need to be able to create an /eyeball/ in
30 simulation that can be moved around and see the world from different
31 angles. I also need to determine weather to use log-polar or cartesian
32 for the visual input, and I need to determine how/wether to
33 disceritise the visual input.
35 I also want to be able to visualize both the sensors and the
36 effectors in pretty pictures. This semi-retarted creature will be my
37 first attempt at bringing everything together.
39 * The creature's body
41 Still going to do an eve-like body in blender, but due to problems
42 importing the joints, etc into jMonkeyEngine3, I'm going to do all
43 the connecting here in clojure code, using the names of the individual
44 components and trial and error. Later, I'll maybe make some sort of
45 creature-building modifications to blender that support whatever
46 discreitized senses I'm going to make.
48 #+name: body-1
49 #+begin_src clojure
50 (ns cortex.silly
51 "let's play!"
52 {:author "Robert McIntyre"})
54 ;; TODO remove this!
55 (require 'cortex.import)
56 (cortex.import/mega-import-jme3)
57 (use '(cortex world util body hearing touch vision))
59 (rlm.rlm-commands/help)
60 (import java.awt.image.BufferedImage)
61 (import javax.swing.JPanel)
62 (import javax.swing.SwingUtilities)
63 (import java.awt.Dimension)
64 (import javax.swing.JFrame)
65 (import java.awt.Dimension)
66 (import com.aurellem.capture.RatchetTimer)
67 (declare joint-create)
69 (defn view-image
70 "Initailizes a JPanel on which you may draw a BufferedImage.
71 Returns a function that accepts a BufferedImage and draws it to the
72 JPanel."
73 []
74 (let [image
75 (atom
76 (BufferedImage. 1 1 BufferedImage/TYPE_4BYTE_ABGR))
77 panel
78 (proxy [JPanel] []
79 (paint
80 [graphics]
81 (proxy-super paintComponent graphics)
82 (.drawImage graphics @image 0 0 nil)))
83 frame (JFrame. "Display Image")]
84 (SwingUtilities/invokeLater
85 (fn []
86 (doto frame
87 (-> (.getContentPane) (.add panel))
88 (.pack)
89 (.setLocationRelativeTo nil)
90 (.setResizable true)
91 (.setVisible true))))
92 (fn [#^BufferedImage i]
93 (reset! image i)
94 (.setSize frame (+ 8 (.getWidth i)) (+ 28 (.getHeight i)))
95 (.repaint panel 0 0 (.getWidth i) (.getHeight i)))))
97 (defn points->image
98 "Take a sparse collection of points and visuliaze it as a
99 BufferedImage."
101 ;; TODO maybe parallelize this since it's easy
103 [points]
104 (if (empty? points)
105 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
106 (let [xs (vec (map first points))
107 ys (vec (map second points))
108 x0 (apply min xs)
109 y0 (apply min ys)
110 width (- (apply max xs) x0)
111 height (- (apply max ys) y0)
112 image (BufferedImage. (inc width) (inc height)
113 BufferedImage/TYPE_BYTE_BINARY)]
114 (dorun
115 (for [index (range (count points))]
116 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
118 image)))
120 (defn test-data
121 []
122 (vec
123 (for [a (range 0 1000 2)
124 b (range 0 1000 2)]
125 (vector a b))
126 ))
128 (defn average [coll]
129 (/ (reduce + coll) (count coll)))
131 (defn collapse-1d
132 "One dimensional analogue of collapse"
133 [center line]
134 (let [length (count line)
135 num-above (count (filter (partial < center) line))
136 num-below (- length num-above)]
137 (range (- center num-below)
138 (+ center num-above))
139 ))
141 (defn collapse
142 "Take a set of pairs of integers and collapse them into a
143 contigous bitmap."
144 [points]
145 (let
146 [num-points (count points)
147 center (vector
148 (int (average (map first points)))
149 (int (average (map first points))))
150 flattened
151 (reduce
152 concat
153 (map
154 (fn [column]
155 (map vector
156 (map first column)
157 (collapse-1d (second center)
158 (map second column))))
159 (partition-by first (sort-by first points))))
160 squeezed
161 (reduce
162 concat
163 (map
164 (fn [row]
165 (map vector
166 (collapse-1d (first center)
167 (map first row))
168 (map second row)))
169 (partition-by second (sort-by second flattened))))
170 relocate
171 (let [min-x (apply min (map first squeezed))
172 min-y (apply min (map second squeezed))]
173 (map (fn [[x y]]
174 [(- x min-x)
175 (- y min-y)])
176 squeezed))]
177 relocate
178 ))
180 (defn load-bullet []
181 (let [sim (world (Node.) {} no-op no-op)]
182 (doto sim
183 (.enqueue
184 (fn []
185 (.stop sim)))
186 (.start))))
188 (defn load-blender-model
189 "Load a .blend file using an asset folder relative path."
190 [^String model]
191 (.loadModel
192 (doto (asset-manager)
193 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
194 model))
196 (defn meta-data [blender-node key]
197 (if-let [data (.getUserData blender-node "properties")]
198 (.findValue data key)
199 nil))
201 (defn blender-to-jme
202 "Convert from Blender coordinates to JME coordinates"
203 [#^Vector3f in]
204 (Vector3f. (.getX in)
205 (.getZ in)
206 (- (.getY in))))
208 (defn jme-to-blender
209 "Convert from JME coordinates to Blender coordinates"
210 [#^Vector3f in]
211 (Vector3f. (.getX in)
212 (- (.getZ in))
213 (.getY in)))
215 (defn joint-targets
216 "Return the two closest two objects to the joint object, ordered
217 from bottom to top according to the joint's rotation."
218 [#^Node parts #^Node joint]
219 ;;(println (meta-data joint "joint"))
220 (.getWorldRotation joint)
221 (loop [radius (float 0.01)]
222 (let [results (CollisionResults.)]
223 (.collideWith
224 parts
225 (BoundingBox. (.getWorldTranslation joint)
226 radius radius radius)
227 results)
228 (let [targets
229 (distinct
230 (map #(.getGeometry %) results))]
231 (if (>= (count targets) 2)
232 (sort-by
233 #(let [v
234 (jme-to-blender
235 (.mult
236 (.inverse (.getWorldRotation joint))
237 (.subtract (.getWorldTranslation %)
238 (.getWorldTranslation joint))))]
239 (println-repl (.getName %) ":" v)
240 (.dot (Vector3f. 1 1 1)
241 v))
242 (take 2 targets))
243 (recur (float (* radius 2))))))))
245 (defn world-to-local
246 "Convert the world coordinates into coordinates relative to the
247 object (i.e. local coordinates), taking into account the rotation
248 of object."
249 [#^Spatial object world-coordinate]
250 (let [out (Vector3f.)]
251 (.worldToLocal object world-coordinate out) out))
253 (defn local-to-world
254 "Convert the local coordinates into coordinates into world relative
255 coordinates"
256 [#^Spatial object local-coordinate]
257 (let [world-coordinate (Vector3f.)]
258 (.localToWorld object local-coordinate world-coordinate)
259 world-coordinate))
262 (defmulti joint-dispatch
263 "Translate blender pseudo-joints into real JME joints."
264 (fn [constraints & _]
265 (:type constraints)))
267 (defmethod joint-dispatch :point
268 [constraints control-a control-b pivot-a pivot-b rotation]
269 (println-repl "creating POINT2POINT joint")
270 (Point2PointJoint.
271 control-a
272 control-b
273 pivot-a
274 pivot-b))
276 (defmethod joint-dispatch :hinge
277 [constraints control-a control-b pivot-a pivot-b rotation]
278 (println-repl "creating HINGE joint")
279 (let [axis
280 (if-let
281 [axis (:axis constraints)]
282 axis
283 Vector3f/UNIT_X)
284 [limit-1 limit-2] (:limit constraints)
285 hinge-axis
286 (.mult
287 rotation
288 (blender-to-jme axis))]
289 (doto
290 (HingeJoint.
291 control-a
292 control-b
293 pivot-a
294 pivot-b
295 hinge-axis
296 hinge-axis)
297 (.setLimit limit-1 limit-2))))
299 (defmethod joint-dispatch :cone
300 [constraints control-a control-b pivot-a pivot-b rotation]
301 (let [limit-xz (:limit-xz constraints)
302 limit-xy (:limit-xy constraints)
303 twist (:twist constraints)]
305 (println-repl "creating CONE joint")
306 (println-repl rotation)
307 (println-repl
308 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
309 (println-repl
310 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
311 (println-repl
312 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
313 (doto
314 (ConeJoint.
315 control-a
316 control-b
317 pivot-a
318 pivot-b
319 rotation
320 rotation)
321 (.setLimit (float limit-xz)
322 (float limit-xy)
323 (float twist)))))
325 (defn connect
326 "here are some examples:
327 {:type :point}
328 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
329 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
331 {:type :cone :limit-xz 0]
332 :limit-xy 0]
333 :twist 0]} (use XZY rotation mode in blender!)"
334 [#^Node obj-a #^Node obj-b #^Node joint]
335 (let [control-a (.getControl obj-a RigidBodyControl)
336 control-b (.getControl obj-b RigidBodyControl)
337 joint-center (.getWorldTranslation joint)
338 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
339 pivot-a (world-to-local obj-a joint-center)
340 pivot-b (world-to-local obj-b joint-center)]
342 (if-let [constraints
343 (map-vals
344 eval
345 (read-string
346 (meta-data joint "joint")))]
347 ;; A side-effect of creating a joint registers
348 ;; it with both physics objects which in turn
349 ;; will register the joint with the physics system
350 ;; when the simulation is started.
351 (do
352 (println-repl "creating joint between"
353 (.getName obj-a) "and" (.getName obj-b))
354 (joint-dispatch constraints
355 control-a control-b
356 pivot-a pivot-b
357 joint-rotation))
358 (println-repl "could not find joint meta-data!"))))
360 (defn assemble-creature [#^Node pieces joints]
361 (dorun
362 (map
363 (fn [geom]
364 (let [physics-control
365 (RigidBodyControl.
366 (HullCollisionShape.
367 (.getMesh geom))
368 (if-let [mass (meta-data geom "mass")]
369 (do
370 (println-repl
371 "setting" (.getName geom) "mass to" (float mass))
372 (float mass))
373 (float 1)))]
375 (.addControl geom physics-control)))
376 (filter #(isa? (class %) Geometry )
377 (node-seq pieces))))
378 (dorun
379 (map
380 (fn [joint]
381 (let [[obj-a obj-b]
382 (joint-targets pieces joint)]
383 (connect obj-a obj-b joint)))
384 joints))
385 pieces)
387 (defn blender-creature [blender-path]
388 (let [model (load-blender-model blender-path)
389 joints
390 (if-let [joint-node (.getChild model "joints")]
391 (seq (.getChildren joint-node))
392 (do (println-repl "could not find joints node")
393 []))]
394 (assemble-creature model joints)))
396 (def hand "Models/creature1/one.blend")
398 (def worm "Models/creature1/try-again.blend")
400 (def touch "Models/creature1/touch.blend")
402 (defn worm-model [] (load-blender-model worm))
404 (defn x-ray [#^ColorRGBA color]
405 (doto (Material. (asset-manager)
406 "Common/MatDefs/Misc/Unshaded.j3md")
407 (.setColor "Color" color)
408 (-> (.getAdditionalRenderState)
409 (.setDepthTest false))))
413 (defn colorful []
414 (.getChild (worm-model) "worm-21"))
416 (import jme3tools.converters.ImageToAwt)
418 (import ij.ImagePlus)
420 (defn triangle-indices
421 "Get the triangle vertex indices of a given triangle from a given
422 mesh."
423 [#^Mesh mesh triangle-index]
424 (let [indices (int-array 3)]
425 (.getTriangle mesh triangle-index indices)
426 (vec indices)))
428 (defn uv-coord
429 "Get the uv-coordinates of the vertex named by vertex-index"
430 [#^Mesh mesh vertex-index]
431 (let [UV-buffer
432 (.getData
433 (.getBuffer
434 mesh
435 VertexBuffer$Type/TexCoord))]
436 (Vector2f.
437 (.get UV-buffer (* vertex-index 2))
438 (.get UV-buffer (+ 1 (* vertex-index 2))))))
440 (defn tri-uv-coord
441 "Get the uv-cooridnates of the triangle's verticies."
442 [#^Mesh mesh #^Triangle triangle]
443 (map (partial uv-coord mesh)
444 (triangle-indices mesh (.getIndex triangle))))
446 (defn touch-receptor-image
447 "Return the touch-sensor distribution image in ImagePlus format, or
448 nil if it does not exist."
449 [#^Geometry obj]
450 (let [mat (.getMaterial obj)]
451 (if-let [texture-param
452 (.getTextureParam
453 mat
454 MaterialHelper/TEXTURE_TYPE_DIFFUSE)]
455 (let
456 [texture
457 (.getTextureValue texture-param)
458 im (.getImage texture)]
459 (ImagePlus.
460 "UV-map"
461 (ImageToAwt/convert im false false 0))))))
463 (import ij.process.ImageProcessor)
464 (import java.awt.image.BufferedImage)
466 (def white -1)
468 (defn filter-pixels
469 "List the coordinates of all pixels matching pred."
470 {:author "Dylan Holmes"}
471 [pred #^ImageProcessor ip]
472 (let
473 [width (.getWidth ip)
474 height (.getHeight ip)]
475 ((fn accumulate [x y matches]
476 (cond
477 (>= y height) matches
478 (>= x width) (recur 0 (inc y) matches)
479 (pred (.getPixel ip x y))
480 (recur (inc x) y (conj matches (Vector2f. x y)))
481 :else (recur (inc x) y matches)))
482 0 0 [])))
484 (defn white-coordinates
485 "List the coordinates of all the white pixels in an image."
486 [#^ImageProcessor ip]
487 (filter-pixels #(= % white) ip))
489 (defn same-side?
490 "Given the points p1 and p2 and the reference point ref, is point p
491 on the same side of the line that goes through p1 and p2 as ref is?"
492 [p1 p2 ref p]
493 (<=
494 0
495 (.dot
496 (.cross (.subtract p2 p1) (.subtract p p1))
497 (.cross (.subtract p2 p1) (.subtract ref p1)))))
499 (defn triangle->matrix4f
500 "Converts the triangle into a 4x4 matrix of vertices: The first
501 three columns contain the vertices of the triangle; the last
502 contains the unit normal of the triangle. The bottom row is filled
503 with 1s."
504 [#^Triangle t]
505 (let [mat (Matrix4f.)
506 [vert-1 vert-2 vert-3]
507 ((comp vec map) #(.get t %) (range 3))
508 unit-normal (do (.calculateNormal t)(.getNormal t))
509 vertices [vert-1 vert-2 vert-3 unit-normal]]
510 (dorun
511 (for [row (range 4) col (range 3)]
512 (do
513 (.set mat col row (.get (vertices row)col))
514 (.set mat 3 row 1))))
515 mat))
517 (defn triangle-transformation
518 "Returns the affine transformation that converts each vertex in the
519 first triangle into the corresponding vertex in the second
520 triangle."
521 [#^Triangle tri-1 #^Triangle tri-2]
522 (.mult
523 (triangle->matrix4f tri-2)
524 (.invert (triangle->matrix4f tri-1))))
526 (def death (Triangle.
527 (Vector3f. 1 1 1)
528 (Vector3f. 1 2 3)
529 (Vector3f. 5 6 7)))
531 (def death-2 (Triangle.
532 (Vector3f. 2 2 2)
533 (Vector3f. 1 1 1)
534 (Vector3f. 0 1 0)))
536 (defn vector2f->vector3f [v]
537 (Vector3f. (.getX v) (.getY v) 0))
539 (extend-type Triangle
540 Textual
541 (text [t]
542 (println "Triangle: " \newline (.get1 t) \newline
543 (.get2 t) \newline (.get3 t))))
545 (defn map-triangle [f #^Triangle tri]
546 (Triangle.
547 (f 0 (.get1 tri))
548 (f 1 (.get2 tri))
549 (f 2 (.get3 tri))))
551 (defn triangle-seq [#^Triangle tri]
552 [(.get1 tri) (.get2 tri) (.get3 tri)])
554 (defn vector3f-seq [#^Vector3f v]
555 [(.getX v) (.getY v) (.getZ v)])
557 (defn inside-triangle?
558 "Is the point inside the triangle? Now what do we do?
559 You might want to hold on there"
560 {:author "Dylan Holmes"}
561 [tri p]
562 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
563 (and
564 (same-side? vert-1 vert-2 vert-3 p)
565 (same-side? vert-2 vert-3 vert-1 p)
566 (same-side? vert-3 vert-1 vert-2 p))))
568 (defn uv-triangle
569 "Convert the mesh triangle into the cooresponding triangle in
570 UV-space. Z-component of these triangles is always zero."
571 [#^Mesh mesh #^Triangle tri]
572 (apply #(Triangle. %1 %2 %3)
573 (map vector2f->vector3f
574 (tri-uv-coord mesh tri))))
576 (defn pixel-triangle
577 "Convert the mesh triangle into the corresponding triangle in
578 UV-pixel-space. Z compenent will be zero."
579 [#^Mesh mesh #^Triangle tri width height]
580 (map-triangle (fn [_ v]
581 (Vector3f. (* width (.getX v))
582 (* height (.getY v))
583 0))
584 (uv-triangle mesh tri)))
586 (def rasterize pixel-triangle)
589 (defn triangle-bounds
590 "Dimensions of the bounding square of the triangle in the form
591 [x y width height].
592 Assumes that the triangle lies in the XY plane."
593 [#^Triangle tri]
594 (let [verts (map vector3f-seq (triangle-seq tri))
595 x (apply min (map first verts))
596 y (apply min (map second verts))]
597 [x y
598 (- (apply max (map first verts)) x)
599 (- (apply max (map second verts)) y)
600 ]))
603 (defn sensors-in-triangle
604 "Find the locations of the touch sensors within a triangle in both
605 UV and gemoetry relative coordinates."
606 [image mesh tri-index]
607 (let [width (.getWidth image)
608 height (.getHeight image)]
613 )
616 (defn locate-feelers
617 "Search the geometry's tactile UV image for touch sensors, returning
618 their positions in geometry-relative coordinates."
619 [#^Geometry geo]
620 (if-let [image (touch-receptor-image geo)]
621 (let [mesh (.getMesh geo)
622 tris (triangles geo)
624 width (.getWidth image)
625 height (.getHeight image)
627 ;; for each triangle
628 sensor-coords
629 (fn [tri]
630 ;; translate triangle to uv-pixel-space
631 (let [uv-tri
632 (pixel-triangle mesh tri width height)
633 bounds (vec (triangle-bounds uv-tri))]
635 ;; get that part of the picture
637 (apply #(.setRoi image %1 %2 %3 %4) bounds)
638 (let [cutout (.crop (.getProcessor image))
639 ;; extract white pixels inside triangle
640 cutout-tri
641 (map-triangle
642 (fn [_ v]
643 (.subtract
644 v
645 (Vector3f. (bounds 0) (bounds 1) (float 0))))
646 uv-tri)
647 whites (filter (partial inside-triangle? cutout-tri)
648 (map vector2f->vector3f
649 (white-coordinates cutout)))
650 ;; translate pixel coordinates to world-space
651 transform (triangle-transformation cutout-tri tri)]
652 (map #(.mult transform %) whites))))]
653 (vec (map sensor-coords tris)))
654 (repeat (count (triangles geo)) [])))
656 (use 'clojure.contrib.def)
658 (defn-memo touch-topology [#^Gemoetry geo]
659 (if-let [image (touch-receptor-image geo)]
660 (let [feeler-coords
661 (map
662 #(vector (int (.getX %)) (int (.getY %)))
663 (white-coordinates
664 (.getProcessor image)))]
665 (vec (collapse feeler-coords)))
666 []))
668 (defn enable-touch [#^Geometry geo]
669 (let [feeler-coords (locate-feelers geo)
670 tris (triangles geo)
671 limit 0.1]
672 (fn [node]
673 (let [sensor-origins
674 (map
675 #(map (partial local-to-world geo) %)
676 feeler-coords)
677 triangle-normals
678 (map (partial get-ray-direction geo)
679 tris)
680 rays
681 (flatten
682 (map (fn [origins norm]
683 (map #(doto (Ray. % norm)
684 (.setLimit limit)) origins))
685 sensor-origins triangle-normals))]
686 (vector
687 (touch-topology geo)
688 (vec
689 (for [ray rays]
690 (do
691 (let [results (CollisionResults.)]
692 (.collideWith node ray results)
693 (let [touch-objects
694 (set
695 (filter #(not (= geo %))
696 (map #(.getGeometry %) results)))]
697 (if (> (count touch-objects) 0)
698 1 0)))))))))))
700 (defn touch [#^Node pieces]
701 (map enable-touch
702 (filter #(isa? (class %) Geometry)
703 (node-seq pieces))))
705 (defn debug-window
706 "creates function that offers a debug view of sensor data"
707 []
708 (let [vi (view-image)]
709 (fn
710 [[coords sensor-data]]
711 (let [image (points->image coords)]
712 (dorun
713 (for [i (range (count coords))]
714 (.setRGB image ((coords i) 0) ((coords i) 1)
715 ({0 -16777216
716 1 -1} (sensor-data i)))))
717 (vi image)))))
720 ;;(defn test-touch [world creature]
723 (defn test-creature [thing]
724 (let [x-axis
725 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
726 y-axis
727 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
728 z-axis
729 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
730 creature (blender-creature thing)
731 touch-nerves (touch creature)
732 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
733 ]
734 (world
735 (nodify [creature
736 (box 10 2 10 :position (Vector3f. 0 -9 0)
737 :color ColorRGBA/Gray :mass 0)
738 x-axis y-axis z-axis
739 ])
740 standard-debug-controls
741 (fn [world]
742 (light-up-everything world)
743 (enable-debug world)
744 ;;(com.aurellem.capture.Capture/captureVideo
745 ;; world (file-str "/home/r/proj/ai-videos/hand"))
746 (.setTimer world (RatchetTimer. 60))
747 ;;(set-gravity world (Vector3f. 0 0 0))
748 )
749 (fn [world tpf]
750 (dorun
751 (map #(%1 (%2 (.getRootNode world))) touch-debug-windows touch-nerves))
752 )
753 ;;(let [timer (atom 0)]
754 ;; (fn [_ _]
755 ;; (swap! timer inc)
756 ;; (if (= (rem @timer 60) 0)
757 ;; (println-repl (float (/ @timer 60))))))
758 )))
760 #+end_src
762 #+results: body-1
763 : #'cortex.silly/tactile-coords
766 * COMMENT purgatory
767 #+begin_src clojure
768 (defn bullet-trans []
769 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
770 :position (Vector3f. -10 5 0))
771 obj-b (sphere 0.5 :color ColorRGBA/Blue
772 :position (Vector3f. -10 -5 0)
773 :mass 0)
774 control-a (.getControl obj-a RigidBodyControl)
775 control-b (.getControl obj-b RigidBodyControl)
776 swivel
777 (.toRotationMatrix
778 (doto (Quaternion.)
779 (.fromAngleAxis (/ Math/PI 2)
780 Vector3f/UNIT_X)))]
781 (doto
782 (ConeJoint.
783 control-a control-b
784 (Vector3f. 0 5 0)
785 (Vector3f. 0 -5 0)
786 swivel swivel)
787 (.setLimit (* 0.6 (/ Math/PI 4))
788 (/ Math/PI 4)
789 (* Math/PI 0.8)))
790 (world (nodify
791 [obj-a obj-b])
792 standard-debug-controls
793 enable-debug
794 no-op)))
797 (defn bullet-trans* []
798 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
799 :position (Vector3f. 5 0 0)
800 :mass 90)
801 obj-b (sphere 0.5 :color ColorRGBA/Blue
802 :position (Vector3f. -5 0 0)
803 :mass 0)
804 control-a (.getControl obj-a RigidBodyControl)
805 control-b (.getControl obj-b RigidBodyControl)
806 move-up? (atom nil)
807 move-down? (atom nil)
808 move-left? (atom nil)
809 move-right? (atom nil)
810 roll-left? (atom nil)
811 roll-right? (atom nil)
812 force 100
813 swivel
814 (.toRotationMatrix
815 (doto (Quaternion.)
816 (.fromAngleAxis (/ Math/PI 2)
817 Vector3f/UNIT_X)))
818 x-move
819 (doto (Matrix3f.)
820 (.fromStartEndVectors Vector3f/UNIT_X
821 (.normalize (Vector3f. 1 1 0))))
823 timer (atom 0)]
824 (doto
825 (ConeJoint.
826 control-a control-b
827 (Vector3f. -8 0 0)
828 (Vector3f. 2 0 0)
829 ;;swivel swivel
830 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
831 x-move Matrix3f/IDENTITY
832 )
833 (.setCollisionBetweenLinkedBodys false)
834 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
835 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
836 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
837 (world (nodify
838 [obj-a obj-b])
839 (merge standard-debug-controls
840 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
841 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
842 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
843 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
844 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
845 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
847 (fn [world]
848 (enable-debug world)
849 (set-gravity world Vector3f/ZERO)
850 )
852 (fn [world _]
854 (if @move-up?
855 (.applyForce control-a
856 (Vector3f. force 0 0)
857 (Vector3f. 0 0 0)))
858 (if @move-down?
859 (.applyForce control-a
860 (Vector3f. (- force) 0 0)
861 (Vector3f. 0 0 0)))
862 (if @move-left?
863 (.applyForce control-a
864 (Vector3f. 0 force 0)
865 (Vector3f. 0 0 0)))
866 (if @move-right?
867 (.applyForce control-a
868 (Vector3f. 0 (- force) 0)
869 (Vector3f. 0 0 0)))
871 (if @roll-left?
872 (.applyForce control-a
873 (Vector3f. 0 0 force)
874 (Vector3f. 0 0 0)))
875 (if @roll-right?
876 (.applyForce control-a
877 (Vector3f. 0 0 (- force))
878 (Vector3f. 0 0 0)))
880 (if (zero? (rem (swap! timer inc) 100))
881 (.attachChild
882 (.getRootNode world)
883 (sphere 0.05 :color ColorRGBA/Yellow
884 :physical? false :position
885 (.getWorldTranslation obj-a)))))
886 )
887 ))
889 (defn transform-trianglesdsd
890 "Transform that converts each vertex in the first triangle
891 into the corresponding vertex in the second triangle."
892 [#^Triangle tri-1 #^Triangle tri-2]
893 (let [in [(.get1 tri-1)
894 (.get2 tri-1)
895 (.get3 tri-1)]
896 out [(.get1 tri-2)
897 (.get2 tri-2)
898 (.get3 tri-2)]]
899 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
900 in* [(.mult translate (in 0))
901 (.mult translate (in 1))
902 (.mult translate (in 2))]
903 final-translation
904 (doto (Matrix4f.)
905 (.setTranslation (out 1)))
907 rotate-1
908 (doto (Matrix3f.)
909 (.fromStartEndVectors
910 (.normalize
911 (.subtract
912 (in* 1) (in* 0)))
913 (.normalize
914 (.subtract
915 (out 1) (out 0)))))
916 in** [(.mult rotate-1 (in* 0))
917 (.mult rotate-1 (in* 1))
918 (.mult rotate-1 (in* 2))]
919 scale-factor-1
920 (.mult
921 (.normalize
922 (.subtract
923 (out 1)
924 (out 0)))
925 (/ (.length
926 (.subtract (out 1)
927 (out 0)))
928 (.length
929 (.subtract (in** 1)
930 (in** 0)))))
931 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
932 in*** [(.mult scale-1 (in** 0))
933 (.mult scale-1 (in** 1))
934 (.mult scale-1 (in** 2))]
940 ]
942 (dorun (map println in))
943 (println)
944 (dorun (map println in*))
945 (println)
946 (dorun (map println in**))
947 (println)
948 (dorun (map println in***))
949 (println)
951 ))))
954 (defn world-setup [joint]
955 (let [joint-position (Vector3f. 0 0 0)
956 joint-rotation
957 (.toRotationMatrix
958 (.mult
959 (doto (Quaternion.)
960 (.fromAngleAxis
961 (* 1 (/ Math/PI 4))
962 (Vector3f. -1 0 0)))
963 (doto (Quaternion.)
964 (.fromAngleAxis
965 (* 1 (/ Math/PI 2))
966 (Vector3f. 0 0 1)))))
967 top-position (.mult joint-rotation (Vector3f. 8 0 0))
969 origin (doto
970 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
971 :position top-position))
972 top (doto
973 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
974 :position top-position)
976 (.addControl
977 (RigidBodyControl.
978 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
979 bottom (doto
980 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
981 :position (Vector3f. 0 0 0))
982 (.addControl
983 (RigidBodyControl.
984 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
985 table (box 10 2 10 :position (Vector3f. 0 -20 0)
986 :color ColorRGBA/Gray :mass 0)
987 a (.getControl top RigidBodyControl)
988 b (.getControl bottom RigidBodyControl)]
990 (cond
991 (= joint :cone)
993 (doto (ConeJoint.
994 a b
995 (world-to-local top joint-position)
996 (world-to-local bottom joint-position)
997 joint-rotation
998 joint-rotation
999 )
1002 (.setLimit (* (/ 10) Math/PI)
1003 (* (/ 4) Math/PI)
1004 0)))
1005 [origin top bottom table]))
1007 (defn test-joint [joint]
1008 (let [[origin top bottom floor] (world-setup joint)
1009 control (.getControl top RigidBodyControl)
1010 move-up? (atom false)
1011 move-down? (atom false)
1012 move-left? (atom false)
1013 move-right? (atom false)
1014 roll-left? (atom false)
1015 roll-right? (atom false)
1016 timer (atom 0)]
1018 (world
1019 (nodify [top bottom floor origin])
1020 (merge standard-debug-controls
1021 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
1022 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
1023 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
1024 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1025 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1026 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1028 (fn [world]
1029 (light-up-everything world)
1030 (enable-debug world)
1031 (set-gravity world (Vector3f. 0 0 0))
1034 (fn [world _]
1035 (if (zero? (rem (swap! timer inc) 100))
1036 (do
1037 ;; (println-repl @timer)
1038 (.attachChild (.getRootNode world)
1039 (sphere 0.05 :color ColorRGBA/Yellow
1040 :position (.getWorldTranslation top)
1041 :physical? false))
1042 (.attachChild (.getRootNode world)
1043 (sphere 0.05 :color ColorRGBA/LightGray
1044 :position (.getWorldTranslation bottom)
1045 :physical? false))))
1047 (if @move-up?
1048 (.applyTorque control
1049 (.mult (.getPhysicsRotation control)
1050 (Vector3f. 0 0 10))))
1051 (if @move-down?
1052 (.applyTorque control
1053 (.mult (.getPhysicsRotation control)
1054 (Vector3f. 0 0 -10))))
1055 (if @move-left?
1056 (.applyTorque control
1057 (.mult (.getPhysicsRotation control)
1058 (Vector3f. 0 10 0))))
1059 (if @move-right?
1060 (.applyTorque control
1061 (.mult (.getPhysicsRotation control)
1062 (Vector3f. 0 -10 0))))
1063 (if @roll-left?
1064 (.applyTorque control
1065 (.mult (.getPhysicsRotation control)
1066 (Vector3f. -1 0 0))))
1067 (if @roll-right?
1068 (.applyTorque control
1069 (.mult (.getPhysicsRotation control)
1070 (Vector3f. 1 0 0))))))))
1074 (defprotocol Frame
1075 (frame [this]))
1077 (extend-type BufferedImage
1078 Frame
1079 (frame [image]
1080 (merge
1081 (apply
1082 hash-map
1083 (interleave
1084 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1085 (vector x y)))
1086 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1087 (let [data (.getRGB image x y)]
1088 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1089 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1090 :b (bit-and 0x0000ff data)))))))
1091 {:width (.getWidth image) :height (.getHeight image)})))
1094 (extend-type ImagePlus
1095 Frame
1096 (frame [image+]
1097 (frame (.getBufferedImage image+))))
1100 #+end_src
1103 * COMMENT generate source
1104 #+begin_src clojure :tangle ../src/cortex/silly.clj
1105 <<body-1>>
1106 #+end_src