rlm@1: (ns clojureDemo.VideoParse)
rlm@1:   
rlm@1:  
rlm@1: 
rlm@1: ;this file is not used anymore, except for the (display %) function.
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (import '(java.awt Rectangle Robot Toolkit) )
rlm@1: (import '(java.awt.image BufferedImage) )
rlm@1: (import '(java.awt Graphics2D Panel))
rlm@1: (import '(java.io File) )
rlm@1: (import '(javax.imageio ImageIO) )
rlm@1: (import '(com.xuggle.mediatool ToolFactory))
rlm@1: (import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
rlm@1: (import '(com.xuggle.mediatool MediaToolAdapter))
rlm@1: (import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
rlm@1: (import '(javax.swing JFrame))
rlm@1: 
rlm@1: (import clojure.lang.LazySeq)
rlm@1: 
rlm@1: (import '(name.audet.samuel.javacv.jna highgui cv cxcore))
rlm@1: 
rlm@1: (import '(name.audet.samuel.javacv CanvasFrame))
rlm@1: 
rlm@1: (import '(name.audet.samuel.javacv.jna cxcore$IplImage))
rlm@1: 
rlm@1: (import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
rlm@1: (import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
rlm@1: 
rlm@1: ;definitions
rlm@1: 
rlm@1: (def -inf Double/NEGATIVE_INFINITY)
rlm@1: (def inf  Double/POSITIVE_INFINITY)
rlm@1: 
rlm@1: (use 'clojure.contrib.repl-utils)
rlm@1: 
rlm@1: 
rlm@1: ;minor functions
rlm@1: 
rlm@1: (defn converge
rlm@1:   "recursively runs update until prior passes accept, then returns"
rlm@1:   [prior update accept]
rlm@1:   (if (accept prior) prior (recur (update prior) update accept)))
rlm@1: 
rlm@1: (defn interval-width [interval] (- (last interval) (first interval)))
rlm@1: 
rlm@1: (defn midpoint [interval] 
rlm@1:   (let [a (first interval) b (last interval)]
rlm@1:     (if (and (= a -inf) (= b inf)) 0
rlm@1:     (if (= a -inf) (midpoint [(- b 200000) b])
rlm@1: 	(if (= b inf) (midpoint [a (+ a 200000)])
rlm@1: 	    (int (/ (+ a b) 2)))))))
rlm@1: 
rlm@1: (defn cart2
rlm@1:   "calculates the cartesian product in 2 dimensions"
rlm@1:   [point] 
rlm@1:   (let [[x y] point] (for [abscissa (range x) ordinate (range y)] [abscissa ordinate])))
rlm@1: 
rlm@1: (defn closeCapture
rlm@1:   [capture]
rlm@1:   (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
rlm@1: 
rlm@1: (defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
rlm@1: 
rlm@1: (defn screenshot "grab screenshot" [] 
rlm@1:   
rlm@1:   (ImageIO/write
rlm@1:    (.createScreenCapture (Robot.) (Rectangle. (.getScreenSize (Toolkit/getDefaultToolkit))))
rlm@1:    "JPG"
rlm@1:    (File. "/home/r/Desktop/screenie.jpg")))
rlm@1: 
rlm@1: (defn- readerRecurse
rlm@1:   "calls .readPacket until there's nothing left to do"
rlm@1:   [reader]
rlm@1:   (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
rlm@1:     nil                                   ; it returns null when it has MORE to process, and signals an error when done... 
rlm@1:     (recur reader)))
rlm@1: 
rlm@1: (defmacro times
rlm@1:   "perform multiple timed tests on a form"
rlm@1:   [n form]
rlm@1:   `(dotimes [_# ~n] (time ~form)))
rlm@1:   
rlm@1: (defmacro me-1
rlm@1:   "does macroexpand-1 without having to quote the form"
rlm@1:   [form]
rlm@1:   (list 'macroexpand-1 (list 'quote form)))
rlm@1: 
rlm@1: ;Major Functions
rlm@1: 
rlm@1: (defmulti  display "Creates a JFrame and displays a buffered image"  class)
rlm@1: 
rlm@1: (defmethod display 
rlm@1:   BufferedImage  [image] 
rlm@1:   (let [panel (makePanel image)
rlm@1: 	frame (JFrame. "Oh Yeah!")]
rlm@1:     (.add frame panel) 
rlm@1:     (.pack frame) 
rlm@1:     (.setVisible frame true ) 
rlm@1:     (.setSize frame(.getWidth image) (.getHeight image))))
rlm@1: 
rlm@1: (defmethod display
rlm@1:   cxcore$IplImage [image]
rlm@1:   ( display (.getBufferedImage image)))
rlm@1:   
rlm@1: (defmethod display
rlm@1:   String [image]
rlm@1:   (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
rlm@1: 
rlm@1: (defmethod display
rlm@1:   LazySeq [s]
rlm@1:   (display (first s)))
rlm@1: 
rlm@1: 
rlm@1: (defn convert
rlm@1:   "takes video and converts it to a new type of video"
rlm@1:   [videoInput videoOutput]
rlm@1:   (let [reader (ToolFactory/makeReader videoInput)]
rlm@1:     (doto reader
rlm@1:       (.addListener (ToolFactory/makeWriter videoOutput reader))
rlm@1:       (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
rlm@1:     (readerRecurse reader)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn video-frame
rlm@1:   ":("
rlm@1:   [video frame]
rlm@1:   (lazy-seq
rlm@1:    (try 
rlm@1:     (let [capture (highgui/cvCreateFileCapture video)]
rlm@1:       (highgui/cvSetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES frame)
rlm@1:       (println (str "Wanted frame <" frame "> but went to keyFrame " (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES)))
rlm@1:       (let [out (highgui/cvQueryFrame capture)
rlm@1: 	    image (.clone  out)]
rlm@1: 	(highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))
rlm@1: 	[image]))
rlm@1:     (catch java.lang.NullPointerException _ nil))))
rlm@1: 
rlm@1: 
rlm@1:   
rlm@1: 
rlm@1: (defn save-frame
rlm@1:   "takes an opencv image and saves it to disk"
rlm@1:   [frame filename]
rlm@1:   (highgui/cvSaveImage filename frame))
rlm@1: 
rlm@1: 
rlm@1: (defn video-len
rlm@1:   "finds out the real length of a video in log time."
rlm@1:   [video]
rlm@1:   (letfn
rlm@1:       [
rlm@1:        (accept [interval] (= 0 (interval-width interval)))
rlm@1:        (update [interval]
rlm@1: 	       (let [[a b] interval]
rlm@1: 		 (if (> (interval-width interval) 2)
rlm@1: 		   (let [
rlm@1: 			 middle (midpoint interval)
rlm@1: 			 frame (first (video-frame video middle))
rlm@1: 			 ]
rlm@1: 		     (if (nil? frame) [a middle] [middle b]))
rlm@1: 		   [a a])))
rlm@1:        ]
rlm@1:        
rlm@1:    (first (converge [-inf inf] update accept))))
rlm@1: (def video-len (memoize video-len))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (defn getData
rlm@1:   "returns a bunch of stuff about a video"
rlm@1:   [video]
rlm@1:   (let
rlm@1:       [capture (highgui/cvCreateFileCapture video)
rlm@1:        info {:frames      (video-len video)
rlm@1: 	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
rlm@1: 	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
rlm@1: 	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
rlm@1: 	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
rlm@1:       
rlm@1:     (closeCapture capture)
rlm@1:     info))
rlm@1: (def getData (memoize getData))
rlm@1:   
rlm@1: 
rlm@1: (defn sajitify-linear
rlm@1:   "oh yeah!"
rlm@1:   [video string]
rlm@1:   (let [ capture (highgui/cvCreateFileCapture video)
rlm@1: 	frames (:frames (getData video))]
rlm@1:        (dotimes [n frames]
rlm@1: 	 (highgui/cvSaveImage (str string  (format "%06d" n) ".jpg") (highgui/cvQueryFrame capture)))
rlm@1:        (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
rlm@1: 
rlm@1: (defn getFrame
rlm@1:   "gets the frame of a video at the specified time in seconds.
rlm@1:   this works with the simplest interpolation --- just piecewise steps"
rlm@1:   [video time]
rlm@1:   (lazy-seq
rlm@1:   [time  (video-frame video (int (* time (:fps (getData video)))))]))
rlm@1: 
rlm@1: (defn video-seq-times
rlm@1:   "it's the new and improved version of videoSeq, now using OpenCv.
rlm@1:   we expect a sequence of times in seconds"
rlm@1:   [times video]
rlm@1:   (map #(getFrame video %) times))
rlm@1: 
rlm@1: (defn video-seq
rlm@1:   "get's ALL the frames of a video as a lazy sequence of (IplImages)"
rlm@1:   [video] 
rlm@1:   (take (:frames (getData video))   (map #(video-frame video %) (iterate inc 0))))
rlm@1: 
rlm@1: (defn trans-Writer
rlm@1:   "uses data about the video to make a writer"
rlm@1:   [video fileTarget]
rlm@1:   (let [data (getData video)]
rlm@1:   (highgui/cvCreateVideoWriter fileTarget (highgui/CV_FOURCC "F" "L" "V" "1") (:fps data) (cxcore/cvSize (:width data) (:height data)) 1)))
rlm@1: 
rlm@1: (def naturals (iterate inc 0))
rlm@1: 
rlm@1: (defn sajitify-seq
rlm@1:   [video string]
rlm@1:   (dorun (map #(highgui/cvSaveImage (str string  (format "%06d" %2) ".jpg") (first %1)) (video-seq video) naturals)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: