changeset 177:5af4ebe72b97

renamed skin.org to touch.org
author Robert McIntyre <rlm@mit.edu>
date Sat, 04 Feb 2012 06:54:14 -0700
parents 026f69582022
children 6fba17a74a57
files org/skin.org org/touch.org
diffstat 2 files changed, 488 insertions(+), 490 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/org/skin.org	Sat Feb 04 06:52:47 2012 -0700
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,490 +0,0 @@
     1.4 -#+title: Simulated Sense of Touch
     1.5 -#+author: Robert McIntyre
     1.6 -#+email: rlm@mit.edu
     1.7 -#+description: Simulated touch for AI research using JMonkeyEngine and clojure.
     1.8 -#+keywords: simulation, tactile sense, jMonkeyEngine3, clojure
     1.9 -#+SETUPFILE: ../../aurellem/org/setup.org
    1.10 -#+INCLUDE: ../../aurellem/org/level-0.org
    1.11 -
    1.12 -
    1.13 -* Touch
    1.14 -
    1.15 -My creatures need to be able to feel their environments. The idea here
    1.16 -is to create thousands of small /touch receptors/ along the geometries
    1.17 -which make up the creature's body. The number of touch receptors in a
    1.18 -given area is determined by how complicated that area is, as
    1.19 -determined by the total number of triangles in that region. This way,
    1.20 -complicated regions like the hands/face, etc. get more touch receptors
    1.21 -than simpler areas of the body.
    1.22 -
    1.23 -#+name: skin-main
    1.24 -#+begin_src clojure
    1.25 -(ns cortex.touch
    1.26 -  "Simulate the sense of touch in jMonkeyEngine3. Enables any Geometry
    1.27 -  to be outfitted with touch sensors with density proportional to the
    1.28 -  density of triangles along the surface of the Geometry. Enables a
    1.29 -  Geometry to know what parts of itself are touching nearby objects."
    1.30 -  {:author "Robert McIntyre"}
    1.31 -  (:use (cortex world util sense))
    1.32 -  (:import com.jme3.scene.Geometry)
    1.33 -  (:import com.jme3.collision.CollisionResults)
    1.34 -  (:import jme3tools.converters.ImageToAwt)
    1.35 -  (:import (com.jme3.math Triangle Vector3f Ray)))
    1.36 -   
    1.37 -(use 'clojure.contrib.def)
    1.38 -(cortex.import/mega-import-jme3)
    1.39 -
    1.40 -(defn triangles
    1.41 -  "Return a sequence of all the Triangles which compose a given
    1.42 -  Geometry." 
    1.43 -  [#^Geometry geom]
    1.44 -  (let
    1.45 -      [mesh (.getMesh geom)
    1.46 -       triangles (transient [])]
    1.47 -    (dorun
    1.48 -     (for [n (range (.getTriangleCount mesh))]
    1.49 -       (let [tri (Triangle.)]
    1.50 -         (.getTriangle mesh n tri)
    1.51 -        ;; (.calculateNormal tri)
    1.52 -        ;; (.calculateCenter tri)
    1.53 -         (conj! triangles tri))))
    1.54 -    (persistent! triangles)))
    1.55 -   
    1.56 -(defn get-ray-origin
    1.57 -  "Return the origin which a Ray would have to have to be in the exact
    1.58 -  center of a particular Triangle in the Geometry in World
    1.59 -  Coordinates."
    1.60 -  [geom tri]
    1.61 -  (let [new (Vector3f.)]
    1.62 -    (.calculateCenter tri)
    1.63 -    (.localToWorld geom (.getCenter tri) new) new))
    1.64 -
    1.65 -(defn get-ray-direction
    1.66 -  "Return the direction which a Ray would have to have to be to point
    1.67 -  normal to the Triangle, in coordinates relative to the center of the
    1.68 -  Triangle."
    1.69 -  [geom tri]
    1.70 -  (let [n+c (Vector3f.)]
    1.71 -    (.calculateNormal tri)
    1.72 -    (.calculateCenter tri)
    1.73 -    (.localToWorld
    1.74 -     geom
    1.75 -     (.add (.getCenter tri) (.getNormal tri)) n+c)
    1.76 -    (.subtract n+c (get-ray-origin geom tri))))
    1.77 -
    1.78 -;; Every Mesh has many triangles, each with its own index.
    1.79 -;; Every vertex has its own index as well.
    1.80 -
    1.81 -(defn tactile-sensor-image
    1.82 -  "Return the touch-sensor distribution image in BufferedImage format,
    1.83 -   or nil if it does not exist."
    1.84 -  [#^Geometry obj]
    1.85 -  (if-let [image-path (meta-data obj "touch")]
    1.86 -    (ImageToAwt/convert
    1.87 -     (.getImage
    1.88 -      (.loadTexture
    1.89 -       (asset-manager)
    1.90 -       image-path))
    1.91 -    false false 0)))
    1.92 -     
    1.93 -
    1.94 -
    1.95 -(defn triangle
    1.96 -  "Get the triangle specified by triangle-index from the mesh within
    1.97 -  bounds."
    1.98 -  [#^Mesh mesh triangle-index]
    1.99 -  (let [scratch (Triangle.)]
   1.100 -    (.getTriangle mesh triangle-index scratch)
   1.101 -    scratch))
   1.102 -
   1.103 -(defn triangle-vertex-indices
   1.104 -  "Get the triangle vertex indices of a given triangle from a given
   1.105 -   mesh."
   1.106 -  [#^Mesh mesh triangle-index]
   1.107 -  (let [indices (int-array 3)]
   1.108 -    (.getTriangle mesh triangle-index indices)
   1.109 -    (vec indices)))
   1.110 -
   1.111 -(defn vertex-UV-coord
   1.112 -  "Get the uv-coordinates of the vertex named by vertex-index"
   1.113 -  [#^Mesh mesh vertex-index]
   1.114 -  (let [UV-buffer
   1.115 -        (.getData
   1.116 -         (.getBuffer
   1.117 -          mesh
   1.118 -          VertexBuffer$Type/TexCoord))]
   1.119 -    [(.get UV-buffer (* vertex-index 2))
   1.120 -     (.get UV-buffer (+ 1 (* vertex-index 2)))]))
   1.121 -
   1.122 -(defn triangle-UV-coord
   1.123 -  "Get the uv-cooridnates of the triangle's verticies."
   1.124 -  [#^Mesh mesh width height triangle-index]
   1.125 -  (map (fn [[u v]] (vector (* width u) (* height v)))
   1.126 -       (map (partial vertex-UV-coord mesh)
   1.127 -            (triangle-vertex-indices mesh triangle-index))))
   1.128 -  
   1.129 -(defn same-side?
   1.130 -  "Given the points p1 and p2 and the reference point ref, is point p
   1.131 -  on the same side of the line that goes through p1 and p2 as ref is?" 
   1.132 -  [p1 p2 ref p]
   1.133 -  (<=
   1.134 -   0
   1.135 -   (.dot 
   1.136 -    (.cross (.subtract p2 p1) (.subtract p p1))
   1.137 -    (.cross (.subtract p2 p1) (.subtract ref p1)))))
   1.138 -
   1.139 -(defn triangle-seq [#^Triangle tri]
   1.140 -  [(.get1 tri) (.get2 tri) (.get3 tri)])
   1.141 -
   1.142 -(defn vector3f-seq [#^Vector3f v]
   1.143 -  [(.getX v) (.getY v) (.getZ v)])
   1.144 -
   1.145 -(defn inside-triangle?
   1.146 -  "Is the point inside the triangle?"
   1.147 -  {:author "Dylan Holmes"}
   1.148 -  [#^Triangle tri #^Vector3f p]
   1.149 -  (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
   1.150 -    (and
   1.151 -     (same-side? vert-1 vert-2 vert-3 p)
   1.152 -     (same-side? vert-2 vert-3 vert-1 p)
   1.153 -     (same-side? vert-3 vert-1 vert-2 p))))
   1.154 -
   1.155 -(defn triangle->matrix4f
   1.156 -  "Converts the triangle into a 4x4 matrix: The first three columns
   1.157 -   contain the vertices of the triangle; the last contains the unit
   1.158 -   normal of the triangle. The bottom row is filled with 1s."
   1.159 -  [#^Triangle t]
   1.160 -  (let [mat (Matrix4f.)
   1.161 -        [vert-1 vert-2 vert-3]
   1.162 -        ((comp vec map) #(.get t %) (range 3))
   1.163 -        unit-normal (do (.calculateNormal t)(.getNormal t))
   1.164 -        vertices [vert-1 vert-2 vert-3 unit-normal]]
   1.165 -    (dorun 
   1.166 -     (for [row (range 4) col (range 3)]
   1.167 -       (do
   1.168 -         (.set mat col row (.get (vertices row)col))
   1.169 -         (.set mat 3 row 1))))
   1.170 -    mat))
   1.171 -
   1.172 -(defn triangle-transformation
   1.173 -  "Returns the affine transformation that converts each vertex in the
   1.174 -   first triangle into the corresponding vertex in the second
   1.175 -   triangle."
   1.176 -  [#^Triangle tri-1 #^Triangle tri-2]
   1.177 -  (.mult 
   1.178 -   (triangle->matrix4f tri-2)
   1.179 -   (.invert (triangle->matrix4f tri-1))))
   1.180 -
   1.181 -(defn point->vector2f [[u v]]
   1.182 -  (Vector2f. u v))
   1.183 -
   1.184 -(defn vector2f->vector3f [v]
   1.185 -  (Vector3f. (.getX v) (.getY v) 0))
   1.186 -
   1.187 -(defn map-triangle [f #^Triangle tri]
   1.188 -  (Triangle.
   1.189 -   (f 0 (.get1 tri))
   1.190 -   (f 1 (.get2 tri))
   1.191 -   (f 2 (.get3 tri))))
   1.192 -
   1.193 -(defn points->triangle
   1.194 -  "Convert a list of points into a triangle."
   1.195 -  [points]
   1.196 -  (apply #(Triangle. %1 %2 %3)
   1.197 -         (map (fn [point]
   1.198 -                (let [point (vec point)]
   1.199 -                  (Vector3f. (get point 0 0)
   1.200 -                             (get point 1 0)
   1.201 -                             (get point 2 0))))
   1.202 -              (take 3 points))))
   1.203 -
   1.204 -(defn convex-bounds
   1.205 -  ;;dylan
   1.206 -  "Returns the smallest square containing the given
   1.207 -vertices, as a vector of integers [left top width height]."
   1.208 - ;; "Dimensions of the smallest integer bounding square of the list of
   1.209 - ;;  2D verticies in the form: [x y width height]."
   1.210 -  [uv-verts]
   1.211 -  (let [xs (map first uv-verts)
   1.212 -        ys (map second uv-verts)
   1.213 -        x0 (Math/floor (apply min xs))
   1.214 -        y0 (Math/floor (apply min ys))
   1.215 -        x1 (Math/ceil (apply max xs))
   1.216 -        y1 (Math/ceil (apply max ys))]
   1.217 -    [x0 y0 (- x1 x0) (- y1 y0)]))
   1.218 -
   1.219 -(defn sensors-in-triangle
   1.220 -  ;;dylan
   1.221 -  "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
   1.222 -  ;;"Find the locations of the touch sensors within a triangle in both
   1.223 -  ;; UV and gemoetry relative coordinates."
   1.224 -  [image mesh tri-index]
   1.225 -  (let [width (.getWidth image)
   1.226 -        height (.getHeight image)
   1.227 -        UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
   1.228 -        bounds (convex-bounds UV-vertex-coords)
   1.229 -        
   1.230 -        cutout-triangle (points->triangle UV-vertex-coords)
   1.231 -        UV-sensor-coords
   1.232 -        (filter (comp (partial inside-triangle? cutout-triangle)
   1.233 -                      (fn [[u v]] (Vector3f. u v 0)))
   1.234 -                (white-coordinates image bounds))
   1.235 -        UV->geometry (triangle-transformation
   1.236 -                      cutout-triangle
   1.237 -                      (triangle mesh tri-index))
   1.238 -        geometry-sensor-coords
   1.239 -        (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
   1.240 -             UV-sensor-coords)]
   1.241 -  {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
   1.242 -
   1.243 -(defn-memo locate-feelers
   1.244 -  "Search the geometry's tactile UV image for touch sensors, returning
   1.245 -  their positions in geometry-relative coordinates."
   1.246 -  [#^Geometry geo]
   1.247 -  (let [mesh (.getMesh geo)
   1.248 -        num-triangles (.getTriangleCount mesh)]
   1.249 -    (if-let [image (tactile-sensor-image geo)]
   1.250 -      (map
   1.251 -       (partial sensors-in-triangle image mesh)
   1.252 -       (range num-triangles))
   1.253 -      (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
   1.254 -
   1.255 -
   1.256 -
   1.257 -(defn-memo touch-topology [#^Gemoetry geo]
   1.258 -  (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
   1.259 -
   1.260 -(defn-memo feeler-coordinates [#^Geometry geo]
   1.261 -  (vec (map :geometry (locate-feelers geo))))
   1.262 -
   1.263 -(defn enable-touch [#^Geometry geo]
   1.264 -  (let [feeler-coords (feeler-coordinates geo)
   1.265 -        tris (triangles geo)
   1.266 -        limit 0.1
   1.267 -        ;;results (CollisionResults.)
   1.268 -        ]
   1.269 -    (if (empty? (touch-topology geo))
   1.270 -      nil
   1.271 -      (fn [node]
   1.272 -        (let [sensor-origins 
   1.273 -              (map
   1.274 -               #(map (partial local-to-world geo) %)
   1.275 -               feeler-coords)
   1.276 -              triangle-normals 
   1.277 -              (map (partial get-ray-direction geo)
   1.278 -                   tris)
   1.279 -              rays
   1.280 -              (flatten
   1.281 -               (map (fn [origins norm]
   1.282 -                      (map #(doto (Ray. % norm)
   1.283 -                              (.setLimit limit)) origins))
   1.284 -                    sensor-origins triangle-normals))]
   1.285 -          (vector
   1.286 -           (touch-topology geo)
   1.287 -           (vec
   1.288 -            (for [ray rays]
   1.289 -              (do
   1.290 -                (let [results (CollisionResults.)]
   1.291 -                  (.collideWith node ray results)
   1.292 -                  (let [touch-objects
   1.293 -                        (filter #(not (= geo (.getGeometry %)))
   1.294 -                                results)]
   1.295 -                    (- 255
   1.296 -                       (if (empty? touch-objects) 255
   1.297 -                           (rem 
   1.298 -                            (int
   1.299 -                             (* 255 (/ (.getDistance
   1.300 -                                        (first touch-objects)) limit)))
   1.301 -                            256))))))))))))))
   1.302 -                         
   1.303 -  
   1.304 -(defn touch [#^Node pieces]
   1.305 -  (filter (comp not nil?)
   1.306 -          (map enable-touch
   1.307 -               (filter #(isa? (class %) Geometry)
   1.308 -                       (node-seq pieces)))))
   1.309 -
   1.310 -
   1.311 -#+end_src
   1.312 -
   1.313 -
   1.314 -* Example
   1.315 -
   1.316 -#+name: touch-test
   1.317 -#+begin_src clojure 
   1.318 -(ns cortex.test.touch
   1.319 -  (:use (cortex world util touch))
   1.320 -  (:import
   1.321 -   com.jme3.scene.shape.Sphere
   1.322 -   com.jme3.math.ColorRGBA
   1.323 -   com.jme3.math.Vector3f
   1.324 -   com.jme3.material.RenderState$BlendMode
   1.325 -   com.jme3.renderer.queue.RenderQueue$Bucket
   1.326 -   com.jme3.scene.shape.Box
   1.327 -   com.jme3.scene.Node))
   1.328 -
   1.329 -(defn ray-origin-debug
   1.330 -  [ray color]
   1.331 -  (make-shape
   1.332 -   (assoc base-shape
   1.333 -     :shape (Sphere. 5 5 0.05)
   1.334 -     :name "arrow"
   1.335 -     :color color
   1.336 -     :texture false
   1.337 -     :physical? false
   1.338 -     :position
   1.339 -     (.getOrigin ray))))
   1.340 -
   1.341 -(defn ray-debug [ray color]
   1.342 -  (make-shape
   1.343 -   (assoc
   1.344 -       base-shape
   1.345 -     :name "debug-ray"
   1.346 -     :physical? false
   1.347 -     :shape (com.jme3.scene.shape.Line.
   1.348 -             (.getOrigin ray)
   1.349 -             (.add
   1.350 -              (.getOrigin ray)
   1.351 -              (.mult (.getDirection ray)
   1.352 -                     (float (.getLimit ray))))))))
   1.353 -             
   1.354 -
   1.355 -(defn contact-color [contacts]
   1.356 -  (case contacts
   1.357 -    0 ColorRGBA/Gray
   1.358 -    1  ColorRGBA/Red 
   1.359 -    2  ColorRGBA/Green 
   1.360 -    3  ColorRGBA/Yellow 
   1.361 -    4  ColorRGBA/Orange 
   1.362 -    5  ColorRGBA/Red 
   1.363 -    6  ColorRGBA/Magenta 
   1.364 -    7  ColorRGBA/Pink 
   1.365 -    8  ColorRGBA/White))
   1.366 -
   1.367 -(defn update-ray-debug [node ray contacts]
   1.368 -  (let [origin (.getChild node 0)]
   1.369 -    (.setLocalTranslation origin (.getOrigin ray))
   1.370 -    (.setColor (.getMaterial origin) "Color" (contact-color contacts))))
   1.371 -
   1.372 -(defn init-node
   1.373 -  [debug-node rays]
   1.374 -    (.detachAllChildren debug-node)
   1.375 -    (dorun 
   1.376 -     (for [ray rays]
   1.377 -       (do
   1.378 -         (.attachChild
   1.379 -          debug-node 
   1.380 -          (doto (Node.)
   1.381 -            (.attachChild (ray-origin-debug ray ColorRGBA/Gray))
   1.382 -            (.attachChild (ray-debug ray ColorRGBA/Gray))
   1.383 -            ))))))
   1.384 -
   1.385 -(defn manage-ray-debug-node [debug-node geom touch-data limit]
   1.386 -  (let [rays (normal-rays limit geom)]
   1.387 -    (if (not= (count (.getChildren debug-node)) (count touch-data))
   1.388 -      (init-node debug-node rays))
   1.389 -    (dorun 
   1.390 -     (for [n (range (count touch-data))]
   1.391 -       (update-ray-debug
   1.392 -        (.getChild debug-node n) (nth rays n) (nth touch-data n))))))
   1.393 -
   1.394 -(defn transparent-sphere []
   1.395 -  (doto
   1.396 -      (make-shape
   1.397 -       (merge base-shape
   1.398 -	      {:position (Vector3f. 0 2 0)
   1.399 -	       :name "the blob."
   1.400 -	       :material "Common/MatDefs/Misc/Unshaded.j3md"
   1.401 -	       :texture "Textures/purpleWisp.png"
   1.402 -	       :physical? true
   1.403 -	       :mass 70
   1.404 -	       :color ColorRGBA/Blue
   1.405 -	       :shape (Sphere. 10 10 1)}))
   1.406 -    (-> (.getMaterial)
   1.407 -	(.getAdditionalRenderState)
   1.408 -	(.setBlendMode RenderState$BlendMode/Alpha))
   1.409 -    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   1.410 -
   1.411 -(defn transparent-box []
   1.412 -    (doto
   1.413 -      (make-shape
   1.414 -       (merge base-shape
   1.415 -	      {:position (Vector3f. 0 2 0)
   1.416 -	       :name "box"
   1.417 -	       :material "Common/MatDefs/Misc/Unshaded.j3md"
   1.418 -	       :texture "Textures/purpleWisp.png"
   1.419 -	       :physical? true
   1.420 -	       :mass 70
   1.421 -	       :color ColorRGBA/Blue
   1.422 -	       :shape (Box. 1 1 1)}))
   1.423 -    (-> (.getMaterial)
   1.424 -	(.getAdditionalRenderState)
   1.425 -	(.setBlendMode RenderState$BlendMode/Alpha))
   1.426 -    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   1.427 -
   1.428 -(defn transparent-floor []
   1.429 -  (doto
   1.430 -      (box 5 0.2 5  :mass 0 :position (Vector3f. 0 -2 0)
   1.431 -           :material "Common/MatDefs/Misc/Unshaded.j3md"
   1.432 -           :texture "Textures/redWisp.png"
   1.433 -           :name "floor")
   1.434 -    (-> (.getMaterial)
   1.435 -        (.getAdditionalRenderState)
   1.436 -        (.setBlendMode RenderState$BlendMode/Alpha))
   1.437 -    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   1.438 -
   1.439 -(defn test-skin 
   1.440 -  "Testing touch:
   1.441 -   you should see a ball which responds to the table
   1.442 -   and whatever balls hit it."
   1.443 -  []
   1.444 -  (let [b
   1.445 -        ;;(transparent-box)
   1.446 -        (transparent-sphere)
   1.447 -        ;;(sphere)
   1.448 -        f (transparent-floor)
   1.449 -        debug-node (Node.)
   1.450 -        node      (doto (Node.) (.attachChild b) (.attachChild f))
   1.451 -        root-node (doto (Node.) (.attachChild node)
   1.452 -                        (.attachChild debug-node))
   1.453 -        ]
   1.454 -    
   1.455 -    (world
   1.456 -     root-node
   1.457 -     {"key-return" (fire-cannon-ball node)}
   1.458 -     (fn [world]
   1.459 -       ;;  (Capture/SimpleCaptureVideo
   1.460 -       ;;   world 
   1.461 -       ;;   (file-str "/home/r/proj/cortex/tmp/blob.avi"))
   1.462 -       ;;  (no-logging)
   1.463 -       ;;(enable-debug world)
   1.464 -       ;;  (set-accuracy world (/ 1 60))
   1.465 -       )
   1.466 -     
   1.467 -     (fn [& _]
   1.468 -       (let [sensitivity 0.2
   1.469 -             touch-data (touch-percieve sensitivity b node)]
   1.470 -         (manage-ray-debug-node debug-node b touch-data sensitivity))
   1.471 -       ))))
   1.472 -
   1.473 -
   1.474 -#+end_src
   1.475 -
   1.476 -
   1.477 -
   1.478 -
   1.479 -  
   1.480 -* COMMENT code generation
   1.481 -#+begin_src clojure :tangle ../src/cortex/touch.clj
   1.482 -<<skin-main>>
   1.483 -#+end_src
   1.484 -
   1.485 -#+begin_src clojure :tangle ../src/cortex/test/touch.clj 
   1.486 -<<touch-test>>
   1.487 -#+end_src
   1.488 -
   1.489 -
   1.490 -
   1.491 -  
   1.492 -
   1.493 -
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/org/touch.org	Sat Feb 04 06:54:14 2012 -0700
     2.3 @@ -0,0 +1,488 @@
     2.4 +#+title: Simulated Sense of Touch
     2.5 +#+author: Robert McIntyre
     2.6 +#+email: rlm@mit.edu
     2.7 +#+description: Simulated touch for AI research using JMonkeyEngine and clojure.
     2.8 +#+keywords: simulation, tactile sense, jMonkeyEngine3, clojure
     2.9 +#+SETUPFILE: ../../aurellem/org/setup.org
    2.10 +#+INCLUDE: ../../aurellem/org/level-0.org
    2.11 +
    2.12 +
    2.13 +* Touch
    2.14 +
    2.15 +My creatures need to be able to feel their environments. The idea here
    2.16 +is to create thousands of small /touch receptors/ along the geometries
    2.17 +which make up the creature's body. The number of touch receptors in a
    2.18 +given area is determined by how complicated that area is, as
    2.19 +determined by the total number of triangles in that region. This way,
    2.20 +complicated regions like the hands/face, etc. get more touch receptors
    2.21 +than simpler areas of the body.
    2.22 +
    2.23 +#+name: skin-main
    2.24 +#+begin_src clojure
    2.25 +(ns cortex.touch
    2.26 +  "Simulate the sense of touch in jMonkeyEngine3. Enables any Geometry
    2.27 +  to be outfitted with touch sensors with density proportional to the
    2.28 +  density of triangles along the surface of the Geometry. Enables a
    2.29 +  Geometry to know what parts of itself are touching nearby objects."
    2.30 +  {:author "Robert McIntyre"}
    2.31 +  (:use (cortex world util sense))
    2.32 +  (:import com.jme3.scene.Geometry)
    2.33 +  (:import com.jme3.collision.CollisionResults)
    2.34 +  (:import jme3tools.converters.ImageToAwt)
    2.35 +  (:import (com.jme3.math Triangle Vector3f Ray)))
    2.36 +   
    2.37 +(use 'clojure.contrib.def)
    2.38 +(cortex.import/mega-import-jme3)
    2.39 +
    2.40 +(defn triangles
    2.41 +  "Return a sequence of all the Triangles which compose a given
    2.42 +  Geometry." 
    2.43 +  [#^Geometry geom]
    2.44 +  (let
    2.45 +      [mesh (.getMesh geom)
    2.46 +       triangles (transient [])]
    2.47 +    (dorun
    2.48 +     (for [n (range (.getTriangleCount mesh))]
    2.49 +       (let [tri (Triangle.)]
    2.50 +         (.getTriangle mesh n tri)
    2.51 +        ;; (.calculateNormal tri)
    2.52 +        ;; (.calculateCenter tri)
    2.53 +         (conj! triangles tri))))
    2.54 +    (persistent! triangles)))
    2.55 +   
    2.56 +(defn get-ray-origin
    2.57 +  "Return the origin which a Ray would have to have to be in the exact
    2.58 +  center of a particular Triangle in the Geometry in World
    2.59 +  Coordinates."
    2.60 +  [geom tri]
    2.61 +  (let [new (Vector3f.)]
    2.62 +    (.calculateCenter tri)
    2.63 +    (.localToWorld geom (.getCenter tri) new) new))
    2.64 +
    2.65 +(defn get-ray-direction
    2.66 +  "Return the direction which a Ray would have to have to be to point
    2.67 +  normal to the Triangle, in coordinates relative to the center of the
    2.68 +  Triangle."
    2.69 +  [geom tri]
    2.70 +  (let [n+c (Vector3f.)]
    2.71 +    (.calculateNormal tri)
    2.72 +    (.calculateCenter tri)
    2.73 +    (.localToWorld
    2.74 +     geom
    2.75 +     (.add (.getCenter tri) (.getNormal tri)) n+c)
    2.76 +    (.subtract n+c (get-ray-origin geom tri))))
    2.77 +
    2.78 +;; Every Mesh has many triangles, each with its own index.
    2.79 +;; Every vertex has its own index as well.
    2.80 +
    2.81 +(defn tactile-sensor-image
    2.82 +  "Return the touch-sensor distribution image in BufferedImage format,
    2.83 +   or nil if it does not exist."
    2.84 +  [#^Geometry obj]
    2.85 +  (if-let [image-path (meta-data obj "touch")]
    2.86 +    (ImageToAwt/convert
    2.87 +     (.getImage
    2.88 +      (.loadTexture
    2.89 +       (asset-manager)
    2.90 +       image-path))
    2.91 +    false false 0)))
    2.92 +     
    2.93 +
    2.94 +
    2.95 +(defn triangle
    2.96 +  "Get the triangle specified by triangle-index from the mesh within
    2.97 +  bounds."
    2.98 +  [#^Mesh mesh triangle-index]
    2.99 +  (let [scratch (Triangle.)]
   2.100 +    (.getTriangle mesh triangle-index scratch)
   2.101 +    scratch))
   2.102 +
   2.103 +(defn triangle-vertex-indices
   2.104 +  "Get the triangle vertex indices of a given triangle from a given
   2.105 +   mesh."
   2.106 +  [#^Mesh mesh triangle-index]
   2.107 +  (let [indices (int-array 3)]
   2.108 +    (.getTriangle mesh triangle-index indices)
   2.109 +    (vec indices)))
   2.110 +
   2.111 +(defn vertex-UV-coord
   2.112 +  "Get the uv-coordinates of the vertex named by vertex-index"
   2.113 +  [#^Mesh mesh vertex-index]
   2.114 +  (let [UV-buffer
   2.115 +        (.getData
   2.116 +         (.getBuffer
   2.117 +          mesh
   2.118 +          VertexBuffer$Type/TexCoord))]
   2.119 +    [(.get UV-buffer (* vertex-index 2))
   2.120 +     (.get UV-buffer (+ 1 (* vertex-index 2)))]))
   2.121 +
   2.122 +(defn triangle-UV-coord
   2.123 +  "Get the uv-cooridnates of the triangle's verticies."
   2.124 +  [#^Mesh mesh width height triangle-index]
   2.125 +  (map (fn [[u v]] (vector (* width u) (* height v)))
   2.126 +       (map (partial vertex-UV-coord mesh)
   2.127 +            (triangle-vertex-indices mesh triangle-index))))
   2.128 +  
   2.129 +(defn same-side?
   2.130 +  "Given the points p1 and p2 and the reference point ref, is point p
   2.131 +  on the same side of the line that goes through p1 and p2 as ref is?" 
   2.132 +  [p1 p2 ref p]
   2.133 +  (<=
   2.134 +   0
   2.135 +   (.dot 
   2.136 +    (.cross (.subtract p2 p1) (.subtract p p1))
   2.137 +    (.cross (.subtract p2 p1) (.subtract ref p1)))))
   2.138 +
   2.139 +(defn triangle-seq [#^Triangle tri]
   2.140 +  [(.get1 tri) (.get2 tri) (.get3 tri)])
   2.141 +
   2.142 +(defn vector3f-seq [#^Vector3f v]
   2.143 +  [(.getX v) (.getY v) (.getZ v)])
   2.144 +
   2.145 +(defn inside-triangle?
   2.146 +  "Is the point inside the triangle?"
   2.147 +  {:author "Dylan Holmes"}
   2.148 +  [#^Triangle tri #^Vector3f p]
   2.149 +  (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]
   2.150 +    (and
   2.151 +     (same-side? vert-1 vert-2 vert-3 p)
   2.152 +     (same-side? vert-2 vert-3 vert-1 p)
   2.153 +     (same-side? vert-3 vert-1 vert-2 p))))
   2.154 +
   2.155 +(defn triangle->matrix4f
   2.156 +  "Converts the triangle into a 4x4 matrix: The first three columns
   2.157 +   contain the vertices of the triangle; the last contains the unit
   2.158 +   normal of the triangle. The bottom row is filled with 1s."
   2.159 +  [#^Triangle t]
   2.160 +  (let [mat (Matrix4f.)
   2.161 +        [vert-1 vert-2 vert-3]
   2.162 +        ((comp vec map) #(.get t %) (range 3))
   2.163 +        unit-normal (do (.calculateNormal t)(.getNormal t))
   2.164 +        vertices [vert-1 vert-2 vert-3 unit-normal]]
   2.165 +    (dorun 
   2.166 +     (for [row (range 4) col (range 3)]
   2.167 +       (do
   2.168 +         (.set mat col row (.get (vertices row)col))
   2.169 +         (.set mat 3 row 1))))
   2.170 +    mat))
   2.171 +
   2.172 +(defn triangle-transformation
   2.173 +  "Returns the affine transformation that converts each vertex in the
   2.174 +   first triangle into the corresponding vertex in the second
   2.175 +   triangle."
   2.176 +  [#^Triangle tri-1 #^Triangle tri-2]
   2.177 +  (.mult 
   2.178 +   (triangle->matrix4f tri-2)
   2.179 +   (.invert (triangle->matrix4f tri-1))))
   2.180 +
   2.181 +(defn point->vector2f [[u v]]
   2.182 +  (Vector2f. u v))
   2.183 +
   2.184 +(defn vector2f->vector3f [v]
   2.185 +  (Vector3f. (.getX v) (.getY v) 0))
   2.186 +
   2.187 +(defn map-triangle [f #^Triangle tri]
   2.188 +  (Triangle.
   2.189 +   (f 0 (.get1 tri))
   2.190 +   (f 1 (.get2 tri))
   2.191 +   (f 2 (.get3 tri))))
   2.192 +
   2.193 +(defn points->triangle
   2.194 +  "Convert a list of points into a triangle."
   2.195 +  [points]
   2.196 +  (apply #(Triangle. %1 %2 %3)
   2.197 +         (map (fn [point]
   2.198 +                (let [point (vec point)]
   2.199 +                  (Vector3f. (get point 0 0)
   2.200 +                             (get point 1 0)
   2.201 +                             (get point 2 0))))
   2.202 +              (take 3 points))))
   2.203 +
   2.204 +(defn convex-bounds
   2.205 +  ;;dylan
   2.206 +  "Returns the smallest square containing the given
   2.207 +vertices, as a vector of integers [left top width height]."
   2.208 + ;; "Dimensions of the smallest integer bounding square of the list of
   2.209 + ;;  2D verticies in the form: [x y width height]."
   2.210 +  [uv-verts]
   2.211 +  (let [xs (map first uv-verts)
   2.212 +        ys (map second uv-verts)
   2.213 +        x0 (Math/floor (apply min xs))
   2.214 +        y0 (Math/floor (apply min ys))
   2.215 +        x1 (Math/ceil (apply max xs))
   2.216 +        y1 (Math/ceil (apply max ys))]
   2.217 +    [x0 y0 (- x1 x0) (- y1 y0)]))
   2.218 +
   2.219 +(defn sensors-in-triangle
   2.220 +  ;;dylan
   2.221 +  "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."
   2.222 +  ;;"Find the locations of the touch sensors within a triangle in both
   2.223 +  ;; UV and gemoetry relative coordinates."
   2.224 +  [image mesh tri-index]
   2.225 +  (let [width (.getWidth image)
   2.226 +        height (.getHeight image)
   2.227 +        UV-vertex-coords (triangle-UV-coord mesh width height tri-index)
   2.228 +        bounds (convex-bounds UV-vertex-coords)
   2.229 +        
   2.230 +        cutout-triangle (points->triangle UV-vertex-coords)
   2.231 +        UV-sensor-coords
   2.232 +        (filter (comp (partial inside-triangle? cutout-triangle)
   2.233 +                      (fn [[u v]] (Vector3f. u v 0)))
   2.234 +                (white-coordinates image bounds))
   2.235 +        UV->geometry (triangle-transformation
   2.236 +                      cutout-triangle
   2.237 +                      (triangle mesh tri-index))
   2.238 +        geometry-sensor-coords
   2.239 +        (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))
   2.240 +             UV-sensor-coords)]
   2.241 +  {:UV UV-sensor-coords :geometry geometry-sensor-coords}))
   2.242 +
   2.243 +(defn-memo locate-feelers
   2.244 +  "Search the geometry's tactile UV image for touch sensors, returning
   2.245 +  their positions in geometry-relative coordinates."
   2.246 +  [#^Geometry geo]
   2.247 +  (let [mesh (.getMesh geo)
   2.248 +        num-triangles (.getTriangleCount mesh)]
   2.249 +    (if-let [image (tactile-sensor-image geo)]
   2.250 +      (map
   2.251 +       (partial sensors-in-triangle image mesh)
   2.252 +       (range num-triangles))
   2.253 +      (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))
   2.254 +
   2.255 +(defn-memo touch-topology [#^Gemoetry geo]
   2.256 +  (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))
   2.257 +
   2.258 +(defn-memo feeler-coordinates [#^Geometry geo]
   2.259 +  (vec (map :geometry (locate-feelers geo))))
   2.260 +
   2.261 +(defn enable-touch [#^Geometry geo]
   2.262 +  (let [feeler-coords (feeler-coordinates geo)
   2.263 +        tris (triangles geo)
   2.264 +        limit 0.1
   2.265 +        ;;results (CollisionResults.)
   2.266 +        ]
   2.267 +    (if (empty? (touch-topology geo))
   2.268 +      nil
   2.269 +      (fn [node]
   2.270 +        (let [sensor-origins 
   2.271 +              (map
   2.272 +               #(map (partial local-to-world geo) %)
   2.273 +               feeler-coords)
   2.274 +              triangle-normals 
   2.275 +              (map (partial get-ray-direction geo)
   2.276 +                   tris)
   2.277 +              rays
   2.278 +              (flatten
   2.279 +               (map (fn [origins norm]
   2.280 +                      (map #(doto (Ray. % norm)
   2.281 +                              (.setLimit limit)) origins))
   2.282 +                    sensor-origins triangle-normals))]
   2.283 +          (vector
   2.284 +           (touch-topology geo)
   2.285 +           (vec
   2.286 +            (for [ray rays]
   2.287 +              (do
   2.288 +                (let [results (CollisionResults.)]
   2.289 +                  (.collideWith node ray results)
   2.290 +                  (let [touch-objects
   2.291 +                        (filter #(not (= geo (.getGeometry %)))
   2.292 +                                results)]
   2.293 +                    (- 255
   2.294 +                       (if (empty? touch-objects) 255
   2.295 +                           (rem 
   2.296 +                            (int
   2.297 +                             (* 255 (/ (.getDistance
   2.298 +                                        (first touch-objects)) limit)))
   2.299 +                            256))))))))))))))
   2.300 +                         
   2.301 +  
   2.302 +(defn touch [#^Node pieces]
   2.303 +  (filter (comp not nil?)
   2.304 +          (map enable-touch
   2.305 +               (filter #(isa? (class %) Geometry)
   2.306 +                       (node-seq pieces)))))
   2.307 +
   2.308 +
   2.309 +#+end_src
   2.310 +
   2.311 +
   2.312 +* Example
   2.313 +
   2.314 +#+name: touch-test
   2.315 +#+begin_src clojure 
   2.316 +(ns cortex.test.touch
   2.317 +  (:use (cortex world util touch))
   2.318 +  (:import
   2.319 +   com.jme3.scene.shape.Sphere
   2.320 +   com.jme3.math.ColorRGBA
   2.321 +   com.jme3.math.Vector3f
   2.322 +   com.jme3.material.RenderState$BlendMode
   2.323 +   com.jme3.renderer.queue.RenderQueue$Bucket
   2.324 +   com.jme3.scene.shape.Box
   2.325 +   com.jme3.scene.Node))
   2.326 +
   2.327 +(defn ray-origin-debug
   2.328 +  [ray color]
   2.329 +  (make-shape
   2.330 +   (assoc base-shape
   2.331 +     :shape (Sphere. 5 5 0.05)
   2.332 +     :name "arrow"
   2.333 +     :color color
   2.334 +     :texture false
   2.335 +     :physical? false
   2.336 +     :position
   2.337 +     (.getOrigin ray))))
   2.338 +
   2.339 +(defn ray-debug [ray color]
   2.340 +  (make-shape
   2.341 +   (assoc
   2.342 +       base-shape
   2.343 +     :name "debug-ray"
   2.344 +     :physical? false
   2.345 +     :shape (com.jme3.scene.shape.Line.
   2.346 +             (.getOrigin ray)
   2.347 +             (.add
   2.348 +              (.getOrigin ray)
   2.349 +              (.mult (.getDirection ray)
   2.350 +                     (float (.getLimit ray))))))))
   2.351 +             
   2.352 +
   2.353 +(defn contact-color [contacts]
   2.354 +  (case contacts
   2.355 +    0 ColorRGBA/Gray
   2.356 +    1  ColorRGBA/Red 
   2.357 +    2  ColorRGBA/Green 
   2.358 +    3  ColorRGBA/Yellow 
   2.359 +    4  ColorRGBA/Orange 
   2.360 +    5  ColorRGBA/Red 
   2.361 +    6  ColorRGBA/Magenta 
   2.362 +    7  ColorRGBA/Pink 
   2.363 +    8  ColorRGBA/White))
   2.364 +
   2.365 +(defn update-ray-debug [node ray contacts]
   2.366 +  (let [origin (.getChild node 0)]
   2.367 +    (.setLocalTranslation origin (.getOrigin ray))
   2.368 +    (.setColor (.getMaterial origin) "Color" (contact-color contacts))))
   2.369 +
   2.370 +(defn init-node
   2.371 +  [debug-node rays]
   2.372 +    (.detachAllChildren debug-node)
   2.373 +    (dorun 
   2.374 +     (for [ray rays]
   2.375 +       (do
   2.376 +         (.attachChild
   2.377 +          debug-node 
   2.378 +          (doto (Node.)
   2.379 +            (.attachChild (ray-origin-debug ray ColorRGBA/Gray))
   2.380 +            (.attachChild (ray-debug ray ColorRGBA/Gray))
   2.381 +            ))))))
   2.382 +
   2.383 +(defn manage-ray-debug-node [debug-node geom touch-data limit]
   2.384 +  (let [rays (normal-rays limit geom)]
   2.385 +    (if (not= (count (.getChildren debug-node)) (count touch-data))
   2.386 +      (init-node debug-node rays))
   2.387 +    (dorun 
   2.388 +     (for [n (range (count touch-data))]
   2.389 +       (update-ray-debug
   2.390 +        (.getChild debug-node n) (nth rays n) (nth touch-data n))))))
   2.391 +
   2.392 +(defn transparent-sphere []
   2.393 +  (doto
   2.394 +      (make-shape
   2.395 +       (merge base-shape
   2.396 +	      {:position (Vector3f. 0 2 0)
   2.397 +	       :name "the blob."
   2.398 +	       :material "Common/MatDefs/Misc/Unshaded.j3md"
   2.399 +	       :texture "Textures/purpleWisp.png"
   2.400 +	       :physical? true
   2.401 +	       :mass 70
   2.402 +	       :color ColorRGBA/Blue
   2.403 +	       :shape (Sphere. 10 10 1)}))
   2.404 +    (-> (.getMaterial)
   2.405 +	(.getAdditionalRenderState)
   2.406 +	(.setBlendMode RenderState$BlendMode/Alpha))
   2.407 +    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   2.408 +
   2.409 +(defn transparent-box []
   2.410 +    (doto
   2.411 +      (make-shape
   2.412 +       (merge base-shape
   2.413 +	      {:position (Vector3f. 0 2 0)
   2.414 +	       :name "box"
   2.415 +	       :material "Common/MatDefs/Misc/Unshaded.j3md"
   2.416 +	       :texture "Textures/purpleWisp.png"
   2.417 +	       :physical? true
   2.418 +	       :mass 70
   2.419 +	       :color ColorRGBA/Blue
   2.420 +	       :shape (Box. 1 1 1)}))
   2.421 +    (-> (.getMaterial)
   2.422 +	(.getAdditionalRenderState)
   2.423 +	(.setBlendMode RenderState$BlendMode/Alpha))
   2.424 +    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   2.425 +
   2.426 +(defn transparent-floor []
   2.427 +  (doto
   2.428 +      (box 5 0.2 5  :mass 0 :position (Vector3f. 0 -2 0)
   2.429 +           :material "Common/MatDefs/Misc/Unshaded.j3md"
   2.430 +           :texture "Textures/redWisp.png"
   2.431 +           :name "floor")
   2.432 +    (-> (.getMaterial)
   2.433 +        (.getAdditionalRenderState)
   2.434 +        (.setBlendMode RenderState$BlendMode/Alpha))
   2.435 +    (.setQueueBucket RenderQueue$Bucket/Transparent)))
   2.436 +
   2.437 +(defn test-skin 
   2.438 +  "Testing touch:
   2.439 +   you should see a ball which responds to the table
   2.440 +   and whatever balls hit it."
   2.441 +  []
   2.442 +  (let [b
   2.443 +        ;;(transparent-box)
   2.444 +        (transparent-sphere)
   2.445 +        ;;(sphere)
   2.446 +        f (transparent-floor)
   2.447 +        debug-node (Node.)
   2.448 +        node      (doto (Node.) (.attachChild b) (.attachChild f))
   2.449 +        root-node (doto (Node.) (.attachChild node)
   2.450 +                        (.attachChild debug-node))
   2.451 +        ]
   2.452 +    
   2.453 +    (world
   2.454 +     root-node
   2.455 +     {"key-return" (fire-cannon-ball node)}
   2.456 +     (fn [world]
   2.457 +       ;;  (Capture/SimpleCaptureVideo
   2.458 +       ;;   world 
   2.459 +       ;;   (file-str "/home/r/proj/cortex/tmp/blob.avi"))
   2.460 +       ;;  (no-logging)
   2.461 +       ;;(enable-debug world)
   2.462 +       ;;  (set-accuracy world (/ 1 60))
   2.463 +       )
   2.464 +     
   2.465 +     (fn [& _]
   2.466 +       (let [sensitivity 0.2
   2.467 +             touch-data (touch-percieve sensitivity b node)]
   2.468 +         (manage-ray-debug-node debug-node b touch-data sensitivity))
   2.469 +       ))))
   2.470 +
   2.471 +
   2.472 +#+end_src
   2.473 +
   2.474 +
   2.475 +
   2.476 +
   2.477 +  
   2.478 +* COMMENT code generation
   2.479 +#+begin_src clojure :tangle ../src/cortex/touch.clj
   2.480 +<<skin-main>>
   2.481 +#+end_src
   2.482 +
   2.483 +#+begin_src clojure :tangle ../src/cortex/test/touch.clj 
   2.484 +<<touch-test>>
   2.485 +#+end_src
   2.486 +
   2.487 +
   2.488 +
   2.489 +  
   2.490 +
   2.491 +