#+title: Simulated Sense of Touch

 #+author: Robert McIntyre

 #+email: rlm@mit.edu

 #+description: Simulated touch for AI research using JMonkeyEngine and clojure.

 #+keywords: simulation, tactile sense, jMonkeyEngine3, clojure

 #+SETUPFILE: ../../aurellem/org/setup.org

 #+INCLUDE: ../../aurellem/org/level-0.org

 

 

 * Touch

 

 My creatures need to be able to feel their environments. The idea here

 is to thousands of small /touch receptors/ along the geometries which

 make up the creature's body.  The number of touch receptors in a given

 area is determined by how complicated that area is, as determined by

 the total number of triangles in that region. This way, complicated

 regions like the hands/face, etc. get more touch receptors than

 simpler areas of the body.

 

 #+srcname: skin-main

 #+begin_src clojure

 (ns cortex.touch

   "Simulate the sense of touch in jMonkeyEngine3. Enables any Geometry

   to be outfitted with touch sensors with density proportional to the

   density of triangles along the surface of the Geometry. Enables a

   Geometry to know what parts of itself are touching nearby objects."

   {:author "Robert McIntyre"}

   (:use (cortex world util))

   (:import com.jme3.scene.Geometry)

   (:import com.jme3.collision.CollisionResults)

   (:import (com.jme3.math Triangle Vector3f Ray)))

    

 (defn triangles

   "Return a sequence of all the Triangles which compose a given

   Geometry." 

   [#^Geometry geom]

   (let

       [mesh (.getMesh geom)

        triangles (transient [])]

     (dorun

      (for [n (range (.getTriangleCount mesh))]

        (let [tri (Triangle.)]

          (.getTriangle mesh n tri)

         ;; (.calculateNormal tri)

         ;; (.calculateCenter tri)

          (conj! triangles tri))))

     (persistent! triangles)))

    

 (defn get-ray-origin

   "Return the origin which a Ray would have to have to be in the exact

   center of a particular Triangle in the Geometry in World

   Coordinates."

   [geom tri]

   (let [new (Vector3f.)]

     (.calculateCenter tri)

     (.localToWorld geom (.getCenter tri) new) new))

 

 (defn get-ray-direction

   "Return the direction which a Ray would have to have to be in the

   exact center of a particular Triangle in the Geometry, pointing

   normal to the Triangle, in coordinates relative to the center of the

   Triangle."

   [geom tri]

   (let [n+c (Vector3f.)]

     (.calculateNormal tri)

     (.calculateCenter tri)

     (.localToWorld

      geom

      (.add (.getCenter tri) (.getNormal tri)) n+c)

     (.subtract n+c (get-ray-origin geom tri))))

 

 (defn normal-rays

   "For each Triangle which comprises the Geometry, returns a Ray which

   is centered on that Triangle, points outward in a normal direction,

   and extends for =limit= distance."

   [limit #^Geometry geom]

   (vec

    (map 

     (fn [tri]

       (doto 

           (Ray. (get-ray-origin geom tri)

                 (get-ray-direction geom tri))

         (.setLimit limit)))

     (triangles geom))))

 

 (defn touch-percieve

   "Augment a Geometry with the sense of touch. Returns a sequence of

   non-negative integers, one for each triangle, with the value of the

   integer describing how many objects a ray of length =limit=, normal

   to the triangle and originating from its center, encountered. The

   Geometry itself is not counted among the results."

   [limit geom node]

   (let [normals  (normal-rays limit geom)]

     (doall

      (for [ray normals]

        (do

          (let [results (CollisionResults.)]

            (.collideWith node ray results)

            (let [touch-objects

                  (set (filter #(not (= geom %))

                               (map #(.getGeometry %) results)))]

              (count touch-objects))))))))

 #+end_src

 

 

 * Example

 

 #+srcname: touch-test

 #+begin_src clojure 

 (ns test.touch

   (:use (cortex world util touch)))

 

 (cortex.import/mega-import-jme3)

   

 (import java.util.logging.Level)

 (import java.util.logging.Logger)

 (use 'hello.brick-wall)

 

 

 (defn ray-origin-debug

   [ray color]

   (make-shape

    (assoc base-shape

      :shape (Sphere. 5 5 0.05)

      :name "arrow"

      :color color

      :texture false

      :physical? false

      :position

      (.getOrigin ray))))

 

 (defn ray-debug [ray color]

   (make-shape

    (assoc

        base-shape

      :name "debug-ray"

      :physical? false

      :shape (com.jme3.scene.shape.Line.

              (.getOrigin ray)

              (.add

               (.getOrigin ray)

               (.mult (.getDirection ray)

                      (float (.getLimit ray))))))))

              

 

 (defn contact-color [contacts]

   (case contacts

     0 ColorRGBA/Gray

     1  ColorRGBA/Red 

     2  ColorRGBA/Green 

     3  ColorRGBA/Yellow 

     4  ColorRGBA/Orange 

     5  ColorRGBA/Red 

     6  ColorRGBA/Magenta 

     7  ColorRGBA/Pink 

     8  ColorRGBA/White))

 

 (defn update-ray-debug [node ray contacts]

   (let [origin (.getChild node 0)]

     (.setLocalTranslation origin (.getOrigin ray))

     (.setColor (.getMaterial origin) "Color" (contact-color contacts))))

 

 (defn init-node

   [debug-node rays]

     (println-repl "Init touch debug node.")

     (.detachAllChildren debug-node)

     (dorun 

      (for [ray rays]

        (do

          (.attachChild

           debug-node 

           (doto (Node.)

             (.attachChild (ray-origin-debug ray ColorRGBA/Gray))

             (.attachChild (ray-debug ray ColorRGBA/Gray))

             ))))))

 

 (defn manage-ray-debug-node [debug-node geom touch-data limit]

   (let [rays (normal-rays limit geom)]

     (if (not= (count (.getChildren debug-node)) (count touch-data))

       (init-node debug-node rays))

     (dorun 

      (for [n (range (count touch-data))]

        (update-ray-debug

         (.getChild debug-node n) (nth rays n) (nth touch-data n))))))

 

 

 

 (defn no-logging []

   (.setLevel (Logger/getLogger "com.jme3") Level/OFF))

 

 (defn set-accuracy [world new-accuracy]

   (let [physics-manager (.getState (.getStateManager world) BulletAppState)]

     (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))

 

 (defn transparent-sphere []

   (doto

       (make-shape

        (merge base-shape

 	      {:position (Vector3f. 0 2 0)

 	       :name "the blob."

 	       :material "Common/MatDefs/Misc/Unshaded.j3md"

 	       :texture "Textures/purpleWisp.png"

 	       :physical? true

 	       :mass 70

 	       :color ColorRGBA/Blue

 	       :shape (Sphere. 10 10 1)}))

     (-> (.getMaterial)

 	(.getAdditionalRenderState)

 	(.setBlendMode RenderState$BlendMode/Alpha))

     (.setQueueBucket RenderQueue$Bucket/Transparent)))

 

 (defn transparent-box []

     (doto

       (make-shape

        (merge base-shape

 	      {:position (Vector3f. 0 2 0)

 	       :name "box"

 	       :material "Common/MatDefs/Misc/Unshaded.j3md"

 	       :texture "Textures/purpleWisp.png"

 	       :physical? true

 	       :mass 70

 	       :color ColorRGBA/Blue

 	       :shape (Box. 1 1 1)}))

     (-> (.getMaterial)

 	(.getAdditionalRenderState)

 	(.setBlendMode RenderState$BlendMode/Alpha))

     (.setQueueBucket RenderQueue$Bucket/Transparent)))

 

 (defn transparent-floor []

   (doto

       (box 5 0.2 5  :mass 0 :position (Vector3f. 0 -2 0)

            :material "Common/MatDefs/Misc/Unshaded.j3md"

            :texture "Textures/redWisp.png"

            :name "floor")

     (-> (.getMaterial)

         (.getAdditionalRenderState)

         (.setBlendMode RenderState$BlendMode/Alpha))

     (.setQueueBucket RenderQueue$Bucket/Transparent)))

 

 (defn test-skin []

   (let [b

 	;;(transparent-box)

 	(transparent-sphere)

         ;;(sphere)

 	f (transparent-floor)

         debug-node (Node.)

         node      (doto (Node.) (.attachChild b) (.attachChild f))

         root-node (doto (Node.) (.attachChild node)

                         (.attachChild debug-node))

         ]

     

     (world

      root-node

      {"key-return" (fire-cannon-ball node)}

      (fn [world]

        ;;  (Capture/SimpleCaptureVideo

        ;;   world 

        ;;   (file-str "/home/r/proj/cortex/tmp/blob.avi"))

        ;;  (no-logging)

        ;;(enable-debug world)

        ;;  (set-accuracy world (/ 1 60))

      )

 

      (fn [& _]

        (let [sensitivity 0.2

              touch-data (touch-percieve sensitivity b node)]

          (manage-ray-debug-node debug-node b touch-data sensitivity)

          )

        (Thread/sleep 10)

        ))))

 

 

 #+end_src

 

 

 

 

   

 * COMMENT code generation

 #+begin_src clojure :tangle ../src/cortex/touch.clj

 <<skin-main>>

 #+end_src

 

 #+begin_src clojure :tangle ../src/test/touch.clj 

 <<touch-test>>

 #+end_src