# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1326114126 25200
# Node ID 2bcc7636cfeac6390432e774d6d5bdf5cecac23c
# Parent  6d7c17c847a34bb79184ba92c97907830292637d
faster touch creation code

diff -r 6d7c17c847a3 -r 2bcc7636cfea assets/Models/creature1/tip.png
Binary file assets/Models/creature1/tip.png has changed
diff -r 6d7c17c847a3 -r 2bcc7636cfea assets/Models/creature1/try-again.blend
Binary file assets/Models/creature1/try-again.blend has changed
diff -r 6d7c17c847a3 -r 2bcc7636cfea org/test-creature.org
--- a/org/test-creature.org	Sun Jan 08 06:11:58 2012 -0700
+++ b/org/test-creature.org	Mon Jan 09 06:02:06 2012 -0700
@@ -307,22 +307,13 @@
    )))
 
 
-(def colorful (.getChild (worm-model) "worm-21"))
-
-(def im-data
-  (let [sink (byte-array 3145727)
-        data (.getData (.getImage texture) 0)]
-    (.rewind data)
-    (.get data sink)
-    (vec (seq sink))))
-
+(defn colorful []
+  (.getChild (worm-model) "worm-21"))
 
 (import jme3tools.converters.ImageToAwt)
 
 (import ij.ImagePlus)
 
-
-
 (defn triangle-indices
   "Get the triangle vertex indices of a given triangle from a given
    mesh."
@@ -339,19 +330,15 @@
          (.getBuffer
           mesh
           VertexBuffer$Type/TexCoord))]
-    [(.get UV-buffer (* vertex-index 2))
-     (.get UV-buffer (+ 1 (* vertex-index 2)))]))
+    (Vector2f.
+     (.get UV-buffer (* vertex-index 2))
+     (.get UV-buffer (+ 1 (* vertex-index 2))))))
 
