rlm@1: (ns clojureDemo.GenesisPlay)
rlm@1: 
rlm@1: 
rlm@1: (use 'clojure.contrib.import-static)
rlm@1: (import '(java.io File))
rlm@1: (import '(org.apache.commons.io FileUtils))
rlm@1: (import '(javax.imageio ImageIO) )
rlm@1: (import '(javax.swing JFrame))
rlm@1: (import '(java.awt Color BorderLayout))
rlm@1: (import '(ij.plugin PlugIn))
rlm@1: (import '(ij ImagePlus IJ))
rlm@1: (import '(java.lang Math))
rlm@1: 
rlm@1: (use 'clojureDemo.appeture)
rlm@1: 
rlm@1: (import-static java.lang.Math pow abs)
rlm@1: 
rlm@1: (import '(ij Macro))
rlm@1: 
rlm@1: (import '(java.io BufferedReader InputStreamReader))
rlm@1: (import '(java.awt.image BufferedImage))
rlm@1: (import '(genesis Genesis))
rlm@1: (import '(utils Mark))
rlm@1: (import '(capenLow StoryProcessor))
rlm@1: (import '(connections Connections WiredBox))
rlm@1: (import '(specialBoxes BasicBox MultiFunctionBox))
rlm@1: (import '(http Start))
rlm@1: (import '(engineering NewHardWiredTranslator))
rlm@1: 
rlm@1: (import '(java.awt Polygon))
rlm@1: (import '(java.awt.geom Line2D$Double))
rlm@1: (use 'clojure.contrib.str-utils)
rlm@1: 
rlm@1: 
rlm@1: (use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
rlm@1: (use 'clojureDemo.MegaDeath)
rlm@1: 
rlm@1: 
rlm@1: (use 'clojure.contrib.combinatorics)
rlm@1: 
rlm@1: (use 'clojure.contrib.repl-utils)
rlm@1: (use ['clojureDemo.Defines 
rlm@1:       :only '(
rlm@1: 	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
rlm@1: 		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
rlm@1: 		  collide0 collide1 collide2 collide3 collide4  
rlm@1: 		  give0 give1 give2 give3 give4 target default)])
rlm@1: 
rlm@1: 
rlm@1: ;(proxy 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn startInFrame-rm 
rlm@1:   [genesis]
rlm@1:   (.start genesis)
rlm@1:   (let [frame (JFrame.)]
rlm@1:     (doto frame
rlm@1:       (.setTitle "Genesis")
rlm@1:       (.setBounds 0 0 1024 768)
rlm@1:       (doto (.getContentPane)
rlm@1: 	(.setBackground Color/WHITE)
rlm@1: 	(.setLayout (BorderLayout.))
rlm@1: 	(.add genesis))
rlm@1:       (.setJMenuBar (.getMenuBar genesis))
rlm@1:       (.setVisible true))
rlm@1:     frame))
rlm@1: 
rlm@1: 
rlm@1: (defn run-genesis
rlm@1:   ([]  (startInFrame-rm (Genesis.)))
rlm@1:   ([genesis] (startInFrame-rm genesis)))
rlm@1:     
rlm@1: (defn lazy->hashMap
rlm@1:   [lazy]
rlm@1:    (zipmap  (map first lazy) (map last lazy)))
rlm@1: 
rlm@1: (defn make-box
rlm@1:   "constructs a wired box sutiable for interfacing to Genesis"
rlm@1:   [name process-fn]
rlm@1:   (let [box (proxy [BasicBox] [] (getName [] name) 
rlm@1: 		   (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]
rlm@1:     (.addSignalProcessor (Connections/getPorts box) "process")
rlm@1:     box))
rlm@1: 
rlm@1: 
rlm@1: (defn make-generator-box
rlm@1:   "makes a box which only outputs a constant"
rlm@1:   [name constant]
rlm@1:   (let [box (proxy [BasicBox] []  (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]    
rlm@1:     (.addSignalProcessor (Connections/getPorts box) "process")
rlm@1:     box))
rlm@1: 
rlm@1: (defn naturals [] (iterate inc 0))
rlm@1: 
rlm@1: ;; ;(defn make-multifn-box [& args]
rlm@1: ;; ;  (apply hash-map args)
rlm@1:   
rlm@1: ;; ;  (map mega-macro naturals )
rlm@1: 
rlm@1: ;; ;  )
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defmacro function-name
rlm@1:   [function]
rlm@1:   (list str (list 'quote function)))
rlm@1: 
rlm@1: (defn make-vision-box 
rlm@1:   "eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"
rlm@1:   [function1 function2]
rlm@1:   (let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box") 
rlm@1: 		   (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))
rlm@1: 		   (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]
rlm@1: 	(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
rlm@1: 	(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
rlm@1: 	box))
rlm@1:   
rlm@1: ;; (defn make-box
rlm@1: ;;   [name & functions]
rlm@1: ;;   (let [box (proxy [MultiFunctionBox] [] (getName [] name)
rlm@1: ;; 		   (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
rlm@1: ;; 		     ((symbol (str "process" (first indexed-fun))) 
rlm@1: ;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]
rlm@1:     
rlm@1: ;;     (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
rlm@1: ;;       (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun))  (str "process" (first indexed-fun))))
rlm@1: ;;     box))
rlm@1: 
rlm@1: ;; (defmacro proxy-functions
rlm@1: ;;   [ name & functions]
rlm@1: ;; (into
rlm@1: ;;  (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
rlm@1: ;;    (list (symbol (str "process" (first indexed-fun))) (vector 'obj)  
rlm@1: ;; 	 (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))
rlm@1: ;;  (list  (list 'getName (vector) name)   (vector) (vector MultiFunctionBox) 'proxy)))
rlm@1:    
rlm@1: 
rlm@1: 
rlm@1: ;; 		     ((symbol (str "process" (first indexed-fun))) 
rlm@1: ;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))
rlm@1: 
rlm@1: ;; (defmacro make-fun2-box
rlm@1: ;;   [name & functions]
rlm@1:   
rlm@1: 
rlm@1: 
rlm@1: ;; (defmacro make-fun-box
rlm@1: ;;   [name & functions]
rlm@1: ;;   (let [proxy-functions 
rlm@1: ;; 	(for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
rlm@1: ;; 	   ((symbol (str "process" (first indexed-fun)))
rlm@1: ;; 		      [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]
rlm@1:     
rlm@1: 
rlm@1:   
rlm@1: ;;   `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]
rlm@1: ;;      ~proxy-functions     
rlm@1: ;;     box#))
rlm@1: 
rlm@1: ;; (defmacro return
rlm@1: ;;   [name & functions]
rlm@1: ;;   (let [out (for [x functions]
rlm@1: ;;     x)]
rlm@1: ;;      out))
rlm@1: 
rlm@1:   
rlm@1: 
rlm@1: 		   
rlm@1: 
rlm@1: (defn local-genesis
rlm@1:   "connects the custom vision interperter to genesis"
rlm@1:   [function1 function2]
rlm@1:   (let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]
rlm@1:     (Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)
rlm@1:     (Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)
rlm@1:     genesis))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn frame-hash
rlm@1:   "yields a convienent representation for the pixles in an image.
rlm@1:    Because of the size of the structvre generated, this must only be used
rlm@1:    in a transient way so that java can do it's garbage collection."
rlm@1:   [imagePlus]
rlm@1:   (with-meta
rlm@1:   (let [buf (.. imagePlus getBufferedImage)
rlm@1: 	color (.getColorModel buf)]
rlm@1:    (doall (apply hash-map 
rlm@1: 	   (interleave 
rlm@1: 	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
rlm@1: 	      (vector x y)))
rlm@1: 	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
rlm@1: 	     (let [data (.getRGB buf x y)] 
rlm@1: 	      (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
rlm@1: 			:g (bit-shift-right (bit-and 0x00ff00 data) 8)
rlm@1: 			:b (bit-and 0x0000ff data)))))))))
rlm@1:   {:width  (.getWidth imagePlus) :height (.getHeight imagePlus)}))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn vid-seq
rlm@1:   [video]
rlm@1:   (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn video-hash
rlm@1:   "turns an entire video into a nice hash-map
rlm@1:    .... or at least it would, if java didn't suck and only give me 
rlm@1:    2 GB to work with with no way to increase it.
rlm@1:    linear processing... grumble grumble ....."
rlm@1:   [video-seq]
rlm@1:   (apply hash-map
rlm@1: 	 (interleave
rlm@1: 	  (naturals)
rlm@1: 	  (doall (map #(frame-hash %) video-seq)))))
rlm@1: 	   
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn frame-hash->bufferedImage
rlm@1:   [frame-hash]
rlm@1:     (let [data  (meta frame-hash)
rlm@1: 	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
rlm@1: 	
rlm@1: 	(doall (for [element frame-hash] 
rlm@1: 	  (let [coord  (key element) 
rlm@1: 		rgb   (val element)
rlm@1: 		packed-RGB 
rlm@1: 		(+ (bit-shift-left (:r rgb) 16)
rlm@1: 		   (bit-shift-left (:g rgb) 8)
rlm@1: 		                   (:b rgb))]
rlm@1: 	    (.setRGB image (first coord) (last coord) packed-RGB))))
rlm@1: 	image))
rlm@1: 
rlm@1: (defmethod display
rlm@1:   clojure.lang.PersistentHashMap [frame-hash]
rlm@1:   (display (frame-hash->bufferedImage frame-hash)))
rlm@1: 
rlm@1:  (defmethod display
rlm@1:    clojure.lang.PersistentArrayMap [frame-hash]
rlm@1:    (display (frame-hash->bufferedImage frame-hash)))
rlm@1: 
rlm@1: ;; (defmethod display 
rlm@1: ;;    clojure.lang.LazySeq [frame-hash]
rlm@1: ;;   (display (frame-hash->bufferedImage frame-hash)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn rectangle-window
rlm@1:   "efficiently grabs a rectangle from the frame-hash.
rlm@1:    Values that don't exisist in the picture are colored negative green!"
rlm@1:   [x y l w frame-hash]
rlm@1:   (let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]
rlm@1: 
rlm@1:     (with-meta
rlm@1:       (zipmap
rlm@1:        coords
rlm@1:        (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))   
rlm@1:       (meta frame-hash))))
rlm@1: 
rlm@1: 
rlm@1: (defn sum 
rlm@1:      "squashes all the dinensions of the picture together into a single dimension
rlm@1:       sutiable for analysis."
rlm@1:      [window]
rlm@1:      (zipmap
rlm@1:       (keys window)
rlm@1:       (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))
rlm@1: 
rlm@1: (defn b&w
rlm@1:   "turn everything grey"
rlm@1:   [window]
rlm@1:   (with-meta
rlm@1:   (zipmap
rlm@1:    (keys window)
rlm@1:    (map (fn  [rgb] 
rlm@1: 	  (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]
rlm@1: 	    {:r sum :g sum :b sum })) (vals window))) (meta window)))
rlm@1: 
rlm@1: (defn green-select-x-form
rlm@1:   "find green things"
rlm@1:   [window]
rlm@1:   (with-meta
rlm@1:   (zipmap
rlm@1:    (keys window)
rlm@1:    (map (fn  [rgb] 
rlm@1: 	  (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))
rlm@1: 	    rgb
rlm@1: 	    {:r 0 :g 0 :b 0})) (vals window))) (meta window)))
rlm@1:   
rlm@1: 
rlm@1: (defn manual-line-detect
rlm@1:   "Ty as I might, this can never be truly effective until higher level
rlm@1:    processes contribute to dynamicaly adjusting these paramaters. For
rlm@1:    now I'll settle with simple manual calibration."
rlm@1:   [var1 mean1 var2 mean2]
rlm@1:   (> 
rlm@1:   (if (or (< var1 250) (< var2 250))
rlm@1:     (abs (int (- mean1 mean2)))
rlm@1:     0) 55))
rlm@1: ;30 looks good
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn frame-windows
rlm@1:   "analyzes a frame in terms of lots of tiny windows which 
rlm@1:    each try to find some sort of edge."
rlm@1:   ([ x-form frame]
rlm@1:      (with-meta
rlm@1:      (let [width (:width  (meta frame) 500)
rlm@1: 	   height(:height (meta frame) 500 )]
rlm@1:        (filter (comp not nil?) 
rlm@1: 	       (for [x (range 0 width 2) y (range 0 height 2)]
rlm@1: 		 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))
rlm@1:   ([frame]  (frame-windows identity frame)))
rlm@1: 
rlm@1: 
rlm@1: (defn static-segmentation
rlm@1:   "divides a single picture frame into appropiate objects using a 
rlm@1:    simple watershed method based on sharp color variation.
rlm@1:    radius: the general size of the window in pixels
rlm@1:    gradient: threshold for a color gradient to be recognized as a edge"
rlm@1:   [radius gradient frame]
rlm@1:   (let [ah (frame-hash frame)]
rlm@1:     ah))
rlm@1: 
rlm@1: 
rlm@1: (defn video-parse
rlm@1:   "this is the equilivalent to the S.T.A.R.T Parser for videos
rlm@1:       right now it's just a simple blob detector"
rlm@1:   [video-seq]
rlm@1:   
rlm@1:   )
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn overlay-draw
rlm@1:  [frame-hash overlay]
rlm@1:  (let [image  (frame-hash->bufferedImage frame-hash)
rlm@1:        g2 (.getGraphics image)]
rlm@1:    (doall (for [ x overlay] 
rlm@1:      (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))] 
rlm@1:        (.drawLine g2 x1 y1 x2 y2))))
rlm@1:      image))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn video-seq->b&w
rlm@1:   [video-seq]
rlm@1:   (with-meta
rlm@1:     (map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))
rlm@1: 
rlm@1:     (map (fn [imgPlus]
rlm@1: 	   (let [play (frame-hash imgPlus)]
rlm@1: 	     (b&w play)))
rlm@1: 	 video-seq))
rlm@1:     (meta video-seq)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn vid-save
rlm@1:   [filename vid-seq]
rlm@1:   (trans-save filename 
rlm@1: 	     (with-meta (map (comp #(ImagePlus. "reverse-x-form" %)  frame-hash->bufferedImage) vid-seq) (meta vid-seq))))
rlm@1:  
rlm@1: 
rlm@1: 
rlm@1: ;(def g0 (video-seq give0))
rlm@1: (def gen (proxy [Genesis] [] ))
rlm@1: (def short-give  (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))
rlm@1: 
rlm@1: (def sg short-give)
rlm@1: (def g1 (first sg))
rlm@1: (def gs sg)
rlm@1: (def play  (frame-hash (first sg)))
rlm@1: (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
rlm@1: 
rlm@1: (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
rlm@1: (def b+w-play (b&w play))
rlm@1: (def rgb (rectangle-window 50 50 1 1 play))
rlm@1: (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)))
rlm@1: 
rlm@1: (def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))
rlm@1: 
rlm@1: (def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))
rlm@1: (def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))
rlm@1: (def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))
rlm@1: (def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))
rlm@1: (def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (comment
rlm@1:   ok here's the plan--
rlm@1: 
rlm@1:   "genesis/language"
rlm@1:   raw text -> START -> representations/memory -> story tree
rlm@1:   
rlm@1:   "genesis/vision"
rlm@1:   raw video -> blob detector -> representations/memory -> event/structure tree
rlm@1: 
rlm@1:   first, we start off with a video.
rlm@1:   the video get's passed through the blob detector.
rlm@1:   
rlm@1:   (blob-detector 
rlm@1:    first-pass-  divide up each frame into exasutive polygons. no temporal dependence
rlm@1:    second-pass- do a pairwise comparison of frames to link the polygons from each frame.
rlm@1:                 polygons can either split apart or merge, but this step establishes their geneology.
rlm@1:    third-pass-  link the polygons together into higher objects using hueristic rules about motion
rlm@1:                 these rules are determined by the language system, but for now they will be hardcoded.
rlm@1:                 the only thing for now is that things that move together are the same object.
rlm@1:   )
rlm@1: 
rlm@1: 
rlm@1:   so now, we have a temporal history of polygons.
rlm@1:   the language part of the story may specify that certain characters
rlm@1:   with certain qualities do certain actions. 
rlm@1:   
rlm@1:   "Bob is wearing a red shirt. Shirts are big. Bob is a person.
rlm@1:    Mary is wearing a green shirt.
rlm@1:    Bob is person-sized.
rlm@1:    Bob is moving.
rlm@1:    The green object is a ball.
rlm@1:    Bob gives the ball to Mary."
rlm@1: 
rlm@1:   Now, Genesis can select just the polygons that are important to the story,
rlm@1:   and it also learns important facts such as the relative size of a person to a ball.
rlm@1: 
rlm@1:   The details which are captured in the polygon-transition space are--
rlm@1:   x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area
rlm@1:   polygon shape
rlm@1:   
rlm@1:   This information recurses on every component polygon as well.
rlm@1: 
rlm@1:   When genesis want's to learn about verbs in particular, 
rlm@1:   it selects the aproapiate blobs from the linguistic desctiption (in bob's
rlm@1:   case it's "the big red blob on the left", for example.)
rlm@1: 
rlm@1:   after selecting a subset of the blobs, it calculates the angles and distances between 
rlm@1:   those blobs' centers as erll as whether they are touching or overlaping.
rlm@1: 
rlm@1:   From this sequence it derives an example of the verb.
rlm@1: 
rlm@1:   From other examples it can do arch earning to refine the sequence to its salient features.
rlm@1:  )
rlm@1:   
rlm@1: 
rlm@1: 
rlm@1: (comment (things you can do that will actually work!)
rlm@1: 
rlm@1: (do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))
rlm@1: ;genesis integration:
rlm@1: (def gen5 (make-generator-box "the 5th element" 5))
rlm@1: (Connections/wire gen5 (make-box "printer" println))
rlm@1: (Connections/viewNetwork)
rlm@1: (.process gen5 :ignore) ; causes 5 to be printed
rlm@1: (Connections/obliterateNetwork)
rlm@1: (.process gen5 :ignore); since the network connections were dissolved, nothing prints.
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: )
rlm@1: 
rlm@1: 
rlm@1: