view org/test-creature.org @ 108:92b857b6145d

slow implementation of UV-mapped touch is complete
author Robert McIntyre <rlm@mit.edu>
date Sun, 15 Jan 2012 04:08:31 -0700
parents 53fb379ac678
children c05d8d222166
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)
68 (use 'clojure.contrib.def)
70 (defn view-image
71 "Initailizes a JPanel on which you may draw a BufferedImage.
72 Returns a function that accepts a BufferedImage and draws it to the
73 JPanel."
74 []
75 (let [image
76 (atom
77 (BufferedImage. 1 1 BufferedImage/TYPE_4BYTE_ABGR))
78 panel
79 (proxy [JPanel] []
80 (paint
81 [graphics]
82 (proxy-super paintComponent graphics)
83 (.drawImage graphics @image 0 0 nil)))
84 frame (JFrame. "Display Image")]
85 (SwingUtilities/invokeLater
86 (fn []
87 (doto frame
88 (-> (.getContentPane) (.add panel))
89 (.pack)
90 (.setLocationRelativeTo nil)
91 (.setResizable true)
92 (.setVisible true))))
93 (fn [#^BufferedImage i]
94 (reset! image i)
95 (.setSize frame (+ 8 (.getWidth i)) (+ 28 (.getHeight i)))
96 (.repaint panel 0 0 (.getWidth i) (.getHeight i)))))
98 (defn points->image
99 "Take a sparse collection of points and visuliaze it as a
100 BufferedImage."
102 ;; TODO maybe parallelize this since it's easy
104 [points]
105 (if (empty? points)
106 (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)
107 (let [xs (vec (map first points))
108 ys (vec (map second points))
109 x0 (apply min xs)
110 y0 (apply min ys)
111 width (- (apply max xs) x0)
112 height (- (apply max ys) y0)
113 image (BufferedImage. (inc width) (inc height)
114 BufferedImage/TYPE_BYTE_BINARY)]
115 (dorun
116 (for [index (range (count points))]
117 (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))
119 image)))
121 (defn test-data
122 []
123 (vec
124 (for [a (range 0 1000 2)
125 b (range 0 1000 2)]
126 (vector a b))
127 ))
129 (defn average [coll]
130 (/ (reduce + coll) (count coll)))
132 (defn collapse-1d
133 "One dimensional analogue of collapse"
134 [center line]
135 (let [length (count line)
136 num-above (count (filter (partial < center) line))
137 num-below (- length num-above)]
138 (range (- center num-below)
139 (+ center num-above))
140 ))
142 (defn collapse
143 "Take a set of pairs of integers and collapse them into a
144 contigous bitmap."
145 [points]
146 (if (empty? points) []
147 (let
148 [num-points (count points)
149 center (vector
150 (int (average (map first points)))
151 (int (average (map first points))))
152 flattened
153 (reduce
154 concat
155 (map
156 (fn [column]
157 (map vector
158 (map first column)
159 (collapse-1d (second center)
160 (map second column))))
161 (partition-by first (sort-by first points))))
162 squeezed
163 (reduce
164 concat
165 (map
166 (fn [row]
167 (map vector
168 (collapse-1d (first center)
169 (map first row))
170 (map second row)))
171 (partition-by second (sort-by second flattened))))
172 relocate
173 (let [min-x (apply min (map first squeezed))
174 min-y (apply min (map second squeezed))]
175 (map (fn [[x y]]
176 [(- x min-x)
177 (- y min-y)])
178 squeezed))]
179 relocate
180 )))
182 (defn load-bullet []
183 (let [sim (world (Node.) {} no-op no-op)]
184 (doto sim
185 (.enqueue
186 (fn []
187 (.stop sim)))
188 (.start))))
190 (defn load-blender-model
191 "Load a .blend file using an asset folder relative path."
192 [^String model]
193 (.loadModel
194 (doto (asset-manager)
195 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
196 model))
198 (defn meta-data [blender-node key]
199 (if-let [data (.getUserData blender-node "properties")]
200 (.findValue data key)
201 nil))
203 (defn blender-to-jme
204 "Convert from Blender coordinates to JME coordinates"
205 [#^Vector3f in]
206 (Vector3f. (.getX in)
207 (.getZ in)
208 (- (.getY in))))
210 (defn jme-to-blender
211 "Convert from JME coordinates to Blender coordinates"
212 [#^Vector3f in]
213 (Vector3f. (.getX in)
214 (- (.getZ in))
215 (.getY in)))
217 (defn joint-targets
218 "Return the two closest two objects to the joint object, ordered
219 from bottom to top according to the joint's rotation."
220 [#^Node parts #^Node joint]
221 ;;(println (meta-data joint "joint"))
222 (.getWorldRotation joint)
223 (loop [radius (float 0.01)]
224 (let [results (CollisionResults.)]
225 (.collideWith
226 parts
227 (BoundingBox. (.getWorldTranslation joint)
228 radius radius radius)
229 results)
230 (let [targets
231 (distinct
232 (map #(.getGeometry %) results))]
233 (if (>= (count targets) 2)
234 (sort-by
235 #(let [v
236 (jme-to-blender
237 (.mult
238 (.inverse (.getWorldRotation joint))
239 (.subtract (.getWorldTranslation %)
240 (.getWorldTranslation joint))))]
241 (println-repl (.getName %) ":" v)
242 (.dot (Vector3f. 1 1 1)
243 v))
244 (take 2 targets))
245 (recur (float (* radius 2))))))))
247 (defn world-to-local
248 "Convert the world coordinates into coordinates relative to the
249 object (i.e. local coordinates), taking into account the rotation
250 of object."
251 [#^Spatial object world-coordinate]
252 (let [out (Vector3f.)]
253 (.worldToLocal object world-coordinate out) out))
255 (defn local-to-world
256 "Convert the local coordinates into coordinates into world relative
257 coordinates"
258 [#^Spatial object local-coordinate]
259 (let [world-coordinate (Vector3f.)]
260 (.localToWorld object local-coordinate world-coordinate)
261 world-coordinate))
264 (defmulti joint-dispatch
265 "Translate blender pseudo-joints into real JME joints."
266 (fn [constraints & _]
267 (:type constraints)))
269 (defmethod joint-dispatch :point
270 [constraints control-a control-b pivot-a pivot-b rotation]
271 (println-repl "creating POINT2POINT joint")
272 (Point2PointJoint.
273 control-a
274 control-b
275 pivot-a
276 pivot-b))
278 (defmethod joint-dispatch :hinge
279 [constraints control-a control-b pivot-a pivot-b rotation]
280 (println-repl "creating HINGE joint")
281 (let [axis
282 (if-let
283 [axis (:axis constraints)]
284 axis
285 Vector3f/UNIT_X)
286 [limit-1 limit-2] (:limit constraints)
287 hinge-axis
288 (.mult
289 rotation
290 (blender-to-jme axis))]
291 (doto
292 (HingeJoint.
293 control-a
294 control-b
295 pivot-a
296 pivot-b
297 hinge-axis
298 hinge-axis)
299 (.setLimit limit-1 limit-2))))
301 (defmethod joint-dispatch :cone
302 [constraints control-a control-b pivot-a pivot-b rotation]
303 (let [limit-xz (:limit-xz constraints)
304 limit-xy (:limit-xy constraints)
305 twist (:twist constraints)]
307 (println-repl "creating CONE joint")
308 (println-repl rotation)
309 (println-repl
310 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
311 (println-repl
312 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
313 (println-repl
314 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
315 (doto
316 (ConeJoint.
317 control-a
318 control-b
319 pivot-a
320 pivot-b
321 rotation
322 rotation)
323 (.setLimit (float limit-xz)
324 (float limit-xy)
325 (float twist)))))
327 (defn connect
328 "here are some examples:
329 {:type :point}
330 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
331 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
333 {:type :cone :limit-xz 0]
334 :limit-xy 0]
335 :twist 0]} (use XZY rotation mode in blender!)"
336 [#^Node obj-a #^Node obj-b #^Node joint]
337 (let [control-a (.getControl obj-a RigidBodyControl)
338 control-b (.getControl obj-b RigidBodyControl)
339 joint-center (.getWorldTranslation joint)
340 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
341 pivot-a (world-to-local obj-a joint-center)
342 pivot-b (world-to-local obj-b joint-center)]
344 (if-let [constraints
345 (map-vals
346 eval
347 (read-string
348 (meta-data joint "joint")))]
349 ;; A side-effect of creating a joint registers
350 ;; it with both physics objects which in turn
351 ;; will register the joint with the physics system
352 ;; when the simulation is started.
353 (do
354 (println-repl "creating joint between"
355 (.getName obj-a) "and" (.getName obj-b))
356 (joint-dispatch constraints
357 control-a control-b
358 pivot-a pivot-b
359 joint-rotation))
360 (println-repl "could not find joint meta-data!"))))
362 (defn assemble-creature [#^Node pieces joints]
363 (dorun
364 (map
365 (fn [geom]
366 (let [physics-control
367 (RigidBodyControl.
368 (HullCollisionShape.
369 (.getMesh geom))
370 (if-let [mass (meta-data geom "mass")]
371 (do
372 (println-repl
373 "setting" (.getName geom) "mass to" (float mass))
374 (float mass))
375 (float 1)))]
377 (.addControl geom physics-control)))
378 (filter #(isa? (class %) Geometry )
379 (node-seq pieces))))
380 (dorun
381 (map
382 (fn [joint]
383 (let [[obj-a obj-b]
384 (joint-targets pieces joint)]
385 (connect obj-a obj-b joint)))
386 joints))
387 pieces)
389 (defn blender-creature [blender-path]
390 (let [model (load-blender-model blender-path)
391 joints
392 (if-let [joint-node (.getChild model "joints")]
393 (seq (.getChildren joint-node))
394 (do (println-repl "could not find joints node")
395 []))]
396 (assemble-creature model joints)))
398 (def hand "Models/creature1/one.blend")
400 (def worm "Models/creature1/try-again.blend")
402 (def touch "Models/creature1/touch.blend")
404 (defn worm-model [] (load-blender-model worm))
406 (defn x-ray [#^ColorRGBA color]
407 (doto (Material. (asset-manager)
408 "Common/MatDefs/Misc/Unshaded.j3md")
409 (.setColor "Color" color)
410 (-> (.getAdditionalRenderState)
411 (.setDepthTest false))))
415 (defn colorful []
416 (.getChild (worm-model) "worm-21"))
418 (import jme3tools.converters.ImageToAwt)
420 (import ij.ImagePlus)
422 ;; Every Mesh has many triangles, each with its own index.
423 ;; Every vertex has its own index as well.
425 (defn tactile-sensor-image
426 "Return the touch-sensor distribution image in ImagePlus format, or
427 nil if it does not exist."
428 [#^Geometry obj]
429 (let [mat (.getMaterial obj)]
430 (if-let [texture-param
431 (.getTextureParam
432 mat
433 MaterialHelper/TEXTURE_TYPE_DIFFUSE)]
434 (let
435 [texture
436 (.getTextureValue texture-param)
437 im (.getImage texture)]
438 (ImageToAwt/convert im false false 0)))))
440 (import ij.process.ImageProcessor)
441 (import java.awt.image.BufferedImage)
443 (def white -1)
445 (defn filter-pixels
446 "List the coordinates of all pixels matching pred, within the bounds
447 provided. Bounds -> [x0 y0 width height]"
448 {:author "Dylan Holmes"}
449 ([pred #^BufferedImage image]
450 (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))
451 ([pred #^BufferedImage image [x0 y0 width height]]
452 ((fn accumulate [x y matches]
453 (cond
454 (>= y (+ height y0)) matches
455 (>= x (+ width x0)) (recur 0 (inc y) matches)
456 (pred (.getRGB image x y))
457 (recur (inc x) y (conj matches [x y]))
458 :else (recur (inc x) y matches)))
459 x0 y0 [])))
461 (defn white-coordinates
462 "Coordinates of all the white pixels in a subset of the image."
463 [#^BufferedImage image bounds]
464 (filter-pixels #(= % white) image bounds))
466 (defn triangle
467 "Get the triangle specified by triangle-index from the mesh"
468 [#^Mesh mesh triangle-index]
469 (let [scratch (Triangle.)]
470 (.getTriangle mesh triangle-index scratch)
471 scratch))
473 (defn triangle-vertex-indices
474 "Get the triangle vertex indices of a given triangle from a given
475 mesh."
476 [#^Mesh mesh triangle-index]
477 (let [indices (int-array 3)]
478 (.getTriangle mesh triangle-index indices)
479 (vec indices)))
481 (defn vertex-UV-coord
482 "Get the uv-coordinates of the vertex named by vertex-index"
483 [#^Mesh mesh vertex-index]
484 (let [UV-buffer
485 (.getData
486 (.getBuffer
487 mesh
488 VertexBuffer$Type/TexCoord))]
489 [(.get UV-buffer (* vertex-index 2))
490 (.get UV-buffer (+ 1 (* vertex-index 2)))]))
492 (defn triangle-UV-coord
493 "Get the uv-cooridnates of the triangle's verticies."
494 [#^Mesh mesh width height triangle-index]
495 (map (fn [[u v]] (vector (* width u) (* height v)))
496 (map (partial vertex-UV-coord mesh)
497 (triangle-vertex-indices mesh triangle-index))))
499 (defn same-side?
500 "Given the points p1 and p2 and the reference point ref, is point p
501 on the same side of the line that goes through p1 and p2 as ref is?"
502 [p1 p2 ref p]
503 (<=
504 0
505 (.dot
506 (.cross (.subtract p2 p1) (.subtract p p1))
507 (.cross (.subtract p2 p1) (.subtract ref p1)))))
509 (defn triangle-seq [#^Triangle tri]
510 [(.get1 tri) (.get2 tri) (.get3 tri)])
512 (defn vector3f-seq [#^Vector3f v]
513 [(.getX v) (.getY v) (.getZ v)])
515 (defn inside-triangle?
516 "Is the point inside the triangle?"
517 {:author "Dylan Holmes"}
518 [#^Triangle tri #^Vector3f p]
519 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
520 (and
521 (same-side? vert-1 vert-2 vert-3 p)
522 (same-side? vert-2 vert-3 vert-1 p)
523 (same-side? vert-3 vert-1 vert-2 p))))
525 (defn triangle->matrix4f
526 "Converts the triangle into a 4x4 matrix: The first three columns
527 contain the vertices of the triangle; the last contains the unit
528 normal of the triangle. The bottom row is filled with 1s."
529 [#^Triangle t]
530 (let [mat (Matrix4f.)
531 [vert-1 vert-2 vert-3]
532 ((comp vec map) #(.get t %) (range 3))
533 unit-normal (do (.calculateNormal t)(.getNormal t))
534 vertices [vert-1 vert-2 vert-3 unit-normal]]
535 (dorun
536 (for [row (range 4) col (range 3)]
537 (do
538 (.set mat col row (.get (vertices row)col))
539 (.set mat 3 row 1))))
540 mat))
542 (defn triangle-transformation
543 "Returns the affine transformation that converts each vertex in the
544 first triangle into the corresponding vertex in the second
545 triangle."
546 [#^Triangle tri-1 #^Triangle tri-2]
547 (.mult
548 (triangle->matrix4f tri-2)
549 (.invert (triangle->matrix4f tri-1))))
551 (defn point->vector2f [[u v]]
552 (Vector2f. u v))
554 (defn vector2f->vector3f [v]
555 (Vector3f. (.getX v) (.getY v) 0))
557 (defn map-triangle [f #^Triangle tri]
558 (Triangle.
559 (f 0 (.get1 tri))
560 (f 1 (.get2 tri))
561 (f 2 (.get3 tri))))
563 (defn points->triangle
564 "Convert a list of points into a triangle."
565 [points]
566 (apply #(Triangle. %1 %2 %3)
567 (map (fn [point]
568 (let [point (vec point)]
569 (Vector3f. (get point 0 0)
570 (get point 1 0)
571 (get point 2 0))))
572 (take 3 points))))
574 (defn convex-bounds
575 "Dimensions of the smallest integer bounding square of the list of
576 2D verticies in the form: [x y width height]."
577 [uv-verts]
578 (let [xs (map first uv-verts)
579 ys (map second uv-verts)
580 x0 (Math/floor (apply min xs))
581 y0 (Math/floor (apply min ys))
582 x1 (Math/ceil (apply max xs))
583 y1 (Math/ceil (apply max ys))]
584 [x0 y0 (- x1 x0) (- y1 y0)]))
586 (defn sensors-in-triangle
587 "Find the locations of the touch sensors within a triangle in both
588 UV and gemoetry relative coordinates."
589 [image mesh tri-index]
590 (let [width (.getWidth image)
591 height (.getHeight image)
592 UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
593 bounds (convex-bounds UV-vertex-coords)
595 cutout-triangle (points->triangle UV-vertex-coords)
596 UV-sensor-coords
597 (filter (comp (partial inside-triangle? cutout-triangle)
598 (fn [[u v]] (Vector3f. u v 0)))
599 (white-coordinates image bounds))
600 UV->geometry (triangle-transformation
601 cutout-triangle
602 (triangle mesh tri-index))
603 geometry-sensor-coords
604 (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
605 UV-sensor-coords)]
606 {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
608 (defn-memo locate-feelers
609 "Search the geometry's tactile UV image for touch sensors, returning
610 their positions in geometry-relative coordinates."
611 [#^Geometry geo]
612 (let [mesh (.getMesh geo)
613 num-triangles (.getTriangleCount mesh)]
614 (if-let [image (tactile-sensor-image geo)]
615 (map
616 (partial sensors-in-triangle image mesh)
617 (range num-triangles))
618 (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
620 (use 'clojure.contrib.def)
622 (defn-memo touch-topology [#^Gemoetry geo]
623 (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
625 (defn-memo feeler-coordinates [#^Geometry geo]
626 (vec (map :geometry (locate-feelers geo))))
628 (defn enable-touch [#^Geometry geo]
629 (let [feeler-coords (feeler-coordinates geo)
630 tris (triangles geo)
631 limit 0.1]
632 (fn [node]
633 (let [sensor-origins
634 (map
635 #(map (partial local-to-world geo) %)
636 feeler-coords)
637 triangle-normals
638 (map (partial get-ray-direction geo)
639 tris)
640 rays
641 (flatten
642 (map (fn [origins norm]
643 (map #(doto (Ray. % norm)
644 (.setLimit limit)) origins))
645 sensor-origins triangle-normals))]
646 (vector
647 (touch-topology geo)
648 (vec
649 (for [ray rays]
650 (do
651 (let [results (CollisionResults.)]
652 (.collideWith node ray results)
653 (let [touch-objects
654 (set
655 (filter #(not (= geo %))
656 (map #(.getGeometry %) results)))]
657 (if (> (count touch-objects) 0)
658 1 0)))))))))))
660 (defn touch [#^Node pieces]
661 (map enable-touch
662 (filter #(isa? (class %) Geometry)
663 (node-seq pieces))))
665 (defn debug-window
666 "creates function that offers a debug view of sensor data"
667 []
668 (let [vi (view-image)]
669 (fn
670 [[coords sensor-data]]
671 (let [image (points->image coords)]
672 (dorun
673 (for [i (range (count coords))]
674 (.setRGB image ((coords i) 0) ((coords i) 1)
675 ({0 -16777216
676 1 -1} (sensor-data i)))))
677 (vi image)))))
680 ;;(defn test-touch [world creature]
683 (defn test-creature [thing]
684 (let [x-axis
685 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
686 y-axis
687 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
688 z-axis
689 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)
690 creature (blender-creature thing)
691 touch-nerves (touch creature)
692 touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)
693 ]
694 (world
695 (nodify [creature
696 (box 10 2 10 :position (Vector3f. 0 -9 0)
697 :color ColorRGBA/Gray :mass 0)
698 x-axis y-axis z-axis
699 ])
700 standard-debug-controls
701 (fn [world]
702 (light-up-everything world)
703 (enable-debug world)
704 ;;(com.aurellem.capture.Capture/captureVideo
705 ;; world (file-str "/home/r/proj/ai-videos/hand"))
706 (.setTimer world (RatchetTimer. 60))
707 ;;(speed-up world)
708 ;;(set-gravity world (Vector3f. 0 0 0))
709 )
710 (fn [world tpf]
711 (dorun
712 (map #(%1 (%2 (.getRootNode world))) touch-debug-windows touch-nerves))
713 )
714 ;;(let [timer (atom 0)]
715 ;; (fn [_ _]
716 ;; (swap! timer inc)
717 ;; (if (= (rem @timer 60) 0)
718 ;; (println-repl (float (/ @timer 60))))))
719 )))
721 #+end_src
723 #+results: body-1
724 : #'cortex.silly/tactile-coords
727 * COMMENT purgatory
728 #+begin_src clojure
729 (defn bullet-trans []
730 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
731 :position (Vector3f. -10 5 0))
732 obj-b (sphere 0.5 :color ColorRGBA/Blue
733 :position (Vector3f. -10 -5 0)
734 :mass 0)
735 control-a (.getControl obj-a RigidBodyControl)
736 control-b (.getControl obj-b RigidBodyControl)
737 swivel
738 (.toRotationMatrix
739 (doto (Quaternion.)
740 (.fromAngleAxis (/ Math/PI 2)
741 Vector3f/UNIT_X)))]
742 (doto
743 (ConeJoint.
744 control-a control-b
745 (Vector3f. 0 5 0)
746 (Vector3f. 0 -5 0)
747 swivel swivel)
748 (.setLimit (* 0.6 (/ Math/PI 4))
749 (/ Math/PI 4)
750 (* Math/PI 0.8)))
751 (world (nodify
752 [obj-a obj-b])
753 standard-debug-controls
754 enable-debug
755 no-op)))
758 (defn bullet-trans* []
759 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
760 :position (Vector3f. 5 0 0)
761 :mass 90)
762 obj-b (sphere 0.5 :color ColorRGBA/Blue
763 :position (Vector3f. -5 0 0)
764 :mass 0)
765 control-a (.getControl obj-a RigidBodyControl)
766 control-b (.getControl obj-b RigidBodyControl)
767 move-up? (atom nil)
768 move-down? (atom nil)
769 move-left? (atom nil)
770 move-right? (atom nil)
771 roll-left? (atom nil)
772 roll-right? (atom nil)
773 force 100
774 swivel
775 (.toRotationMatrix
776 (doto (Quaternion.)
777 (.fromAngleAxis (/ Math/PI 2)
778 Vector3f/UNIT_X)))
779 x-move
780 (doto (Matrix3f.)
781 (.fromStartEndVectors Vector3f/UNIT_X
782 (.normalize (Vector3f. 1 1 0))))
784 timer (atom 0)]
785 (doto
786 (ConeJoint.
787 control-a control-b
788 (Vector3f. -8 0 0)
789 (Vector3f. 2 0 0)
790 ;;swivel swivel
791 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
792 x-move Matrix3f/IDENTITY
793 )
794 (.setCollisionBetweenLinkedBodys false)
795 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
796 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
797 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
798 (world (nodify
799 [obj-a obj-b])
800 (merge standard-debug-controls
801 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
802 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
803 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
804 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
805 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
806 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
808 (fn [world]
809 (enable-debug world)
810 (set-gravity world Vector3f/ZERO)
811 )
813 (fn [world _]
815 (if @move-up?
816 (.applyForce control-a
817 (Vector3f. force 0 0)
818 (Vector3f. 0 0 0)))
819 (if @move-down?
820 (.applyForce control-a
821 (Vector3f. (- force) 0 0)
822 (Vector3f. 0 0 0)))
823 (if @move-left?
824 (.applyForce control-a
825 (Vector3f. 0 force 0)
826 (Vector3f. 0 0 0)))
827 (if @move-right?
828 (.applyForce control-a
829 (Vector3f. 0 (- force) 0)
830 (Vector3f. 0 0 0)))
832 (if @roll-left?
833 (.applyForce control-a
834 (Vector3f. 0 0 force)
835 (Vector3f. 0 0 0)))
836 (if @roll-right?
837 (.applyForce control-a
838 (Vector3f. 0 0 (- force))
839 (Vector3f. 0 0 0)))
841 (if (zero? (rem (swap! timer inc) 100))
842 (.attachChild
843 (.getRootNode world)
844 (sphere 0.05 :color ColorRGBA/Yellow
845 :physical? false :position
846 (.getWorldTranslation obj-a)))))
847 )
848 ))
850 (defn transform-trianglesdsd
851 "Transform that converts each vertex in the first triangle
852 into the corresponding vertex in the second triangle."
853 [#^Triangle tri-1 #^Triangle tri-2]
854 (let [in [(.get1 tri-1)
855 (.get2 tri-1)
856 (.get3 tri-1)]
857 out [(.get1 tri-2)
858 (.get2 tri-2)
859 (.get3 tri-2)]]
860 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
861 in* [(.mult translate (in 0))
862 (.mult translate (in 1))
863 (.mult translate (in 2))]
864 final-translation
865 (doto (Matrix4f.)
866 (.setTranslation (out 1)))
868 rotate-1
869 (doto (Matrix3f.)
870 (.fromStartEndVectors
871 (.normalize
872 (.subtract
873 (in* 1) (in* 0)))
874 (.normalize
875 (.subtract
876 (out 1) (out 0)))))
877 in** [(.mult rotate-1 (in* 0))
878 (.mult rotate-1 (in* 1))
879 (.mult rotate-1 (in* 2))]
880 scale-factor-1
881 (.mult
882 (.normalize
883 (.subtract
884 (out 1)
885 (out 0)))
886 (/ (.length
887 (.subtract (out 1)
888 (out 0)))
889 (.length
890 (.subtract (in** 1)
891 (in** 0)))))
892 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
893 in*** [(.mult scale-1 (in** 0))
894 (.mult scale-1 (in** 1))
895 (.mult scale-1 (in** 2))]
901 ]
903 (dorun (map println in))
904 (println)
905 (dorun (map println in*))
906 (println)
907 (dorun (map println in**))
908 (println)
909 (dorun (map println in***))
910 (println)
912 ))))
915 (defn world-setup [joint]
916 (let [joint-position (Vector3f. 0 0 0)
917 joint-rotation
918 (.toRotationMatrix
919 (.mult
920 (doto (Quaternion.)
921 (.fromAngleAxis
922 (* 1 (/ Math/PI 4))
923 (Vector3f. -1 0 0)))
924 (doto (Quaternion.)
925 (.fromAngleAxis
926 (* 1 (/ Math/PI 2))
927 (Vector3f. 0 0 1)))))
928 top-position (.mult joint-rotation (Vector3f. 8 0 0))
930 origin (doto
931 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
932 :position top-position))
933 top (doto
934 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
935 :position top-position)
937 (.addControl
938 (RigidBodyControl.
939 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
940 bottom (doto
941 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
942 :position (Vector3f. 0 0 0))
943 (.addControl
944 (RigidBodyControl.
945 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
946 table (box 10 2 10 :position (Vector3f. 0 -20 0)
947 :color ColorRGBA/Gray :mass 0)
948 a (.getControl top RigidBodyControl)
949 b (.getControl bottom RigidBodyControl)]
951 (cond
952 (= joint :cone)
954 (doto (ConeJoint.
955 a b
956 (world-to-local top joint-position)
957 (world-to-local bottom joint-position)
958 joint-rotation
959 joint-rotation
960 )
963 (.setLimit (* (/ 10) Math/PI)
964 (* (/ 4) Math/PI)
965 0)))
966 [origin top bottom table]))
968 (defn test-joint [joint]
969 (let [[origin top bottom floor] (world-setup joint)
970 control (.getControl top RigidBodyControl)
971 move-up? (atom false)
972 move-down? (atom false)
973 move-left? (atom false)
974 move-right? (atom false)
975 roll-left? (atom false)
976 roll-right? (atom false)
977 timer (atom 0)]
979 (world
980 (nodify [top bottom floor origin])
981 (merge standard-debug-controls
982 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
983 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
984 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
985 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
986 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
987 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
989 (fn [world]
990 (light-up-everything world)
991 (enable-debug world)
992 (set-gravity world (Vector3f. 0 0 0))
993 )
995 (fn [world _]
996 (if (zero? (rem (swap! timer inc) 100))
997 (do
998 ;; (println-repl @timer)
999 (.attachChild (.getRootNode world)
1000 (sphere 0.05 :color ColorRGBA/Yellow
1001 :position (.getWorldTranslation top)
1002 :physical? false))
1003 (.attachChild (.getRootNode world)
1004 (sphere 0.05 :color ColorRGBA/LightGray
1005 :position (.getWorldTranslation bottom)
1006 :physical? false))))
1008 (if @move-up?
1009 (.applyTorque control
1010 (.mult (.getPhysicsRotation control)
1011 (Vector3f. 0 0 10))))
1012 (if @move-down?
1013 (.applyTorque control
1014 (.mult (.getPhysicsRotation control)
1015 (Vector3f. 0 0 -10))))
1016 (if @move-left?
1017 (.applyTorque control
1018 (.mult (.getPhysicsRotation control)
1019 (Vector3f. 0 10 0))))
1020 (if @move-right?
1021 (.applyTorque control
1022 (.mult (.getPhysicsRotation control)
1023 (Vector3f. 0 -10 0))))
1024 (if @roll-left?
1025 (.applyTorque control
1026 (.mult (.getPhysicsRotation control)
1027 (Vector3f. -1 0 0))))
1028 (if @roll-right?
1029 (.applyTorque control
1030 (.mult (.getPhysicsRotation control)
1031 (Vector3f. 1 0 0))))))))
1035 (defprotocol Frame
1036 (frame [this]))
1038 (extend-type BufferedImage
1039 Frame
1040 (frame [image]
1041 (merge
1042 (apply
1043 hash-map
1044 (interleave
1045 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1046 (vector x y)))
1047 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
1048 (let [data (.getRGB image x y)]
1049 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
1050 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
1051 :b (bit-and 0x0000ff data)))))))
1052 {:width (.getWidth image) :height (.getHeight image)})))
1055 (extend-type ImagePlus
1056 Frame
1057 (frame [image+]
1058 (frame (.getBufferedImage image+))))
1061 #+end_src
1064 * COMMENT generate source
1065 #+begin_src clojure :tangle ../src/cortex/silly.clj
1066 <<body-1>>
1067 #+end_src