Mercurial > lasercutter

     1 (ns clojureDemo.OpenCv)

     2   

     3 (import '(java.awt Rectangle Robot Toolkit) )

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

     5 (import '(java.awt Graphics2D Panel))

     6 (import '(java.io File) )

     7 (import '(javax.imageio ImageIO) )

     8 (import '(javax.swing JFrame))

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

    10 (import clojure.lang.LazySeq)

    11 (import '(name.audet.samuel.javacv.jna highgui cv cxcore 

    12 				       cxcore$IplImage highgui$CvCapture$PointerByReference  

    13 				       highgui$CvVideoWriter$PointerByReference cxcore$IplImage$PointerByReference))

    14 (import '(name.audet.samuel.javacv CanvasFrame JavaCvErrorCallback))

    15 

    16 (.redirectError (JavaCvErrorCallback.))

    17 

    18 (use 'clojure.contrib.repl-utils)

    19 ;(use 'clojureDemo.Defines)

    20 ;(use '[clojureDemo.Xuggle :only (cache)])

    21 

    22 ;this is still a work in progress, I'll come back to it later when I understand 

    23 ;jna more thoroughly.  the important abstraction here is 

    24 ;video-seq, which gives a lazy sequence of Intel Image Processing library images.

    25 

    26 (defn naturals [] (iterate inc 0))

    27 

    28 (defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))

    29 

    30 

    31 (defmulti  display "Creates a JFrame and displays a buffered image"  class)

    32 

    33 (defmethod display 

    34   BufferedImage  [image] 

    35   (let [panel (makePanel image)

    36 	frame (JFrame. "Oh Yeah!")]

    37     (.add frame panel) 

    38     (.pack frame) 

    39     (.setVisible frame true ) 

    40     (.setSize frame(.getWidth image) (.getHeight image))))

    41 

    42 (defmethod display

    43   cxcore$IplImage [image]

    44   ( display (.getBufferedImage image)))

    45   

    46 (defmethod display

    47   String [image]

    48   (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))

    49 

    50 (defmethod display

    51   LazySeq [s]

    52   (display (first s)))

    53 

    54 

    55 

    56 (def ext "jpg") 

    57 ;see below for the rationale for this choice of extention.

    58 

    59 (def cache-location "/home/r/Desktop/vision-cache/")

    60 

    61 (defn close-capture

    62   [capture]

    63   (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))

    64 

    65 (defn close-writer

    66   [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 

    67 

    68 (defn- cache-path

    69   [video]

    70   (File. cache-location (.getName video)))

    71 

    72 (defn- already-cached

    73   "this is the simplest and most retarded way to do it"

    74   [video]

    75   (.exists (cache-path video)))

    76 

    77 (defn write-frame 

    78   [capture target-dir n]

    79   (let [image (highgui/cvQueryFrame capture)]

    80     (if (nil? image) false

    81 	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))

    82 

    83 (defn- write-frame-bad

    84   [capture target-dir n]

    85   (println (str "saving frame: " n))

    86   (let [image (highgui/cvQueryFrame capture)]

    87     (if (nil? image) false

    88 	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))

    89 

    90 (defn- write-frames

    91   [video target-dir]

    92   (let [capture (highgui/cvCreateFileCapture (.getPath video))]

    93    (dorun 

    94     (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))

    95     (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))

    96 

    97 (defn- cache-frames

    98   [cache-location video]

    99   (time 

   100    (do

   101      (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")

   102      (FileUtils/deleteDirectory (cache-path video))

   103      (FileUtils/forceMkdir (cache-path video))

   104      (write-frames video  (cache-path video)))))

   105 

   106 ;(defn cache

   107 ;  [video]

   108 ;  (if (already-cached video) nil (cache-frames cache-location video)))

   109  

   110 (defn video-len 

   111   [video]

   112   (alength (.list (cache-path video))))

   113 (def video-len (memoize video-len))

   114  

   115 (defn video-data

   116   "since the opencv version is so absolutely unreliable..."

   117   [video]

   118   (let

   119       [capture (highgui/cvCreateFileCapture (.getPath video))

   120        info {:length      (video-len video)

   121 	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)

   122 	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)

   123 	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)

   124 	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]

   125     (close-capture capture)

   126     info))

   127 (def video-data (memoize video-data))

   128 

   129 (defn video-frame-path

   130      [video n]

   131      (File. (cache-path video)  (str n "."  ext)))

   132 

   133 

   134 (defn- video-frame-ipl

   135   [video n] 

   136 ;  (cache video)

   137   (let 

   138       [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)

   139        jvm-managed (.clone c++-managed)] 

   140 	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.

   141 	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 

   142          ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 

   143          ;other function has to worry about manual garbage collection ever again.

   144          ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size

   145          ;which is the issue, but something involving the image header.

   146     (cxcore/cvReleaseImage (.pointerByReference c++-managed))

   147     jvm-managed

   148 ))

   149   

   150 

   151 (defn- video-frame-buffered

   152   "takes one frame from a video in constant time"

   153   [video n]

   154  ; (cache video)

   155   (ImageIO/read (File. (cache-path video) (str n "."  ext))))

   156 

   157 (defn video-frame [video n] (video-frame-buffered video n))

   158 

   159 (defn- dumb-write 

   160   [video n writer]

   161   (let 

   162       [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]

   163     (highgui/cvWriteFrame writer  c++-managed)

   164     (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))

   165 

   166 (defn video-seq

   167   "makes a lazy sequence of IPL images"

   168   ;additionally, I want to pass metadata around with the sequence.

   169   [video] ;(cache video)

   170   (map #(video-frame video %) (range (video-len video))))

   171 (defn video-writer

   172   "uses data about the video to make a writer"

   173   [data fileTarget]

   174   (highgui/cvCreateVideoWriter 

   175    (str fileTarget)

   176    

   177    ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)

   178    ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)

   179    ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)

   180    ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)

   181    (highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)

   182    ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)

   183    ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)

   184    ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)

   185    ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  

   186 

   187    (:fps data) (cxcore/cvSize (:width data) (:height data)) 

   188    1; 1 here means that we're writing in color.

   189     ; you cannot change it to 0 to write in 

   190     ; black and white. Everything just crashes instead.

   191     ; what a useful paramater.

   192    ))

   193 

   194 

   195 (defn naturals []  (iterate inc 0))

   196 

   197 

   198 (defn write-frame-2

   199   [writer frame]

   200   (let [c++-frame (cxcore$IplImage/createFrom frame)]

   201     (highgui/cvWriteFrame writer c++-frame)

   202    ; (cxcore/cvReleaseImage (.pointerByReference c++-frame)))

   203 )

   204     frame)

   205 

   206 (defn save-seq 

   207   [writer video-seq]

   208   (map #(write-frame-2 writer %) video-seq))

   209 

   210 (defmacro trans-save

   211 "there's a small problem with trans-save --- it IS

   212 truly transitive, but it does too much work....

   213 sometimes it writes files twice.

   214 this is functionally correct though."

   215   [target config video-seq]

   216   `(let [writer# (video-writer ~config ~target)]

   217      (do

   218        (dorun (save-seq writer# ~video-seq))

   219        (close-writer writer#)

   220        ~video-seq)))

   221 

   222 

   223 

   224 (comment 

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

   226 )
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 20 Aug 2010 00:32:44 -0400
parents
children