rlm@1: (ns clojureDemo.OpenCv)
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 '(javax.swing JFrame))
rlm@1: (import '(org.apache.commons.io FileUtils))
rlm@1: (import clojure.lang.LazySeq)
rlm@1: (import '(name.audet.samuel.javacv.jna highgui cv cxcore 
rlm@1: 				       cxcore$IplImage highgui$CvCapture$PointerByReference  
rlm@1: 				       highgui$CvVideoWriter$PointerByReference cxcore$IplImage$PointerByReference))
rlm@1: (import '(name.audet.samuel.javacv CanvasFrame JavaCvErrorCallback))
rlm@1: 
rlm@1: (.redirectError (JavaCvErrorCallback.))
rlm@1: 
rlm@1: (use 'clojure.contrib.repl-utils)
rlm@1: ;(use 'clojureDemo.Defines)
rlm@1: ;(use '[clojureDemo.Xuggle :only (cache)])
rlm@1: 
rlm@1: ;this is still a work in progress, I'll come back to it later when I understand 
rlm@1: ;jna more thoroughly.  the important abstraction here is 
rlm@1: ;video-seq, which gives a lazy sequence of Intel Image Processing library images.
rlm@1: 
rlm@1: (defn naturals [] (iterate inc 0))
rlm@1: 
rlm@1: (defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
rlm@1: 
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: 
rlm@1: (def ext "jpg") 
rlm@1: ;see below for the rationale for this choice of extention.
rlm@1: 
rlm@1: (def cache-location "/home/r/Desktop/vision-cache/")
rlm@1: 
rlm@1: (defn close-capture
rlm@1:   [capture]
rlm@1:   (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
rlm@1: 
rlm@1: (defn close-writer
rlm@1:   [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 
rlm@1: 
rlm@1: (defn- cache-path
rlm@1:   [video]
rlm@1:   (File. cache-location (.getName video)))
rlm@1: 
rlm@1: (defn- already-cached
rlm@1:   "this is the simplest and most retarded way to do it"
rlm@1:   [video]
rlm@1:   (.exists (cache-path video)))
rlm@1: 
rlm@1: (defn write-frame 
rlm@1:   [capture target-dir n]
rlm@1:   (let [image (highgui/cvQueryFrame capture)]
rlm@1:     (if (nil? image) false
rlm@1: 	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))
rlm@1: 
rlm@1: (defn- write-frame-bad
rlm@1:   [capture target-dir n]
rlm@1:   (println (str "saving frame: " n))
rlm@1:   (let [image (highgui/cvQueryFrame capture)]
rlm@1:     (if (nil? image) false
rlm@1: 	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))
rlm@1: 
rlm@1: (defn- write-frames
rlm@1:   [video target-dir]
rlm@1:   (let [capture (highgui/cvCreateFileCapture (.getPath video))]
rlm@1:    (dorun 
rlm@1:     (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
rlm@1:     (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
rlm@1: 
rlm@1: (defn- cache-frames
rlm@1:   [cache-location video]
rlm@1:   (time 
rlm@1:    (do
rlm@1:      (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
rlm@1:      (FileUtils/deleteDirectory (cache-path video))
rlm@1:      (FileUtils/forceMkdir (cache-path video))
rlm@1:      (write-frames video  (cache-path video)))))
rlm@1: 
rlm@1: ;(defn cache
rlm@1: ;  [video]
rlm@1: ;  (if (already-cached video) nil (cache-frames cache-location video)))
rlm@1:  
rlm@1: (defn video-len 
rlm@1:   [video]
rlm@1:   (alength (.list (cache-path video))))
rlm@1: (def video-len (memoize video-len))
rlm@1:  
rlm@1: (defn video-data
rlm@1:   "since the opencv version is so absolutely unreliable..."
rlm@1:   [video]
rlm@1:   (let
rlm@1:       [capture (highgui/cvCreateFileCapture (.getPath video))
rlm@1:        info {:length      (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:     (close-capture capture)
rlm@1:     info))
rlm@1: (def video-data (memoize video-data))
rlm@1: 
rlm@1: (defn video-frame-path
rlm@1:      [video n]
rlm@1:      (File. (cache-path video)  (str n "."  ext)))
rlm@1: 
rlm@1: 
rlm@1: (defn- video-frame-ipl
rlm@1:   [video n] 
rlm@1: ;  (cache video)
rlm@1:   (let 
rlm@1:       [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)
rlm@1:        jvm-managed (.clone c++-managed)] 
rlm@1: 	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
rlm@1: 	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 
rlm@1:          ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 
rlm@1:          ;other function has to worry about manual garbage collection ever again.
rlm@1:          ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
rlm@1:          ;which is the issue, but something involving the image header.
rlm@1:     (cxcore/cvReleaseImage (.pointerByReference c++-managed))
rlm@1:     jvm-managed
rlm@1: ))
rlm@1:   
rlm@1: 
rlm@1: (defn- video-frame-buffered
rlm@1:   "takes one frame from a video in constant time"
rlm@1:   [video n]
rlm@1:  ; (cache video)
rlm@1:   (ImageIO/read (File. (cache-path video) (str n "."  ext))))
rlm@1: 
rlm@1: (defn video-frame [video n] (video-frame-buffered video n))
rlm@1: 
rlm@1: (defn- dumb-write 
rlm@1:   [video n writer]
rlm@1:   (let 
rlm@1:       [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
rlm@1:     (highgui/cvWriteFrame writer  c++-managed)
rlm@1:     (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
rlm@1: 
rlm@1: (defn video-seq
rlm@1:   "makes a lazy sequence of IPL images"
rlm@1:   ;additionally, I want to pass metadata around with the sequence.
rlm@1:   [video] ;(cache video)
rlm@1:   (map #(video-frame video %) (range (video-len video))))
rlm@1: (defn video-writer
rlm@1:   "uses data about the video to make a writer"
rlm@1:   [data fileTarget]
rlm@1:   (highgui/cvCreateVideoWriter 
rlm@1:    (str fileTarget)
rlm@1:    
rlm@1:    ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)
rlm@1:    ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
rlm@1:    ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
rlm@1:    ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)
rlm@1:    (highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)
rlm@1:    ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)
rlm@1:    ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)
rlm@1:    ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)
rlm@1:    ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  
rlm@1: 
rlm@1:    (:fps data) (cxcore/cvSize (:width data) (:height data)) 
rlm@1:    1; 1 here means that we're writing in color.
rlm@1:     ; you cannot change it to 0 to write in 
rlm@1:     ; black and white. Everything just crashes instead.
rlm@1:     ; what a useful paramater.
rlm@1:    ))
rlm@1: 
rlm@1: 
rlm@1: (defn naturals []  (iterate inc 0))
rlm@1: 
rlm@1: 
rlm@1: (defn write-frame-2
rlm@1:   [writer frame]
rlm@1:   (let [c++-frame (cxcore$IplImage/createFrom frame)]
rlm@1:     (highgui/cvWriteFrame writer c++-frame)
rlm@1:    ; (cxcore/cvReleaseImage (.pointerByReference c++-frame)))
rlm@1: )
rlm@1:     frame)
rlm@1: 
rlm@1: (defn save-seq 
rlm@1:   [writer video-seq]
rlm@1:   (map #(write-frame-2 writer %) video-seq))
rlm@1: 
rlm@1: (defmacro trans-save
rlm@1: "there's a small problem with trans-save --- it IS
rlm@1: truly transitive, but it does too much work....
rlm@1: sometimes it writes files twice.
rlm@1: this is functionally correct though."
rlm@1:   [target config video-seq]
rlm@1:   `(let [writer# (video-writer ~config ~target)]
rlm@1:      (do
rlm@1:        (dorun (save-seq writer# ~video-seq))
rlm@1:        (close-writer writer#)
rlm@1:        ~video-seq)))
rlm@1: 
rlm@1: 
rlm@1: 
rlm@1: (comment 
rlm@1: (do (use :reload-all 'clojureDemo.OpenCv) (in-ns 'clojureDemo.OpenCv))
rlm@1: )