Mercurial > lasercutter

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

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