Mercurial > lasercutter

     1 (ns clojureDemo.VideoTransforms)

     2   

     3 (import '(java.awt Rectangle Robot Toolkit) )

     4 (import '(java.awt.image BufferedImage) )

     5 (import '(java.awt Graphics2D Panel))

     6 (import '(java.io File) )

     7 (import '(javax.imageio ImageIO) )

     8 (import '(javax.swing JFrame))

     9 (import '(org.apache.commons.io FileUtils))

    10 (import clojure.lang.LazySeq)

    11 (import '(name.audet.samuel.javacv.jna highgui cv cxcore))

    12 (import '(name.audet.samuel.javacv CanvasFrame))

    13 (import '(name.audet.samuel.javacv.jna cxcore$IplImage))

    14 (import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))

    15 (import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))

    16 (import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))

    17 (import '(name.audet.samuel.javacv.jna cxcore$IplImage))

    18 (import '(name.audet.samuel.javacv JavaCvErrorCallback))

    19 

    20 (.redirectError (JavaCvErrorCallback.));this enables the c errors to travel up to the JVM

    21                                        ;where they can be handled.

    22 

    23 

    24 (use '[clojureDemo.VisionCore :only (video-seq cache video-data close-writer)])

    25 

    26  

    27 (use 'clojure.contrib.repl-utils)

    28 

    29 (def -inf Double/NEGATIVE_INFINITY)

    30 (def inf  Double/POSITIVE_INFINITY)

    31 

    32 

    33 (def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))

    34 (def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))

    35 (def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))

    36 (def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))

    37 

    38 (def base (File. "/home/r/Desktop/source-videos/"))

    39 

    40 (def app0 (File. base "approach0v2.avi"))

    41 (def app1 (File. base "approach1v3.avi"))

    42 (def app2 (File. base "approach0v3.avi"))

    43 (def app3 (File. base "approach2v2.avi"))

    44 (def app4 (File. base "approach1v2.avi")) 

    45 (def app5 (File. base "approach2v3.avi"))

    46   

    47 (def bounce0 (File. base "bounce0v2.avi"))  

    48 (def bounce1 (File. base "bounce1v3.avi")) 

    49 (def bounce2 (File. base "bounce3v2.avi"))

    50 (def bounce3 (File. base "bounce0v3.avi"))  

    51 (def bounce4 (File. base "bounce2v2.avi"))

    52 (def bounce5 (File. base "bounce1v2.avi"))  

    53 (def bounce6 (File. base "bounce2v3.avi"))

    54 

    55 (def collide0 (File. base "collide0v3.avi"))  

    56 (def collide1 (File. base "collide2v3.avi")) 

    57 (def collide2 (File. base "collide1v2.avi"))

    58 (def collide3 (File. base "collide0v2.avi"))  

    59 (def collide4 (File. base "collide1v3.avi")) 

    60   

    61 (def give0 (File. base "give0v3.avi"))  

    62 (def give1 (File. base "give2v3.avi")) 

    63 (def give2 (File. base "give1v2.avi")) 

    64 (def give3 (File. base "give0v2.avi"))        

    65 (def give4 (File. base "give1v3.avi"))

    66 

    67 

    68 (def target (File. "/home/r/Desktop/output-vision/"))

    69 (def default(File. target "default.avi"))

    70 (defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))

    71 

    72 (defmulti  display "Creates a JFrame and displays a buffered image"  class)

    73 

    74 (defmethod display 

    75   BufferedImage  [image] 

    76   (let [panel (makePanel image)

    77 	frame (JFrame. "Oh Yeah!")]

    78     (.add frame panel) 

    79     (.pack frame) 

    80     (.setVisible frame true ) 

    81     (.setSize frame(.getWidth image) (.getHeight image))))

    82 

    83 (defmethod display

    84   cxcore$IplImage [image]

    85   ( display (.getBufferedImage image)))

    86   

    87 (defmethod display

    88   String [image]

    89   (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))

    90 

    91 (defmethod display

    92   LazySeq [s]

    93   (display (first s)))

    94 

    95 

    96 (defn video-writer

    97   "uses data about the video to make a writer"

    98   [data fileTarget]

    99   (highgui/cvCreateVideoWriter 

   100    (str fileTarget)

   101    

   102    ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)

   103    ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)

   104    ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)

   105    ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)

   106    ;;(highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)

   107    (highgui/CV_FOURCC \H,\D,\Y,\C)

   108    ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)

   109    ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)

   110    ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)

   111    ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  

   112 

   113    (:fps data) (cxcore/cvSize (:width data) (:height data)) 

   114    1; 1 here means that we're writing in color.

   115     ; you cannot change it to 0 to write in 

   116     ; black and white. Everything just crashes instead.

   117     ; what a useful paramater.

   118    ))

   119 

   120 

   121 (defn naturals []  (iterate inc 0))

   122 

   123 

   124 (defn write-frame

   125   [writer frame]

   126   (do

   127     (highgui/cvWriteFrame writer frame)

   128     frame))

   129 

   130 (defn number-seq

   131   [video-seq]

   132   (map #(vector %1 %2) (naturals) video-seq))

   133 

   134 (defn save-seq 

   135   [writer video-seq]

   136   (map #(write-frame writer %) video-seq))

   137   

   138 (defn create-runonce [function]

   139   (let [sentinel (Object.)

   140 	result (atom sentinel)]

   141     (fn [& args]

   142       (locking sentinel

   143 	(if (= @result sentinel)

   144 	  (reset! result (function))

   145 	  @result)))))

   146 

   147 (defmacro oncer 

   148   [video-seq-gen]

   149   `((create-runonce #(~@video-seq-gen))))

   150 

   151 (defmacro trans-save

   152 "there's a small problem with trans-save --- it IS

   153 truly transitive, but it does too much work....

   154 sometimes it writes files twice.

   155 this is functionally correct though."

   156   [target config video-seq]

   157   `(let [writer# (video-writer ~config ~target)]

   158      (do

   159        (dorun (save-seq writer# ~video-seq))

   160        (close-writer writer#)

   161        ~video-seq)))

   162 

   163 (defn save-video

   164   [video target]

   165   (let [writer (video-writer (video-data video) target)]

   166     (do 

   167       (dorun (map #(write-frame writer %) (video-seq video)))

   168       (close-writer writer))))

   169 

   170 

   171 (comment (Examples of things you can try that will actually work)

   172 

   173 (def lazy-human (video-seq human0)) ;makes a lazy sequence of frames and returns instantly.

   174 (def target1 (File. "some/path/out1.avi")) ;just creates a normal Java File object.

   175 (def target2 (File. "some/other/path/out2.avi"))

   176 (def human0-data (video-data human0)) ;creates a map containing the fps, width, and height of the video. 

   177 

   178 (trans-save target human0-data (video-seq human0))

   179 ;saves a copy of human0 to disk.

   180 

   181 (trans-save target2 human0-data (video-seq-filter (trans-save target1 human0-data (video-seq human0))))

   182 ;saves an unaltered copy of human0 to disk, filters the sequence of 

   183 ;Intel Processing Library images by video-seq-filter, and writes the 

   184 ;filtered result to disk.  video-seq-filter could discard every other frame,

   185 ;take the sequence by fives and do temporal blurring, or just turn every

   186 ;frame to black and white. 

   187 

   188 

   189 (do (use :reload-all 'clojureDemo.VideoTransforms) (in-ns 'clojureDemo.VideoTransforms))

   190 

   191 )

   192 

   193  

   194
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 20 Aug 2010 00:32:44 -0400
parents
children