-(defn touch-receptor-image [#^Geometry obj]
-  
-
-
-;; yay there's a converter!
-
-(defn uv-image []
+(defn touch-receptor-image
+  "Return the touch-sensor distribution image in ImagePlus format."
+  [#^Geometry obj]
   (let
-      [colorful (.getChild (worm-model) "worm-21")
-       mat (.getMaterial colorful)
+      [mat (.getMaterial obj)
        texture
        (.getTextureValue
         (.getTextureParam
@@ -362,11 +349,257 @@
         "UV-map"
         (ImageToAwt/convert im false false 0))))
 
+
+(import ij.process.ImageProcessor)
+(import java.awt.image.BufferedImage)
+
+(defprotocol Frame
+  (frame [this]))
+
+(extend-type BufferedImage
+  Frame
+  (frame [image]
+    (merge  
+     (apply
+      hash-map 
+      (interleave 
+       (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
+                (vector x y)))
+       (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]
+                (let [data (.getRGB image x y)] 
+                  (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
+                            :g (bit-shift-right (bit-and 0x00ff00 data) 8)
+                            :b (bit-and 0x0000ff data)))))))
+     {:width  (.getWidth image) :height (.getHeight image)})))
+
+
+(extend-type ImagePlus
+  Frame
+  (frame [image+]
+    (frame (.getBufferedImage image+))))
+
+(defn rgb->int [r g b]
+  (+ (bit-shift-left r 16)
+     (bit-shift-left g 8)
+     b))
+     
+  
+
+(defn filter-pixels
+  "List the coordinates of all pixels matching pred."
+  [pred #^ImageProcessor ip]
+  (let
+      [width (.getWidth ip)
+       height (.getHeight ip)]
+    ((fn accumulate [x y matches]
+       (cond
+        (>= y height) matches
+        (>= x width) (recur 0 (inc y) matches)
+        (pred (.getPixel ip x y))
+        (recur (inc x) y (conj matches (Vector2f. x y)))
+        :else (recur (inc x) y matches)))
+     0 0 [])))
+
+
+
+
+
+(defn filter-pixels*
+  [pred #^ImageProcessor ip]
+  (let
+      [width (.getWidth ip)
+       height (.getHeight ip)
+       coords (ref [])
+       process 
+       (fn [[start end]]
+         (loop [i start]
+           (if (<= i end)
+             (do 
+               (let [column (rem i height)
+                     row (unchecked-divide i width)]
+                 (if (pred (.getPixel ip row column))
+                   (dosync (ref-set
+                            coords
+                            (conj @coords (Vector2f. column row)))))
+        
+               (recur (inc i)))))))
+       ]
+
+       
+    (dorun 
+     (pmap process (partition
+                    2
+                    (conj (vec (range 0 (* width height) 100))
+                          (* width height)))))
+    @coords))
+
+
+
+(comment
+  ((->
+    f
+    (partial x)
+    (partial y)
+    (partial z))))
+
+(defn filter-pixels**
+  [pred #^ImageProcessor ip]
+  (let [width (.getWidth ip)
+        height (.getHeight ip)]
+    ((fn f [x1 x2 y1 y2]
+       (println x1)
+         (if
+             (and
+              (= x1 (dec x2))
+              (= y1 (dec y2)))
+           (if (pred (.getPixel ip x1 y1))
+             [[x1 y1]]
+             [])
+           (let
+               [xm (+ x1 (/ (- x2 x1) 2))
+                ym (+ y1 (/ (- y2 y1) 2))]
+           (apply concat
+           (pvalues
+            ;;(f x1 xm y1 ym)
+            ;;(f xm x2 y1 ym)
+            ;;(f x1 xm ym y2)
+            (f xm x2 ym y2))))))
+       0 width 0 height)))
+    
+
+
+
+  
+       
+
+
+(defn white-coordinates*
+  [#^ImageProcessor ip]
+  (filter-pixels** #(== % -1) ip))
+  
+
+(defn white-coordinates
+  "List the coordinates of all the white pixels in an image."
+  [#^ImageProcessor ip]
+  (let [height (.getHeight ip)
+        width  (.getWidth  ip)
+        coords (transient [])]
+    (dorun 
+     (for [x (range width)
+           y (range height)]
+       (let [pixel (.getPixel ip x y)]
+         (if (= pixel -1)
+           (conj! coords (Vector2f. x y))))))
+    (persistent! coords)))
+                                    
+        
+
+
+
+    
+  
+
+(def white {:r 255, :g 255, :b 255})
+(def black {:r 0,   :g 0,   :b 0})
+
+
+(defn same-side? [p1 p2 ref p]
+  (<=
+   0
+   (.dot 
+    (.cross (.subtract p2 p1) (.subtract p p1))
+    (.cross (.subtract p2 p1) (.subtract ref p1)))))
+
+(defn inside-triangle?
+  [vert-1 vert-2 vert-3 p]
+   (and
+    (same-side? vert-1 vert-2 vert-3 p)
+    (same-side? vert-2 vert-3 vert-1 p)
+    (same-side? vert-3 vert-1 vert-2 p)))
+
+
+(defn white? [color]
+  (and 
+   (= (:r color) 255)
+   (= (:b color) 255)
+   (= (:g color) 255)))
+                        
+
 ;; for each triangle in the mesh,
 ;; get the normal to the triangle,
 ;; look at the UV touch map, restricted to that triangle,
 ;; get the positions of those touch sensors in geometry-relative
 ;; coordinates.
+(defn tactile-coords [#^Geometry obj]
+  (let [mesh (.getMesh obj)
+        num-triangles (.getTriangleCount mesh)
+        num-verticies (.getVertexCount mesh)
+        uv-coord (partial uv-coord mesh)
+        triangle-indices (partial triangle-indices mesh)
+        receptors (touch-receptor-image obj)
+        ]
+    (map
+     (fn [[tri-1 tri-2 tri-3]]
+       (let [width (.getWidth receptors)
+             height (.getHeight receptors)
+             uv-1 (uv-coord tri-1)
+             uv-2 (uv-coord tri-2)
+             uv-3 (uv-coord tri-3)
+             x-coords (map #(.getX %) [uv-1 uv-2 uv-3])
+             y-coords (map #(.getY %) [uv-1 uv-2 uv-3])
+             max-x (Math/ceil (* width (apply max x-coords)))
+             min-x (Math/floor (* width (apply min x-coords)))
+             max-y (Math/ceil (* height (apply max y-coords)))
+             min-y (Math/floor (* height (apply min y-coords)))
+
+             image-1 (Vector2f. (* width (.getX uv-1))
+                                (* height (.getY uv-1)))
+             image-2 (Vector2f. (* width (.getX uv-2))
+                                (* height (.getY uv-2)))
+             image-3 (Vector2f. (* width (.getX uv-3))
+                                (* height (.getY uv-3)))
+             left-corner
+             (Vector2f. min-x min-y)
+             
+             ]
+
+         (.setRoi receptors min-x min-y (- max-x min-x) (- max-y min-y))
+         (let [processor  (.crop (.getProcessor receptors))
+               image (frame (.getBufferedImage processor))]
+           (with-meta
+             (filter-keys
+              (fn [[x y]]
+                (inside-triangle?
+                 (.subtract image-1 left-corner)
+                 (.subtract image-2 left-corner)
+                 (.subtract image-3 left-corner)
+                 (Vector2f. x y)))
+              
+              
+              (filter-vals white? image))
+             {:image
+              (comment
+                (.getBufferedImage
+                 (doto processor
+                   (.flipVertical))))
+               }
+           ))
+         )) (map triangle-indices (range num-triangles)))))
+    
+
+
+
+
+
+    
+(defn all-names []
+  (concat 
+   (re-split #"\n" (slurp (file-str
+                           "/home/r/proj/names/dist.female.first")))
+   (re-split #"\n" (slurp (file-str
+                           "/home/r/proj/names/dist.male.first")))
+   (re-split #"\n" (slurp (file-str
+                           "/home/r/proj/names/dist.all.last")))))
 
 
 
@@ -382,9 +615,6 @@
   Lulzable
   (load-lulz [this] (println "the lulz have arrived!")))
 
-(defn 
-
-
 
 (defn world-setup [joint]
   (let [joint-position (Vector3f. 0 0 0)