1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojureDemo/GenesisPlay.clj	Fri Aug 20 00:32:44 2010 -0400
     1.3 @@ -0,0 +1,501 @@
     1.4 +(ns clojureDemo.GenesisPlay)
     1.5 +
     1.6 +
     1.7 +(use 'clojure.contrib.import-static)
     1.8 +(import '(java.io File))
     1.9 +(import '(org.apache.commons.io FileUtils))
    1.10 +(import '(javax.imageio ImageIO) )
    1.11 +(import '(javax.swing JFrame))
    1.12 +(import '(java.awt Color BorderLayout))
    1.13 +(import '(ij.plugin PlugIn))
    1.14 +(import '(ij ImagePlus IJ))
    1.15 +(import '(java.lang Math))
    1.16 +
    1.17 +(use 'clojureDemo.appeture)
    1.18 +
    1.19 +(import-static java.lang.Math pow abs)
    1.20 +
    1.21 +(import '(ij Macro))
    1.22 +
    1.23 +(import '(java.io BufferedReader InputStreamReader))
    1.24 +(import '(java.awt.image BufferedImage))
    1.25 +(import '(genesis Genesis))
    1.26 +(import '(utils Mark))
    1.27 +(import '(capenLow StoryProcessor))
    1.28 +(import '(connections Connections WiredBox))
    1.29 +(import '(specialBoxes BasicBox MultiFunctionBox))
    1.30 +(import '(http Start))
    1.31 +(import '(engineering NewHardWiredTranslator))
    1.32 +
    1.33 +(import '(java.awt Polygon))
    1.34 +(import '(java.awt.geom Line2D$Double))
    1.35 +(use 'clojure.contrib.str-utils)
    1.36 +
    1.37 +
    1.38 +(use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
    1.39 +(use 'clojureDemo.MegaDeath)
    1.40 +
    1.41 +
    1.42 +(use 'clojure.contrib.combinatorics)
    1.43 +
    1.44 +(use 'clojure.contrib.repl-utils)
    1.45 +(use ['clojureDemo.Defines 
    1.46 +      :only '(
    1.47 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
    1.48 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
    1.49 +		  collide0 collide1 collide2 collide3 collide4  
    1.50 +		  give0 give1 give2 give3 give4 target default)])
    1.51 +
    1.52 +
    1.53 +;(proxy 
    1.54 +
    1.55 +
    1.56 +
    1.57 +
    1.58 +
    1.59 +(defn startInFrame-rm 
    1.60 +  [genesis]
    1.61 +  (.start genesis)
    1.62 +  (let [frame (JFrame.)]
    1.63 +    (doto frame
    1.64 +      (.setTitle "Genesis")
    1.65 +      (.setBounds 0 0 1024 768)
    1.66 +      (doto (.getContentPane)
    1.67 +	(.setBackground Color/WHITE)
    1.68 +	(.setLayout (BorderLayout.))
    1.69 +	(.add genesis))
    1.70 +      (.setJMenuBar (.getMenuBar genesis))
    1.71 +      (.setVisible true))
    1.72 +    frame))
    1.73 +
    1.74 +
    1.75 +(defn run-genesis
    1.76 +  ([]  (startInFrame-rm (Genesis.)))
    1.77 +  ([genesis] (startInFrame-rm genesis)))
    1.78 +    
    1.79 +(defn lazy->hashMap
    1.80 +  [lazy]
    1.81 +   (zipmap  (map first lazy) (map last lazy)))
    1.82 +
    1.83 +(defn make-box
    1.84 +  "constructs a wired box sutiable for interfacing to Genesis"
    1.85 +  [name process-fn]
    1.86 +  (let [box (proxy [BasicBox] [] (getName [] name) 
    1.87 +		   (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]
    1.88 +    (.addSignalProcessor (Connections/getPorts box) "process")
    1.89 +    box))
    1.90 +
    1.91 +
    1.92 +(defn make-generator-box
    1.93 +  "makes a box which only outputs a constant"
    1.94 +  [name constant]
    1.95 +  (let [box (proxy [BasicBox] []  (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]    
    1.96 +    (.addSignalProcessor (Connections/getPorts box) "process")
    1.97 +    box))
    1.98 +
    1.99 +(defn naturals [] (iterate inc 0))
   1.100 +
   1.101 +;; ;(defn make-multifn-box [& args]
   1.102 +;; ;  (apply hash-map args)
   1.103 +  
   1.104 +;; ;  (map mega-macro naturals )
   1.105 +
   1.106 +;; ;  )
   1.107 +
   1.108 +
   1.109 +
   1.110 +
   1.111 +(defmacro function-name
   1.112 +  [function]
   1.113 +  (list str (list 'quote function)))
   1.114 +
   1.115 +(defn make-vision-box 
   1.116 +  "eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"
   1.117 +  [function1 function2]
   1.118 +  (let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box") 
   1.119 +		   (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))
   1.120 +		   (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]
   1.121 +	(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
   1.122 +	(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
   1.123 +	box))
   1.124 +  
   1.125 +;; (defn make-box
   1.126 +;;   [name & functions]
   1.127 +;;   (let [box (proxy [MultiFunctionBox] [] (getName [] name)
   1.128 +;; 		   (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   1.129 +;; 		     ((symbol (str "process" (first indexed-fun))) 
   1.130 +;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]
   1.131 +    
   1.132 +;;     (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   1.133 +;;       (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun))  (str "process" (first indexed-fun))))
   1.134 +;;     box))
   1.135 +
   1.136 +;; (defmacro proxy-functions
   1.137 +;;   [ name & functions]
   1.138 +;; (into
   1.139 +;;  (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   1.140 +;;    (list (symbol (str "process" (first indexed-fun))) (vector 'obj)  
   1.141 +;; 	 (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))
   1.142 +;;  (list  (list 'getName (vector) name)   (vector) (vector MultiFunctionBox) 'proxy)))
   1.143 +   
   1.144 +
   1.145 +
   1.146 +;; 		     ((symbol (str "process" (first indexed-fun))) 
   1.147 +;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))
   1.148 +
   1.149 +;; (defmacro make-fun2-box
   1.150 +;;   [name & functions]
   1.151 +  
   1.152 +
   1.153 +
   1.154 +;; (defmacro make-fun-box
   1.155 +;;   [name & functions]
   1.156 +;;   (let [proxy-functions 
   1.157 +;; 	(for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
   1.158 +;; 	   ((symbol (str "process" (first indexed-fun)))
   1.159 +;; 		      [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]
   1.160 +    
   1.161 +
   1.162 +  
   1.163 +;;   `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]
   1.164 +;;      ~proxy-functions     
   1.165 +;;     box#))
   1.166 +
   1.167 +;; (defmacro return
   1.168 +;;   [name & functions]
   1.169 +;;   (let [out (for [x functions]
   1.170 +;;     x)]
   1.171 +;;      out))
   1.172 +
   1.173 +  
   1.174 +
   1.175 +		   
   1.176 +
   1.177 +(defn local-genesis
   1.178 +  "connects the custom vision interperter to genesis"
   1.179 +  [function1 function2]
   1.180 +  (let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]
   1.181 +    (Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)
   1.182 +    (Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)
   1.183 +    genesis))
   1.184 +
   1.185 +
   1.186 +
   1.187 +
   1.188 +
   1.189 +
   1.190 +(defn frame-hash
   1.191 +  "yields a convienent representation for the pixles in an image.
   1.192 +   Because of the size of the structvre generated, this must only be used
   1.193 +   in a transient way so that java can do it's garbage collection."
   1.194 +  [imagePlus]
   1.195 +  (with-meta
   1.196 +  (let [buf (.. imagePlus getBufferedImage)
   1.197 +	color (.getColorModel buf)]
   1.198 +   (doall (apply hash-map 
   1.199 +	   (interleave 
   1.200 +	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
   1.201 +	      (vector x y)))
   1.202 +	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
   1.203 +	     (let [data (.getRGB buf x y)] 
   1.204 +	      (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
   1.205 +			:g (bit-shift-right (bit-and 0x00ff00 data) 8)
   1.206 +			:b (bit-and 0x0000ff data)))))))))
   1.207 +  {:width  (.getWidth imagePlus) :height (.getHeight imagePlus)}))
   1.208 +
   1.209 +
   1.210 +
   1.211 +(defn vid-seq
   1.212 +  [video]
   1.213 +  (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))
   1.214 +
   1.215 +
   1.216 +
   1.217 +
   1.218 +
   1.219 +(defn video-hash
   1.220 +  "turns an entire video into a nice hash-map
   1.221 +   .... or at least it would, if java didn't suck and only give me 
   1.222 +   2 GB to work with with no way to increase it.
   1.223 +   linear processing... grumble grumble ....."
   1.224 +  [video-seq]
   1.225 +  (apply hash-map
   1.226 +	 (interleave
   1.227 +	  (naturals)
   1.228 +	  (doall (map #(frame-hash %) video-seq)))))
   1.229 +	   
   1.230 +
   1.231 +
   1.232 +
   1.233 +(defn frame-hash->bufferedImage
   1.234 +  [frame-hash]
   1.235 +    (let [data  (meta frame-hash)
   1.236 +	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
   1.237 +	
   1.238 +	(doall (for [element frame-hash] 
   1.239 +	  (let [coord  (key element) 
   1.240 +		rgb   (val element)
   1.241 +		packed-RGB 
   1.242 +		(+ (bit-shift-left (:r rgb) 16)
   1.243 +		   (bit-shift-left (:g rgb) 8)
   1.244 +		                   (:b rgb))]
   1.245 +	    (.setRGB image (first coord) (last coord) packed-RGB))))
   1.246 +	image))
   1.247 +
   1.248 +(defmethod display
   1.249 +  clojure.lang.PersistentHashMap [frame-hash]
   1.250 +  (display (frame-hash->bufferedImage frame-hash)))
   1.251 +
   1.252 + (defmethod display
   1.253 +   clojure.lang.PersistentArrayMap [frame-hash]
   1.254 +   (display (frame-hash->bufferedImage frame-hash)))
   1.255 +
   1.256 +;; (defmethod display 
   1.257 +;;    clojure.lang.LazySeq [frame-hash]
   1.258 +;;   (display (frame-hash->bufferedImage frame-hash)))
   1.259 +
   1.260 +
   1.261 +
   1.262 +
   1.263 +
   1.264 +(defn rectangle-window
   1.265 +  "efficiently grabs a rectangle from the frame-hash.
   1.266 +   Values that don't exisist in the picture are colored negative green!"
   1.267 +  [x y l w frame-hash]
   1.268 +  (let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]
   1.269 +
   1.270 +    (with-meta
   1.271 +      (zipmap
   1.272 +       coords
   1.273 +       (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))   
   1.274 +      (meta frame-hash))))
   1.275 +
   1.276 +
   1.277 +(defn sum 
   1.278 +     "squashes all the dinensions of the picture together into a single dimension
   1.279 +      sutiable for analysis."
   1.280 +     [window]
   1.281 +     (zipmap
   1.282 +      (keys window)
   1.283 +      (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))
   1.284 +
   1.285 +(defn b&w
   1.286 +  "turn everything grey"
   1.287 +  [window]
   1.288 +  (with-meta
   1.289 +  (zipmap
   1.290 +   (keys window)
   1.291 +   (map (fn  [rgb] 
   1.292 +	  (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]
   1.293 +	    {:r sum :g sum :b sum })) (vals window))) (meta window)))
   1.294 +
   1.295 +(defn green-select-x-form
   1.296 +  "find green things"
   1.297 +  [window]
   1.298 +  (with-meta
   1.299 +  (zipmap
   1.300 +   (keys window)
   1.301 +   (map (fn  [rgb] 
   1.302 +	  (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))
   1.303 +	    rgb
   1.304 +	    {:r 0 :g 0 :b 0})) (vals window))) (meta window)))
   1.305 +  
   1.306 +
   1.307 +(defn manual-line-detect
   1.308 +  "Ty as I might, this can never be truly effective until higher level
   1.309 +   processes contribute to dynamicaly adjusting these paramaters. For
   1.310 +   now I'll settle with simple manual calibration."
   1.311 +  [var1 mean1 var2 mean2]
   1.312 +  (> 
   1.313 +  (if (or (< var1 250) (< var2 250))
   1.314 +    (abs (int (- mean1 mean2)))
   1.315 +    0) 55))
   1.316 +;30 looks good
   1.317 +
   1.318 +
   1.319 +
   1.320 +
   1.321 +(defn frame-windows
   1.322 +  "analyzes a frame in terms of lots of tiny windows which 
   1.323 +   each try to find some sort of edge."
   1.324 +  ([ x-form frame]
   1.325 +     (with-meta
   1.326 +     (let [width (:width  (meta frame) 500)
   1.327 +	   height(:height (meta frame) 500 )]
   1.328 +       (filter (comp not nil?) 
   1.329 +	       (for [x (range 0 width 2) y (range 0 height 2)]
   1.330 +		 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))
   1.331 +  ([frame]  (frame-windows identity frame)))
   1.332 +
   1.333 +
   1.334 +(defn static-segmentation
   1.335 +  "divides a single picture frame into appropiate objects using a 
   1.336 +   simple watershed method based on sharp color variation.
   1.337 +   radius: the general size of the window in pixels
   1.338 +   gradient: threshold for a color gradient to be recognized as a edge"
   1.339 +  [radius gradient frame]
   1.340 +  (let [ah (frame-hash frame)]
   1.341 +    ah))
   1.342 +
   1.343 +
   1.344 +(defn video-parse
   1.345 +  "this is the equilivalent to the S.T.A.R.T Parser for videos
   1.346 +      right now it's just a simple blob detector"
   1.347 +  [video-seq]
   1.348 +  
   1.349 +  )
   1.350 +
   1.351 +
   1.352 +
   1.353 +(defn overlay-draw
   1.354 + [frame-hash overlay]
   1.355 + (let [image  (frame-hash->bufferedImage frame-hash)
   1.356 +       g2 (.getGraphics image)]
   1.357 +   (doall (for [ x overlay] 
   1.358 +     (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))] 
   1.359 +       (.drawLine g2 x1 y1 x2 y2))))
   1.360 +     image))
   1.361 +
   1.362 +
   1.363 +
   1.364 +(defn video-seq->b&w
   1.365 +  [video-seq]
   1.366 +  (with-meta
   1.367 +    (map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))
   1.368 +
   1.369 +    (map (fn [imgPlus]
   1.370 +	   (let [play (frame-hash imgPlus)]
   1.371 +	     (b&w play)))
   1.372 +	 video-seq))
   1.373 +    (meta video-seq)))
   1.374 +
   1.375 +
   1.376 +
   1.377 +(defn vid-save
   1.378 +  [filename vid-seq]
   1.379 +  (trans-save filename 
   1.380 +	     (with-meta (map (comp #(ImagePlus. "reverse-x-form" %)  frame-hash->bufferedImage) vid-seq) (meta vid-seq))))
   1.381 + 
   1.382 +
   1.383 +
   1.384 +;(def g0 (video-seq give0))
   1.385 +(def gen (proxy [Genesis] [] ))
   1.386 +(def short-give  (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))
   1.387 +
   1.388 +(def sg short-give)
   1.389 +(def g1 (first sg))
   1.390 +(def gs sg)
   1.391 +(def play  (frame-hash (first sg)))
   1.392 +(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
   1.393 +
   1.394 +(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
   1.395 +(def b+w-play (b&w play))
   1.396 +(def rgb (rectangle-window 50 50 1 1 play))
   1.397 +(def invertedPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals b+w-play))) (meta play)))
   1.398 +
   1.399 +(def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))
   1.400 +
   1.401 +(def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))
   1.402 +(def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))
   1.403 +(def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))
   1.404 +(def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))
   1.405 +(def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))
   1.406 +
   1.407 +
   1.408 +
   1.409 +
   1.410 +
   1.411 +
   1.412 +
   1.413 +
   1.414 +
   1.415 +
   1.416 +
   1.417 +
   1.418 +
   1.419 +
   1.420 +
   1.421 +
   1.422 +
   1.423 +
   1.424 +
   1.425 +
   1.426 +
   1.427 +
   1.428 +
   1.429 +
   1.430 +
   1.431 +
   1.432 +(comment
   1.433 +  ok here's the plan--
   1.434 +
   1.435 +  "genesis/language"
   1.436 +  raw text -> START -> representations/memory -> story tree
   1.437 +  
   1.438 +  "genesis/vision"
   1.439 +  raw video -> blob detector -> representations/memory -> event/structure tree
   1.440 +
   1.441 +  first, we start off with a video.
   1.442 +  the video get's passed through the blob detector.
   1.443 +  
   1.444 +  (blob-detector 
   1.445 +   first-pass-  divide up each frame into exasutive polygons. no temporal dependence
   1.446 +   second-pass- do a pairwise comparison of frames to link the polygons from each frame.
   1.447 +                polygons can either split apart or merge, but this step establishes their geneology.
   1.448 +   third-pass-  link the polygons together into higher objects using hueristic rules about motion
   1.449 +                these rules are determined by the language system, but for now they will be hardcoded.
   1.450 +                the only thing for now is that things that move together are the same object.
   1.451 +  )
   1.452 +
   1.453 +
   1.454 +  so now, we have a temporal history of polygons.
   1.455 +  the language part of the story may specify that certain characters
   1.456 +  with certain qualities do certain actions. 
   1.457 +  
   1.458 +  "Bob is wearing a red shirt. Shirts are big. Bob is a person.
   1.459 +   Mary is wearing a green shirt.
   1.460 +   Bob is person-sized.
   1.461 +   Bob is moving.
   1.462 +   The green object is a ball.
   1.463 +   Bob gives the ball to Mary."
   1.464 +
   1.465 +  Now, Genesis can select just the polygons that are important to the story,
   1.466 +  and it also learns important facts such as the relative size of a person to a ball.
   1.467 +
   1.468 +  The details which are captured in the polygon-transition space are--
   1.469 +  x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area
   1.470 +  polygon shape
   1.471 +  
   1.472 +  This information recurses on every component polygon as well.
   1.473 +
   1.474 +  When genesis want's to learn about verbs in particular, 
   1.475 +  it selects the aproapiate blobs from the linguistic desctiption (in bob's
   1.476 +  case it's "the big red blob on the left", for example.)
   1.477 +
   1.478 +  after selecting a subset of the blobs, it calculates the angles and distances between 
   1.479 +  those blobs' centers as erll as whether they are touching or overlaping.
   1.480 +
   1.481 +  From this sequence it derives an example of the verb.
   1.482 +
   1.483 +  From other examples it can do arch earning to refine the sequence to its salient features.
   1.484 + )
   1.485 +  
   1.486 +
   1.487 +
   1.488 +(comment (things you can do that will actually work!)
   1.489 +
   1.490 +(do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))
   1.491 +;genesis integration:
   1.492 +(def gen5 (make-generator-box "the 5th element" 5))
   1.493 +(Connections/wire gen5 (make-box "printer" println))
   1.494 +(Connections/viewNetwork)
   1.495 +(.process gen5 :ignore) ; causes 5 to be printed
   1.496 +(Connections/obliterateNetwork)
   1.497 +(.process gen5 :ignore); since the network connections were dissolved, nothing prints.
   1.498 +
   1.499 +
   1.500 +
   1.501 +)
   1.502 +
   1.503 +
   1.504 +