annotate src/clojureDemo/OpenCv.clj @ 6:4ae2497acf7d

saving progress
author Robert McIntyre <rlm@mit.edu>
date Fri, 20 Aug 2010 03:18:05 -0400
parents 6d9bdaf919f7
children
rev   line source
rlm@1 1 (ns clojureDemo.OpenCv)
rlm@1 2
rlm@1 3 (import '(java.awt Rectangle Robot Toolkit) )
rlm@1 4 (import '(java.awt.image BufferedImage) )
rlm@1 5 (import '(java.awt Graphics2D Panel))
rlm@1 6 (import '(java.io File) )
rlm@1 7 (import '(javax.imageio ImageIO) )
rlm@1 8 (import '(javax.swing JFrame))
rlm@1 9 (import '(org.apache.commons.io FileUtils))
rlm@1 10 (import clojure.lang.LazySeq)
rlm@1 11 (import '(name.audet.samuel.javacv.jna highgui cv cxcore
rlm@1 12 cxcore$IplImage highgui$CvCapture$PointerByReference
rlm@1 13 highgui$CvVideoWriter$PointerByReference cxcore$IplImage$PointerByReference))
rlm@1 14 (import '(name.audet.samuel.javacv CanvasFrame JavaCvErrorCallback))
rlm@1 15
rlm@1 16 (.redirectError (JavaCvErrorCallback.))
rlm@1 17
rlm@1 18 (use 'clojure.contrib.repl-utils)
rlm@1 19 ;(use 'clojureDemo.Defines)
rlm@1 20 ;(use '[clojureDemo.Xuggle :only (cache)])
rlm@1 21
rlm@1 22 ;this is still a work in progress, I'll come back to it later when I understand
rlm@1 23 ;jna more thoroughly. the important abstraction here is
rlm@1 24 ;video-seq, which gives a lazy sequence of Intel Image Processing library images.
rlm@1 25
rlm@1 26 (defn naturals [] (iterate inc 0))
rlm@1 27
rlm@1 28 (defn- makePanel [image] (proxy [Panel] [] (paint [g] (.drawImage g image 0 0 nil))))
rlm@1 29
rlm@1 30
rlm@1 31 (defmulti display "Creates a JFrame and displays a buffered image" class)
rlm@1 32
rlm@1 33 (defmethod display
rlm@1 34 BufferedImage [image]
rlm@1 35 (let [panel (makePanel image)
rlm@1 36 frame (JFrame. "Oh Yeah!")]
rlm@1 37 (.add frame panel)
rlm@1 38 (.pack frame)
rlm@1 39 (.setVisible frame true )
rlm@1 40 (.setSize frame(.getWidth image) (.getHeight image))))
rlm@1 41
rlm@1 42 (defmethod display
rlm@1 43 cxcore$IplImage [image]
rlm@1 44 ( display (.getBufferedImage image)))
rlm@1 45
rlm@1 46 (defmethod display
rlm@1 47 String [image]
rlm@1 48 (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
rlm@1 49
rlm@1 50 (defmethod display
rlm@1 51 LazySeq [s]
rlm@1 52 (display (first s)))
rlm@1 53
rlm@1 54
rlm@1 55
rlm@1 56 (def ext "jpg")
rlm@1 57 ;see below for the rationale for this choice of extention.
rlm@1 58
rlm@1 59 (def cache-location "/home/r/Desktop/vision-cache/")
rlm@1 60
rlm@1 61 (defn close-capture
rlm@1 62 [capture]
rlm@1 63 (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
rlm@1 64
rlm@1 65 (defn close-writer
rlm@1 66 [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer)))
rlm@1 67
rlm@1 68 (defn- cache-path
rlm@1 69 [video]
rlm@1 70 (File. cache-location (.getName video)))
rlm@1 71
rlm@1 72 (defn- already-cached
rlm@1 73 "this is the simplest and most retarded way to do it"
rlm@1 74 [video]
rlm@1 75 (.exists (cache-path video)))
rlm@1 76
rlm@1 77 (defn write-frame
rlm@1 78 [capture target-dir n]
rlm@1 79 (let [image (highgui/cvQueryFrame capture)]
rlm@1 80 (if (nil? image) false
rlm@1 81 (highgui/cvSaveImage (str (File. target-dir (str n "." ext))) image))))
rlm@1 82
rlm@1 83 (defn- write-frame-bad
rlm@1 84 [capture target-dir n]
rlm@1 85 (println (str "saving frame: " n))
rlm@1 86 (let [image (highgui/cvQueryFrame capture)]
rlm@1 87 (if (nil? image) false
rlm@1 88 ( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "." ext))))))
rlm@1 89
rlm@1 90 (defn- write-frames
rlm@1 91 [video target-dir]
rlm@1 92 (let [capture (highgui/cvCreateFileCapture (.getPath video))]
rlm@1 93 (dorun
rlm@1 94 (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
rlm@1 95 (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
rlm@1 96
rlm@1 97 (defn- cache-frames
rlm@1 98 [cache-location video]
rlm@1 99 (time
rlm@1 100 (do
rlm@1 101 (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
rlm@1 102 (FileUtils/deleteDirectory (cache-path video))
rlm@1 103 (FileUtils/forceMkdir (cache-path video))
rlm@1 104 (write-frames video (cache-path video)))))
rlm@1 105
rlm@1 106 ;(defn cache
rlm@1 107 ; [video]
rlm@1 108 ; (if (already-cached video) nil (cache-frames cache-location video)))
rlm@1 109
rlm@1 110 (defn video-len
rlm@1 111 [video]
rlm@1 112 (alength (.list (cache-path video))))
rlm@1 113 (def video-len (memoize video-len))
rlm@1 114
rlm@1 115 (defn video-data
rlm@1 116 "since the opencv version is so absolutely unreliable..."
rlm@1 117 [video]
rlm@1 118 (let
rlm@1 119 [capture (highgui/cvCreateFileCapture (.getPath video))
rlm@1 120 info {:length (video-len video)
rlm@1 121 :width (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
rlm@1 122 :height (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
rlm@1 123 :fps (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
rlm@1 124 :codec (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
rlm@1 125 (close-capture capture)
rlm@1 126 info))
rlm@1 127 (def video-data (memoize video-data))
rlm@1 128
rlm@1 129 (defn video-frame-path
rlm@1 130 [video n]
rlm@1 131 (File. (cache-path video) (str n "." ext)))
rlm@1 132
rlm@1 133
rlm@1 134 (defn- video-frame-ipl
rlm@1 135 [video n]
rlm@1 136 ; (cache video)
rlm@1 137 (let
rlm@1 138 [c++-managed (highgui/cvLoadImage (str (File. (cache-path video) (str n "." ext))) highgui/CV_LOAD_IMAGE_COLOR)
rlm@1 139 jvm-managed (.clone c++-managed)]
rlm@1 140 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
rlm@1 141 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by
rlm@1 142 ;the JVM's Garbage Collector. By getting rid of the c++ part right here and now, no
rlm@1 143 ;other function has to worry about manual garbage collection ever again.
rlm@1 144 ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
rlm@1 145 ;which is the issue, but something involving the image header.
rlm@1 146 (cxcore/cvReleaseImage (.pointerByReference c++-managed))
rlm@1 147 jvm-managed
rlm@1 148 ))
rlm@1 149
rlm@1 150
rlm@1 151 (defn- video-frame-buffered
rlm@1 152 "takes one frame from a video in constant time"
rlm@1 153 [video n]
rlm@1 154 ; (cache video)
rlm@1 155 (ImageIO/read (File. (cache-path video) (str n "." ext))))
rlm@1 156
rlm@1 157 (defn video-frame [video n] (video-frame-buffered video n))
rlm@1 158
rlm@1 159 (defn- dumb-write
rlm@1 160 [video n writer]
rlm@1 161 (let
rlm@1 162 [c++-managed (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
rlm@1 163 (highgui/cvWriteFrame writer c++-managed)
rlm@1 164 (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
rlm@1 165
rlm@1 166 (defn video-seq
rlm@1 167 "makes a lazy sequence of IPL images"
rlm@1 168 ;additionally, I want to pass metadata around with the sequence.
rlm@1 169 [video] ;(cache video)
rlm@1 170 (map #(video-frame video %) (range (video-len video))))
rlm@1 171 (defn video-writer
rlm@1 172 "uses data about the video to make a writer"
rlm@1 173 [data fileTarget]
rlm@1 174 (highgui/cvCreateVideoWriter
rlm@1 175 (str fileTarget)
rlm@1 176
rlm@1 177 ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec (112913.386195 msecs) (104 MB)
rlm@1 178 ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
rlm@1 179 ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
rlm@1 180 ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs) (83 MB)
rlm@1 181 (highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec (99037.738131 msecs) (85 MB)
rlm@1 182 ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec (101141.993551 msecs) (89 MB)
rlm@1 183 ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec (crashed)
rlm@1 184 ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec (104307.567802 msecs) (93 MB)
rlm@1 185 ;(:codec data) ;= whatever the movie originally had. (98278.694169 msecs) (1.9 GB)
rlm@1 186
rlm@1 187 (:fps data) (cxcore/cvSize (:width data) (:height data))
rlm@1 188 1; 1 here means that we're writing in color.
rlm@1 189 ; you cannot change it to 0 to write in
rlm@1 190 ; black and white. Everything just crashes instead.
rlm@1 191 ; what a useful paramater.
rlm@1 192 ))
rlm@1 193
rlm@1 194
rlm@1 195 (defn naturals [] (iterate inc 0))
rlm@1 196
rlm@1 197
rlm@1 198 (defn write-frame-2
rlm@1 199 [writer frame]
rlm@1 200 (let [c++-frame (cxcore$IplImage/createFrom frame)]
rlm@1 201 (highgui/cvWriteFrame writer c++-frame)
rlm@1 202 ; (cxcore/cvReleaseImage (.pointerByReference c++-frame)))
rlm@1 203 )
rlm@1 204 frame)
rlm@1 205
rlm@1 206 (defn save-seq
rlm@1 207 [writer video-seq]
rlm@1 208 (map #(write-frame-2 writer %) video-seq))
rlm@1 209
rlm@1 210 (defmacro trans-save
rlm@1 211 "there's a small problem with trans-save --- it IS
rlm@1 212 truly transitive, but it does too much work....
rlm@1 213 sometimes it writes files twice.
rlm@1 214 this is functionally correct though."
rlm@1 215 [target config video-seq]
rlm@1 216 `(let [writer# (video-writer ~config ~target)]
rlm@1 217 (do
rlm@1 218 (dorun (save-seq writer# ~video-seq))
rlm@1 219 (close-writer writer#)
rlm@1 220 ~video-seq)))
rlm@1 221
rlm@1 222
rlm@1 223
rlm@1 224 (comment
rlm@1 225 (do (use :reload-all 'clojureDemo.OpenCv) (in-ns 'clojureDemo.OpenCv))
rlm@1 226 )