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

 (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 [answer (count (filter #(not (= geom (.getGeometry %))) results)) 

                  ;;color (contact-color answer)

                  ]

              ;;(dorun (map #(println-repl (.getName (.getGeometry %))) results))

              answer )))))))

 

 (defn enable-debug [world]

   (.enableDebug 

    (.getPhysicsSpace

     (.getState

      (.getStateManager world)

      BulletAppState))

    (asset-manager)))

 

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

 	;;controls

 	;;(make-touch-sphere b)

 	;;(make-touch b)

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

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

        (let [touch-data (touch-percieve 0.2 b node)]

          ;;(println-repl touch-data)

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

        (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