annotate src/clojureDemo/VideoParse.clj @ 1:6d9bdaf919f7

added clojureDemo source
author Robert McIntyre <rlm@mit.edu>
date Fri, 20 Aug 2010 00:32:44 -0400
parents
children
rev   line source
rlm@1 1 (ns clojureDemo.VideoParse)
rlm@1 2
rlm@1 3
rlm@1 4
rlm@1 5 ;this file is not used anymore, except for the (display %) function.
rlm@1 6
rlm@1 7
rlm@1 8
rlm@1 9 (import '(java.awt Rectangle Robot Toolkit) )
rlm@1 10 (import '(java.awt.image BufferedImage) )
rlm@1 11 (import '(java.awt Graphics2D Panel))
rlm@1 12 (import '(java.io File) )
rlm@1 13 (import '(javax.imageio ImageIO) )
rlm@1 14 (import '(com.xuggle.mediatool ToolFactory))
rlm@1 15 (import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
rlm@1 16 (import '(com.xuggle.mediatool MediaToolAdapter))
rlm@1 17 (import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
rlm@1 18 (import '(javax.swing JFrame))
rlm@1 19
rlm@1 20 (import clojure.lang.LazySeq)
rlm@1 21
rlm@1 22 (import '(name.audet.samuel.javacv.jna highgui cv cxcore))
rlm@1 23
rlm@1 24 (import '(name.audet.samuel.javacv CanvasFrame))
rlm@1 25
rlm@1 26 (import '(name.audet.samuel.javacv.jna cxcore$IplImage))
rlm@1 27
rlm@1 28 (import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
rlm@1 29 (import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
rlm@1 30
rlm@1 31 ;definitions
rlm@1 32
rlm@1 33 (def -inf Double/NEGATIVE_INFINITY)
rlm@1 34 (def inf Double/POSITIVE_INFINITY)
rlm@1 35
rlm@1 36 (use 'clojure.contrib.repl-utils)
rlm@1 37
rlm@1 38
rlm@1 39 ;minor functions
rlm@1 40
rlm@1 41 (defn converge
rlm@1 42 "recursively runs update until prior passes accept, then returns"
rlm@1 43 [prior update accept]
rlm@1 44 (if (accept prior) prior (recur (update prior) update accept)))
rlm@1 45
rlm@1 46 (defn interval-width [interval] (- (last interval) (first interval)))
rlm@1 47
rlm@1 48 (defn midpoint [interval]
rlm@1 49 (let [a (first interval) b (last interval)]
rlm@1 50 (if (and (= a -inf) (= b inf)) 0
rlm@1 51 (if (= a -inf) (midpoint [(- b 200000) b])
rlm@1 52 (if (= b inf) (midpoint [a (+ a 200000)])
rlm@1 53 (int (/ (+ a b) 2)))))))
rlm@1 54
rlm@1 55 (defn cart2
rlm@1 56 "calculates the cartesian product in 2 dimensions"
rlm@1 57 [point]
rlm@1 58 (let [[x y] point] (for [abscissa (range x) ordinate (range y)] [abscissa ordinate])))
rlm@1 59
rlm@1 60 (defn closeCapture
rlm@1 61 [capture]
rlm@1 62 (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
rlm@1 63
rlm@1 64 (defn- makePanel [image] (proxy [Panel] [] (paint [g] (.drawImage g image 0 0 nil))))
rlm@1 65
rlm@1 66 (defn screenshot "grab screenshot" []
rlm@1 67
rlm@1 68 (ImageIO/write
rlm@1 69 (.createScreenCapture (Robot.) (Rectangle. (.getScreenSize (Toolkit/getDefaultToolkit))))
rlm@1 70 "JPG"
rlm@1 71 (File. "/home/r/Desktop/screenie.jpg")))
rlm@1 72
rlm@1 73 (defn- readerRecurse
rlm@1 74 "calls .readPacket until there's nothing left to do"
rlm@1 75 [reader]
rlm@1 76 (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
rlm@1 77 nil ; it returns null when it has MORE to process, and signals an error when done...
rlm@1 78 (recur reader)))
rlm@1 79
rlm@1 80 (defmacro times
rlm@1 81 "perform multiple timed tests on a form"
rlm@1 82 [n form]
rlm@1 83 `(dotimes [_# ~n] (time ~form)))
rlm@1 84
rlm@1 85 (defmacro me-1
rlm@1 86 "does macroexpand-1 without having to quote the form"
rlm@1 87 [form]
rlm@1 88 (list 'macroexpand-1 (list 'quote form)))
rlm@1 89
rlm@1 90 ;Major Functions
rlm@1 91
rlm@1 92 (defmulti display "Creates a JFrame and displays a buffered image" class)
rlm@1 93
rlm@1 94 (defmethod display
rlm@1 95 BufferedImage [image]
rlm@1 96 (let [panel (makePanel image)
rlm@1 97 frame (JFrame. "Oh Yeah!")]
rlm@1 98 (.add frame panel)
rlm@1 99 (.pack frame)
rlm@1 100 (.setVisible frame true )
rlm@1 101 (.setSize frame(.getWidth image) (.getHeight image))))
rlm@1 102
rlm@1 103 (defmethod display
rlm@1 104 cxcore$IplImage [image]
rlm@1 105 ( display (.getBufferedImage image)))
rlm@1 106
rlm@1 107 (defmethod display
rlm@1 108 String [image]
rlm@1 109 (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
rlm@1 110
rlm@1 111 (defmethod display
rlm@1 112 LazySeq [s]
rlm@1 113 (display (first s)))
rlm@1 114
rlm@1 115
rlm@1 116 (defn convert
rlm@1 117 "takes video and converts it to a new type of video"
rlm@1 118 [videoInput videoOutput]
rlm@1 119 (let [reader (ToolFactory/makeReader videoInput)]
rlm@1 120 (doto reader
rlm@1 121 (.addListener (ToolFactory/makeWriter videoOutput reader))
rlm@1 122 (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
rlm@1 123 (readerRecurse reader)))
rlm@1 124
rlm@1 125
rlm@1 126
rlm@1 127 (defn video-frame
rlm@1 128 ":("
rlm@1 129 [video frame]
rlm@1 130 (lazy-seq
rlm@1 131 (try
rlm@1 132 (let [capture (highgui/cvCreateFileCapture video)]
rlm@1 133 (highgui/cvSetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES frame)
rlm@1 134 (println (str "Wanted frame <" frame "> but went to keyFrame " (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES)))
rlm@1 135 (let [out (highgui/cvQueryFrame capture)
rlm@1 136 image (.clone out)]
rlm@1 137 (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))
rlm@1 138 [image]))
rlm@1 139 (catch java.lang.NullPointerException _ nil))))
rlm@1 140
rlm@1 141
rlm@1 142
rlm@1 143
rlm@1 144 (defn save-frame
rlm@1 145 "takes an opencv image and saves it to disk"
rlm@1 146 [frame filename]
rlm@1 147 (highgui/cvSaveImage filename frame))
rlm@1 148
rlm@1 149
rlm@1 150 (defn video-len
rlm@1 151 "finds out the real length of a video in log time."
rlm@1 152 [video]
rlm@1 153 (letfn
rlm@1 154 [
rlm@1 155 (accept [interval] (= 0 (interval-width interval)))
rlm@1 156 (update [interval]
rlm@1 157 (let [[a b] interval]
rlm@1 158 (if (> (interval-width interval) 2)
rlm@1 159 (let [
rlm@1 160 middle (midpoint interval)
rlm@1 161 frame (first (video-frame video middle))
rlm@1 162 ]
rlm@1 163 (if (nil? frame) [a middle] [middle b]))
rlm@1 164 [a a])))
rlm@1 165 ]
rlm@1 166
rlm@1 167 (first (converge [-inf inf] update accept))))
rlm@1 168 (def video-len (memoize video-len))
rlm@1 169
rlm@1 170
rlm@1 171
rlm@1 172 (defn getData
rlm@1 173 "returns a bunch of stuff about a video"
rlm@1 174 [video]
rlm@1 175 (let
rlm@1 176 [capture (highgui/cvCreateFileCapture video)
rlm@1 177 info {:frames (video-len video)
rlm@1 178 :width (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
rlm@1 179 :height (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
rlm@1 180 :fps (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
rlm@1 181 :codec (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
rlm@1 182
rlm@1 183 (closeCapture capture)
rlm@1 184 info))
rlm@1 185 (def getData (memoize getData))
rlm@1 186
rlm@1 187
rlm@1 188 (defn sajitify-linear
rlm@1 189 "oh yeah!"
rlm@1 190 [video string]
rlm@1 191 (let [ capture (highgui/cvCreateFileCapture video)
rlm@1 192 frames (:frames (getData video))]
rlm@1 193 (dotimes [n frames]
rlm@1 194 (highgui/cvSaveImage (str string (format "%06d" n) ".jpg") (highgui/cvQueryFrame capture)))
rlm@1 195 (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
rlm@1 196
rlm@1 197 (defn getFrame
rlm@1 198 "gets the frame of a video at the specified time in seconds.
rlm@1 199 this works with the simplest interpolation --- just piecewise steps"
rlm@1 200 [video time]
rlm@1 201 (lazy-seq
rlm@1 202 [time (video-frame video (int (* time (:fps (getData video)))))]))
rlm@1 203
rlm@1 204 (defn video-seq-times
rlm@1 205 "it's the new and improved version of videoSeq, now using OpenCv.
rlm@1 206 we expect a sequence of times in seconds"
rlm@1 207 [times video]
rlm@1 208 (map #(getFrame video %) times))
rlm@1 209
rlm@1 210 (defn video-seq
rlm@1 211 "get's ALL the frames of a video as a lazy sequence of (IplImages)"
rlm@1 212 [video]
rlm@1 213 (take (:frames (getData video)) (map #(video-frame video %) (iterate inc 0))))
rlm@1 214
rlm@1 215 (defn trans-Writer
rlm@1 216 "uses data about the video to make a writer"
rlm@1 217 [video fileTarget]
rlm@1 218 (let [data (getData video)]
rlm@1 219 (highgui/cvCreateVideoWriter fileTarget (highgui/CV_FOURCC "F" "L" "V" "1") (:fps data) (cxcore/cvSize (:width data) (:height data)) 1)))
rlm@1 220
rlm@1 221 (def naturals (iterate inc 0))
rlm@1 222
rlm@1 223 (defn sajitify-seq
rlm@1 224 [video string]
rlm@1 225 (dorun (map #(highgui/cvSaveImage (str string (format "%06d" %2) ".jpg") (first %1)) (video-seq video) naturals)))
rlm@1 226
rlm@1 227
rlm@1 228
rlm@1 229
rlm@1 230