Mercurial > lasercutter

annotate src/clojureDemo/VideoTransforms.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
rev   line source
rlm@1 1 (ns clojureDemo.VideoTransforms)
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 (import '(name.audet.samuel.javacv CanvasFrame))
rlm@1 13 (import '(name.audet.samuel.javacv.jna cxcore$IplImage))
rlm@1 14 (import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
rlm@1 15 (import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
rlm@1 16 (import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))
rlm@1 17 (import '(name.audet.samuel.javacv.jna cxcore$IplImage))
rlm@1 18 (import '(name.audet.samuel.javacv JavaCvErrorCallback))
rlm@1 19
rlm@1 20 (.redirectError (JavaCvErrorCallback.));this enables the c errors to travel up to the JVM
rlm@1 21 ;where they can be handled.
rlm@1 22
rlm@1 23
rlm@1 24 (use '[clojureDemo.VisionCore :only (video-seq cache video-data close-writer)])
rlm@1 25
rlm@1 26
rlm@1 27 (use 'clojure.contrib.repl-utils)
rlm@1 28
rlm@1 29 (def -inf Double/NEGATIVE_INFINITY)
rlm@1 30 (def inf Double/POSITIVE_INFINITY)
rlm@1 31
rlm@1 32
rlm@1 33 (def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
rlm@1 34 (def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
rlm@1 35 (def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))
rlm@1 36 (def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))
rlm@1 37
rlm@1 38 (def base (File. "/home/r/Desktop/source-videos/"))
rlm@1 39
rlm@1 40 (def app0 (File. base "approach0v2.avi"))
rlm@1 41 (def app1 (File. base "approach1v3.avi"))
rlm@1 42 (def app2 (File. base "approach0v3.avi"))
rlm@1 43 (def app3 (File. base "approach2v2.avi"))
rlm@1 44 (def app4 (File. base "approach1v2.avi"))
rlm@1 45 (def app5 (File. base "approach2v3.avi"))
rlm@1 46
rlm@1 47 (def bounce0 (File. base "bounce0v2.avi"))
rlm@1 48 (def bounce1 (File. base "bounce1v3.avi"))
rlm@1 49 (def bounce2 (File. base "bounce3v2.avi"))
rlm@1 50 (def bounce3 (File. base "bounce0v3.avi"))
rlm@1 51 (def bounce4 (File. base "bounce2v2.avi"))
rlm@1 52 (def bounce5 (File. base "bounce1v2.avi"))
rlm@1 53 (def bounce6 (File. base "bounce2v3.avi"))
rlm@1 54
rlm@1 55 (def collide0 (File. base "collide0v3.avi"))
rlm@1 56 (def collide1 (File. base "collide2v3.avi"))
rlm@1 57 (def collide2 (File. base "collide1v2.avi"))
rlm@1 58 (def collide3 (File. base "collide0v2.avi"))
rlm@1 59 (def collide4 (File. base "collide1v3.avi"))
rlm@1 60
rlm@1 61 (def give0 (File. base "give0v3.avi"))
rlm@1 62 (def give1 (File. base "give2v3.avi"))
rlm@1 63 (def give2 (File. base "give1v2.avi"))
rlm@1 64 (def give3 (File. base "give0v2.avi"))
rlm@1 65 (def give4 (File. base "give1v3.avi"))
rlm@1 66
rlm@1 67
rlm@1 68 (def target (File. "/home/r/Desktop/output-vision/"))
rlm@1 69 (def default(File. target "default.avi"))
rlm@1 70 (defn- makePanel [image] (proxy [Panel] [] (paint [g] (.drawImage g image 0 0 nil))))
rlm@1 71
rlm@1 72 (defmulti display "Creates a JFrame and displays a buffered image" class)
rlm@1 73
rlm@1 74 (defmethod display
rlm@1 75 BufferedImage [image]
rlm@1 76 (let [panel (makePanel image)
rlm@1 77 frame (JFrame. "Oh Yeah!")]
rlm@1 78 (.add frame panel)
rlm@1 79 (.pack frame)
rlm@1 80 (.setVisible frame true )
rlm@1 81 (.setSize frame(.getWidth image) (.getHeight image))))
rlm@1 82
rlm@1 83 (defmethod display
rlm@1 84 cxcore$IplImage [image]
rlm@1 85 ( display (.getBufferedImage image)))
rlm@1 86
rlm@1 87 (defmethod display
rlm@1 88 String [image]
rlm@1 89 (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
rlm@1 90
rlm@1 91 (defmethod display
rlm@1 92 LazySeq [s]
rlm@1 93 (display (first s)))
rlm@1 94
rlm@1 95
rlm@1 96 (defn video-writer
rlm@1 97 "uses data about the video to make a writer"
rlm@1 98 [data fileTarget]
rlm@1 99 (highgui/cvCreateVideoWriter
rlm@1 100 (str fileTarget)
rlm@1 101
rlm@1 102 ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec (112913.386195 msecs) (104 MB)
rlm@1 103 ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
rlm@1 104 ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
rlm@1 105 ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs) (83 MB)
rlm@1 106 ;;(highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec (99037.738131 msecs) (85 MB)
rlm@1 107 (highgui/CV_FOURCC \H,\D,\Y,\C)
rlm@1 108 ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec (101141.993551 msecs) (89 MB)
rlm@1 109 ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec (crashed)
rlm@1 110 ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec (104307.567802 msecs) (93 MB)
rlm@1 111 ;(:codec data) ;= whatever the movie originally had. (98278.694169 msecs) (1.9 GB)
rlm@1 112
rlm@1 113 (:fps data) (cxcore/cvSize (:width data) (:height data))
rlm@1 114 1; 1 here means that we're writing in color.
rlm@1 115 ; you cannot change it to 0 to write in
rlm@1 116 ; black and white. Everything just crashes instead.
rlm@1 117 ; what a useful paramater.
rlm@1 118 ))
rlm@1 119
rlm@1 120
rlm@1 121 (defn naturals [] (iterate inc 0))
rlm@1 122
rlm@1 123
rlm@1 124 (defn write-frame
rlm@1 125 [writer frame]
rlm@1 126 (do
rlm@1 127 (highgui/cvWriteFrame writer frame)
rlm@1 128 frame))
rlm@1 129
rlm@1 130 (defn number-seq
rlm@1 131 [video-seq]
rlm@1 132 (map #(vector %1 %2) (naturals) video-seq))
rlm@1 133
rlm@1 134 (defn save-seq
rlm@1 135 [writer video-seq]
rlm@1 136 (map #(write-frame writer %) video-seq))
rlm@1 137
rlm@1 138 (defn create-runonce [function]
rlm@1 139 (let [sentinel (Object.)
rlm@1 140 result (atom sentinel)]
rlm@1 141 (fn [& args]
rlm@1 142 (locking sentinel
rlm@1 143 (if (= @result sentinel)
rlm@1 144 (reset! result (function))
rlm@1 145 @result)))))
rlm@1 146
rlm@1 147 (defmacro oncer
rlm@1 148 [video-seq-gen]
rlm@1 149 `((create-runonce #(~@video-seq-gen))))
rlm@1 150
rlm@1 151 (defmacro trans-save
rlm@1 152 "there's a small problem with trans-save --- it IS
rlm@1 153 truly transitive, but it does too much work....
rlm@1 154 sometimes it writes files twice.
rlm@1 155 this is functionally correct though."
rlm@1 156 [target config video-seq]
rlm@1 157 `(let [writer# (video-writer ~config ~target)]
rlm@1 158 (do
rlm@1 159 (dorun (save-seq writer# ~video-seq))
rlm@1 160 (close-writer writer#)
rlm@1 161 ~video-seq)))
rlm@1 162
rlm@1 163 (defn save-video
rlm@1 164 [video target]
rlm@1 165 (let [writer (video-writer (video-data video) target)]
rlm@1 166 (do
rlm@1 167 (dorun (map #(write-frame writer %) (video-seq video)))
rlm@1 168 (close-writer writer))))
rlm@1 169
rlm@1 170
rlm@1 171 (comment (Examples of things you can try that will actually work)
rlm@1 172
rlm@1 173 (def lazy-human (video-seq human0)) ;makes a lazy sequence of frames and returns instantly.
rlm@1 174 (def target1 (File. "some/path/out1.avi")) ;just creates a normal Java File object.
rlm@1 175 (def target2 (File. "some/other/path/out2.avi"))
rlm@1 176 (def human0-data (video-data human0)) ;creates a map containing the fps, width, and height of the video.
rlm@1 177
rlm@1 178 (trans-save target human0-data (video-seq human0))
rlm@1 179 ;saves a copy of human0 to disk.
rlm@1 180
rlm@1 181 (trans-save target2 human0-data (video-seq-filter (trans-save target1 human0-data (video-seq human0))))
rlm@1 182 ;saves an unaltered copy of human0 to disk, filters the sequence of
rlm@1 183 ;Intel Processing Library images by video-seq-filter, and writes the
rlm@1 184 ;filtered result to disk. video-seq-filter could discard every other frame,
rlm@1 185 ;take the sequence by fives and do temporal blurring, or just turn every
rlm@1 186 ;frame to black and white.
rlm@1 187
rlm@1 188
rlm@1 189 (do (use :reload-all 'clojureDemo.VideoTransforms) (in-ns 'clojureDemo.VideoTransforms))
rlm@1 190
rlm@1 191 )
rlm@1 192
rlm@1 193
rlm@1 194