|
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 )
|
