#|
sbcl --script "$0" "${@:1}"
exit
|#

(defun ffmpeg (&rest args)
  (run-program "ffmpeg" (list* "-hide_banner" "-loglevel" "error" (mapcar #'princ-to-string args))
               :search T :error *error-output*))

(defun ffprobe (&rest args)
  (with-output-to-string (out)
    (run-program "ffprobe" (list* "-hide_banner" "-loglevel" "error" (mapcar #'princ-to-string args))
                 :search T :output out :error *error-output*)))

(defun parameters (in)
  (let ((data (ffprobe "-i" (native-namestring in)
                       "-of" "flat=s=-"
                       "-show_streams")))
    (with-input-from-string (stream data)
      (loop for line = (read-line stream NIL)
            while line
            collect (let ((eq (position #\= line)))
                      (cons (intern (string-upcase (subseq line 0 eq)) "KEYWORD")
                            (read-from-string (subseq line (1+ eq)))))))))

(defun video-parameters (in)
  (let ((parameters (parameters in)))
    (list :width (cdr (assoc :streams-stream-0-width parameters))
          :height (cdr (assoc :streams-stream-0-height parameters))
          :framerate (read-from-string (cdr (assoc :streams-stream-0-r_frame_rate parameters)))
          :bitrate (read-from-string (cdr (assoc :streams-stream-0-bit_rate parameters))))))

(defun thumbnail (thumb in &key fps bitrate (out (make-pathname :name (format NIL "~a_thumbnail" (pathname-name in)) :defaults in)))
  (let ((tmp #p"/tmp/thumb-temp.mp4")
        (params (video-parameters in)))
    (format T "Creating thumbnailed video...~%")
    (ffmpeg "-i" (native-namestring thumb)
            "-f" "lavfi"
            "-i" "anullsrc"
            "-c:v" "libx264"
            "-s" (format NIL "~ax~a" (getf params :width) (getf params :height))
            "-r" (or fps (getf params :framerate))
            "-t" "0.02"
            "-c:a" "aac"
            "-ac" "2"
            "-ar" "44100"
            "-shortest"
            "-pix_fmt" "yuv420p"
            (native-namestring tmp))
    (ffmpeg "-i" (native-namestring tmp)
            "-i" (native-namestring in)
            "-filter_complex" "[0:v:0][0:a:0][1:v:0][1:a:0]concat=2:v=1:a=1[v][a]"
            "-c:v" "libx264"
            "-b:v" (or bitrate (getf params :bitrate))
            "-map" "[v]"
            "-map" "[a]"
            (native-namestring out))
    (delete-file tmp)))

(defun main (&rest args)
  (let ((thumb NIL) (in NIL)
        (out NIL)
        fps bitrate)
    (loop for arg = (pop args)
          while arg
          do (cond ((or (string= "-f" arg) (string= "-fps" arg))
                    (setf fps (parse-integer (pop args))))
                   ((or (string= "-b" arg) (string= "-bitrate" arg))
                    (setf bitrate (pop args)))
                   ((string= "-o" arg)
                    (setf out (pop args)))
                   (thumb
                    (setf in arg))
                   (in
                    (format T "Multiple input files not possible!~%")
                    (exit :code 1))
                   (T
                    (setf thumb arg))))
    (if (and thumb in)
        (thumbnail thumb in
                   :fps fps :bitrate bitrate
                   :out (or out (make-pathname :type "gif" :defaults in)))
        (format T "mkthumb [-f FPS] [-b BITRATE] [-s SCALING] [-o OUTPUT] thumbnail input~%"))))

(apply #'main (rest *posix-argv*))