#+title: SKIN!

 #+author: Robert McIntyre

 #+email: rlm@mit.edu

 #+description: Simulating touch in JMonkeyEngine

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

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

 #+babel: :mkdirp yes :noweb yes

 

 let's see what checkboxes look like:

  

 * test [1/2]

  - [ ] item 1

  - [X] item 2

 

 

 * skin!

 

 #+srcname: skin-main

 #+begin_src clojure

 (ns body.skin)

 (use 'cortex.world)

 (use 'cortex.import)

 (use 'clojure.contrib.def)

 (cortex.import/mega-import-jme3)

 (rlm.rlm-commands/help)

 

 (import java.util.logging.Level)

 (import java.util.logging.Logger)

 

 

 

 ;; looks like we can use GhostControls for implementing touch.

 ;; for example:

 (def rc (GhostControl. (BoxCollisionShape. (Vector3f. 2 2 2))))

 (def shifted-sphere

      (doto (CompoundCollisionShape.)

        (.addChildShape (SphereCollisionShape. 3) (Vector3f. 1 0 0))))

 

 (def gc (GhostControl. shifted-sphere))

 (def b (box 1 1 1 :mass 1))

 (.addControl b rc)

 (.addControl b gc)

 

 

 (defn looksies! []

   (view b))

 

 ;; overlapping objects can be gotten via =.getOverlappingCount= and

 ;; =.getOverlappingObjects=

 

 ;; looks like I might be able to place a small "touch-sphere" whther

 ;; on every triangle in the object's  mesh, or at the verticies, using

 ;; .getTriangleCount() on the mesh gotten by .getMesh()

 

 ;; this way, I can create a mesh and just divide up it's faces using

 ;; blender, and this will create the touch sensor distribution.

 

 

 (defn make-touch-sphere [#^Geometry geom]

   (let [tri (Triangle.)

 	mesh (.getMesh geom)

 	controls! (transient [])]

     (dorun

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

        (do

 	 (.getTriangle mesh n tri)

 	 (.calculateCenter tri)

 	 (let [control 

 	       (doto

 		   (GhostControl.

 		    (doto (CompoundCollisionShape.)

 		      (.addChildShape

 		       (SphereCollisionShape. (float 0.1))

 		       (.mult (.getCenter tri) (float 1)))

 		      (.setMargin -0.1)))

 		 (.setApplyPhysicsLocal true))]

 		  

 	   (.addControl geom control)

 	   (conj! controls! control)))))

     (persistent! controls!)))

 

 

 (defn triangles [#^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 new-touch [#^Geometry geom]

   (dorun (map

           (comp no-op #(.getCenter %))

               (triangles geom))))

 

 

 

         

 (defn normal-arrows

   "returns a node containing arrows which point

    in the normal direction of each face of the

    given Geometry"

   [#^Geometry geom]

   (let [node (Node.)]

     (dorun

      (map #(.attachChild node %)

           (map 

            (fn [tri]

              (make-shape

               (assoc base-shape

                 :shape (Sphere. 5 5 0.05)

                 :name "arrow"

                 :color ColorRGBA/Orange

                 :texture false

                 :asset-manager (asset-manager)

                 :physical? false

                 ;;:rotation

                 ;;(.mult

                 ;; (doto (Quaternion.)

                 ;;   (.lookAt (.getNormal tri)

                 ;;            Vector3f/UNIT_Y))

                 ;; (.getLocalRotation geom))

                 :position

                 (.add

                  (.getCenter tri)

                  (.getLocalTranslation geom)))))

            (triangles geom))))

     node))

 

 

 (defn get-ray-origin

   [geom tri]

   (.add

    (.getCenter tri)

    (.getLocalTranslation geom)))

 

 (defn get-ray-direction

   [geom tri]

   (.mult (.getLocalRotation geom)

          (.getNormal tri)))

 

 (defn ray-debug [ray]

   (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 normal-rays

   "returns rays"

   [limit #^Geometry geom]

   (vec

    (map 

     (fn [tri]

       (doto 

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

                 (get-ray-direction geom tri))

                 

       (.setLimit limit)))

     (triangles geom))))

 

 

 (defn collision-debug [node result]

 

   (println-repl "contact point: " (.getContactPoint result))

 

 

   )

 

 (defn touch-percieve [limit geom node debug-node]

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

     (.detachAllChildren debug-node)

     (.attachChild debug-node (normal-arrows geom))

     

     (println-repl "---------")

     (doall

      (for [ray normals]

        (do

          (let [results (CollisionResults.)]

            (.attachChild debug-node (ray-debug ray))

            (.collideWith geom ray results)

            

             ;;(println-repl (.size results) "results for " ray)

            ;;(doall (map (partial collision-debug node) results))

            (.size results)

            ))))))

 

 (defn arrow-view [obj]

   (view (doto (Node.)

           (.attachChild (normal-arrows obj))

           (.attachChild obj))))

 

 

 (defn make-touch [#^Geometry geom]

   (let [tri (Triangle.)

 	mesh (.getMesh geom)

 	controls! (transient [])]

     (dorun

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

        (do

 	 (.getTriangle mesh n tri)

 	 (.calculateCenter tri)

 	 (.calculateNormal tri)

 ;;	 (println-repl tri)

 ;;	 (println-repl (.get1 tri))

 ;;	 (println-repl (.get2 tri))

 ;;	 (println-repl (.get3 tri))

 ;;	 (println-repl (.getCenter tri))

 ;;	 (println-repl (.getNormal tri))

 	 (let [control

 	       (doto 

 		   (GhostControl.

 		    

 		     (doto (CompoundCollisionShape.)

 		       (.addChildShape

 		        (SimplexCollisionShape. Vector3f/ZERO)

 			(.mult (.getCenter tri) (float 1)))		    

 		      (.setMargin 0)

 		      ))

 		 (.setApplyPhysicsLocal true))]

 	   (.addControl geom control)

 	   (conj! controls! control)))))

     (persistent! controls!)))

 

 (use 'hello.brick-wall)

 

 (defn touch-reception [controls]

     (let [control

 	  (first 

 	   (filter 

 	    #(< 2 (.getOverlappingCount %)) controls))]

       (if (not (nil? control))

 	(println

 	 (seq

 	  (.getOverlappingObjects control))))))

 

 (defn touch-print [controls]

   (println

    (map #(count (.getNonGhostOverlappingObjects %)) controls)))

 

 (defn set-debug-color [#^ColorRGBA color #^GhostControl gc]

   (.setColor (.getMaterial (.getChild (.getDebugShape gc) 0)) "Color" color))

 

 (defn html-color [html-str]

   ((fn [[r g b]] (ColorRGBA. r g b (float 1)))

    (map #(float (/ (Integer/parseInt % 16) 255))

 	(map (partial apply str) (partition 2 html-str)))))

 

 (defn color-touch [controls]

   (no-exceptions

    (dorun

     (map

      (fn [control]

        (case (count (.getNonGhostOverlappingObjects control))

 	     0 (set-debug-color ColorRGBA/Gray control)

 	     1 (set-debug-color ColorRGBA/Blue control)

 	     2 (set-debug-color ColorRGBA/Green control)

 	     3 (set-debug-color ColorRGBA/Yellow control)

 	     4 (set-debug-color ColorRGBA/Orange control)

 	     5 (set-debug-color ColorRGBA/Red control)

 	     6 (set-debug-color ColorRGBA/Magenta control)

 	     7 (set-debug-color ColorRGBA/Pink control)

 	     8 (set-debug-color ColorRGBA/White control)))

      controls))))

 

 (defn enable-debug [world]

   (.enableDebug 

    (.getPhysicsSpace

     (.getState

      (.getStateManager world)

      BulletAppState))

    (asset-manager)))

 

 (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 "the blob."

 	       :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")

     (-> (.getMaterial)

         (.getAdditionalRenderState)

         (.setBlendMode RenderState$BlendMode/Alpha))

     (.setQueueBucket RenderQueue$Bucket/Transparent)))

 

 

 (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 test-skin []

   (let [b

 	;;(transparent-sphere)

 	(transparent-box)

 	f (transparent-floor)

 	;;controls

 	;;(make-touch-sphere b)

 	;;(make-touch b)

         debug-node (Node.)

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

                         (.attachChild debug-node))

         

 	]

     

     (world

      

      node

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

       "key-space"  (fn [game value]

       		    (println-repl (touch-percieve 1 b node debug-node)))

       }

      ;;no-op

      (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 [& _]

        (Thread/sleep 10)

        ;;(touch-print controls)

        ;;(color-touch controls)

        ))))

 

 #+end_src

 

 #+results: skin-main

 : #'body.skin/test-skin

 

 

 

 

   

 

 * COMMENT code generation

 #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes

 <<skin-main>>

 #+end_src