(ns clojureDemo.GenesisPlay)

 

 

 (use 'clojure.contrib.import-static)

 (import '(java.io File))

 (import '(org.apache.commons.io FileUtils))

 (import '(javax.imageio ImageIO) )

 (import '(javax.swing JFrame))

 (import '(java.awt Color BorderLayout))

 (import '(ij.plugin PlugIn))

 (import '(ij ImagePlus IJ))

 (import '(java.lang Math))

 

 (use 'clojureDemo.appeture)

 

 (import-static java.lang.Math pow abs)

 

 (import '(ij Macro))

 

 (import '(java.io BufferedReader InputStreamReader))

 (import '(java.awt.image BufferedImage))

 (import '(genesis Genesis))

 (import '(utils Mark))

 (import '(capenLow StoryProcessor))

 (import '(connections Connections WiredBox))

 (import '(specialBoxes BasicBox MultiFunctionBox))

 (import '(http Start))

 (import '(engineering NewHardWiredTranslator))

 

 (import '(java.awt Polygon))

 (import '(java.awt.geom Line2D$Double))

 (use 'clojure.contrib.str-utils)

 

 

 (use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])

 (use 'clojureDemo.MegaDeath)

 

 

 (use 'clojure.contrib.combinatorics)

 

 (use 'clojure.contrib.repl-utils)

 (use ['clojureDemo.Defines 

       :only '(

 	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 

 		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6

 		  collide0 collide1 collide2 collide3 collide4  

 		  give0 give1 give2 give3 give4 target default)])

 

 

 ;(proxy 

 

 

 

 

 

 (defn startInFrame-rm 

   [genesis]

   (.start genesis)

   (let [frame (JFrame.)]

     (doto frame

       (.setTitle "Genesis")

       (.setBounds 0 0 1024 768)

       (doto (.getContentPane)

 	(.setBackground Color/WHITE)

 	(.setLayout (BorderLayout.))

 	(.add genesis))

       (.setJMenuBar (.getMenuBar genesis))

       (.setVisible true))

     frame))

 

 

 (defn run-genesis

   ([]  (startInFrame-rm (Genesis.)))

   ([genesis] (startInFrame-rm genesis)))

     

 (defn lazy->hashMap

   [lazy]

    (zipmap  (map first lazy) (map last lazy)))

 

 (defn make-box

   "constructs a wired box sutiable for interfacing to Genesis"

   [name process-fn]

   (let [box (proxy [BasicBox] [] (getName [] name) 

 		   (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]

     (.addSignalProcessor (Connections/getPorts box) "process")

     box))

 

 

 (defn make-generator-box

   "makes a box which only outputs a constant"

   [name constant]

   (let [box (proxy [BasicBox] []  (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]    

     (.addSignalProcessor (Connections/getPorts box) "process")

     box))

 

 (defn naturals [] (iterate inc 0))

 

 ;; ;(defn make-multifn-box [& args]

 ;; ;  (apply hash-map args)

   

 ;; ;  (map mega-macro naturals )

 

 ;; ;  )

 

 

 

 

 (defmacro function-name

   [function]

   (list str (list 'quote function)))

 

 (defn make-vision-box 

   "eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"

   [function1 function2]

   (let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box") 

 		   (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))

 		   (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]

 	(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")

 	(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")

 	box))

   

 ;; (defn make-box

 ;;   [name & functions]

 ;;   (let [box (proxy [MultiFunctionBox] [] (getName [] name)

 ;; 		   (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 

 ;; 		     ((symbol (str "process" (first indexed-fun))) 

 ;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]

     

 ;;     (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 

 ;;       (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun))  (str "process" (first indexed-fun))))

 ;;     box))

 

 ;; (defmacro proxy-functions

 ;;   [ name & functions]

 ;; (into

 ;;  (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 

 ;;    (list (symbol (str "process" (first indexed-fun))) (vector 'obj)  

 ;; 	 (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))

 ;;  (list  (list 'getName (vector) name)   (vector) (vector MultiFunctionBox) 'proxy)))

    

 

 

 ;; 		     ((symbol (str "process" (first indexed-fun))) 

 ;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))

 

 ;; (defmacro make-fun2-box

 ;;   [name & functions]

   

 

 

 ;; (defmacro make-fun-box

 ;;   [name & functions]

 ;;   (let [proxy-functions 

 ;; 	(for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]

 ;; 	   ((symbol (str "process" (first indexed-fun)))

 ;; 		      [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]

     

 

   

 ;;   `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]

 ;;      ~proxy-functions     

 ;;     box#))

 

 ;; (defmacro return

 ;;   [name & functions]

 ;;   (let [out (for [x functions]

 ;;     x)]

 ;;      out))

 

   

 

 		   

 

 (defn local-genesis

   "connects the custom vision interperter to genesis"

   [function1 function2]

   (let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]

     (Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)

     (Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)

     genesis))

 

 

 

 

 

 

 (defn frame-hash

   "yields a convienent representation for the pixles in an image.

    Because of the size of the structvre generated, this must only be used

    in a transient way so that java can do it's garbage collection."

   [imagePlus]

   (with-meta

   (let [buf (.. imagePlus getBufferedImage)

 	color (.getColorModel buf)]

    (doall (apply hash-map 

 	   (interleave 

 	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]

 	      (vector x y)))

 	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]

 	     (let [data (.getRGB buf 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 imagePlus) :height (.getHeight imagePlus)}))

 

 

 

 (defn vid-seq

   [video]

   (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))

 

 

 

 

 

 (defn video-hash

   "turns an entire video into a nice hash-map

    .... or at least it would, if java didn't suck and only give me 

    2 GB to work with with no way to increase it.

    linear processing... grumble grumble ....."

   [video-seq]

   (apply hash-map

 	 (interleave

 	  (naturals)

 	  (doall (map #(frame-hash %) video-seq)))))

 	   

 

 

 

 (defn frame-hash->bufferedImage

   [frame-hash]

     (let [data  (meta frame-hash)

 	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]

 	

 	(doall (for [element frame-hash] 

 	  (let [coord  (key element) 

 		rgb   (val element)

 		packed-RGB 

 		(+ (bit-shift-left (:r rgb) 16)

 		   (bit-shift-left (:g rgb) 8)

 		                   (:b rgb))]

 	    (.setRGB image (first coord) (last coord) packed-RGB))))

 	image))

 

 (defmethod display

   clojure.lang.PersistentHashMap [frame-hash]

   (display (frame-hash->bufferedImage frame-hash)))

 

  (defmethod display

    clojure.lang.PersistentArrayMap [frame-hash]

    (display (frame-hash->bufferedImage frame-hash)))

 

 ;; (defmethod display 

 ;;    clojure.lang.LazySeq [frame-hash]

 ;;   (display (frame-hash->bufferedImage frame-hash)))

 

 

 

 

 

 (defn rectangle-window

   "efficiently grabs a rectangle from the frame-hash.

    Values that don't exisist in the picture are colored negative green!"

   [x y l w frame-hash]

   (let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]

 

     (with-meta

       (zipmap

        coords

        (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))   

       (meta frame-hash))))

 

 

 (defn sum 

      "squashes all the dinensions of the picture together into a single dimension

       sutiable for analysis."

      [window]

      (zipmap

       (keys window)

       (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))

 

 (defn b&w

   "turn everything grey"

   [window]

   (with-meta

   (zipmap

    (keys window)

    (map (fn  [rgb] 

 	  (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]

 	    {:r sum :g sum :b sum })) (vals window))) (meta window)))

 

 (defn green-select-x-form

   "find green things"

   [window]

   (with-meta

   (zipmap

    (keys window)

    (map (fn  [rgb] 

 	  (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))

 	    rgb

 	    {:r 0 :g 0 :b 0})) (vals window))) (meta window)))

   

 

 (defn manual-line-detect

   "Ty as I might, this can never be truly effective until higher level

    processes contribute to dynamicaly adjusting these paramaters. For

    now I'll settle with simple manual calibration."

   [var1 mean1 var2 mean2]

   (> 

   (if (or (< var1 250) (< var2 250))

     (abs (int (- mean1 mean2)))

     0) 55))

 ;30 looks good

 

 

 

 

 (defn frame-windows

   "analyzes a frame in terms of lots of tiny windows which 

    each try to find some sort of edge."

   ([ x-form frame]

      (with-meta

      (let [width (:width  (meta frame) 500)

 	   height(:height (meta frame) 500 )]

        (filter (comp not nil?) 

 	       (for [x (range 0 width 2) y (range 0 height 2)]

 		 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))

   ([frame]  (frame-windows identity frame)))

 

 

 (defn static-segmentation

   "divides a single picture frame into appropiate objects using a 

    simple watershed method based on sharp color variation.

    radius: the general size of the window in pixels

    gradient: threshold for a color gradient to be recognized as a edge"

   [radius gradient frame]

   (let [ah (frame-hash frame)]

     ah))

 

 

 (defn video-parse

   "this is the equilivalent to the S.T.A.R.T Parser for videos

       right now it's just a simple blob detector"

   [video-seq]

   

   )

 

 

 

 (defn overlay-draw

  [frame-hash overlay]

  (let [image  (frame-hash->bufferedImage frame-hash)

        g2 (.getGraphics image)]

    (doall (for [ x overlay] 

      (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))] 

        (.drawLine g2 x1 y1 x2 y2))))

      image))

 

 

 

 (defn video-seq->b&w

   [video-seq]

   (with-meta

     (map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))

 

     (map (fn [imgPlus]

 	   (let [play (frame-hash imgPlus)]

 	     (b&w play)))

 	 video-seq))

     (meta video-seq)))

 

 

 

 (defn vid-save

   [filename vid-seq]

   (trans-save filename 

 	     (with-meta (map (comp #(ImagePlus. "reverse-x-form" %)  frame-hash->bufferedImage) vid-seq) (meta vid-seq))))

  

 

 

 ;(def g0 (video-seq give0))

 (def gen (proxy [Genesis] [] ))

 (def short-give  (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))

 

 (def sg short-give)

 (def g1 (first sg))

 (def gs sg)

 (def play  (frame-hash (first sg)))

 (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))

 

 (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))

 (def b+w-play (b&w play))

 (def rgb (rectangle-window 50 50 1 1 play))

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

 

 (def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))

 

 (def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))

 (def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))

 (def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))

 (def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))

 (def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 (comment

   ok here's the plan--

 

   "genesis/language"

   raw text -> START -> representations/memory -> story tree

   

   "genesis/vision"

   raw video -> blob detector -> representations/memory -> event/structure tree

 

   first, we start off with a video.

   the video get's passed through the blob detector.

   

   (blob-detector 

    first-pass-  divide up each frame into exasutive polygons. no temporal dependence

    second-pass- do a pairwise comparison of frames to link the polygons from each frame.

                 polygons can either split apart or merge, but this step establishes their geneology.

    third-pass-  link the polygons together into higher objects using hueristic rules about motion

                 these rules are determined by the language system, but for now they will be hardcoded.

                 the only thing for now is that things that move together are the same object.

   )

 

 

   so now, we have a temporal history of polygons.

   the language part of the story may specify that certain characters

   with certain qualities do certain actions. 

   

   "Bob is wearing a red shirt. Shirts are big. Bob is a person.

    Mary is wearing a green shirt.

    Bob is person-sized.

    Bob is moving.

    The green object is a ball.

    Bob gives the ball to Mary."

 

   Now, Genesis can select just the polygons that are important to the story,

   and it also learns important facts such as the relative size of a person to a ball.

 

   The details which are captured in the polygon-transition space are--

   x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area

   polygon shape

   

   This information recurses on every component polygon as well.

 

   When genesis want's to learn about verbs in particular, 

   it selects the aproapiate blobs from the linguistic desctiption (in bob's

   case it's "the big red blob on the left", for example.)

 

   after selecting a subset of the blobs, it calculates the angles and distances between 

   those blobs' centers as erll as whether they are touching or overlaping.

 

   From this sequence it derives an example of the verb.

 

   From other examples it can do arch earning to refine the sequence to its salient features.

  )

   

 

 

 (comment (things you can do that will actually work!)

 

 (do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))

 ;genesis integration:

 (def gen5 (make-generator-box "the 5th element" 5))

 (Connections/wire gen5 (make-box "printer" println))

 (Connections/viewNetwork)

 (.process gen5 :ignore) ; causes 5 to be printed

 (Connections/obliterateNetwork)

 (.process gen5 :ignore); since the network connections were dissolved, nothing prints.

 

 

 

 )