# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1282278764 14400
# Node ID 6d9bdaf919f715d32a46a31fc575f3468fd38189
# Parent  163bf9b2fd1303647d1a42edd712111838233b39
added clojureDemo source

diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/ArchLearning.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/ArchLearning.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,562 @@
+(ns clojureDemo.ArchLearning
+  (:gen-class
+   :implements [connections.WiredBox]
+   :methods [ [process [Object] void] [setFile [Object] void] ]
+   :post-init register))
+
+(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))
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+
+(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 '(engineering NewHardWiredTranslator))
+
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+(use 'clojure.contrib.str-utils)
+
+
+;genesis imports
+(import '(http Start))
+
+
+(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.GenesisPlay)
+
+(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)])
+
+(defn -register
+   "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
+   [this]
+   (println "ClojureBox (register) : Register is run 
+    only when the object is created, as if it were a constructor.")
+   (. (connections.Connections/getPorts this) addSignalProcessor "process"))
+
+(defn -process [ this obj ]
+  (println "ClojureBox (process) :  This is a LISP function, 
+   being called through Java, through the wiredBox metaphor.")
+  (.transmit (Connections/getPorts this)  obj))
+
+(defn -getName
+  "the [_] means that  the function gets an explicit 'this'
+    argument, just like python. In this case we don't care about it."
+  [_]  "ArchLearning")
+
+
+
+
+
+(def output-base (File. "/home/r/Desktop/output-vision"))
+(def rsgs (with-meta (take 10 gs) (meta gs)))
+(def rrsgs (with-meta (take 3 rsgs) (meta gs)))
+; a concept is going to be derived from Genesis' own xml based representations.
+; this is an form of archlearning which figures out a function that representes
+; the concepts.
+
+
+(def black {:r 0  :g 0 :b 0})
+(def white {:r 255 :g 255 :b 255})
+
+
+(defn window-frame
+  "analyzes a frame in terms of lots of tiny windows which 
+   each try to find some sort of edge. keeps coordinates."
+  ([x-form frame]
+     (let [lines (frame-windows x-form frame)]
+       (zipmap (for [x lines] (first (rest x)))
+	       lines)))
+  ([frame]
+     (window-frame identity frame)))
+
+
+(defn intense-select-x-form
+  "discard silly gray things"
+  [window]
+  (with-meta
+    (zipmap
+     (keys window)
+     (map (fn  [rgb]
+	    (let [spread (- (max (:r rgb) (:g rgb) (:b rgb)) (min (:r rgb) (:g rgb) (:b rgb)))]
+	      (if (> spread 45)
+		rgb
+		{:r 0 :g 0 :b 0}))) (vals window)))  (meta window)))
+
+(defn edges-x-form
+  [window]
+  (frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))
+
+   
+
+(defn rgb-max
+  [rgb1 rgb2]
+  {:r (max (:r rgb1) (:r rgb2))
+   :g (max (:g rgb1) (:g rgb2))
+   :b (max (:b rgb1) (:b rgb2))})
+
+(defn frame-hash-add
+  [frame1 frame2]
+  (with-meta
+  (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
+    (zipmap indexes (for [x indexes] (rgb-max (frame1 x black)  (frame2 x black))))) (meta frame1)))
+
+
+
+(defn vid-seq-add
+  "for black and white video-sequences. Just adds them together into one image sequence"
+  [vid-seq1 vid-seq2]
+  (with-meta 
+    (map  #(ImagePlus. "ADD B&W" (frame-hash->bufferedImage %)) (map frame-hash-add (map frame-hash vid-seq1) (map frame-hash vid-seq2)))
+    (meta vid-seq1)))
+
+(defn edges-center-draw
+  ([base edges]
+     (frame-hash-add
+      base
+      (zipmap (keys edges) (repeat white))))
+  ([edges]
+     (edges-center-draw blank edges)))
+
+(defn edge-dot-x-form
+  "gives a new frame-hash with only the edge points, all white."
+  [frame]
+  (edges-center-draw (window-frame frame)))
+
+  
+(defn rgb-euclidian
+  [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
+  (pow (+ (pow (- r1 r2) 2)
+	  (pow (- g1 g2) 2)
+	  (pow (- b1 b2) 2)) 0.5))
+  
+(defn rgb-sub
+  [tolerance rgb1 rgb2]
+  (if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))
+
+
+
+(defn frame-subtract
+  [tolerance frame1 frame2]
+  (with-meta
+  (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
+    (zipmap indexes (for [x indexes] (rgb-sub tolerance (frame1 x)  (frame2 x))))) (meta frame1)))
+
+
+(defn image-subtract
+  [tolerance [img1 img2]]
+  (frame-subtract tolerance (frame-hash img1) (frame-hash img2)))
+
+
+(defn motion-detect
+  ([tolerance video-seq]
+     (with-meta
+       (map (partial image-subtract tolerance) (partition 2 1 video-seq)) (meta video-seq)))
+  ([video-seq]
+     (motion-detect 40 video-seq)))
+
+(defn motion-x-form
+  ([tolerance video-seq]
+     (with-meta    
+       (map  #(ImagePlus. "motion-detect!" (frame-hash->bufferedImage %)) (motion-detect tolerance video-seq))
+       (meta video-seq)))
+  ([video-seq] 
+     (motion-x-form 40 video-seq)))
+;the edge detector is what finds objects.
+;movement disambiguates between different ways of interperting what objects are there
+;color / other qualifiers enable focus on a subset of objects, and can give objects names.
+
+
+
+  
+
+(defn find-an-object
+  "tries to find a single object from the current sensory-buffer, which
+   is a video-seq for now. My idea here is for this to feed-back on itself,
+   adjusting parameters till it can find it's target, and then using those 
+   to construct an representation of the object in terms of how to find it using
+   other visual routines paramaters."
+  [video-seq])
+
+
+
+(defn transform
+  [x-form video-seq]
+  (with-meta
+    (map (fn [imgPlus]
+	   (let [play (frame-hash imgPlus)]
+	     (x-form play)))
+	 video-seq)
+    (meta video-seq)))
+
+
+(defn apply-x-form
+  [x-form video-seq]
+  (with-meta
+    (map #(ImagePlus. "transformed!" (frame-hash->bufferedImage %))
+	 (map (fn [imgPlus]
+		(let [play (frame-hash imgPlus)]
+		  (x-form play)))
+	      video-seq))
+    (meta video-seq)))
+
+
+
+(defn only-white
+  "reduce the image to only its white points"
+  [window]
+  (with-meta
+  (let [new-keys
+	(filter  #(= white (window %)) (keys window))]
+    (zipmap new-keys (map window new-keys))) (meta window)))
+
+
+
+
+(defn white-sum 
+ [& rgbs]
+ (let[ wht-map {white 1}]
+ (reduce + (map #(wht-map % 0) rgbs))))
+
+(defn island?
+  "return false if there's nothing around it within a certain radius"
+  [window [x y]]
+  (let [radius 3]
+    (<= (apply white-sum (vals (rectangle-window x y radius radius window))) 1)))
+
+(defn white-border
+  "anything that relies on a hack like this to work is wrong"
+  [window]
+  (with-meta
+    (let [info (meta window)]
+      (into window
+	    (zipmap
+	     (for [x (range (:width info)) y (range (:height info)) 
+		   :when (or (= (-(:width info) 1) x) (= (- (:height info) 1) y) (= 0 y) (= 0 x))] [x y])
+	     (repeat white))))(meta window)))
+
+(defn polygonize
+   "for each edge-point, try to connect it with all the edge points around it, 
+   or obliterate it if it doesn't have any edge points close by."
+  [window]
+  (with-meta
+  (let [edges (only-white window)]
+    (let [new-keys
+	  (filter (comp not (partial island? window)) (keys window))]
+      (let [ready-points (zipmap new-keys (map window new-keys))]
+ (meta window))))))
+
+
+(defn connect-the-dots
+  [radius window]
+  (let [edge-points (white-border (only-white window))
+	image  (frame-hash->bufferedImage window)
+	g2 (.getGraphics image)]
+    (doall
+     (for [[x y] (keys edge-points)]
+       
+       (let [points  (apply cartesian-product (repeat 2 (keys (only-white (rectangle-window x y radius radius edge-points)))))]
+	(if (not (empty? points))
+	  (doall
+	  (for [[[x1 y1][x2 y2]] points]
+	    (.drawLine g2 x1 y1 x2 y2)))))))
+    (frame-hash (ImagePlus. "stupid..."  image))))
+
+ 
+(defn blob-x-form
+  [window]
+  (with-meta 
+    ((comp (partial connect-the-dots 4) edge-dot-x-form) window)
+  (meta window)))
+
+
+
+
+(defn connect-points
+ [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 disambiguate-edges
+  "Like in project Prakesh, the thing that lets you discern shapes
+   is watching them *move* coherently. After many months of this 
+   motion-boosting, the edge-detector itself becomes good enogh to 
+   analyze static pictures without motion.  This function takes edges
+   and tries to combine them into lines, dividing the world into
+   polygonal regions.  Motion is used to associate two regions together.
+   associated with those points, that information is also used."
+  [edges motion]
+)
+  
+
+(defn triple-seq
+  [triple]
+  (list (.getFirst triple) (.getSecond triple) (.getThird triple)))
+
+(defn contains-word?
+  [word triple]
+  (contains? (set  (map (fn [s] (re-sub #"-\d+" "" s)) (triple-seq triple))) word))
+
+
+(defn write 
+  [reference]
+  (fn [x] (dosync 
+	   (println "wrote "  " to " "ref.")
+	   (ref-set reference x))))
+
+
+;; (defn join-point-lists
+;;   [pointlist1 pointlist2]
+;;   (for [x  :while (not(= x 5))] x)))
+
+(defn extract-single-blob
+  "find the biggest blob in an image and return it"
+  [window]
+  ;we're assuming that there are only blobs left -- funning this on an unprocessed
+  ;image will just return the entire image
+  (map list window))
+
+
+
+
+(def gen-out (ref nil))
+(def triple (ref nil))
+
+
+
+(def gen1 (ref ()))
+(def gen2 (ref ()))
+(def gen3 (ref ()))
+(def gen4 (ref ()))
+(def gen5 (ref ()))
+(def gen6 (ref ()))
+(def gen7 (ref ()))
+(def gen8 (ref ()))
+
+
+(defn make-color-generator
+  []
+ (let [r (java.util.Random. 58)
+       g (java.util.Random. 125)
+       b (java.util.Random. 8)]
+   #(hash-map :r (.nextInt r 255)  :g (.nextInt r 255)   :b (.nextInt r 255))))
+
+
+;a blob is a collection of:
+;points, colors
+;other blobs
+;so, a window is a blob too.
+
+
+
+
+
+
+;; (defn blob-color-absob
+;;   [blob1 blob2]
+;;   (if (and (< (rgb-euclidian (color-avg blob1) (color-avg blob2)) 20) (close-together blob1 blob2))
+;;     (combine blob1 blob2)
+;;     '(blob1 blob2)))
+  
+
+(defn make-test-box
+  "stupid."
+  []
+  (let [box (proxy [MultiFunctionBox] [] (getName [] "test-box [clojure]") 
+		   (process1 [obj] ((write gen1) obj))
+		   (process2 [obj] ((write gen2) obj))
+		   (process3 [obj] ((write gen3) obj))
+		   (process4 [obj] ((write gen4) obj))
+		   (process5 [obj] ((write gen5) obj))
+		   (process6 [obj] ((write gen6) obj))
+		   (process7 [obj] ((write gen7) obj))
+		   (process8 [obj] ((write gen8) obj)))]
+    
+    (.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
+    (.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
+    (.addSignalProcessor (Connections/getPorts box) "PORT3" "process3")
+    (.addSignalProcessor (Connections/getPorts box) "PORT4" "process4")
+    (.addSignalProcessor (Connections/getPorts box) "PORT5" "process5")
+    (.addSignalProcessor (Connections/getPorts box) "PORT6" "process6")
+    (.addSignalProcessor (Connections/getPorts box) "PORT7" "process7")
+    (.addSignalProcessor (Connections/getPorts box) "PORT8" "process8")
+    box))
+
+
+
+(defn writer-box
+  [reference]
+  (let [box (proxy [MultiFunctionBox] [] 
+	      (getName [] "ref-set\n [clojure]")
+	      (process1 [obj] ((write reference) obj)))]
+     (.addSignalProcessor (Connections/getPorts box) "process1")
+     box))
+
+
+
+
+(def triples  (ref ()))
+(def parse    (ref ()))
+(def raw      (ref ()))
+(def idioms   (ref ()))
+(def yes-no   (ref ()))
+(def imagine  (ref ()))
+(def traj     (ref ()))
+(def action   (ref ()))
+(def transfer (ref ()))
+(def pix      (ref ()))
+(def property (ref ()))
+
+(use 'clojure.contrib.str-utils)
+
+(defn process-video-and-subtitles
+  [this file]
+  ;we're looking for a text file of the same name as the video file.
+  (let [subtitles (File. (.getParent file) (str (last (first (re-seq #"(^.*)\.avi$" (.getName file)))) ".txt"))]
+    (dorun 
+    (for [line (re-split #"\n" (slurp (str subtitles)))]
+      (do (println line)
+      (.transmit (Connections/getPorts this)  line)))))
+  (display (first (video-seq file))))
+
+(defn process-triple
+  [this triple]
+  (println "RLM [vision-box]: " triple))
+
+(defn visionBox
+  []
+  (let [box (proxy [MultiFunctionBox] [] 
+	      (getName [] "VisionBox \n [clojure]")
+	      (process1 [obj] (process-video-and-subtitles this obj))
+	      (process2 [obj] (process-triple this obj)))]
+  (.addSignalProcessor (Connections/getPorts box) "video-in" "process1")
+  (.addSignalProcessor (Connections/getPorts box) "triple-in" "process2")
+
+  (println "the good box")
+  box))
+
+  
+
+
+
+(defn custom-genesis
+  "connects the writer boxes to genesis"
+  []
+  (Connections/obliterateNetwork)
+  (let [stupid-box (make-test-box) genesis (Genesis.) vis-box (visionBox) ]
+    (Connections/wire "tripple port" (.getStartParser genesis) (writer-box triples))
+    (Connections/wire "parse" (.getStartParser genesis) (writer-box parse))
+    (Connections/wire "result" (.getNewSemanticTranslator genesis) (writer-box raw))
+    (Connections/wire (.getIdiomExpert genesis) (writer-box idioms))
+    (Connections/wire "yes-no question" (.getCommandExpert genesis) (writer-box yes-no))
+    (Connections/wire "imagine" (.getCommandExpert genesis)  (writer-box imagine))
+    (Connections/wire "viewer" (.getTrajectoryExpert genesis) (writer-box traj))
+    (Connections/wire "viewer" (.getActionExpert genesis) (writer-box action))
+    (Connections/wire "next" (.getTransferExpert genesis) (writer-box transfer))
+    (Connections/wire  (.getRachelsPictureFinder genesis) (writer-box pix))
+    (Connections/wire "viewer" (.getPropertyExpert genesis) (writer-box property))
+    (Connections/wire "tripple port" (.getStartParser genesis) "triple-in" vis-box)
+    
+
+    (Connections/wire (.getArchLearning genesis) "video-in" vis-box)
+    (Connections/wire  vis-box "sentence" (.getStartParser genesis))
+    
+ genesis))
+
+
+(use 'clojure.contrib.def)
+
+(defvar learning-hash  {}
+  "Right now this serves as the visual memory.  
+   It's full of verbs/objects and the programs
+   that find them.")
+
+(def green {:r 0 :g 200 :b 0})
+(def blue  {:r 0  :g 0  :b 255})
+(def red   {:r 255 :g 0 :b 0})
+
+
+(defn color-similar?
+  [threshold window color coord]
+  (< (rgb-euclidian (window coord) color) threshold))
+;should also have the same "shape" here
+
+(defn color-select
+     [threshold color window]
+     (with-meta
+       (let [new-keys
+	     (filter  (partial color-similar? threshold window color) (keys window))]
+	 (zipmap new-keys (map window new-keys)))
+	   (meta window)))
+
+
+
+(defn object-sequence
+  "get's the largest blob of the given color from a video sequence."
+  [color video-seq]
+ (apply-x-form (comp (partial color-select 135 color) intense-select-x-form) rrsgs))
+
+(defn -setFile
+  [this file]
+  (println "file is " file)
+  (.process this file))
+
+
+
+
+(comment (things you can do that will actually work!)
+
+(do (use :reload-all 'clojureDemo.ArchLearning) (in-ns 'clojureDemo.ArchLearning))
+
+(display (overlay-draw (green-select-x-form play) (frame-windows green-select-x-form play )))
+
+;vision stuff
+
+(def edgesD (transform window-frame rrsgs))
+
+(doall 
+ (def edgesI (apply-x-form edges-x-form rrsgs))
+ (display (rectangle-window 50 50 50 50 (frame-hash (nth edgesI 1))))
+ )
+
+(def polyjuice (white-border (only-white (edge-dot-x-form play))))
+
+(count  (color-select 135 red (intense-select-x-form (frame-hash (last sg)))))
+(trans-save (File. output-base "only-red.avi")(apply-x-form (comp (partial color-select 135 red) intense-select-x-form) rrsgs))
+)
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/BasicVision.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/BasicVision.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,85 @@
+(ns clojureDemo.BasicVision)
+
+
+(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))
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+
+(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 '(engineering NewHardWiredTranslator))
+
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+(use 'clojure.contrib.str-utils)
+
+
+;genesis imports
+(import '(http Start))
+
+
+(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.GenesisPlay)
+(use 'clojureDemo.ArchLearning)
+
+(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)])
+
+
+
+; a concept is going to be derived from Genesis' own xml based representations.
+; this is an form of archlearning which figures out a function that representes
+; the concepts.
+
+
+     
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(comment
+
+(do (use :reload-all 'clojureDemo.BasicVision) (in-ns 'clojureDemo.BasicVision))
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/Defines.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/Defines.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,46 @@
+(ns clojureDemo.Defines)
+
+(import '(java.io File))
+
+(def -inf Double/NEGATIVE_INFINITY)
+(def inf  Double/POSITIVE_INFINITY)
+
+
+(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
+(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
+(def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))
+(def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))
+(def blow (File. "/home/r/Desktop/source-videos/blow.avi"))
+
+(def base (File. "/home/r/Desktop/source-videos/"))
+
+(def app0 (File. base "approach0v2.avi"))
+(def app1 (File. base "approach1v3.avi"))
+(def app2 (File. base "approach0v3.avi"))
+(def app3 (File. base "approach2v2.avi"))
+(def app4 (File. base "approach1v2.avi")) 
+(def app5 (File. base "approach2v3.avi"))
+  
+(def bounce0 (File. base "bounce0v2.avi"))  
+(def bounce1 (File. base "bounce1v3.avi")) 
+(def bounce2 (File. base "bounce3v2.avi"))
+(def bounce3 (File. base "bounce0v3.avi"))  
+(def bounce4 (File. base "bounce2v2.avi"))
+(def bounce5 (File. base "bounce1v2.avi"))  
+(def bounce6 (File. base "bounce2v3.avi"))
+
+(def collide0 (File. base "collide0v3.avi"))  
+(def collide1 (File. base "collide2v3.avi")) 
+(def collide2 (File. base "collide1v2.avi"))
+(def collide3 (File. base "collide0v2.avi"))  
+(def collide4 (File. base "collide1v3.avi")) 
+  
+(def give0 (File. base "give0v3.avi"))  
+(def give1 (File. base "give2v3.avi")) 
+(def give2 (File. base "give1v2.avi")) 
+(def give3 (File. base "give0v2.avi"))        
+(def give4 (File. base "give1v3.avi"))
+
+
+(def target (File. "/home/r/Desktop/output-vision/"))
+(def default(File. target "default.avi"))
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/FaceDetect.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/FaceDetect.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,70 @@
+(ns clojureDemo.FaceDetect
+  (:import (javax.swing JFrame JLabel Timer)
+	   (java.awt.event ActionListener KeyAdapter)
+	   (java.awt Canvas Image Color)
+	   (java.awt.image MemoryImageSource)
+	   (hypermedia.video OpenCV)))
+
+;this will not work with the current setup;
+;it's just here as a reference for how to access
+;cameras.
+
+(def frame-rate (int 1000/30))
+(def width 640)
+(def height 480)
+
+(defn vision []
+  (doto (OpenCV.)
+    (.capture width height)
+    (.cascade OpenCV/CASCADE_FRONTALFACE_ALT)
+))
+
+(defn capture-image [vis]
+  (.read vis)
+  (let [mis (MemoryImageSource. (.width vis) (.height vis)
+				(.pixels vis) 0 (.width vis))]
+    (.createImage (Canvas.) mis)))
+
+(defn detect-face [vis]
+  (.detect vis 1.2 2 OpenCV/HAAR_DO_CANNY_PRUNING 20 20))
+
+(defn capture-action [vis panel image faces]
+  (proxy [ActionListener] []
+    (actionPerformed
+     [e]
+     (dosync (ref-set image (capture-image vis))
+	     (ref-set faces (detect-face vis)))
+     (.repaint panel))))
+
+(defn panel [image faces]
+  (proxy [JLabel] [] 
+    (paint
+     [g]
+     (.drawImage g @image 0 0 nil)
+     (.setColor g Color/red)
+     (doseq [square @faces]
+       (.drawRect g
+		  (.x square) (.y square)
+		  (.width square) (.height square))))))
+
+(defn key-listener [vis timer]
+  (proxy [KeyAdapter] [] 
+    (keyReleased 
+     [e]
+     (.stop timer)
+     (.dispose vis))))
+
+(defn main []
+  (let [vis   (vision)
+	image (ref (capture-image vis))
+	faces (ref (detect-face vis))
+	panel (panel image faces)
+	timer (Timer. frame-rate (capture-action vis panel image faces))]
+    (.start timer)
+    (doto (JFrame.)
+      (.add panel)
+      (.addKeyListener (key-listener vis timer))
+      (.setSize width height)
+      (.show))))
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/GenesisPlay.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/GenesisPlay.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,501 @@
+(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.
+
+
+
+)
+
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/ImageJ.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/ImageJ.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,12 @@
+(ns clojureDemo.ImageJ)
+
+
+
+
+(comment 
+
+(do (use :reload-all 'clojureDemo.ImageJ) (in-ns 'clojureDemo.ImageJ))
+
+1255231 for non delayed version.
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/LocalGenesis.class
Binary file src/clojureDemo/LocalGenesis.class has changed
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/MegaDeath.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/MegaDeath.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,90 @@
+(ns clojureDemo.MegaDeath)
+
+(import '(java.io File))
+(import '(org.apache.commons.io FileUtils))
+(import '(javax.imageio ImageIO) )
+
+(import '(ij.plugin PlugIn))
+(import '(ij ImagePlus IJ))
+
+(import '(ij Macro))
+
+(import '(java.io BufferedReader InputStreamReader))
+(import '(java.awt.image BufferedImage))
+
+
+
+(use '[clojureDemo.Xuggle :only (video-seq trans-save flash video-data display)])
+
+
+(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)])
+
+
+(def hamster  (first (video-seq look)))
+(def ham (.getImage hamster))
+
+(set! *print-length* 10)
+
+
+
+(defn final-ficker
+  "wtf?"
+  [& vars]
+  (class (last vars)))
+
+(defmulti log-polar (fn [& args] (class (last args))))
+
+(defmethod log-polar clojure.lang.LazySeq
+  ([X Y video-seq]
+     (with-meta (map #(log-polar % X Y) video-seq) (meta video-seq)))
+  ([video-seq]
+     (with-meta (map #(log-polar %) video-seq) (meta video-seq))))
+
+
+(defmethod log-polar ij.ImagePlus
+     [imageP]
+     (let [thread (Thread/currentThread)
+	   options ""]
+       (.setName thread "Run$_polar-transform")
+       (Macro/setOptions thread options)
+       (IJ/runPlugIn imageP "clojureDemo.Polar_Transformer" "")
+       (let [return-image (IJ/getImage)]
+	 (.hide return-image)
+	 return-image)))
+
+(defn x-polar2 
+     [imageP]
+     (let [thread (Thread/currentThread)
+	   options ""]
+       (.setName thread "Run$_polar-transform")
+       (Macro/setOptions thread options)
+       (IJ/runPlugIn imageP "clojureDemo.Polar_Transformer" "")))
+
+
+
+(defn follow-object
+     "takes in a video stream and does the most basic and simple forms of object detection."
+     [video-seq]
+)
+
+
+
+
+
+
+
+
+
+
+
+(comment
+
+(do (use :reload-all 'clojureDemo.MegaDeath) (in-ns 'clojureDemo.MegaDeath))
+(map #(ns-unmap 'user %)(keys (ns-interns 'user)))
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/OpenCv.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/OpenCv.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,226 @@
+(ns clojureDemo.OpenCv)
+  
+(import '(java.awt Rectangle Robot Toolkit) )
+(import '(java.awt.image BufferedImage) )
+(import '(java.awt Graphics2D Panel))
+(import '(java.io File) )
+(import '(javax.imageio ImageIO) )
+(import '(javax.swing JFrame))
+(import '(org.apache.commons.io FileUtils))
+(import clojure.lang.LazySeq)
+(import '(name.audet.samuel.javacv.jna highgui cv cxcore 
+				       cxcore$IplImage highgui$CvCapture$PointerByReference  
+				       highgui$CvVideoWriter$PointerByReference cxcore$IplImage$PointerByReference))
+(import '(name.audet.samuel.javacv CanvasFrame JavaCvErrorCallback))
+
+(.redirectError (JavaCvErrorCallback.))
+
+(use 'clojure.contrib.repl-utils)
+;(use 'clojureDemo.Defines)
+;(use '[clojureDemo.Xuggle :only (cache)])
+
+;this is still a work in progress, I'll come back to it later when I understand 
+;jna more thoroughly.  the important abstraction here is 
+;video-seq, which gives a lazy sequence of Intel Image Processing library images.
+
+(defn naturals [] (iterate inc 0))
+
+(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
+
+
+(defmulti  display "Creates a JFrame and displays a buffered image"  class)
+
+(defmethod display 
+  BufferedImage  [image] 
+  (let [panel (makePanel image)
+	frame (JFrame. "Oh Yeah!")]
+    (.add frame panel) 
+    (.pack frame) 
+    (.setVisible frame true ) 
+    (.setSize frame(.getWidth image) (.getHeight image))))
+
+(defmethod display
+  cxcore$IplImage [image]
+  ( display (.getBufferedImage image)))
+  
+(defmethod display
+  String [image]
+  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
+
+(defmethod display
+  LazySeq [s]
+  (display (first s)))
+
+
+
+(def ext "jpg") 
+;see below for the rationale for this choice of extention.
+
+(def cache-location "/home/r/Desktop/vision-cache/")
+
+(defn close-capture
+  [capture]
+  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
+
+(defn close-writer
+  [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 
+
+(defn- cache-path
+  [video]
+  (File. cache-location (.getName video)))
+
+(defn- already-cached
+  "this is the simplest and most retarded way to do it"
+  [video]
+  (.exists (cache-path video)))
+
+(defn write-frame 
+  [capture target-dir n]
+  (let [image (highgui/cvQueryFrame capture)]
+    (if (nil? image) false
+	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))
+
+(defn- write-frame-bad
+  [capture target-dir n]
+  (println (str "saving frame: " n))
+  (let [image (highgui/cvQueryFrame capture)]
+    (if (nil? image) false
+	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))
+
+(defn- write-frames
+  [video target-dir]
+  (let [capture (highgui/cvCreateFileCapture (.getPath video))]
+   (dorun 
+    (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
+    (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
+
+(defn- cache-frames
+  [cache-location video]
+  (time 
+   (do
+     (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
+     (FileUtils/deleteDirectory (cache-path video))
+     (FileUtils/forceMkdir (cache-path video))
+     (write-frames video  (cache-path video)))))
+
+;(defn cache
+;  [video]
+;  (if (already-cached video) nil (cache-frames cache-location video)))
+ 
+(defn video-len 
+  [video]
+  (alength (.list (cache-path video))))
+(def video-len (memoize video-len))
+ 
+(defn video-data
+  "since the opencv version is so absolutely unreliable..."
+  [video]
+  (let
+      [capture (highgui/cvCreateFileCapture (.getPath video))
+       info {:length      (video-len video)
+	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
+	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
+	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
+	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
+    (close-capture capture)
+    info))
+(def video-data (memoize video-data))
+
+(defn video-frame-path
+     [video n]
+     (File. (cache-path video)  (str n "."  ext)))
+
+
+(defn- video-frame-ipl
+  [video n] 
+;  (cache video)
+  (let 
+      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)
+       jvm-managed (.clone c++-managed)] 
+	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
+	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 
+         ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 
+         ;other function has to worry about manual garbage collection ever again.
+         ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
+         ;which is the issue, but something involving the image header.
+    (cxcore/cvReleaseImage (.pointerByReference c++-managed))
+    jvm-managed
+))
+  
+
+(defn- video-frame-buffered
+  "takes one frame from a video in constant time"
+  [video n]
+ ; (cache video)
+  (ImageIO/read (File. (cache-path video) (str n "."  ext))))
+
+(defn video-frame [video n] (video-frame-buffered video n))
+
+(defn- dumb-write 
+  [video n writer]
+  (let 
+      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
+    (highgui/cvWriteFrame writer  c++-managed)
+    (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
+
+(defn video-seq
+  "makes a lazy sequence of IPL images"
+  ;additionally, I want to pass metadata around with the sequence.
+  [video] ;(cache video)
+  (map #(video-frame video %) (range (video-len video))))
+(defn video-writer
+  "uses data about the video to make a writer"
+  [data fileTarget]
+  (highgui/cvCreateVideoWriter 
+   (str fileTarget)
+   
+   ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)
+   ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
+   ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
+   ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)
+   (highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)
+   ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)
+   ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)
+   ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)
+   ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  
+
+   (:fps data) (cxcore/cvSize (:width data) (:height data)) 
+   1; 1 here means that we're writing in color.
+    ; you cannot change it to 0 to write in 
+    ; black and white. Everything just crashes instead.
+    ; what a useful paramater.
+   ))
+
+
+(defn naturals []  (iterate inc 0))
+
+
+(defn write-frame-2
+  [writer frame]
+  (let [c++-frame (cxcore$IplImage/createFrom frame)]
+    (highgui/cvWriteFrame writer c++-frame)
+   ; (cxcore/cvReleaseImage (.pointerByReference c++-frame)))
+)
+    frame)
+
+(defn save-seq 
+  [writer video-seq]
+  (map #(write-frame-2 writer %) video-seq))
+
+(defmacro trans-save
+"there's a small problem with trans-save --- it IS
+truly transitive, but it does too much work....
+sometimes it writes files twice.
+this is functionally correct though."
+  [target config video-seq]
+  `(let [writer# (video-writer ~config ~target)]
+     (do
+       (dorun (save-seq writer# ~video-seq))
+       (close-writer writer#)
+       ~video-seq)))
+
+
+
+(comment 
+(do (use :reload-all 'clojureDemo.OpenCv) (in-ns 'clojureDemo.OpenCv))
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/Polar_Transformer.class
Binary file src/clojureDemo/Polar_Transformer.class has changed
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/ScracthPad.class
Binary file src/clojureDemo/ScracthPad.class has changed
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/TestNetwork.class
Binary file src/clojureDemo/TestNetwork.class has changed
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/VideoParse.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/VideoParse.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,230 @@
+(ns clojureDemo.VideoParse)
+  
+ 
+
+;this file is not used anymore, except for the (display %) function.
+
+
+
+(import '(java.awt Rectangle Robot Toolkit) )
+(import '(java.awt.image BufferedImage) )
+(import '(java.awt Graphics2D Panel))
+(import '(java.io File) )
+(import '(javax.imageio ImageIO) )
+(import '(com.xuggle.mediatool ToolFactory))
+(import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
+(import '(com.xuggle.mediatool MediaToolAdapter))
+(import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
+(import '(javax.swing JFrame))
+
+(import clojure.lang.LazySeq)
+
+(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
+
+(import '(name.audet.samuel.javacv CanvasFrame))
+
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
+
+(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
+(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
+
+;definitions
+
+(def -inf Double/NEGATIVE_INFINITY)
+(def inf  Double/POSITIVE_INFINITY)
+
+(use 'clojure.contrib.repl-utils)
+
+
+;minor functions
+
+(defn converge
+  "recursively runs update until prior passes accept, then returns"
+  [prior update accept]
+  (if (accept prior) prior (recur (update prior) update accept)))
+
+(defn interval-width [interval] (- (last interval) (first interval)))
+
+(defn midpoint [interval] 
+  (let [a (first interval) b (last interval)]
+    (if (and (= a -inf) (= b inf)) 0
+    (if (= a -inf) (midpoint [(- b 200000) b])
+	(if (= b inf) (midpoint [a (+ a 200000)])
+	    (int (/ (+ a b) 2)))))))
+
+(defn cart2
+  "calculates the cartesian product in 2 dimensions"
+  [point] 
+  (let [[x y] point] (for [abscissa (range x) ordinate (range y)] [abscissa ordinate])))
+
+(defn closeCapture
+  [capture]
+  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
+
+(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
+
+(defn screenshot "grab screenshot" [] 
+  
+  (ImageIO/write
+   (.createScreenCapture (Robot.) (Rectangle. (.getScreenSize (Toolkit/getDefaultToolkit))))
+   "JPG"
+   (File. "/home/r/Desktop/screenie.jpg")))
+
+(defn- readerRecurse
+  "calls .readPacket until there's nothing left to do"
+  [reader]
+  (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
+    nil                                   ; it returns null when it has MORE to process, and signals an error when done... 
+    (recur reader)))
+
+(defmacro times
+  "perform multiple timed tests on a form"
+  [n form]
+  `(dotimes [_# ~n] (time ~form)))
+  
+(defmacro me-1
+  "does macroexpand-1 without having to quote the form"
+  [form]
+  (list 'macroexpand-1 (list 'quote form)))
+
+;Major Functions
+
+(defmulti  display "Creates a JFrame and displays a buffered image"  class)
+
+(defmethod display 
+  BufferedImage  [image] 
+  (let [panel (makePanel image)
+	frame (JFrame. "Oh Yeah!")]
+    (.add frame panel) 
+    (.pack frame) 
+    (.setVisible frame true ) 
+    (.setSize frame(.getWidth image) (.getHeight image))))
+
+(defmethod display
+  cxcore$IplImage [image]
+  ( display (.getBufferedImage image)))
+  
+(defmethod display
+  String [image]
+  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
+
+(defmethod display
+  LazySeq [s]
+  (display (first s)))
+
+
+(defn convert
+  "takes video and converts it to a new type of video"
+  [videoInput videoOutput]
+  (let [reader (ToolFactory/makeReader videoInput)]
+    (doto reader
+      (.addListener (ToolFactory/makeWriter videoOutput reader))
+      (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
+    (readerRecurse reader)))
+
+
+
+(defn video-frame
+  ":("
+  [video frame]
+  (lazy-seq
+   (try 
+    (let [capture (highgui/cvCreateFileCapture video)]
+      (highgui/cvSetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES frame)
+      (println (str "Wanted frame <" frame "> but went to keyFrame " (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES)))
+      (let [out (highgui/cvQueryFrame capture)
+	    image (.clone  out)]
+	(highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))
+	[image]))
+    (catch java.lang.NullPointerException _ nil))))
+
+
+  
+
+(defn save-frame
+  "takes an opencv image and saves it to disk"
+  [frame filename]
+  (highgui/cvSaveImage filename frame))
+
+
+(defn video-len
+  "finds out the real length of a video in log time."
+  [video]
+  (letfn
+      [
+       (accept [interval] (= 0 (interval-width interval)))
+       (update [interval]
+	       (let [[a b] interval]
+		 (if (> (interval-width interval) 2)
+		   (let [
+			 middle (midpoint interval)
+			 frame (first (video-frame video middle))
+			 ]
+		     (if (nil? frame) [a middle] [middle b]))
+		   [a a])))
+       ]
+       
+   (first (converge [-inf inf] update accept))))
+(def video-len (memoize video-len))
+
+
+
+(defn getData
+  "returns a bunch of stuff about a video"
+  [video]
+  (let
+      [capture (highgui/cvCreateFileCapture video)
+       info {:frames      (video-len video)
+	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
+	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
+	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
+	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
+      
+    (closeCapture capture)
+    info))
+(def getData (memoize getData))
+  
+
+(defn sajitify-linear
+  "oh yeah!"
+  [video string]
+  (let [ capture (highgui/cvCreateFileCapture video)
+	frames (:frames (getData video))]
+       (dotimes [n frames]
+	 (highgui/cvSaveImage (str string  (format "%06d" n) ".jpg") (highgui/cvQueryFrame capture)))
+       (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
+
+(defn getFrame
+  "gets the frame of a video at the specified time in seconds.
+  this works with the simplest interpolation --- just piecewise steps"
+  [video time]
+  (lazy-seq
+  [time  (video-frame video (int (* time (:fps (getData video)))))]))
+
+(defn video-seq-times
+  "it's the new and improved version of videoSeq, now using OpenCv.
+  we expect a sequence of times in seconds"
+  [times video]
+  (map #(getFrame video %) times))
+
+(defn video-seq
+  "get's ALL the frames of a video as a lazy sequence of (IplImages)"
+  [video] 
+  (take (:frames (getData video))   (map #(video-frame video %) (iterate inc 0))))
+
+(defn trans-Writer
+  "uses data about the video to make a writer"
+  [video fileTarget]
+  (let [data (getData video)]
+  (highgui/cvCreateVideoWriter fileTarget (highgui/CV_FOURCC "F" "L" "V" "1") (:fps data) (cxcore/cvSize (:width data) (:height data)) 1)))
+
+(def naturals (iterate inc 0))
+
+(defn sajitify-seq
+  [video string]
+  (dorun (map #(highgui/cvSaveImage (str string  (format "%06d" %2) ".jpg") (first %1)) (video-seq video) naturals)))
+
+
+
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/VideoTransforms.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/VideoTransforms.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,194 @@
+(ns clojureDemo.VideoTransforms)
+  
+(import '(java.awt Rectangle Robot Toolkit) )
+(import '(java.awt.image BufferedImage) )
+(import '(java.awt Graphics2D Panel))
+(import '(java.io File) )
+(import '(javax.imageio ImageIO) )
+(import '(javax.swing JFrame))
+(import '(org.apache.commons.io FileUtils))
+(import clojure.lang.LazySeq)
+(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
+(import '(name.audet.samuel.javacv CanvasFrame))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
+(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
+(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
+(import '(name.audet.samuel.javacv JavaCvErrorCallback))
+
+(.redirectError (JavaCvErrorCallback.));this enables the c errors to travel up to the JVM
+                                       ;where they can be handled.
+
+
+(use '[clojureDemo.VisionCore :only (video-seq cache video-data close-writer)])
+
+ 
+(use 'clojure.contrib.repl-utils)
+
+(def -inf Double/NEGATIVE_INFINITY)
+(def inf  Double/POSITIVE_INFINITY)
+
+
+(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
+(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
+(def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))
+(def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))
+
+(def base (File. "/home/r/Desktop/source-videos/"))
+
+(def app0 (File. base "approach0v2.avi"))
+(def app1 (File. base "approach1v3.avi"))
+(def app2 (File. base "approach0v3.avi"))
+(def app3 (File. base "approach2v2.avi"))
+(def app4 (File. base "approach1v2.avi")) 
+(def app5 (File. base "approach2v3.avi"))
+  
+(def bounce0 (File. base "bounce0v2.avi"))  
+(def bounce1 (File. base "bounce1v3.avi")) 
+(def bounce2 (File. base "bounce3v2.avi"))
+(def bounce3 (File. base "bounce0v3.avi"))  
+(def bounce4 (File. base "bounce2v2.avi"))
+(def bounce5 (File. base "bounce1v2.avi"))  
+(def bounce6 (File. base "bounce2v3.avi"))
+
+(def collide0 (File. base "collide0v3.avi"))  
+(def collide1 (File. base "collide2v3.avi")) 
+(def collide2 (File. base "collide1v2.avi"))
+(def collide3 (File. base "collide0v2.avi"))  
+(def collide4 (File. base "collide1v3.avi")) 
+  
+(def give0 (File. base "give0v3.avi"))  
+(def give1 (File. base "give2v3.avi")) 
+(def give2 (File. base "give1v2.avi")) 
+(def give3 (File. base "give0v2.avi"))        
+(def give4 (File. base "give1v3.avi"))
+
+
+(def target (File. "/home/r/Desktop/output-vision/"))
+(def default(File. target "default.avi"))
+(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
+
+(defmulti  display "Creates a JFrame and displays a buffered image"  class)
+
+(defmethod display 
+  BufferedImage  [image] 
+  (let [panel (makePanel image)
+	frame (JFrame. "Oh Yeah!")]
+    (.add frame panel) 
+    (.pack frame) 
+    (.setVisible frame true ) 
+    (.setSize frame(.getWidth image) (.getHeight image))))
+
+(defmethod display
+  cxcore$IplImage [image]
+  ( display (.getBufferedImage image)))
+  
+(defmethod display
+  String [image]
+  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
+
+(defmethod display
+  LazySeq [s]
+  (display (first s)))
+
+
+(defn video-writer
+  "uses data about the video to make a writer"
+  [data fileTarget]
+  (highgui/cvCreateVideoWriter 
+   (str fileTarget)
+   
+   ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)
+   ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
+   ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
+   ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)
+   ;;(highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)
+   (highgui/CV_FOURCC \H,\D,\Y,\C)
+   ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)
+   ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)
+   ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)
+   ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  
+
+   (:fps data) (cxcore/cvSize (:width data) (:height data)) 
+   1; 1 here means that we're writing in color.
+    ; you cannot change it to 0 to write in 
+    ; black and white. Everything just crashes instead.
+    ; what a useful paramater.
+   ))
+
+
+(defn naturals []  (iterate inc 0))
+
+
+(defn write-frame
+  [writer frame]
+  (do
+    (highgui/cvWriteFrame writer frame)
+    frame))
+
+(defn number-seq
+  [video-seq]
+  (map #(vector %1 %2) (naturals) video-seq))
+
+(defn save-seq 
+  [writer video-seq]
+  (map #(write-frame writer %) video-seq))
+  
+(defn create-runonce [function]
+  (let [sentinel (Object.)
+	result (atom sentinel)]
+    (fn [& args]
+      (locking sentinel
+	(if (= @result sentinel)
+	  (reset! result (function))
+	  @result)))))
+
+(defmacro oncer 
+  [video-seq-gen]
+  `((create-runonce #(~@video-seq-gen))))
+
+(defmacro trans-save
+"there's a small problem with trans-save --- it IS
+truly transitive, but it does too much work....
+sometimes it writes files twice.
+this is functionally correct though."
+  [target config video-seq]
+  `(let [writer# (video-writer ~config ~target)]
+     (do
+       (dorun (save-seq writer# ~video-seq))
+       (close-writer writer#)
+       ~video-seq)))
+
+(defn save-video
+  [video target]
+  (let [writer (video-writer (video-data video) target)]
+    (do 
+      (dorun (map #(write-frame writer %) (video-seq video)))
+      (close-writer writer))))
+
+
+(comment (Examples of things you can try that will actually work)
+
+(def lazy-human (video-seq human0)) ;makes a lazy sequence of frames and returns instantly.
+(def target1 (File. "some/path/out1.avi")) ;just creates a normal Java File object.
+(def target2 (File. "some/other/path/out2.avi"))
+(def human0-data (video-data human0)) ;creates a map containing the fps, width, and height of the video. 
+
+(trans-save target human0-data (video-seq human0))
+;saves a copy of human0 to disk.
+
+(trans-save target2 human0-data (video-seq-filter (trans-save target1 human0-data (video-seq human0))))
+;saves an unaltered copy of human0 to disk, filters the sequence of 
+;Intel Processing Library images by video-seq-filter, and writes the 
+;filtered result to disk.  video-seq-filter could discard every other frame,
+;take the sequence by fives and do temporal blurring, or just turn every
+;frame to black and white. 
+
+
+(do (use :reload-all 'clojureDemo.VideoTransforms) (in-ns 'clojureDemo.VideoTransforms))
+
+)
+
+ 
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/VisionCore.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/VisionCore.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,229 @@
+(ns clojureDemo.VisionCore)
+  
+(import '(java.awt Rectangle Robot Toolkit) )
+(import '(java.awt.image BufferedImage) )
+(import '(java.awt Graphics2D Panel))
+(import '(java.io File) )
+(import '(javax.imageio ImageIO) )
+(import '(javax.swing JFrame))
+(import '(org.apache.commons.io FileUtils))
+(import clojure.lang.LazySeq)
+(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
+(import '(name.audet.samuel.javacv CanvasFrame))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
+(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
+(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))
+(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
+(import '(name.audet.samuel.javacv JavaCvErrorCallback))
+(.redirectError (JavaCvErrorCallback.))
+
+(use 'clojure.contrib.repl-utils)
+
+(def -inf Double/NEGATIVE_INFINITY)
+(def inf  Double/POSITIVE_INFINITY)
+
+
+
+(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
+(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
+
+(def target (File. "/home/r/Desktop/output-vision/"))
+
+
+;this is still a work in progress, I'll come back to it later when I understand 
+;jna more thoroughly.  the important abstraction here is 
+;video-seq, which gives a lazy sequence of Intel Image Processing library images.
+
+(defn naturals [] (iterate inc 0))
+
+(def ext "jpg") 
+;see below for the rationale for this choice of extention.
+
+(def cache-location "/home/r/Desktop/vision-cache/")
+
+(defn close-capture
+  [capture]
+  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
+
+(defn close-writer
+  [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 
+
+(defn- cache-path
+  [video]
+  (File. cache-location (.getName video)))
+
+(defn- already-cached
+  "this is the simplest and most retarded way to do it"
+  [video]
+  (.exists (cache-path video)))
+
+(defn- write-frame 
+  [capture target-dir n]
+  (let [image (highgui/cvQueryFrame capture)]
+    (if (nil? image) false
+	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))
+
+(defn- write-frame-bad
+  [capture target-dir n]
+  (println (str "saving frame: " n))
+  (let [image (highgui/cvQueryFrame capture)]
+    (if (nil? image) false
+	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))
+
+(defn- write-frames
+  [video target-dir]
+  (let [capture (highgui/cvCreateFileCapture (.getPath video))]
+   (dorun 
+    (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
+    (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
+
+(defn- cache-frames
+  [cache-location video]
+  (time 
+   (do
+     (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
+     (FileUtils/deleteDirectory (cache-path video))
+     (FileUtils/forceMkdir (cache-path video))
+     (write-frames video  (cache-path video)))))
+
+(defn cache
+  [video]
+  (if (already-cached video) nil (cache-frames cache-location video)))
+ 
+(defn video-len 
+  [video] (cache video)
+  (alength (.list (cache-path video))))
+(def video-len (memoize video-len))
+ 
+(defn video-data
+  "since the opencv version is so absolutely unreliable..."
+  [video]
+  (let
+      [capture (highgui/cvCreateFileCapture (.getPath video))
+       info {:length      (video-len video)
+	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
+	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
+	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
+	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
+    (close-capture capture)
+    info))
+(def video-data (memoize video-data))
+
+(defn- video-frame
+  [video n] 
+  (cache video)
+  (let 
+      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)
+       jvm-managed (.clone c++-managed)] 
+	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
+	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 
+         ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 
+         ;other function has to worry about manual garbage collection ever again.
+         ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
+         ;which is the issue, but something involving the image header.
+    (cxcore/cvReleaseImage (.pointerByReference c++-managed))
+    jvm-managed
+))
+  
+
+(defn- video-frame-buffered
+  "takes one frame from a video in constant time"
+  [video n]
+  (cache video)
+  (ImageIO/read (File. (cache-path video) (str n "."  ext))))
+
+
+(defn- dumb-write 
+  [video n writer]
+  (let 
+      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
+    (highgui/cvWriteFrame writer  c++-managed)
+    (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
+
+(defn video-seq
+  "makes a lazy sequence of IPL images"
+  ;additionally, I want to pass metadata around with the sequence.
+  [video] (cache video)
+  (map #(video-frame video %) (range (video-len video))))
+
+
+
+
+
+
+(comment
+
+; I initially decided to use .sr because it loads the fastest out of all the 
+; formats opencv supports, under a simple benchmark of reading/writing
+; a blank file of each  type 100 times.
+
+  ;I just kept changing the file extention at the REPL to generate these times.     
+  (def file "test.tiff")
+  (do 
+    (time (dotimes [_ 100] (highgui/cvSaveImage (str cache-location file) ipl)))
+    (time (dotimes [_ 100]  (highgui/cvLoadImage (str cache-location file)))))
+
+  ;      Write              Read
+  (jpg  4404.000955 msecs 3397.8564   msecs)
+  (jpeg 4376.138853 msecs 3482.990118 msecs)
+  (jpeg 4253.721501 msecs 3414.004122 msecs)
+  (bmp  3488.281695 msecs  786.883035 msecs)
+  (dib  3589.010247 msecs  685.681985 msecs)
+  (jpe  4288.541679 msecs 3359.819425 msecs)
+  (png 10127.648557 msecs 3786.184994 msecs)
+  (pbm  3880.794141 msecs  917.737667 msecs)
+  (pgm  3879.710445 msecs  894.78237  msecs)
+  (ppm  3938.319148 msecs 1014.412766 msecs)
+  (sr   3510.893891 msecs  676.502596 msecs)
+  (dib  3434.654784 msecs  737.495844 msecs)
+  (bmp  3354.956726 msecs  783.353025 msecs)
+  (ras  3351.400751 msecs  722.548007 msecs)
+  (tiff 3657.893326 msecs 1361.576798 msecs)
+  (tif  3594.753736 msecs 1254.568533 msecs)
+
+;Ah, but now it's time for some more tests.
+;I started using
+(def ext ".sr")
+;, and an empty cache, and ran
+(cache lian)
+"caching entire video structure... this will take a while... go get a snack or something :)"
+"Elapsed time: 56486.816728 msecs"
+(time (dorun (video-seq lian)))
+"Elapsed time: 120515.66221 msecs"
+(time (dorun (video-seq lian)))
+"Elapsed time: 122867.82989 msecs" ;good agreement with times
+
+;*erased vision cache with*
+;*rm -rf ~/Desktop/vision-cache *
+(def ext ".bmp")
+(cache lian)
+"Elapsed time: 59613.624691 msecs"
+(time (dorun (video-seq lian)))
+"Elapsed time: 123850.390784 msecs"
+
+;same process except with
+(def ext ".jpg")
+(cache lian)
+"Elapsed time: 139964.031921 msecs"
+(time (dorun (video-seq lian)))
+"Elapsed time: 127740.50204 msecs"
+
+;I find this quite shocking --- the jpg's do take longer to cache,
+;but the processing time is almost the same!
+
+;since lian is 434 MB as a bunch of jpg files, and 3.7 GB as .sr files,
+;I'll go with the jpgs.
+
+
+;; writing files
+
+"JPG"
+(time (write-video sarah (File. "/home/r/Desktop/clojure2.avi")))
+"Elapsed time: 371541.024455 msecs"
+
+"BMP"
+(time (write-video sarah (File. "/home/r/Desktop/clojure3.avi")))
+"Elapsed time: 382568.502361 msecs"
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/VisionReader.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/VisionReader.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,31 @@
+(ns clojureDemo.VisionReader
+  (:gen-class
+   :implements [connections.WiredBox]
+   :methods [ [process [Object] void] [setFile [Object] void] ]
+   :post-init register))
+
+(import '(davidNackoul PlotUnitMatchAlgorithm StoryGraph PlotUnit))
+(import '(bridge.reps.things Sequence Thing))
+
+
+(defn -setFile
+  [this file]
+  (println "file is " file))
+
+(defn -register
+   "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
+   [this]
+   (println "ClojureBox  (register) : Register is run 
+    only when the object is created, as if it were in every constructor.")
+   (. (connections.Connections/getPorts this) addSignalProcessor "process"))
+
+(defn -process [ _ _ ]
+  (println "ClojureBox (process) :  This is a LISP function, 
+   being called through Java, through the wiredBox metaphor."))
+
+(defn -getName
+  "the [_] means that  the function gets an explicit 'this'
+    argument, just like python. In this case we don't care about it."
+  [_]  "VisionReader")
+
+ 
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/WiredDemo.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/WiredDemo.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,40 @@
+(ns clojureDemo.WiredDemo
+(		
+ :gen-class
+ :implements [connections.WiredBox]
+ :methods [ [process [Object] void]]
+ :post-init register
+)
+)
+   
+
+(defn -register [this]
+
+; translate:
+; Connections.getPorts(this).addSignalProcessor("process");
+; ---- to -----
+
+(println "ClojureBox  (register) : Register is run only when the object is created, like a constructor.")
+
+(. (connections.Connections/getPorts this) addSignalProcessor "process")
+
+
+)
+
+
+(defn -process [ _ _ ]
+(println "ClojureBox (process) :  This is a LISP function, being called through Java, through the wiredBox metaphor.")
+)
+
+
+
+
+(
+defn -getName [_]  "ClojureBox"
+
+; the [_] means that  the function gets an explicit "this" argument, like python,
+; but we don't care about it.
+
+)
+
+ 
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/Xuggle.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/Xuggle.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,221 @@
+(ns clojureDemo.Xuggle)
+
+(import '(ij ImagePlus IJ))
+(import '(java.awt Rectangle Robot Toolkit) )
+(import '(java.awt.image BufferedImage) )
+(import '(java.awt Graphics2D Panel))
+(import '(java.io File) )
+(import '(javax.imageio ImageIO) )
+(import '(com.xuggle.mediatool ToolFactory))
+(import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
+(import '(com.xuggle.mediatool MediaToolAdapter MediaListenerAdapter))
+(import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
+(import '(javax.swing JFrame))
+(import '(com.xuggle.mediatool IMediaWriter))
+(import '(org.apache.commons.io FileUtils))
+(import '(javax.imageio.stream FileImageOutputStream))
+(import '(javax.imageio ImageWriteParam IIOImage))
+(import '(com.xuggle.xuggler IRational))
+(import '(java.util.concurrent TimeUnit))
+(import '(com.xuggle.xuggler ICodec))
+
+(use  'clojureDemo.Defines)
+;(use '[clojureDemo.OpenCv :only (video-data)])
+
+
+
+(import '(java.io File))
+(import '(org.apache.commons.io FileUtils))
+(import '(javax.imageio ImageIO) )
+
+(import '(ij.plugin PlugIn))
+(import '(ij ImagePlus IJ))
+
+
+(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)])
+
+
+;(def hamster (ImagePlus. "lklk" (first (video-seq look))))
+
+
+
+
+
+(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
+
+
+(defmulti  display "Creates a JFrame and displays a buffered image"  class)
+
+(defmethod display 
+  BufferedImage  [image] 
+  (let [panel (makePanel image)
+	frame (JFrame. "Oh Yeah!")]
+    (.add frame panel) 
+    (.pack frame) 
+    (.setVisible frame true ) 
+    (.setSize frame(.getWidth image) (.getHeight image))))
+ 
+(defmethod display
+  ImagePlus [image]
+  (display (.getBufferedImage image)))
+
+
+
+
+(defn flash
+     [image]
+     
+     (.start (Thread. (fn [] 
+			(do 
+			  (.show image)
+			  (.updateAndRepaintWindow image)
+			  (Thread/sleep 4000)
+			  (.hide image))))))
+
+
+(defn readerRecurse
+  "calls .readPacket until there's nothing left to do"
+  [reader]
+  (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
+    nil                                   ; it returns null when it has MORE to process, and signals an error when done... 
+    (recur reader)))
+
+
+(def *cache-directory* (File. "/home/r/Desktop/vision-cache"))
+(def *ext* "jpg")
+
+
+
+
+(defn writeJpg
+  "WTF is this shit?!"
+  [image target quality]
+  (let [jpgWriter (.next (ImageIO/getImageWritersByFormatName *ext*))]
+    (doto (.getDefaultWriteParam jpgWriter) 
+      (.setCompressionMode ImageWriteParam/MODE_EXPLICIT)
+      (.setCompressionQuality quality))
+    (doto jpgWriter
+      (.setOutput (FileImageOutputStream. target))
+      (.write (IIOImage. image nil nil))
+      (.dispose))))
+    
+
+
+(defn cache-path
+  [video]
+  (File. *cache-directory* (.getName video)))
+
+(defn video-frame-path
+     [video n]
+     (File. (cache-path video)  (str n "."  *ext*)))
+
+
+(defn already-cached
+  "this is the simplest and most retarded way to do it"
+  [video]
+  (.exists (cache-path video)))
+
+
+ 
+ 
+
+
+(defn make-incrementer [start increment] (let [a (ref (- start increment))] (fn [] (dosync (ref-set a (+ @a increment))))))
+
+(defn make-frame-writer
+  [video]
+  (let [incrementer (make-incrementer 0 1)]
+  (proxy [MediaListenerAdapter] [] 
+    
+    (onVideoPicture
+     [event]
+     ;(println (.getImage event))
+     ;(println (File. (cache-path video) (str (incrementer) "." *ext* ) ))
+     
+     (let [target  (File. (cache-path video) (str (incrementer) "." *ext* ))]
+       (if (= *ext* "jpg")
+	 (writeJpg (.getImage event)  target  1)
+	 (ImageIO/write (.getImage event) *ext* target )))))))
+    
+
+
+(defn cache 
+  "caching of frames without opencv"
+  [video]
+  
+  (if (already-cached video)
+    nil 
+    (time
+    (let [reader (ToolFactory/makeReader (str video))]
+      (println "slow cache!")
+      (FileUtils/forceMkdir (cache-path video))
+      (doto reader
+	(.setBufferedImageTypeToGenerate BufferedImage/TYPE_3BYTE_BGR)
+	(.addListener  (make-frame-writer video))
+	(.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
+      (readerRecurse reader)))))
+
+
+(defn video-data 
+  "get video data without opencv"
+  [video] (cache video)
+
+  
+  {:length (- (count (file-seq (cache-path video))) 1)
+   :width  (.getWidth (ImagePlus. (str (video-frame-path video 0))))
+   :height (.getHeight (ImagePlus. (str (video-frame-path video 0))))
+   :fps 30}) ; yeah --- I'll figure this out later.
+ (def video-data (memoize video-data))
+
+
+
+(defn convert
+  "takes video and converts it to a new type of video"
+  [videoInput videoOutput]
+  (let [reader (ToolFactory/makeReader (str videoInput))]
+    (doto reader
+      (.addListener (ToolFactory/makeWriter (str videoOutput) reader))
+      (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
+    (readerRecurse reader)))
+
+
+(import '(com.xuggle.xuggler.video ConverterFactory))
+
+
+(defn trans-save
+  "this is a transitive way to save a stream to an avi file.
+   It uses meta data to determine what fps to use to encode."
+  [destination video-seq]
+  (let [data (meta video-seq)
+	writer (ToolFactory/makeWriter (str destination))
+	incrementer (make-incrementer 0 (/ 1 30))]
+    (.addVideoStream writer 0 0 (ICodec/findEncodingCodecByName "mpeg4") 
+		     (IRational/make (double (:fps data))) 
+		     (int (:width data)) (int (:height data)))
+    (dorun (map  #(.encodeVideo writer 0 
+			 (ConverterFactory/convertToType (.getBufferedImage %) BufferedImage/TYPE_3BYTE_BGR) 
+			(long (* 1000000000 (incrementer)))  TimeUnit/NANOSECONDS)  video-seq))
+	(.close writer))
+  video-seq)
+
+
+(defn video-seq 
+  "let's use ImagePlus stuff!"
+  ([video] (cache video) 
+    (with-meta (map #(ImagePlus. (str (video-frame-path video %))) (range (:length (video-data video))) ) (video-data video))))
+
+
+
+
+
+
+(comment 
+  (do (use :reload-all 'clojureDemo.Xuggle) (in-ns 'clojureDemo.Xuggle))
+)
+ 
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/appeture.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/appeture.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,103 @@
+(ns clojureDemo.appeture)
+
+(use 'clojure.contrib.repl-utils)
+(use 'clojure.contrib.accumulators)
+
+"right now this only will work on odd square arrays"
+
+(def rrr {[0 0] 20 , [1 0] 20, [2 0] 20
+	  [0 1]  0 , [1 1]  0, [2 1]  0
+	  [0 2]  0 , [1 2]  0, [2 2]  0})
+
+(def rrrr {[0 0] 20 , [1 0] 20, [2 0] 20 , [3 0] 20, [4 0] 20,
+	   [0 1] 20 , [1 1] 20, [2 1] 20 , [3 1] 20, [4 1] 20,
+	   [0 2]  0 , [1 2]  0, [2 2]  0 , [3 2] 0,  [4 2] 0,
+	   [0 3]  0 , [1 3]  0, [2 3]  0 , [3 3] 0,  [4 3] 0,
+	   [0 4]  0 , [1 4]  0, [2 4]  0 , [3 4] 0,  [4 4] 0,})
+
+(defn vector-mul
+  [mul vect]
+  (apply vector (map #(* mul %) vect)) )
+
+(defn vector-sum
+  ([] 0)
+  ([& args] 
+  (apply vector (reduce #(map + %1 %2) args))))
+
+(defn vector-sub
+  [vector1 vector2]
+  (vector-sum vector1 (vector-mul -1 vector2)))
+ 
+(defn vector-dot
+  [vector1 vector2]
+  (reduce + (map * vector1 vector2)))
+
+(defn center
+  [window]
+  (let [coords (keys window)]
+  (vector-mul (/ 1 (count coords)) (apply vector-sum coords))))
+
+(defn window-segmentate
+  [window line]
+  (let [center (center window)]
+  (letfn [(path   [window] (filter (fn [point] (apply = (line center point))) (keys window)))
+	  (top    [window] (filter (fn [point] (apply > (line center point))) (keys window)))
+	  (bottom [window] (filter (fn [point] (apply < (line center point))) (keys window)))]
+     {:top (top window) :bottom (bottom window) :line (path window)})))
+
+(defn diag1
+  [window]
+  (window-segmentate window (fn [center point] (list (first  (vector-sub point center)) (-(last  (vector-sub point center)))))))
+
+(defn diag2
+  [window]
+(window-segmentate window  (fn [center point] (list (first (vector-sub point center)) (last  (vector-sub point center))))))
+ 
+(defn vert
+  [window]
+(window-segmentate window  (fn [center point] (list (first (vector-sub point center)) 0))))
+ 
+(defn horiz
+  [window]
+(window-segmentate window  (fn [center point] (list 0 (last (vector-sub point center))))))
+
+
+ 
+
+ 
+
+(defn lines
+  [window]    
+    (let [lines (list (vert window) (horiz window) (diag1 window) (diag2 window))]
+      lines))
+;This is the wrong model.  Higher level processors should set these paramaters, and 
+; juggle them around if they aren't getting anything they understand.
+
+
+
+(defn stats-base
+  [sections window sel-fun]
+ (let [stats-top    (add-items empty-mean-variance (map window (:top sections)))
+	stats-bottom (add-items empty-mean-variance (map window (:bottom sections)))]
+   (let [ var1 (:variance stats-top) mean1 (:mean stats-top) var2 (:variance stats-bottom) mean2 (:mean stats-bottom)]
+     (sel-fun var1 mean1 var2 mean2))))
+
+(defn window-line
+  [window transformation detection]
+  (let [x-window (transformation window)]
+    (first (filter #(stats-base % x-window detection) (lines x-window)))))
+	       
+(defn window-stats
+  ([window] (window-stats window identity))
+  ([window transformation]
+  (let [x-window (transformation window)]
+    (map (fn [line] (stats-base line x-window #(list %1 %2 %3 %4))) (lines x-window)))))
+
+
+
+
+(comment 
+
+(do (use :reload-all 'clojureDemo.appeture) (in-ns 'clojureDemo.appeture))
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/explore.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/explore.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,11 @@
+(ns clojureDemo.explore)
+
+(use 'clojure.contrib.accumulators)
+(use 'clojure.contrib.repl-utils)
+
+
+(comment 
+
+(do (use :reload-all 'clojureDemo.explore) (in-ns 'clojureDemo.explore))
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/import_java_fns.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/import_java_fns.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,10 @@
+(ns clojureDemo.import-java-fns)
+
+
+
+(defmacro single-arg-fn [package fun]
+  (let [name (symbol (str package "/" fun))]
+  `(defn ~fun [a#] (~name a#))))
+
+(defmacro java-map [package & fns]
+  `(do ~@(map #(list 'single-arg-fn package %) fns)))
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/librlm.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/librlm.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,11 @@
+(ns clojureDemo.librlm)
+
+  (defmethod*  - java.lang.Boolean [x] (not x))
+
+;  (defmethod + [java.lang.Boolean java.lang.Boolean]
+;    [a b] (or a b))
+  
+;  (defmethod * [java.lang.Boolean java.lang.Boolean]
+;    [a b] (and a b))
+  
+;  (defmethod / java.lang.Boolean [x] x)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/librlm.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/librlm.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,11 @@
+(ns clojureDemo.librlm)
+
+;  (defmethod*  - java.lang.Boolean [x] (not x))
+
+;  (defmethod + [java.lang.Boolean java.lang.Boolean]
+;    [a b] (or a b))
+  
+;  (defmethod * [java.lang.Boolean java.lang.Boolean]
+;    [a b] (and a b))
+  
+;  (defmethod / java.lang.Boolean [x] x)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/project-euler.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/project-euler.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,16 @@
+
+
+(ns clojureDemo.project-euler)
+
+
+(use 'clojureDemo.rlm)
+(rlm-base-load)
+
+(defn range-sum 
+"calculates the sum of a range.  Takes the exact same arguments
+ as clojure.core/range"
+([end]
+   (/ (* end (- end 1) ) 2)))
+
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/project_euler.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/project_euler.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,559 @@
+
+(ns clojureDemo.project-euler
+
+(:refer-clojure :exclude [+ - / * 
+			  assoc conj dissoc empty get into seq
+			  = < > <= >= zero?
+			  ])
+
+(:use [clojure.contrib.generic
+	 arithmetic
+	 collection
+	 comparison
+	 ])
+
+(:use [clojure.contrib
+	 combinatorics
+	 repl-utils
+	 def
+	 duck-streams
+	 shell-out
+	 import-static
+	 lazy-seqs
+	 logging
+	 map-utils
+	 math
+	 mock
+	 monads
+	 ns-utils
+         seq-utils
+         function-utils
+       profile
+       str-utils
+	 ])
+
+(:use [clojure.contrib.pprint :exclude [write]])
+  
+(:use [clojure.contrib.pprint.examples
+	 hexdump
+	 json
+	 multiply
+	 props
+	 show-doc
+	 xml
+	 ])
+
+(:import java.io.File)
+(:import [java.util Calendar Date])
+
+)
+
+
+
+
+
+(defn range-sum 
+  "calculates the sum of a range.  Takes the exact same arguments
+  as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
+  ([end]
+     (/ (* end (- end 1) ) 2))
+  
+  ([start end]
+     (- (range-sum end) (range-sum start)))
+
+  ([start end step]
+     (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
+     (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
+
+
+
+(defn range-sum-squares
+  "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
+   but runs in O(1) time."
+  ([end]
+     (let [n (- end 1)]
+     (- (* (expt n 3) 1/3) ;continous volume
+	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
+
+   ([start end]
+     (- (range-sum-squares end) (range-sum-squares start)))
+
+   ([start end step]
+      ;; (letfn [(zero-sum-squares [end step]
+      ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
+      ;; 	(+ 
+      ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
+      ;; 	 (zero-sum end step) 
+      ;; 	 (* start start (int (/ (- end start) step)))))))
+))	
+
+
+(defn prime-factors 
+  "all the prime factors of the number n"
+  [n]
+  (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
+
+(defn factor? [a b] (= 0 (rem a b)))
+
+(defn factor-map [a b]
+  (if (factor? a b) 
+	{b (quot a b)}
+	nil))
+
+
+(defn divides? [numerator divisor] (= (rem numerator divisor) 0))
+
+
+(def != (comp not =))
+
+
+(defn decompose [number factor]
+    (loop [n number counter 0]
+      (if (!= (rem n factor) 0)
+        counter
+	(recur (/ n factor) (inc counter)))))
+
+	
+
+
+
+
+
+(defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
+  (let [divisor (nth primes index)
+	new-index (inc index)
+	done? (= num 1)]
+    (if (divides? num divisor)
+      (let [new-num (/ num (expt divisor (decompose num divisor)))   
+	    factors (assoc factors divisor (decompose num divisor))]
+	[[factors done?] (assoc old-state
+		 :current-num new-num :prime-index new-index :prime-factors factors)])
+      
+      [[factors done?] (assoc old-state 
+	       :current-num num :prime-index new-index :prime-factors factors)])))
+      
+
+(defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
+
+(defn fuck-it [] 
+  (domonad state-m 
+	   [[factors done?]
+	    (state-m-until second wtf nil)]
+	   
+	   factors))
+
+(defn prime-factor-map [num]
+  
+  (first ((fuck-it) {:prime-factors {}
+		     :prime-index 0
+		     :current-num num})))
+
+(defn prime-factors-monad [num]
+  (sort (keys (prime-factor-map num))))
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fun with state monad
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defn ++ [{num :num :as world}]
+  (let [num++ (inc num)]
+    [num++ (assoc world :num num++)]))
+
+(defn huh? []
+  (with-monad state-m 
+    (domonad [x ++
+	      y ++]
+	     y)))
+
+
+(comment 
+
+huh?
+->
+((let [m-bind (fn m-bind-state [mv f]
+		(fn [s]
+		  (let [[v ss] (mv s)]
+		    ((f v) ss))))] 
+       (m-bind
+	++ (fn [x] ++))) {:num 1})
+
+
+)
+
+
+(defn wordify [n] (cl-format nil "~R" n))
+    
+(defn british-letter-count-prof [n]
+  (prof :total
+  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
+	word (prof :wordify (wordify n))
+	word-seq (prof :sequence (seq word))
+	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
+	word-count (prof :count (count word-filter))
+	answer (prof :add (+ and? word-count))]
+    answer)))
+
+(defn british-letter-count-prof2 
+"now this is faster, because it uses string manipulation.  go profiling!"
+[n]
+  (prof :total
+  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
+	word (prof :wordify (wordify n))
+	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
+	
+	word-count (prof :count (.length word-regex))
+	answer (prof :add (+ and? word-count))]
+    answer)))
+
+
+   
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;pseudo code for primes
+
+;fn prime-decomposition
+; [n]
+; map = {} 
+; 
+; for x in primes
+;   add to map (divide teh fick out n x)
+;   n = n / prime-factors
+;   if n == 1 BREAK;
+;
+;
+
+
+
+(defn rng [seed]
+  (let [m      259200
+	value  (/ (float seed) (float m))
+	next   (rem (+ 54773 (* 7141 seed)) m)]
+    [value next]))
+
+
+(defn yeah! []
+  (let [name sequence-m 
+	m-bind (:m-bind name) 
+	m-result (:m-result name) 
+	m-zero (:m-zero name) 
+	m-plus (:m-plus name)] 
+
+
+    (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
+
+
+(defn ohhhh!! []
+  
+  (let 
+      [name state-m 
+       m-bind (:m-bind name) 
+       m-result (:m-result name) ]
+    
+    (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
+
+
+
+(defmulti palindrome? class)
+  
+(defmethod palindrome? (class "string") [a]
+  (= (seq a) (reverse a)))
+
+(defmethod palindrome? (class 500) [a]
+  (palindrome? (str a)))
+
+
+
+
+
+
+
+
+(defn circulars 
+  "returns a vector of all the circular permutations of a number"
+  [n]
+  (map #(Integer. (apply str %)) (rotations (seq (str n)))))
+    
+
+(defn prime-factors
+  [n]
+  (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
+
+
+(defmethod = [nil java.lang.Integer] [ a b ]
+  false)
+
+
+
+(def mil 1000000)
+(def bil 1000000000)
+
+(defn primes-under-million [] (apply hash-set (take 78498 primes)))
+(def primes-under-million (memoize primes-under-million))
+
+
+(defn primes-under-billion [] (apply hash-set (take 664579 primes)))
+(def primes-under-billion (memoize primes-under-billion))
+
+
+
+
+
+(defn prime? [n] (not (nil? (get (primes-under-billion) n))))
+
+
+(defn circular-memoize 
+  "assumes that f is a predicate that takes in a number for which, 
+   if the predicate is true for the number, it is also true for all
+   of the circular permutations of the number.  Memoizes the result
+   for all circular permutations so as to avoid subsequent computation."
+  [f]
+   (let [mem (atom {})]
+    (fn [n]
+      (if-let [e (find @mem n)]
+        (val e)
+        (let [ret (f n)]
+	  (dorun (for [circ (circulars n)]
+		   (swap! mem assoc n ret)))
+          ret)))))
+
+(defn circularly-prime?
+  [n]
+  (not (some (comp not prime?) (circulars n))))
+
+(def circularly-prime? (memoize circularly-prime?))
+
+
+(defmethod = :default  [& args]
+  (apply clojure.core/= args))
+  
+(def logins 
+     (map str
+	  [319 680 180 690 129 620 762 689 762 318
+	   368 710 720 710 629 168 160 689 716 731
+	   736 729 316 729 729 710 769 290 719 680
+	   318 389 162 289 162 718 729 319 790 680
+	   890 362 319 760 316 729 380 319 728 716]))
+
+(defn remove-multiples [n]
+  (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
+
+(defn insert [item n vect]
+  (let [split (split-at n vect)]
+    (apply vector (flatten [(first split) item (last split)]))))
+
+(defn expand-code [old-code [c b a]]
+  (let [main-length (count old-code)]
+    (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
+      (insert c z (insert b y (insert a x old-code)))))) 
+
+(defn domain-expand-contract [old-domain constraint]
+  (let [new-domain 
+	(map remove-multiples 
+	     (remove-multiples 
+	      (sort 
+	       (apply concat 
+		      (map #(expand-code % constraint) old-domain)))))
+	min-code-length (apply min (map count new-domain)) ]
+    (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
+(def domain-expand-contract (memoize domain-expand-contract))
+
+
+
+(defn lazy-fibo 
+  ([] (concat [0 1] (lazy-fibo 0 1)))
+  ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
+
+
+(defn collatz-seq [n]  
+  (lazy-seq
+  (cond (= n 1) [1]
+	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
+	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
+(def collatz-seq (memoize collatz-seq))
+
+
+
+(defn pythagorean-triple? [a b c]
+  (let [[a b c] (sort [a b c])]
+    (= (+ (* a a) (* b b) ) (* c c))))
+
+
+(defn sum-squares [coll]
+  (reduce +  (map #(* % %) coll)))
+
+
+(defn british-letter-count [n]
+  
+  (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
+
+    (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
+
+
+
+(defmacro apply-macro
+  "This is evil.  Don't ever use it.  It makes a macro behave like a
+  function.  Seriously, how messed up is that?
+
+  Evaluates all args, then uses them as arguments to the macro as with
+  apply.
+
+  (def things [true true false])
+  (apply-macro and things)
+  ;; Expands to:  (and true true false)"
+  [macro & args]
+  (cons macro (flatten (map eval args))))
+
+(defn fun1 [] (Thread/sleep 5000) 5)
+
+(defn fun2 [] (Thread/sleep 30000) 5)
+
+
+(def naturals (iterate inc 0))
+  
+
+
+
+(defn race []
+  (let [result (ref nil)
+	threads [(Thread. (fn [] (try 
+				  (let [answer (fun1)] 
+				    (dosync (ref-set result answer)))
+				  (catch Exception _ nil))))
+		 (Thread. (fn [] (try 
+				  (let [answer (fun2)] 
+				    (dosync (ref-set result answer))) 
+				  (catch Exception _ nil))))]]
+	   
+    (dorun (map #(.start %) threads))
+    (loop []
+      (if (!= (deref result) nil)
+	(do (dorun (map #(.stop %) threads))
+	    (deref result))
+	(recur)))))
+
+
+
+
+
+
+
+(defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
+
+(def jan-1-1901 (make-date 1900 0 1))
+
+(defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*"  (str  date)))
+
+(count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))
+
+
+
+
+(comment
+
+;; ----------------------------------------------------------------------
+;; Answers
+;; ----------------------------------------------------------------------
+
+; Problem 1 
+(+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
+
+; Problem 2
+(reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
+
+; Problem 3
+(apply max (prime-factors 600851475143))
+
+; Problem 4
+(reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
+
+; Problem 5
+(reduce lcm (range 1 21))
+
+; Problem 6
+(- (expt (range-sum 101) 2) (range-sum-squares 101))
+
+; Problem 7
+(nth primes 10000)
+
+
+; Problem 9
+(reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
+      :when (= (+ a b c) 1000)] [a b c])))
+
+; Problem 10 
+(reduce + (for [a primes :while (< a 2000000)] a))
+
+
+
+
+
+; Problem 14
+(first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
+
+
+; Problem 16
+(reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
+
+; Problem 17
+(reduce + (map british-letter-count (range 1 1001)))
+
+
+; Problem 24
+(nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
+
+; Problem 33
+(reduce * (for [num (range 1 10) 
+      den (range 1  10) 
+      weird (range 1 10) 
+      top [(+ num (* 10 weird))]
+      bottom [(+ weird (* 10 den))]
+      :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
+  (/ bottom top)))
+
+; Problem 35
+(count (filter circularly-prime? (primes-under-million)))
+
+; Problem 40 
+(let [fff (apply str (take 1030000 naturals))] 
+  (reduce * (map #(Character/getNumericValue (nth fff %)) 
+		 (map (fn [x] (expt 10 x)) (range 7)) )))
+
+
+
+
+
+
+; Problem 79
+(reduce domain-expand-contract [""] logins)
+
+)
+
+
+
+
+
+
+
+
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/project_euler.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/project_euler.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,559 @@
+
+(ns clojureDemo.project-euler
+
+(:refer-clojure :exclude [+ - / * 
+			  assoc conj dissoc empty get into seq
+			  = < > <= >= zero?
+			  ])
+
+(:use [clojure.contrib.generic
+	 arithmetic
+	 collection
+	 comparison
+	 ])
+
+(:use [clojure.contrib
+	 combinatorics
+	 repl-utils
+	 def
+	 duck-streams
+	 shell-out
+	 import-static
+	 lazy-seqs
+	 logging
+	 map-utils
+	 math
+	 mock
+	 monads
+	 ns-utils
+         seq-utils
+         function-utils
+       profile
+       str-utils
+	 ])
+
+(:use [clojure.contrib.pprint :exclude [write]])
+  
+(:use [clojure.contrib.pprint.examples
+	 hexdump
+	 json
+	 multiply
+	 props
+	 show-doc
+	 xml
+	 ])
+
+(:import java.io.File)
+(:import [java.util Calendar Date])
+
+)
+
+
+
+
+
+(defn range-sum 
+  "calculates the sum of a range.  Takes the exact same arguments
+  as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
+  ([end]
+     (/ (* end (- end 1) ) 2))
+  
+  ([start end]
+     (- (range-sum end) (range-sum start)))
+
+  ([start end step]
+     (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
+     (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
+
+
+
+(defn range-sum-squares
+  "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
+   but runs in O(1) time."
+  ([end]
+     (let [n (- end 1)]
+     (- (* (expt n 3) 1/3) ;continous volume
+	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
+
+   ([start end]
+     (- (range-sum-squares end) (range-sum-squares start)))
+
+   ([start end step]
+      ;; (letfn [(zero-sum-squares [end step]
+      ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
+      ;; 	(+ 
+      ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
+      ;; 	 (zero-sum end step) 
+      ;; 	 (* start start (int (/ (- end start) step)))))))
+))	
+
+
+(defn prime-factors 
+  "all the prime factors of the number n"
+  [n]
+  (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
+
+(defn factor? [a b] (= 0 (rem a b)))
+
+(defn factor-map [a b]
+  (if (factor? a b) 
+	{b (quot a b)}
+	nil))
+
+
+(defn divides? [numerator divisor] (= (rem numerator divisor) 0))
+
+
+(def != (comp not =))
+
+
+(defn decompose [number factor]
+    (loop [n number counter 0]
+      (if (!= (rem n factor) 0)
+        counter
+	(recur (/ n factor) (inc counter)))))
+
+	
+
+
+
+
+
+(defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
+  (let [divisor (nth primes index)
+	new-index (inc index)
+	done? (= num 1)]
+    (if (divides? num divisor)
+      (let [new-num (/ num (expt divisor (decompose num divisor)))   
+	    factors (assoc factors divisor (decompose num divisor))]
+	[[factors done?] (assoc old-state
+		 :current-num new-num :prime-index new-index :prime-factors factors)])
+      
+      [[factors done?] (assoc old-state 
+	       :current-num num :prime-index new-index :prime-factors factors)])))
+      
+
+(defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
+
+(defn fuck-it [] 
+  (domonad state-m 
+	   [[factors done?]
+	    (state-m-until second wtf nil)]
+	   
+	   factors))
+
+(defn prime-factor-map [num]
+  
+  (first ((fuck-it) {:prime-factors {}
+		     :prime-index 0
+		     :current-num num})))
+
+(defn prime-factors-monad [num]
+  (sort (keys (prime-factor-map num))))
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fun with state monad
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defn ++ [{num :num :as world}]
+  (let [num++ (inc num)]
+    [num++ (assoc world :num num++)]))
+
+(defn huh? []
+  (with-monad state-m 
+    (domonad [x ++
+	      y ++]
+	     y)))
+
+
+(comment 
+
+huh?
+->
+((let [m-bind (fn m-bind-state [mv f]
+		(fn [s]
+		  (let [[v ss] (mv s)]
+		    ((f v) ss))))] 
+       (m-bind
+	++ (fn [x] ++))) {:num 1})
+
+
+)
+
+
+(defn wordify [n] (cl-format nil "~R" n))
+    
+(defn british-letter-count-prof [n]
+  (prof :total
+  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
+	word (prof :wordify (wordify n))
+	word-seq (prof :sequence (seq word))
+	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
+	word-count (prof :count (count word-filter))
+	answer (prof :add (+ and? word-count))]
+    answer)))
+
+(defn british-letter-count-prof2 
+"now this is faster, because it uses string manipulation.  go profiling!"
+[n]
+  (prof :total
+  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
+	word (prof :wordify (wordify n))
+	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
+	
+	word-count (prof :count (.length word-regex))
+	answer (prof :add (+ and? word-count))]
+    answer)))
+
+
+   
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;pseudo code for primes
+
+;fn prime-decomposition
+; [n]
+; map = {} 
+; 
+; for x in primes
+;   add to map (divide teh fick out n x)
+;   n = n / prime-factors
+;   if n == 1 BREAK;
+;
+;
+
+
+
+(defn rng [seed]
+  (let [m      259200
+	value  (/ (float seed) (float m))
+	next   (rem (+ 54773 (* 7141 seed)) m)]
+    [value next]))
+
+
+(defn yeah! []
+  (let [name sequence-m 
+	m-bind (:m-bind name) 
+	m-result (:m-result name) 
+	m-zero (:m-zero name) 
+	m-plus (:m-plus name)] 
+
+
+    (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
+
+
+(defn ohhhh!! []
+  
+  (let 
+      [name state-m 
+       m-bind (:m-bind name) 
+       m-result (:m-result name) ]
+    
+    (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
+
+
+
+(defmulti palindrome? class)
+  
+(defmethod palindrome? (class "string") [a]
+  (= (seq a) (reverse a)))
+
+(defmethod palindrome? (class 500) [a]
+  (palindrome? (str a)))
+
+
+
+
+
+
+
+
+(defn circulars 
+  "returns a vector of all the circular permutations of a number"
+  [n]
+  (map #(Integer. (apply str %)) (rotations (seq (str n)))))
+    
+
+(defn prime-factors
+  [n]
+  (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
+
+
+(defmethod = [nil java.lang.Integer] [ a b ]
+  false)
+
+
+
+(def mil 1000000)
+(def bil 1000000000)
+
+(defn primes-under-million [] (apply hash-set (take 78498 primes)))
+(def primes-under-million (memoize primes-under-million))
+
+
+(defn primes-under-billion [] (apply hash-set (take 664579 primes)))
+(def primes-under-billion (memoize primes-under-billion))
+
+
+
+
+
+(defn prime? [n] (not (nil? (get (primes-under-billion) n))))
+
+
+(defn circular-memoize 
+  "assumes that f is a predicate that takes in a number for which, 
+   if the predicate is true for the number, it is also true for all
+   of the circular permutations of the number.  Memoizes the result
+   for all circular permutations so as to avoid subsequent computation."
+  [f]
+   (let [mem (atom {})]
+    (fn [n]
+      (if-let [e (find @mem n)]
+        (val e)
+        (let [ret (f n)]
+	  (dorun (for [circ (circulars n)]
+		   (swap! mem assoc n ret)))
+          ret)))))
+
+(defn circularly-prime?
+  [n]
+  (not (some (comp not prime?) (circulars n))))
+
+(def circularly-prime? (memoize circularly-prime?))
+
+
+(defmethod = :default  [& args]
+  (apply clojure.core/= args))
+  
+(def logins 
+     (map str
+	  [319 680 180 690 129 620 762 689 762 318
+	   368 710 720 710 629 168 160 689 716 731
+	   736 729 316 729 729 710 769 290 719 680
+	   318 389 162 289 162 718 729 319 790 680
+	   890 362 319 760 316 729 380 319 728 716]))
+
+(defn remove-multiples [n]
+  (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
+
+(defn insert [item n vect]
+  (let [split (split-at n vect)]
+    (apply vector (flatten [(first split) item (last split)]))))
+
+(defn expand-code [old-code [c b a]]
+  (let [main-length (count old-code)]
+    (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
+      (insert c z (insert b y (insert a x old-code)))))) 
+
+(defn domain-expand-contract [old-domain constraint]
+  (let [new-domain 
+	(map remove-multiples 
+	     (remove-multiples 
+	      (sort 
+	       (apply concat 
+		      (map #(expand-code % constraint) old-domain)))))
+	min-code-length (apply min (map count new-domain)) ]
+    (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
+(def domain-expand-contract (memoize domain-expand-contract))
+
+
+
+(defn lazy-fibo 
+  ([] (concat [0 1] (lazy-fibo 0 1)))
+  ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
+
+
+(defn collatz-seq [n]  
+  (lazy-seq
+  (cond (= n 1) [1]
+	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
+	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
+(def collatz-seq (memoize collatz-seq))
+
+
+
+(defn pythagorean-triple? [a b c]
+  (let [[a b c] (sort [a b c])]
+    (= (+ (* a a) (* b b) ) (* c c))))
+
+
+(defn sum-squares [coll]
+  (reduce +  (map #(* % %) coll)))
+
+
+(defn british-letter-count [n]
+  
+  (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
+
+    (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
+
+
+
+(defmacro apply-macro
+  "This is evil.  Don't ever use it.  It makes a macro behave like a
+  function.  Seriously, how messed up is that?
+
+  Evaluates all args, then uses them as arguments to the macro as with
+  apply.
+
+  (def things [true true false])
+  (apply-macro and things)
+  ;; Expands to:  (and true true false)"
+  [macro & args]
+  (cons macro (flatten (map eval args))))
+
+(defn fun1 [] (Thread/sleep 5000) 5)
+
+(defn fun2 [] (Thread/sleep 30000) 5)
+
+
+(def naturals (iterate inc 0))
+  
+
+
+
+(defn race []
+  (let [result (ref nil)
+	threads [(Thread. (fn [] (try 
+				  (let [answer (fun1)] 
+				    (dosync (ref-set result answer)))
+				  (catch Exception _ nil))))
+		 (Thread. (fn [] (try 
+				  (let [answer (fun2)] 
+				    (dosync (ref-set result answer))) 
+				  (catch Exception _ nil))))]]
+	   
+    (dorun (map #(.start %) threads))
+    (loop []
+      (if (!= (deref result) nil)
+	(do (dorun (map #(.stop %) threads))
+	    (deref result))
+	(recur)))))
+
+
+
+
+
+
+
+(defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
+
+(def jan-1-1901 (make-date 1900 0 1))
+
+(defn sunday? [#^java.util.Calendar date] (= 7 (.getDay (.getTime date))))
+
+
+
+
+
+
+(comment
+
+;; ----------------------------------------------------------------------
+;; Answers
+;; ----------------------------------------------------------------------
+
+; Problem 1 
+(+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
+
+; Problem 2
+(reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
+
+; Problem 3
+(apply max (prime-factors 600851475143))
+
+; Problem 4
+(reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
+
+; Problem 5
+(reduce lcm (range 1 21))
+
+; Problem 6
+(- (expt (range-sum 101) 2) (range-sum-squares 101))
+
+; Problem 7
+(nth primes 10000)
+
+
+; Problem 9
+(reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
+      :when (= (+ a b c) 1000)] [a b c])))
+
+; Problem 10 
+(reduce + (for [a primes :while (< a 2000000)] a))
+
+
+
+
+
+; Problem 14
+(first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
+
+
+; Problem 16
+(reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
+
+; Problem 17
+(reduce + (map british-letter-count (range 1 1001)))
+
+
+; Problem 24
+(nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
+
+; Problem 33
+(reduce * (for [num (range 1 10) 
+      den (range 1  10) 
+      weird (range 1 10) 
+      top [(+ num (* 10 weird))]
+      bottom [(+ weird (* 10 den))]
+      :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
+  (/ bottom top)))
+
+; Problem 35
+(count (filter circularly-prime? (primes-under-million)))
+
+; Problem 40 
+(let [fff (apply str (take 1030000 naturals))] 
+  (reduce * (map #(Character/getNumericValue (nth fff %)) 
+		 (map (fn [x] (expt 10 x)) (range 7)) )))
+
+
+
+
+
+
+; Problem 79
+(reduce domain-expand-contract [""] logins)
+
+)
+
+
+
+
+
+
+
+
+
+
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/rlm.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/rlm.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,67 @@
+(ns clojureDemo.rlm
+
+(:refer-clojure :exclude [+ - / * 
+			  assoc conj dissoc empty get into seq
+			  = < > <= >= zero?
+			  ])
+
+(:use [clojure.contrib.generic
+	 arithmetic
+	 collection
+	 comparison
+	 ])
+
+(:use [clojure.contrib
+         accumulators
+	 combinatorics
+	 repl-utils
+	 def
+	 duck-streams
+	 shell-out
+	 import-static
+	 lazy-seqs
+	 logging
+	 map-utils
+	 math
+	 mock
+	 monads
+	 ns-utils
+	 ])
+
+(:use [clojure.contrib.pprint :exclude [write]])
+  
+(:use [clojure.contrib.pprint.examples
+	 hexdump
+	 json
+	 multiply
+	 props
+	 show-doc
+	 xml
+	 ])
+
+(:import java.io.File)
+
+
+
+)
+
+
+  
+  
+
+
+
+(defn rlm-extra-load []
+  (use :reload-all
+       '[ clojureDemo
+	 rlm
+	 project-euler
+	 ]))
+ 
+
+(defn rlm-switch []
+  (in-ns 'rlm)
+  (rlm-extra-load))
+
+(defn switch-rlm []
+  (rlm-switch))
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/sys-utils.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/sys-utils.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,49 @@
+(ns clojureDemo.sys-utils
+
+:use [clojure.contrib duck-streams str-utils shell-out]
+:import java.io.File
+)
+
+
+
+
+(defn escape-spaces
+  [string]
+  (re-gsub #" " (str \-) string))
+
+
+(defn view 
+  [string]
+  (seq (char-array string)))
+
+(defn parent-source [target file]
+  (File. (str target "/" (.getName (.getParentFile file))"-" (.getName file))))
+
+
+(defn rsync [file1 file2]
+  (let [*out* nil]
+  (sh "rsync" "-avz" (str file1) (escape-spaces(str file2)))))
+
+(defn shunt-file [target file]
+  (rsync (str file) (str (parent-source target file)))) 
+	
+	  
+
+(defn extract-files
+  [regex source destination]
+
+  (map (partial shunt-file destination) 
+  (filter (comp not nil? (partial re-matches regex) str)  (file-seq source))))
+
+(defn test-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str " /home/r/Desktop/judy_yates_computer_archive/MyDocuments/dallas townhome") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
+
+
+(defn judy-jpg-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str "/home/r/Desktop/judy_yates_computer_archive") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/sys_utils.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/sys_utils.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,69 @@
+
+(ns clojureDemo.sys-utils
+
+(:use [clojure.contrib duck-streams str-utils shell-out])
+(:import java.io.File)
+)
+
+
+
+(defn rename [file]
+
+  (if (re-matches #".*\.JPG$" (str file))
+    (sh "mv" (str file)  (re-sub #"\.JPG" ".jpg" (str file)))
+    nil))
+
+
+
+
+(defn escape-spaces
+  [string]
+  (re-gsub #" " (str \-) string))
+
+
+(defn view 
+  [string]
+  (seq (char-array string)))
+
+(defn parent-source [target file]
+  (File. (str target "/" (.getName (.getParentFile file))"-" (.getName file))))
+
+
+(defn rsync [file1 file2]
+  (let [*out* nil]
+  (sh "rsync" "-avz" (str file1) (escape-spaces(str file2)))))
+
+(defn shunt-file [target file]
+  (rsync (str file) (str (parent-source target file)))) 
+	
+	  
+
+(defn extract-files
+  [regex source destination]
+
+  (dorun (map (partial shunt-file destination) 
+  (filter (comp not nil? (partial re-matches regex) str)  (file-seq source)))))
+
+
+(defn file-count [#^java.io.File file]
+  (count (file-seq file)))
+  
+
+
+
+(comment
+
+(defn test-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str " /home/r/Desktop/judy_yates_computer_archive/MyDocuments/dallas townhome") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
+
+
+(defn judy-jpg-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str "/home/r/Desktop/judy_yates_computer_archive") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/clojureDemo/sys_utils.clj~
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojureDemo/sys_utils.clj~	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,61 @@
+
+(ns clojureDemo.sys-utils
+
+(:use [clojure.contrib duck-streams str-utils shell-out])
+(:import java.io.File)
+)
+
+
+
+
+(defn escape-spaces
+  [string]
+  (re-gsub #" " (str \-) string))
+
+
+(defn view 
+  [string]
+  (seq (char-array string)))
+
+(defn parent-source [target file]
+  (File. (str target "/" (.getName (.getParentFile file))"-" (.getName file))))
+
+
+(defn rsync [file1 file2]
+  (let [*out* nil]
+  (sh "rsync" "-avz" (str file1) (escape-spaces(str file2)))))
+
+(defn shunt-file [target file]
+  (rsync (str file) (str (parent-source target file)))) 
+	
+	  
+
+(defn extract-files
+  [regex source destination]
+
+  (dorun (map (partial shunt-file destination) 
+  (filter (comp not nil? (partial re-matches regex) str)  (file-seq source)))))
+
+
+(defn file-count [#^java.io.File file]
+  (count (file-seq file)))
+  
+
+
+
+(comment
+
+(defn test-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str " /home/r/Desktop/judy_yates_computer_archive/MyDocuments/dallas townhome") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
+
+
+(defn judy-jpg-extract
+  []
+  ((partial extract-files #".*\.JPG"
+	    (file-str "/home/r/Desktop/judy_yates_computer_archive") 
+	    (file-str "/home/r/Desktop/judyates_admin/archive-source-images/"))))
+
+)
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/laser/.#rasterize.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/laser/.#rasterize.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -0,0 +1,1 @@
+r@RLM.3097:1282277171
\ No newline at end of file
diff -r 163bf9b2fd13 -r 6d9bdaf919f7 src/laser/rasterize.clj
--- a/src/laser/rasterize.clj	Thu Aug 19 22:24:41 2010 -0400
+++ b/src/laser/rasterize.clj	Fri Aug 20 00:32:44 2010 -0400
@@ -25,6 +25,31 @@
 
 (def img "/home/r/graster/test.png")
 
+
+(def feed 120)
+(def  dpi [500, 500])
+(def on_range [0.0, 0.5])
+(def overshoot 0.5)
+(def offset [1.0, 1.0])
+(def tiles [1, 1])
+(def tile_size [false, false])
+(def tile_spacing [0.125, 0.125])
+(def feed 120)
+(def cut_feed 20)
+(def corner_radius 0)
+
+
+
+
+(defn raster-preamble []
+  (str-join \newline
+	    ["M63 P0\nG61"
+	    (str \F feed)
+	    "M101"
+	    "M3 S1"]))
+
+
+
 (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
@@ -46,6 +71,42 @@
       {:width  (.getWidth image+) :height (.getHeight image+)})))
 
 
+(def white {:r 255, :g 255, :b 255})
+(def black {:r 0,   :g 0,   :b 0})
+
+(def expt #(Math/pow %1 %2))
+
+(defn rgb-euclidian
+  [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
+  (expt (+ (expt (- r1 r2) 2)
+	  (expt (- g1 g2) 2)
+	  (expt (- b1 b2) 2)) 0.5))
+
+(defn b&w
+  "turn everything strictly black or white"
+  [window]
+  (with-meta
+  (zipmap
+   (keys window)
+   (map (fn  [rgb] 
+	  (if (> (rgb-euclidian rgb white) (rgb-euclidian rgb black))
+	    black white))
+	(vals window))) (meta window)))
+
+
+
+
+
+  
+  
+
+
+
+
+
+
+
+
 (defn frame-hash->bufferedImage
   [frame-hash]
     (let [data  (meta frame-hash)