#+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:

 

 * 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)

 (use 'hello.brick-wall)

 

 (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 get-ray-origin

   [geom tri]

   (let [new (Vector3f.)]

     (.calculateCenter tri)

     (.localToWorld geom (.getCenter tri) new)

     new))

 

 (defn get-ray-direction

   [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 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/Blue 

     2  ColorRGBA/Green 

     3  ColorRGBA/Yellow 

     4  ColorRGBA/Orange 

     5  ColorRGBA/Red 

     6  ColorRGBA/Magenta 

     7  ColorRGBA/Pink 

     8  ColorRGBA/White))

 

 (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 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 touch-percieve [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)))]

                ;;(dorun (map #(println-repl (.getName %)) touch-objects))

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

 

 (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

 

 #+results: skin-main

 : #'body.skin/test-skin

 

 

 

 

 

 

   

 * COMMENT code generation

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

 <<skin-main>>

 #+end_src