diff --git a/.local/share/common-lisp/source/ambrevar/all.lisp b/.local/share/common-lisp/source/ambrevar/all.lisp index 940a98b8..fcca4e6f 100644 --- a/.local/share/common-lisp/source/ambrevar/all.lisp +++ b/.local/share/common-lisp/source/ambrevar/all.lisp @@ -42,6 +42,7 @@ (:use-reexport #:ambrevar/debug #:ambrevar/emacs + #:ambrevar/ffprobe #:ambrevar/file #:ambrevar/guix #:ambrevar/shell diff --git a/.local/share/common-lisp/source/ambrevar/ffprobe.lisp b/.local/share/common-lisp/source/ambrevar/ffprobe.lisp new file mode 100644 index 00000000..04d0b8f8 --- /dev/null +++ b/.local/share/common-lisp/source/ambrevar/ffprobe.lisp @@ -0,0 +1,126 @@ +(uiop:define-package ambrevar/ffprobe + (:documentation "FFprobe abstraction.") + (:use #:common-lisp) + (:use #:trivia) + (:import-from #:hu.dwim.defclass-star #:defclass*) + (:import-from #:serapeum #:export-always)) +(in-package ambrevar/ffprobe) +(eval-when (:compile-toplevel :load-toplevel :execute) + (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria) + (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum)) + +(sera:eval-always + (defun name-identity (name definition) + (declare (ignore definition)) + name)) + +(defclass* disposition () + ((default 0) + (dub 0) + (original 0) + (comment 0) + (lyrics 0) + (karaoke 0) + (forced 0) + (hearing-impaired 0) + (visual-impaired 0) + (clean-effects 0) + (attached-pic 0) + (timed-thumbnails 0)) + (:accessor-name-transformer #'name-identity)) + +(defclass* media-stream () ; REVIEW: `stream' is reserved by CL. + ((index 0) + (codec-name "") + (codec-long-name "") + (profile "") + (codec-type "") + (width 0) + (height 0) + (coded-width 0) + (coded-height 0) + (closed-captions 0) + (has-b-frames 0) + (pix-fmt "") + (level 0) + (color-range "") + (color-space "") + (refs 0) + (sample-aspect-ratio "") + (display-aspect-ratio "") + (codec-time-base "") ; TODO: Ratio? + (codec-tag-string "") + (codec-tag "") ; TODO: Hex? + (sample-fmt "") + (sample-rate 0) + (channels 2) + (channel-layout "") + (bits-per-sample 0) + (r-frame-rate "") ; TODO: Ratio? + (avg-frame-rate "") ; TODO: Ratio? + (time-base "") + (start-pts 0) + (start-time 0.0) + (duration-ts 0.0) + (duration 0.0) + (bit-rate 0) + (disposition nil + :type (or null disposition)) + (tags '())) + (:accessor-name-transformer #'name-identity)) + +(defclass* media-format () ; REVIEW: `format' is reserved by CL. + ((filename "") + (nb-streams 0) + (nb-programs 0) + (format-name "") + (format-long-name "") + (start-time 0.0) + (duration 0.0) + (size 0) + (bit-rate 0) + (probe-score 0) + (tags '())) + (:accessor-name-transformer #'name-identity)) + +(defun normalize-cl-json-keywords (sym) + "Turn '--' to '-' and remove '+' from keywords." + (if (keywordp sym) + (intern (str:replace-all + "+" "" + (str:replace-all "--" "-" (symbol-name sym))) + "KEYWORD") + sym)) + +(defun normalize-cl-json-scalar (value) + "Turn non-ratio number string to numbers." + (if (stringp value) + (let ((result (ignore-errors (parse-number:parse-number value)))) + (if (and result + (not (typep result 'ratio))) + result + value)) + value)) + +(defun json->media-args (json) + (alex:mappend (lambda-match + ((cons key value) + (list (normalize-cl-json-keywords key) + (if (listp value) + (format-ffprobe-json value) + (normalize-cl-json-scalar value))))) + json)) + +(defun ffprobe (path) + "Return a list of (MEDIA-FORMAT MEDIA-STREAMS...)." + (let* ((json-string + (cmd:$cmd "ffprobe -v quiet -print_format json -show_format -show_streams -- " + (write-to-string path))) + (json (cl-json:decode-json-from-string json-string))) + (let* ((format-args (json->media-args (alex:assoc-value json :format))) + (format (apply #'make-instance 'media-format format-args))) + (cons format + (mapcar (lambda (s) + (let ((stream-args (json->media-args s))) + (apply #'make-instance 'media-stream stream-args))) + (alex:assoc-value json :streams))))))