some files from videolab

videolab-ffmpeg.lisp

;;;; +----------------------------------------------------------------+
;;;; | Videolab                                                       |
;;;; +----------------------------------------------------------------+

(defpackage #:videolab/ffmpeg
  (:use #:cl
        #:videolab/util
        #:videolab/program-command)
  (:export
   #:ffmpeg-split
   #:ffmpeg-join))

(in-package #:videolab/ffmpeg)

(define-program-command ffmpeg "ffmpeg")

(defun ffmpeg-split (input-video-file output-frames-directory
                     &key (frames-per-second 1)
                          (rescale nil))
  (ffmpeg "-loglevel" "repeat+warning"
          "-i" input-video-file
          (when frames-per-second
            (list "-r" frames-per-second))
          (when rescale
            (list "-s" rescale))
          "-f" "image2"
          (filename-in-directory "frame-%07d.jpeg" output-frames-directory)))

(defun ffmpeg-join (input-frames-directory output-video-file
                    &key (frame-rate 12)
                         (rescale nil))
  (ffmpeg "-loglevel" "repeat+warning"
          "-f" "image2"
          "-framerate" frame-rate
          "-i"
          (filename-in-directory "frame-%07d.jpeg" input-frames-directory)
          (when rescale
            (list "-s" rescale))
          output-video-file))

videolab-program-command.lisp

;;;; +----------------------------------------------------------------+
;;;; | Videolab                                                       |
;;;; +----------------------------------------------------------------+

(defpackage #:videolab/program-command
  (:use #:cl)
  (:import-from
   #:sb-ext
   #:process-exit-code
   #:run-program)
  (:import-from
   #:com.gigamonkeys.json
   #:parse-json)
  (:import-from
   #:split-sequence
   #:split-sequence)
  (:export
   #:define-program-command))

(in-package #:videolab/program-command)

(defmacro define-program-command (name program &key (input nil) (output :print))
  `(defun ,name (&rest args)
     (run ,program args ,input ,output)))

(defvar *program-output-filters*
  (make-hash-table))

(defun program-output-filter (name)
  (cond ((gethash name *program-output-filters*))
        ((functionp name)
         name)
        ((and (symbolp name)
              (fboundp name))
         name)
        (t
         (error "Can't find program output filter named ~S." name))))

(defun (setf program-output-filter) (new-value name)
  (setf (gethash name *program-output-filters*)
        new-value))

(setf (program-output-filter :string) 'identity)

(defun run (program args input output)
  (setf args (preprocess-args args))
  (let ((input-stream
          (cond ((null input)
                 nil)
                ((eq input :first)
                 (make-string-input-stream (or (pop args) "")))
                ((eq input :last)
                 (let ((s (car (last args))))
                   (setf args (butlast args))
                   (make-string-input-stream (or s ""))))
                (t
                 (error "Don't know how to handle input ~S." input)))))
    (labels ((rp (output-stream)
               (run-program program
                            args
                            :search t
                            :input input-stream
                            :output output-stream))
             (rps ()
               (with-output-to-string (out)
                 (rp out)))
             (rpp ()
               (process-exit-code
                (rp *standard-output*))))
      (if (eq output :print)
          (rpp)
          (funcall (program-output-filter output) (rps))))))

(defun preprocess-args (args)
  (cond ((null args)
         '())
        ((listp args)
         (mapcan #'preprocess-arg args))
        (t
         (error "Unexpected args ~S." args))))

(defun preprocess-arg (arg)
  (cond ((stringp arg)
         (list arg))
        ((null arg)
         '())
        ((listp arg)
         (mapcan #'preprocess-arg arg))
        ((numberp arg)
         (list (prin1-to-string arg)))
        (t
         (error "Don't know how to preprocess arg ~S." arg))))

(setf (program-output-filter :json) 'postprocess-json)

(defun postprocess-json (string)
  (let ((json (parse-json string)))
    (if json
        (lispify-json json)
        (error "Empty JSON object returned."))))

(defun lispify-json (json)
  (typecase json
    (vector
     (if (every #'consp json)
         (map 'vector #'lispify-json json)
         json))
    (atom json)
    (cons
     (loop for (key value) on json by #'cddr
           nconc (list (symbol-munger:underscores->lisp-symbol key "KEYWORD")
                       (lispify-json value))))))

(setf (program-output-filter :lines) 'split-to-lines)

(defun split-to-lines (string)
  (values
   (split-sequence #\Newline
                   string
                   :remove-empty-subseqs t)))