rlm@0: #+title: SKIN!
rlm@0: #+author: Robert McIntyre
rlm@0: #+email: rlm@mit.edu
rlm@0: #+description: Simulating touch in JMonkeyEngine
rlm@4: #+SETUPFILE: ../../aurellem/org/setup.org
rlm@4: #+INCLUDE: ../../aurellem/org/level-0.org
rlm@6: #+babel: :mkdirp yes :noweb yes
rlm@0: 
rlm@5: let's see what checkboxes look like:
rlm@5:  
rlm@5: * test [1/2]
rlm@5:  - [ ] item 1
rlm@5:  - [X] item 2
rlm@0: 
rlm@0: 
rlm@0: * skin!
rlm@0: 
rlm@0: #+srcname: skin-main
rlm@0: #+begin_src clojure
rlm@0: (ns body.skin)
rlm@0: (use 'cortex.world)
rlm@0: (use 'cortex.import)
rlm@0: (use 'clojure.contrib.def)
rlm@0: (cortex.import/mega-import-jme3)
rlm@0: (rlm.rlm-commands/help)
rlm@0: 
rlm@0: (import java.util.logging.Level)
rlm@0: (import java.util.logging.Logger)
rlm@0: 
rlm@0: 
rlm@0: 
rlm@0: ;; looks like we can use GhostControls for implementing touch.
rlm@0: ;; for example:
rlm@0: (def rc (GhostControl. (BoxCollisionShape. (Vector3f. 2 2 2))))
rlm@0: (def shifted-sphere
rlm@0:      (doto (CompoundCollisionShape.)
rlm@0:        (.addChildShape (SphereCollisionShape. 3) (Vector3f. 1 0 0))))
rlm@0: 
rlm@0: (def gc (GhostControl. shifted-sphere))
rlm@0: (def b (box 1 1 1 :mass 1))
rlm@0: (.addControl b rc)
rlm@0: (.addControl b gc)
rlm@0: 
rlm@0: 
rlm@0: (defn looksies! []
rlm@0:   (view b))
rlm@0: 
rlm@0: ;; overlapping objects can be gotten via =.getOverlappingCount= and
rlm@0: ;; =.getOverlappingObjects=
rlm@0: 
rlm@0: ;; looks like I might be able to place a small "touch-sphere" whther
rlm@0: ;; on every triangle in the object's  mesh, or at the verticies, using
rlm@0: ;; .getTriangleCount() on the mesh gotten by .getMesh()
rlm@0: 
rlm@0: ;; this way, I can create a mesh and just divide up it's faces using
rlm@0: ;; blender, and this will create the touch sensor distribution.
rlm@0: 
rlm@0: 
rlm@0: (defn make-touch-sphere [#^Geometry geom]
rlm@0:   (let [tri (Triangle.)
rlm@0: 	mesh (.getMesh geom)
rlm@0: 	controls! (transient [])]
rlm@0:     (dorun
rlm@0:      (for [n (range (.getTriangleCount mesh))]
rlm@0:        (do
rlm@0: 	 (.getTriangle mesh n tri)
rlm@0: 	 (.calculateCenter tri)
rlm@0: 	 (let [control 
rlm@0: 	       (doto
rlm@0: 		   (GhostControl.
rlm@0: 		    (doto (CompoundCollisionShape.)
rlm@0: 		      (.addChildShape
rlm@0: 		       (SphereCollisionShape. (float 0.1))
rlm@0: 		       (.mult (.getCenter tri) (float 1)))
rlm@0: 		      (.setMargin -0.1)))
rlm@0: 		 (.setApplyPhysicsLocal true))]
rlm@0: 		  
rlm@0: 	   (.addControl geom control)
rlm@0: 	   (conj! controls! control)))))
rlm@0:     (persistent! controls!)))
rlm@6: 
rlm@6: 
rlm@6: (defn triangles [#^Geometry geom]
rlm@6:   (let
rlm@6:       [mesh (.getMesh geom)
rlm@6:        triangles (transient [])]
rlm@6:     (dorun
rlm@6:      (for [n (range (.getTriangleCount mesh))]
rlm@6:        (let [tri (Triangle.)]
rlm@6:          (.getTriangle mesh n tri)
rlm@6:          (.calculateNormal tri)
rlm@6:          (.calculateCenter tri)
rlm@6:          (conj! triangles tri))))
rlm@6:     (persistent! triangles)))
rlm@6:    
rlm@6: 
rlm@6: (defn new-touch [#^Geometry geom]
rlm@6:   (dorun (map
rlm@6:           (comp no-op #(.getCenter %))
rlm@6:               (triangles geom))))
rlm@6: 
rlm@6: 
rlm@6: 
rlm@6:         
rlm@6: (defn normal-arrows
rlm@6:   "returns a node containing arrows which point
rlm@6:    in the normal direction of each face of the
rlm@6:    given Geometry"
rlm@6:   [#^Geometry geom]
rlm@6:   (let [node (Node.)]
rlm@6:     (dorun
rlm@6:      (map #(.attachChild node %)
rlm@6:           (map 
rlm@6:            (fn [tri]
rlm@6:              (make-shape
rlm@6:               (assoc base-shape
rlm@6:                 :shape (Sphere. 5 5 0.05)
rlm@6:                 :name "arrow"
rlm@6:                 :color ColorRGBA/Orange
rlm@6:                 :texture false
rlm@6:                 :asset-manager (asset-manager)
rlm@6:                 :physical? false
rlm@6:                 ;;:rotation
rlm@6:                 ;;(.mult
rlm@6:                 ;; (doto (Quaternion.)
rlm@6:                 ;;   (.lookAt (.getNormal tri)
rlm@6:                 ;;            Vector3f/UNIT_Y))
rlm@6:                 ;; (.getLocalRotation geom))
rlm@6:                 :position
rlm@6:                 (.add
rlm@6:                  (.getCenter tri)
rlm@6:                  (.getLocalTranslation geom)))))
rlm@6:            (triangles geom))))
rlm@6:     node))
rlm@6: 
rlm@6: 
rlm@6: (defn get-ray-origin
rlm@6:   [geom tri]
rlm@6:   (.add
rlm@6:    (.getCenter tri)
rlm@6:    (.getLocalTranslation geom)))
rlm@6: 
rlm@6: (defn get-ray-direction
rlm@6:   [geom tri]
rlm@6:   (.mult (.getLocalRotation geom)
rlm@6:          (.getNormal tri)))
rlm@6: 
rlm@6: (defn ray-debug [ray]
rlm@6:   (make-shape
rlm@6:    (assoc
rlm@6:        base-shape
rlm@6:      :name "debug-ray"
rlm@6:      :physical? false
rlm@6:      :shape (com.jme3.scene.shape.Line.
rlm@6:              (.getOrigin ray)
rlm@6:              (.add
rlm@6:               (.getOrigin ray)
rlm@6:               (.mult (.getDirection ray)
rlm@6:                      (float (.getLimit ray))))))))
rlm@6:              
rlm@6:                                
rlm@6: 
rlm@6: 
rlm@6: (defn normal-rays
rlm@6:   "returns rays"
rlm@6:   [limit #^Geometry geom]
rlm@6:   (vec
rlm@6:    (map 
rlm@6:     (fn [tri]
rlm@6:       (doto 
rlm@6:           (Ray. (get-ray-origin geom tri)
rlm@6:                 (get-ray-direction geom tri))
rlm@6:                 
rlm@6:       (.setLimit limit)))
rlm@6:     (triangles geom))))
rlm@6: 
rlm@6: 
rlm@6: (defn collision-debug [node result]
rlm@6: 
rlm@6:   (println-repl "contact point: " (.getContactPoint result))
rlm@6: 
rlm@6: 
rlm@6:   )
rlm@6: 
rlm@6: (defn touch-percieve [limit geom node debug-node]
rlm@6:   (let [normals  (normal-rays limit geom)]
rlm@6:     (.detachAllChildren debug-node)
rlm@6:     (.attachChild debug-node (normal-arrows geom))
rlm@6:     
rlm@6:     (println-repl "---------")
rlm@6:     (doall
rlm@6:      (for [ray normals]
rlm@6:        (do
rlm@6:          (let [results (CollisionResults.)]
rlm@6:            (.attachChild debug-node (ray-debug ray))
rlm@6:            (.collideWith geom ray results)
rlm@6:            
rlm@6:             ;;(println-repl (.size results) "results for " ray)
rlm@6:            ;;(doall (map (partial collision-debug node) results))
rlm@6:            (.size results)
rlm@6:            ))))))
rlm@6: 
rlm@6: (defn arrow-view [obj]
rlm@6:   (view (doto (Node.)
rlm@6:           (.attachChild (normal-arrows obj))
rlm@6:           (.attachChild obj))))
rlm@6: 
rlm@0: 
rlm@0: (defn make-touch [#^Geometry geom]
rlm@0:   (let [tri (Triangle.)
rlm@0: 	mesh (.getMesh geom)
rlm@0: 	controls! (transient [])]
rlm@0:     (dorun
rlm@0:      (for [n (range (.getTriangleCount mesh))]
rlm@0:        (do
rlm@0: 	 (.getTriangle mesh n tri)
rlm@0: 	 (.calculateCenter tri)
rlm@0: 	 (.calculateNormal tri)
rlm@5: ;;	 (println-repl tri)
rlm@5: ;;	 (println-repl (.get1 tri))
rlm@5: ;;	 (println-repl (.get2 tri))
rlm@5: ;;	 (println-repl (.get3 tri))
rlm@5: ;;	 (println-repl (.getCenter tri))
rlm@5: ;;	 (println-repl (.getNormal tri))
rlm@0: 	 (let [control
rlm@0: 	       (doto 
rlm@0: 		   (GhostControl.
rlm@0: 		    
rlm@0: 		     (doto (CompoundCollisionShape.)
rlm@0: 		       (.addChildShape
rlm@0: 		        (SimplexCollisionShape. Vector3f/ZERO)
rlm@0: 			(.mult (.getCenter tri) (float 1)))		    
rlm@0: 		      (.setMargin 0)
rlm@0: 		      ))
rlm@0: 		 (.setApplyPhysicsLocal true))]
rlm@0: 	   (.addControl geom control)
rlm@0: 	   (conj! controls! control)))))
rlm@0:     (persistent! controls!)))
rlm@0: 
rlm@0: (use 'hello.brick-wall)
rlm@0: 
rlm@0: (defn touch-reception [controls]
rlm@0:     (let [control
rlm@0: 	  (first 
rlm@0: 	   (filter 
rlm@0: 	    #(< 2 (.getOverlappingCount %)) controls))]
rlm@0:       (if (not (nil? control))
rlm@0: 	(println
rlm@0: 	 (seq
rlm@0: 	  (.getOverlappingObjects control))))))
rlm@0: 
rlm@0: (defn touch-print [controls]
rlm@0:   (println
rlm@0:    (map #(count (.getNonGhostOverlappingObjects %)) controls)))
rlm@0: 
rlm@0: (defn set-debug-color [#^ColorRGBA color #^GhostControl gc]
rlm@0:   (.setColor (.getMaterial (.getChild (.getDebugShape gc) 0)) "Color" color))
rlm@0: 
rlm@0: (defn html-color [html-str]
rlm@0:   ((fn [[r g b]] (ColorRGBA. r g b (float 1)))
rlm@0:    (map #(float (/ (Integer/parseInt % 16) 255))
rlm@0: 	(map (partial apply str) (partition 2 html-str)))))
rlm@0: 
rlm@0: (defn color-touch [controls]
rlm@0:   (no-exceptions
rlm@0:    (dorun
rlm@0:     (map
rlm@0:      (fn [control]
rlm@0:        (case (count (.getNonGhostOverlappingObjects control))
rlm@0: 	     0 (set-debug-color ColorRGBA/Gray control)
rlm@0: 	     1 (set-debug-color ColorRGBA/Blue control)
rlm@0: 	     2 (set-debug-color ColorRGBA/Green control)
rlm@0: 	     3 (set-debug-color ColorRGBA/Yellow control)
rlm@0: 	     4 (set-debug-color ColorRGBA/Orange control)
rlm@0: 	     5 (set-debug-color ColorRGBA/Red control)
rlm@0: 	     6 (set-debug-color ColorRGBA/Magenta control)
rlm@0: 	     7 (set-debug-color ColorRGBA/Pink control)
rlm@0: 	     8 (set-debug-color ColorRGBA/White control)))
rlm@0:      controls))))
rlm@0: 
rlm@0: (defn enable-debug [world]
rlm@0:   (.enableDebug 
rlm@0:    (.getPhysicsSpace
rlm@0:     (.getState
rlm@0:      (.getStateManager world)
rlm@0:      BulletAppState))
rlm@0:    (asset-manager)))
rlm@0: 
rlm@0: (defn transparent-sphere []
rlm@0:   (doto
rlm@0:       (make-shape
rlm@0:        (merge base-shape
rlm@0: 	      {:position (Vector3f. 0 2 0)
rlm@0: 	       :name "the blob."
rlm@0: 	       :material "Common/MatDefs/Misc/Unshaded.j3md"
rlm@0: 	       :texture "Textures/purpleWisp.png"
rlm@0: 	       :physical? true
rlm@0: 	       :mass 70
rlm@0: 	       :color ColorRGBA/Blue
rlm@0: 	       :shape (Sphere. 10 10 1)}))
rlm@0:     (-> (.getMaterial)
rlm@0: 	(.getAdditionalRenderState)
rlm@0: 	(.setBlendMode RenderState$BlendMode/Alpha))
rlm@0:     (.setQueueBucket RenderQueue$Bucket/Transparent)))
rlm@0: 
rlm@0: (defn transparent-box []
rlm@0:     (doto
rlm@0:       (make-shape
rlm@0:        (merge base-shape
rlm@0: 	      {:position (Vector3f. 0 2 0)
rlm@0: 	       :name "the blob."
rlm@0: 	       :material "Common/MatDefs/Misc/Unshaded.j3md"
rlm@0: 	       :texture "Textures/purpleWisp.png"
rlm@0: 	       :physical? true
rlm@0: 	       :mass 70
rlm@0: 	       :color ColorRGBA/Blue
rlm@0: 	       :shape (Box. 1 1 1)}))
rlm@0:     (-> (.getMaterial)
rlm@0: 	(.getAdditionalRenderState)
rlm@0: 	(.setBlendMode RenderState$BlendMode/Alpha))
rlm@0:     (.setQueueBucket RenderQueue$Bucket/Transparent)))
rlm@0: 
rlm@6: 
rlm@6: (defn transparent-floor []
rlm@6:   (doto
rlm@6:       (box 5 0.2 5  :mass 0 :position (Vector3f. 0 -2 0)
rlm@6:            :material "Common/MatDefs/Misc/Unshaded.j3md"
rlm@6:            :texture "Textures/redWisp.png")
rlm@6:     (-> (.getMaterial)
rlm@6:         (.getAdditionalRenderState)
rlm@6:         (.setBlendMode RenderState$BlendMode/Alpha))
rlm@6:     (.setQueueBucket RenderQueue$Bucket/Transparent)))
rlm@6: 
rlm@0: 
rlm@0: (defn no-logging []
rlm@0:   (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
rlm@0: 
rlm@0: (defn set-accuracy [world new-accuracy]
rlm@0:   (let [physics-manager (.getState (.getStateManager world) BulletAppState)]
rlm@0:     (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))
rlm@0: 
rlm@0: (defn test-skin []
rlm@0:   (let [b
rlm@6: 	;;(transparent-sphere)
rlm@6: 	(transparent-box)
rlm@6: 	f (transparent-floor)
rlm@6: 	;;controls
rlm@0: 	;;(make-touch-sphere b)
rlm@6: 	;;(make-touch b)
rlm@6:         debug-node (Node.)
rlm@6:         node      (doto (Node.) (.attachChild b) (.attachChild f)
rlm@6:                         (.attachChild debug-node))
rlm@6:         
rlm@0: 	]
rlm@0:     
rlm@0:     (world
rlm@0:      
rlm@6:      node
rlm@0:      {"key-return" (fire-cannon-ball)
rlm@0:       "key-space"  (fn [game value]
rlm@6:       		    (println-repl (touch-percieve 1 b node debug-node)))
rlm@6:       }
rlm@6:      ;;no-op
rlm@0:      (fn [world]
rlm@6:      ;;  (Capture/SimpleCaptureVideo
rlm@6:      ;;   world 
rlm@6:      ;;   (file-str "/home/r/proj/cortex/tmp/blob.avi"))
rlm@6:      ;;  (no-logging)
rlm@6:      (enable-debug world)
rlm@6:      ;;  (set-accuracy world (/ 1 60))
rlm@0:        )
rlm@0: 
rlm@0:      (fn [& _]
rlm@6:        (Thread/sleep 10)
rlm@5:        ;;(touch-print controls)
rlm@6:        ;;(color-touch controls)
rlm@0:        ))))
rlm@0: 
rlm@0: #+end_src
rlm@0: 
rlm@3: #+results: skin-main
rlm@3: : #'body.skin/test-skin
rlm@3: 
rlm@0: 
rlm@0: 
rlm@0: 
rlm@6:   
rlm@0: 
rlm@0: * COMMENT code generation
rlm@6: #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes
rlm@0: <<skin-main>>
rlm@0: #+end_src
rlm@0: 
rlm@0: 
rlm@0: 
rlm@0: