view org/test-creature.org @ 99:b7a3ba5e879b

made BufferedImage visulation more general
author Robert McIntyre <rlm@mit.edu>
date Sat, 14 Jan 2012 01:07:18 -0700
parents 5b23961433e3
children 940074adc1d5
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
10 * objectives
11 - [ ] get an overall bitmap-like image for touch
12 - [ ] write code to visuliaze this bitmap
13 - [ ] directly change the UV-pixels to show touch sensor activation
14 - [ ] write an explination for why b&w bitmaps for senses is appropiate
15 - [ ] clean up touch code and write visulazation test
16 - [ ] do the same for eyes
18 * Intro
19 So far, I've made the following senses --
20 - Vision
21 - Hearing
22 - Touch
23 - Proprioception
25 And one effector:
26 - Movement
28 However, the code so far has only enabled these senses, but has not
29 actually implemented them. For example, there is still a lot of work
30 to be done for vision. I need to be able to create an /eyeball/ in
31 simulation that can be moved around and see the world from different
32 angles. I also need to determine weather to use log-polar or cartesian
33 for the visual input, and I need to determine how/wether to
34 disceritise the visual input.
36 I also want to be able to visualize both the sensors and the
37 effectors in pretty pictures. This semi-retarted creature will by my
38 first attempt at bringing everything together.
40 * The creature's body
42 Still going to do an eve-like body in blender, but due to problems
43 importing the joints, etc into jMonkeyEngine3, I',m going to do all
44 the connecting here in clojure code, using the names of the individual
45 components and trial and error. Later, I'll maybe make some sort of
46 creature-building modifications to blender that support whatever
47 discreitized senses I'm going to make.
49 #+name: body-1
50 #+begin_src clojure
51 (ns cortex.silly
52 "let's play!"
53 {:author "Robert McIntyre"})
55 ;; TODO remove this!
56 (require 'cortex.import)
57 (cortex.import/mega-import-jme3)
58 (use '(cortex world util body hearing touch vision))
60 (rlm.rlm-commands/help)
61 (import java.awt.image.BufferedImage)
62 (import javax.swing.JPanel)
63 (import javax.swing.SwingUtilities)
64 (import java.awt.Dimension)
65 (import javax.swing.JFrame)
66 (import java.awt.Dimension)
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)))))
98 (defn visualize [points]
102 (defn collapse
103 "Take a set of pairs of integers and collapse them into a
104 contigous bitmap."
105 [points]
106 (let [center [0 0]]
108 )
119 (defn load-bullet []
120 (let [sim (world (Node.) {} no-op no-op)]
121 (.enqueue
122 sim
123 (fn []
124 (.stop sim)))
125 (.start sim)))
127 (defn load-blender-model
128 "Load a .blend file using an asset folder relative path."
129 [^String model]
130 (.loadModel
131 (doto (asset-manager)
132 (.registerLoader BlenderModelLoader (into-array String ["blend"])))
133 model))
135 (defn meta-data [blender-node key]
136 (if-let [data (.getUserData blender-node "properties")]
137 (.findValue data key)
138 nil))
140 (defn blender-to-jme
141 "Convert from Blender coordinates to JME coordinates"
142 [#^Vector3f in]
143 (Vector3f. (.getX in)
144 (.getZ in)
145 (- (.getY in))))
147 (defn jme-to-blender
148 "Convert from JME coordinates to Blender coordinates"
149 [#^Vector3f in]
150 (Vector3f. (.getX in)
151 (- (.getZ in))
152 (.getY in)))
154 (defn joint-targets
155 "Return the two closest two objects to the joint object, ordered
156 from bottom to top according to the joint's rotation."
157 [#^Node parts #^Node joint]
158 ;;(println (meta-data joint "joint"))
159 (.getWorldRotation joint)
160 (loop [radius (float 0.01)]
161 (let [results (CollisionResults.)]
162 (.collideWith
163 parts
164 (BoundingBox. (.getWorldTranslation joint)
165 radius radius radius)
166 results)
167 (let [targets
168 (distinct
169 (map #(.getGeometry %) results))]
170 (if (>= (count targets) 2)
171 (sort-by
172 #(let [v
173 (jme-to-blender
174 (.mult
175 (.inverse (.getWorldRotation joint))
176 (.subtract (.getWorldTranslation %)
177 (.getWorldTranslation joint))))]
178 (println-repl (.getName %) ":" v)
179 (.dot (Vector3f. 1 1 1)
180 v))
181 (take 2 targets))
182 (recur (float (* radius 2))))))))
184 (defn world-to-local
185 "Convert the world coordinates into coordinates relative to the
186 object (i.e. local coordinates), taking into account the rotation
187 of object."
188 [#^Spatial object world-coordinate]
189 (let [out (Vector3f.)]
190 (.worldToLocal object world-coordinate out) out))
192 (defn local-to-world
193 "Convert the local coordinates into coordinates into world relative
194 coordinates"
195 [#^Spatial object local-coordinate]
196 (let [world-coordinate (Vector3f.)]
197 (.localToWorld object local-coordinate world-coordinate)
198 world-coordinate))
201 (defmulti joint-dispatch
202 "Translate blender pseudo-joints into real JME joints."
203 (fn [constraints & _]
204 (:type constraints)))
206 (defmethod joint-dispatch :point
207 [constraints control-a control-b pivot-a pivot-b rotation]
208 (println-repl "creating POINT2POINT joint")
209 (Point2PointJoint.
210 control-a
211 control-b
212 pivot-a
213 pivot-b))
215 (defmethod joint-dispatch :hinge
216 [constraints control-a control-b pivot-a pivot-b rotation]
217 (println-repl "creating HINGE joint")
218 (let [axis
219 (if-let
220 [axis (:axis constraints)]
221 axis
222 Vector3f/UNIT_X)
223 [limit-1 limit-2] (:limit constraints)
224 hinge-axis
225 (.mult
226 rotation
227 (blender-to-jme axis))]
228 (doto
229 (HingeJoint.
230 control-a
231 control-b
232 pivot-a
233 pivot-b
234 hinge-axis
235 hinge-axis)
236 (.setLimit limit-1 limit-2))))
238 (defmethod joint-dispatch :cone
239 [constraints control-a control-b pivot-a pivot-b rotation]
240 (let [limit-xz (:limit-xz constraints)
241 limit-xy (:limit-xy constraints)
242 twist (:twist constraints)]
244 (println-repl "creating CONE joint")
245 (println-repl rotation)
246 (println-repl
247 "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))
248 (println-repl
249 "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))
250 (println-repl
251 "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))
252 (doto
253 (ConeJoint.
254 control-a
255 control-b
256 pivot-a
257 pivot-b
258 rotation
259 rotation)
260 (.setLimit (float limit-xz)
261 (float limit-xy)
262 (float twist)))))
264 (defn connect
265 "here are some examples:
266 {:type :point}
267 {:type :hinge :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}
268 (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)
270 {:type :cone :limit-xz 0]
271 :limit-xy 0]
272 :twist 0]} (use XZY rotation mode in blender!)"
273 [#^Node obj-a #^Node obj-b #^Node joint]
274 (let [control-a (.getControl obj-a RigidBodyControl)
275 control-b (.getControl obj-b RigidBodyControl)
276 joint-center (.getWorldTranslation joint)
277 joint-rotation (.toRotationMatrix (.getWorldRotation joint))
278 pivot-a (world-to-local obj-a joint-center)
279 pivot-b (world-to-local obj-b joint-center)]
281 (if-let [constraints
282 (map-vals
283 eval
284 (read-string
285 (meta-data joint "joint")))]
286 ;; A side-effect of creating a joint registers
287 ;; it with both physics objects which in turn
288 ;; will register the joint with the physics system
289 ;; when the simulation is started.
290 (do
291 (println-repl "creating joint between"
292 (.getName obj-a) "and" (.getName obj-b))
293 (joint-dispatch constraints
294 control-a control-b
295 pivot-a pivot-b
296 joint-rotation))
297 (println-repl "could not find joint meta-data!"))))
299 (defn assemble-creature [#^Node pieces joints]
300 (dorun
301 (map
302 (fn [geom]
303 (let [physics-control
304 (RigidBodyControl.
305 (HullCollisionShape.
306 (.getMesh geom))
307 (if-let [mass (meta-data geom "mass")]
308 (do
309 (println-repl
310 "setting" (.getName geom) "mass to" (float mass))
311 (float mass))
312 (float 1)))]
314 (.addControl geom physics-control)))
315 (filter #(isa? (class %) Geometry )
316 (node-seq pieces))))
317 (dorun
318 (map
319 (fn [joint]
320 (let [[obj-a obj-b]
321 (joint-targets pieces joint)]
322 (connect obj-a obj-b joint)))
323 joints))
324 pieces)
326 (defn blender-creature [blender-path]
327 (let [model (load-blender-model blender-path)
328 joints
329 (if-let [joint-node (.getChild model "joints")]
330 (seq (.getChildren joint-node))
331 (do (println-repl "could not find joints node")
332 []))]
333 (assemble-creature model joints)))
335 (def hand "Models/creature1/one.blend")
337 (def worm "Models/creature1/try-again.blend")
339 (def touch "Models/creature1/touch.blend")
341 (defn worm-model [] (load-blender-model worm))
343 (defn x-ray [#^ColorRGBA color]
344 (doto (Material. (asset-manager)
345 "Common/MatDefs/Misc/Unshaded.j3md")
346 (.setColor "Color" color)
347 (-> (.getAdditionalRenderState)
348 (.setDepthTest false))))
350 (defn test-creature [thing]
351 (let [x-axis
352 (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)
353 y-axis
354 (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)
355 z-axis
356 (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)]
357 (world
358 (nodify [(blender-creature thing)
359 (box 10 2 10 :position (Vector3f. 0 -9 0)
360 :color ColorRGBA/Gray :mass 0)
361 x-axis y-axis z-axis
362 ])
363 standard-debug-controls
364 (fn [world]
365 (light-up-everything world)
366 (enable-debug world)
367 ;;(com.aurellem.capture.Capture/captureVideo
368 ;; world (file-str "/home/r/proj/ai-videos/hand"))
369 (.setTimer world (NanoTimer.))
370 (set-gravity world (Vector3f. 0 0 0))
371 (speed-up world)
372 )
373 no-op
374 ;;(let [timer (atom 0)]
375 ;; (fn [_ _]
376 ;; (swap! timer inc)
377 ;; (if (= (rem @timer 60) 0)
378 ;; (println-repl (float (/ @timer 60))))))
379 )))
381 (defn colorful []
382 (.getChild (worm-model) "worm-21"))
384 (import jme3tools.converters.ImageToAwt)
386 (import ij.ImagePlus)
388 (defn triangle-indices
389 "Get the triangle vertex indices of a given triangle from a given
390 mesh."
391 [#^Mesh mesh triangle-index]
392 (let [indices (int-array 3)]
393 (.getTriangle mesh triangle-index indices)
394 (vec indices)))
396 (defn uv-coord
397 "Get the uv-coordinates of the vertex named by vertex-index"
398 [#^Mesh mesh vertex-index]
399 (let [UV-buffer
400 (.getData
401 (.getBuffer
402 mesh
403 VertexBuffer$Type/TexCoord))]
404 (Vector2f.
405 (.get UV-buffer (* vertex-index 2))
406 (.get UV-buffer (+ 1 (* vertex-index 2))))))
408 (defn tri-uv-coord
409 "Get the uv-cooridnates of the triangle's verticies."
410 [#^Mesh mesh #^Triangle triangle]
411 (map (partial uv-coord mesh)
412 (triangle-indices mesh (.getIndex triangle))))
414 (defn touch-receptor-image
415 "Return the touch-sensor distribution image in ImagePlus format, or
416 nil if it does not exist."
417 [#^Geometry obj]
418 (let [mat (.getMaterial obj)]
419 (if-let [texture-param
420 (.getTextureParam
421 mat
422 MaterialHelper/TEXTURE_TYPE_DIFFUSE)]
423 (let
424 [texture
425 (.getTextureValue texture-param)
426 im (.getImage texture)]
427 (ImagePlus.
428 "UV-map"
429 (ImageToAwt/convert im false false 0))))))
431 (import ij.process.ImageProcessor)
432 (import java.awt.image.BufferedImage)
434 (defprotocol Frame
435 (frame [this]))
437 (extend-type BufferedImage
438 Frame
439 (frame [image]
440 (merge
441 (apply
442 hash-map
443 (interleave
444 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
445 (vector x y)))
446 (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
447 (let [data (.getRGB image x y)]
448 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
449 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
450 :b (bit-and 0x0000ff data)))))))
451 {:width (.getWidth image) :height (.getHeight image)})))
454 (extend-type ImagePlus
455 Frame
456 (frame [image+]
457 (frame (.getBufferedImage image+))))
460 (def white -1)
462 (defn filter-pixels
463 "List the coordinates of all pixels matching pred."
464 {:author "Dylan Holmes"}
465 [pred #^ImageProcessor ip]
466 (let
467 [width (.getWidth ip)
468 height (.getHeight ip)]
469 ((fn accumulate [x y matches]
470 (cond
471 (>= y height) matches
472 (>= x width) (recur 0 (inc y) matches)
473 (pred (.getPixel ip x y))
474 (recur (inc x) y (conj matches (Vector2f. x y)))
475 :else (recur (inc x) y matches)))
476 0 0 [])))
478 (defn white-coordinates
479 "List the coordinates of all the white pixels in an image."
480 [#^ImageProcessor ip]
481 (filter-pixels #(= % white) ip))
483 (defn same-side? [p1 p2 ref p]
484 (<=
485 0
486 (.dot
487 (.cross (.subtract p2 p1) (.subtract p p1))
488 (.cross (.subtract p2 p1) (.subtract ref p1)))))
491 (defn triangle->matrix4f
492 "Converts the triangle into a 4x4 matrix of vertices: The first
493 three columns contain the vertices of the triangle; the last
494 contains the unit normal of the triangle. The bottom row is filled
495 with 1s."
496 [#^Triangle t]
497 (let [mat (Matrix4f.)
498 [vert-1 vert-2 vert-3]
499 ((comp vec map) #(.get t %) (range 3))
500 unit-normal (do (.calculateNormal t)(.getNormal t))
501 vertices [vert-1 vert-2 vert-3 unit-normal]]
503 (dorun
504 (for [row (range 4) col (range 3)]
505 (do
506 (.set mat col row (.get (vertices row)col))
507 (.set mat 3 row 1))))
508 mat))
510 (defn triangle-transformation
511 "Returns the affine transformation that converts each vertex in the
512 first triangle into the corresponding vertex in the second
513 triangle."
514 [#^Triangle tri-1 #^Triangle tri-2]
515 (.mult
516 (triangle->matrix4f tri-2)
517 (.invert (triangle->matrix4f tri-1))))
519 (def death (Triangle.
520 (Vector3f. 1 1 1)
521 (Vector3f. 1 2 3)
522 (Vector3f. 5 6 7)))
524 (def death-2 (Triangle.
525 (Vector3f. 2 2 2)
526 (Vector3f. 1 1 1)
527 (Vector3f. 0 1 0)))
529 (defn vector2f->vector3f [v]
530 (Vector3f. (.getX v) (.getY v) 0))
533 (extend-type Triangle
534 Textual
535 (text [t]
536 (println "Triangle: " \newline (.get1 t) \newline
537 (.get2 t) \newline (.get3 t))))
540 (defn map-triangle [f #^Triangle tri]
541 (Triangle.
542 (f 0 (.get1 tri))
543 (f 1 (.get2 tri))
544 (f 2 (.get3 tri))))
546 (defn triangle-seq [#^Triangle tri]
547 [(.get1 tri) (.get2 tri) (.get3 tri)])
549 (defn vector3f-seq [#^Vector3f v]
550 [(.getX v) (.getY v) (.getZ v)])
552 (defn inside-triangle?
553 "Is the point inside the triangle? Now what do we do?
554 You might want to hold on there"
555 {:author "Dylan Holmes"}
556 [tri p]
557 (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
558 (and
559 (same-side? vert-1 vert-2 vert-3 p)
560 (same-side? vert-2 vert-3 vert-1 p)
561 (same-side? vert-3 vert-1 vert-2 p))))
563 (defn uv-triangle
564 "Convert the mesh triangle into the cooresponding triangle in
565 UV-space. Z-component of these triangles is always zero."
566 [#^Mesh mesh #^Triangle tri]
567 (apply #(Triangle. %1 %2 %3)
568 (map vector2f->vector3f
569 (tri-uv-coord mesh tri))))
571 (defn pixel-triangle
572 "Convert the mesh triange into the corresponding triangle in
573 UV-pixel-space. Z compenent will be zero."
574 [#^Mesh mesh #^Triangle tri width height]
575 (map-triangle (fn [_ v]
576 (Vector3f. (* width (.getX v))
577 (* height (.getY v))
578 0))
579 (uv-triangle mesh tri)))
581 (def rasterize pixel-triangle)
584 (defn triangle-bounds
585 "Dimensions of the bounding square of the triangle in the form
586 [x y width height].
587 Assumes that the triangle lies in the XY plane."
588 [#^Triangle tri]
589 (let [verts (map vector3f-seq (triangle-seq tri))
590 x (apply min (map first verts))
591 y (apply min (map second verts))]
593 [x y
594 (- (apply max (map first verts)) x)
595 (- (apply max (map second verts)) y)
596 ]))
599 (defn locate-feelers
600 "Search the geometry's tactile UV image for touch sensors, returning
601 their positions in geometry-relative coordinates."
602 [#^Geometry geo]
603 (if-let [image (touch-receptor-image geo)]
604 (let [mesh (.getMesh geo)
605 tris (triangles geo)
608 width (.getWidth image)
609 height (.getHeight image)
611 ;; for each triangle
612 sensor-coords
613 (fn [tri]
614 ;; translate triangle to uv-pixel-space
615 (let [uv-tri
616 (pixel-triangle mesh tri width height)
617 bounds (vec (triangle-bounds uv-tri))]
619 ;; get that part of the picture
621 (apply #(.setRoi image %1 %2 %3 %4) bounds)
622 (let [cutout (.crop (.getProcessor image))
623 ;; extract white pixels inside triangle
624 cutout-tri
625 (map-triangle
626 (fn [_ v]
627 (.subtract
628 v
629 (Vector3f. (bounds 0) (bounds 1) (float 0))))
630 uv-tri)
631 whites (filter (partial inside-triangle? cutout-tri)
632 (map vector2f->vector3f
633 (white-coordinates cutout)))
634 ;; translate pixel coordinates to world-space
635 transform (triangle-transformation cutout-tri tri)]
636 (map #(.mult transform %) whites))))]
637 (vec (map sensor-coords tris)))
638 (repeat (count (triangles geo)) [])))
640 (defn enable-touch [#^Geometry geo]
641 (let [feeler-coords (locate-feelers geo)
642 tris (triangles geo)
643 limit 0.1]
644 (fn [node]
645 (let [sensor-origins
646 (map
647 #(map (partial local-to-world geo) %)
648 feeler-coords)
649 triangle-normals
650 (map (partial get-ray-direction geo)
651 tris)
652 rays
653 (flatten
654 (map (fn [origins norm]
655 (map #(doto (Ray. % norm)
656 (.setLimit limit)) origins))
657 sensor-origins triangle-normals))]
658 (for [ray rays]
659 (do
660 (let [results (CollisionResults.)]
661 (.collideWith node ray results)
662 (let [touch-objects
663 (set
664 (filter #(not (= geo %))
665 (map #(.getGeometry %) results)))]
666 (if (> (count touch-objects) 0)
667 1 0)))))))))
669 (defn touch [#^Node pieces]
670 (let [touch-components
671 (map enable-touch
672 (filter #(isa? (class %) Geometry)
673 (node-seq pieces)))]
674 (fn [node]
675 (reduce into [] (map #(% node) touch-components)))))
677 (defn all-names []
678 (concat
679 (re-split #"\n" (slurp (file-str
680 "/home/r/proj/names/dist.female.first")))
681 (re-split #"\n" (slurp (file-str
682 "/home/r/proj/names/dist.male.first")))
683 (re-split #"\n" (slurp (file-str
684 "/home/r/proj/names/dist.all.last")))))
694 (defrecord LulzLoader [])
695 (defprotocol Lulzable (load-lulz [this]))
696 (extend-type LulzLoader
697 Lulzable
698 (load-lulz [this] (println "the lulz have arrived!")))
701 (defn world-setup [joint]
702 (let [joint-position (Vector3f. 0 0 0)
703 joint-rotation
704 (.toRotationMatrix
705 (.mult
706 (doto (Quaternion.)
707 (.fromAngleAxis
708 (* 1 (/ Math/PI 4))
709 (Vector3f. -1 0 0)))
710 (doto (Quaternion.)
711 (.fromAngleAxis
712 (* 1 (/ Math/PI 2))
713 (Vector3f. 0 0 1)))))
714 top-position (.mult joint-rotation (Vector3f. 8 0 0))
716 origin (doto
717 (sphere 0.1 :physical? false :color ColorRGBA/Cyan
718 :position top-position))
719 top (doto
720 (sphere 0.1 :physical? false :color ColorRGBA/Yellow
721 :position top-position)
723 (.addControl
724 (RigidBodyControl.
725 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))
726 bottom (doto
727 (sphere 0.1 :physical? false :color ColorRGBA/DarkGray
728 :position (Vector3f. 0 0 0))
729 (.addControl
730 (RigidBodyControl.
731 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))
732 table (box 10 2 10 :position (Vector3f. 0 -20 0)
733 :color ColorRGBA/Gray :mass 0)
734 a (.getControl top RigidBodyControl)
735 b (.getControl bottom RigidBodyControl)]
737 (cond
738 (= joint :cone)
740 (doto (ConeJoint.
741 a b
742 (world-to-local top joint-position)
743 (world-to-local bottom joint-position)
744 joint-rotation
745 joint-rotation
746 )
749 (.setLimit (* (/ 10) Math/PI)
750 (* (/ 4) Math/PI)
751 0)))
752 [origin top bottom table]))
754 (defn test-joint [joint]
755 (let [[origin top bottom floor] (world-setup joint)
756 control (.getControl top RigidBodyControl)
757 move-up? (atom false)
758 move-down? (atom false)
759 move-left? (atom false)
760 move-right? (atom false)
761 roll-left? (atom false)
762 roll-right? (atom false)
763 timer (atom 0)]
765 (world
766 (nodify [top bottom floor origin])
767 (merge standard-debug-controls
768 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
769 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
770 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
771 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
772 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
773 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
775 (fn [world]
776 (light-up-everything world)
777 (enable-debug world)
778 (set-gravity world (Vector3f. 0 0 0))
779 )
781 (fn [world _]
782 (if (zero? (rem (swap! timer inc) 100))
783 (do
784 ;; (println-repl @timer)
785 (.attachChild (.getRootNode world)
786 (sphere 0.05 :color ColorRGBA/Yellow
787 :position (.getWorldTranslation top)
788 :physical? false))
789 (.attachChild (.getRootNode world)
790 (sphere 0.05 :color ColorRGBA/LightGray
791 :position (.getWorldTranslation bottom)
792 :physical? false))))
794 (if @move-up?
795 (.applyTorque control
796 (.mult (.getPhysicsRotation control)
797 (Vector3f. 0 0 10))))
798 (if @move-down?
799 (.applyTorque control
800 (.mult (.getPhysicsRotation control)
801 (Vector3f. 0 0 -10))))
802 (if @move-left?
803 (.applyTorque control
804 (.mult (.getPhysicsRotation control)
805 (Vector3f. 0 10 0))))
806 (if @move-right?
807 (.applyTorque control
808 (.mult (.getPhysicsRotation control)
809 (Vector3f. 0 -10 0))))
810 (if @roll-left?
811 (.applyTorque control
812 (.mult (.getPhysicsRotation control)
813 (Vector3f. -1 0 0))))
814 (if @roll-right?
815 (.applyTorque control
816 (.mult (.getPhysicsRotation control)
817 (Vector3f. 1 0 0))))))))
820 (defn locate-feelers*
821 "Search the geometry's tactile UV image for touch sensors, returning
822 their positions in geometry-relative coordinates."
823 [#^Geometry geo]
824 (let [uv-image (touch-receptor-image geo)
825 width (.getWidth uv-image)
826 height (.getHeight uv-image)
828 mesh (.getMesh geo)
829 mesh-tris (triangles geo)
831 ;; for each triangle
832 sensor-coords
833 (fn [tri]
834 ;; translate triangle to uv-pixel-space
835 (let [uv-tri
836 (rasterize mesh tri width height)
837 bounds (vec (triangle-bounds uv-tri))]
839 ;; get that part of the picture
841 (apply (partial (memfn setRoi) uv-image) bounds)
842 (let [cutout (.crop (.getProcessor uv-image))
843 ;; extract white pixels inside triangle
844 cutout-tri
845 (map-triangle
846 (fn [_ v]
847 (.subtract
848 v
849 (Vector3f. (bounds 0) (bounds 1) (float 0))))
850 uv-tri)
851 whites (filter (partial inside-triangle? cutout-tri)
852 (map vector2f->vector3f
853 (white-coordinates cutout)))
854 ;; translate pixel coordinates to world-space
855 transform (triangle-transformation cutout-tri tri)]
856 (map #(.mult transform %) whites))))]
860 (for [mesh-tri mesh-tris]
862 (let [uv-tri (rasterize mesh mesh-tri width height)
863 bounding-box (vec (triangle-bounds uv-tri))]
864 (apply (partial (memfn setRoi) uv-image) bounding-box)
865 ))
866 (vec (map sensor-coords mesh-tris))))
869 (defn tactile-coords [#^Geometry obj]
870 (let [mesh (.getMesh obj)
871 num-triangles (.getTriangleCount mesh)
872 num-verticies (.getVertexCount mesh)
873 uv-coord (partial uv-coord mesh)
874 triangle-indices (partial triangle-indices mesh)
875 receptors (touch-receptor-image obj)
876 tris (triangles obj)
877 ]
878 (map
879 (fn [[tri-1 tri-2 tri-3]]
880 (let [width (.getWidth receptors)
881 height (.getHeight receptors)
882 uv-1 (uv-coord tri-1)
883 uv-2 (uv-coord tri-2)
884 uv-3 (uv-coord tri-3)
885 x-coords (map #(.getX %) [uv-1 uv-2 uv-3])
886 y-coords (map #(.getY %) [uv-1 uv-2 uv-3])
887 max-x (Math/ceil (* width (apply max x-coords)))
888 min-x (Math/floor (* width (apply min x-coords)))
889 max-y (Math/ceil (* height (apply max y-coords)))
890 min-y (Math/floor (* height (apply min y-coords)))
892 image-1 (Vector2f. (* width (.getX uv-1))
893 (* height (.getY uv-1)))
894 image-2 (Vector2f. (* width (.getX uv-2))
895 (* height (.getY uv-2)))
896 image-3 (Vector2f. (* width (.getX uv-3))
897 (* height (.getY uv-3)))
898 left-corner
899 (Vector2f. min-x min-y)
900 ]
902 (.setRoi receptors min-x min-y (- max-x min-x) (- max-y min-y))
903 (let [processor (.crop (.getProcessor receptors))]
904 (map
905 #(.add left-corner %)
907 (filter
908 (partial
909 inside-triangle?
910 (.subtract image-1 left-corner)
911 (.subtract image-2 left-corner)
912 (.subtract image-3 left-corner))
913 (white-coordinates processor))))
914 )) (map triangle-indices (range num-triangles)))))
916 #+end_src
918 #+results: body-1
919 : #'cortex.silly/test-joint
922 * COMMENT purgatory
923 #+begin_src clojure
924 (defn bullet-trans []
925 (let [obj-a (sphere 0.5 :color ColorRGBA/Red
926 :position (Vector3f. -10 5 0))
927 obj-b (sphere 0.5 :color ColorRGBA/Blue
928 :position (Vector3f. -10 -5 0)
929 :mass 0)
930 control-a (.getControl obj-a RigidBodyControl)
931 control-b (.getControl obj-b RigidBodyControl)
932 swivel
933 (.toRotationMatrix
934 (doto (Quaternion.)
935 (.fromAngleAxis (/ Math/PI 2)
936 Vector3f/UNIT_X)))]
937 (doto
938 (ConeJoint.
939 control-a control-b
940 (Vector3f. 0 5 0)
941 (Vector3f. 0 -5 0)
942 swivel swivel)
943 (.setLimit (* 0.6 (/ Math/PI 4))
944 (/ Math/PI 4)
945 (* Math/PI 0.8)))
946 (world (nodify
947 [obj-a obj-b])
948 standard-debug-controls
949 enable-debug
950 no-op)))
953 (defn bullet-trans* []
954 (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red
955 :position (Vector3f. 5 0 0)
956 :mass 90)
957 obj-b (sphere 0.5 :color ColorRGBA/Blue
958 :position (Vector3f. -5 0 0)
959 :mass 0)
960 control-a (.getControl obj-a RigidBodyControl)
961 control-b (.getControl obj-b RigidBodyControl)
962 move-up? (atom nil)
963 move-down? (atom nil)
964 move-left? (atom nil)
965 move-right? (atom nil)
966 roll-left? (atom nil)
967 roll-right? (atom nil)
968 force 100
969 swivel
970 (.toRotationMatrix
971 (doto (Quaternion.)
972 (.fromAngleAxis (/ Math/PI 2)
973 Vector3f/UNIT_X)))
974 x-move
975 (doto (Matrix3f.)
976 (.fromStartEndVectors Vector3f/UNIT_X
977 (.normalize (Vector3f. 1 1 0))))
979 timer (atom 0)]
980 (doto
981 (ConeJoint.
982 control-a control-b
983 (Vector3f. -8 0 0)
984 (Vector3f. 2 0 0)
985 ;;swivel swivel
986 ;;Matrix3f/IDENTITY Matrix3f/IDENTITY
987 x-move Matrix3f/IDENTITY
988 )
989 (.setCollisionBetweenLinkedBodys false)
990 (.setLimit (* 1 (/ Math/PI 4)) ;; twist
991 (* 1 (/ Math/PI 4)) ;; swing span in X-Y plane
992 (* 0 (/ Math/PI 4)))) ;; swing span in Y-Z plane
993 (world (nodify
994 [obj-a obj-b])
995 (merge standard-debug-controls
996 {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))
997 "key-t" (fn [_ pressed?] (reset! move-down? pressed?))
998 "key-f" (fn [_ pressed?] (reset! move-left? pressed?))
999 "key-g" (fn [_ pressed?] (reset! move-right? pressed?))
1000 "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))
1001 "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})
1003 (fn [world]
1004 (enable-debug world)
1005 (set-gravity world Vector3f/ZERO)
1008 (fn [world _]
1010 (if @move-up?
1011 (.applyForce control-a
1012 (Vector3f. force 0 0)
1013 (Vector3f. 0 0 0)))
1014 (if @move-down?
1015 (.applyForce control-a
1016 (Vector3f. (- force) 0 0)
1017 (Vector3f. 0 0 0)))
1018 (if @move-left?
1019 (.applyForce control-a
1020 (Vector3f. 0 force 0)
1021 (Vector3f. 0 0 0)))
1022 (if @move-right?
1023 (.applyForce control-a
1024 (Vector3f. 0 (- force) 0)
1025 (Vector3f. 0 0 0)))
1027 (if @roll-left?
1028 (.applyForce control-a
1029 (Vector3f. 0 0 force)
1030 (Vector3f. 0 0 0)))
1031 (if @roll-right?
1032 (.applyForce control-a
1033 (Vector3f. 0 0 (- force))
1034 (Vector3f. 0 0 0)))
1036 (if (zero? (rem (swap! timer inc) 100))
1037 (.attachChild
1038 (.getRootNode world)
1039 (sphere 0.05 :color ColorRGBA/Yellow
1040 :physical? false :position
1041 (.getWorldTranslation obj-a)))))
1043 ))
1045 (defn transform-trianglesdsd
1046 "Transform that converts each vertex in the first triangle
1047 into the corresponding vertex in the second triangle."
1048 [#^Triangle tri-1 #^Triangle tri-2]
1049 (let [in [(.get1 tri-1)
1050 (.get2 tri-1)
1051 (.get3 tri-1)]
1052 out [(.get1 tri-2)
1053 (.get2 tri-2)
1054 (.get3 tri-2)]]
1055 (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))
1056 in* [(.mult translate (in 0))
1057 (.mult translate (in 1))
1058 (.mult translate (in 2))]
1059 final-translation
1060 (doto (Matrix4f.)
1061 (.setTranslation (out 1)))
1063 rotate-1
1064 (doto (Matrix3f.)
1065 (.fromStartEndVectors
1066 (.normalize
1067 (.subtract
1068 (in* 1) (in* 0)))
1069 (.normalize
1070 (.subtract
1071 (out 1) (out 0)))))
1072 in** [(.mult rotate-1 (in* 0))
1073 (.mult rotate-1 (in* 1))
1074 (.mult rotate-1 (in* 2))]
1075 scale-factor-1
1076 (.mult
1077 (.normalize
1078 (.subtract
1079 (out 1)
1080 (out 0)))
1081 (/ (.length
1082 (.subtract (out 1)
1083 (out 0)))
1084 (.length
1085 (.subtract (in** 1)
1086 (in** 0)))))
1087 scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))
1088 in*** [(.mult scale-1 (in** 0))
1089 (.mult scale-1 (in** 1))
1090 (.mult scale-1 (in** 2))]
1098 (dorun (map println in))
1099 (println)
1100 (dorun (map println in*))
1101 (println)
1102 (dorun (map println in**))
1103 (println)
1104 (dorun (map println in***))
1105 (println)
1107 ))))
1112 #+end_src
1115 * COMMENT generate source
1116 #+begin_src clojure :tangle ../src/cortex/silly.clj
1117 <<body-1>>
1118 #+end_src