100 lines
4.0 KiB
Common Lisp
100 lines
4.0 KiB
Common Lisp
;(load (sb-ext:posix-getenv "ASDF"))
|
|
(asdf:load-system 'cl-cffi-gtk)
|
|
(asdf:load-system 'cl-gobject-introspection)
|
|
|
|
(defpackage :capturing-frames
|
|
(:use :cl))
|
|
|
|
(in-package :capturing-frames)
|
|
(gir:require-namespace "GLib")
|
|
(defvar *gstreamer* (gir:require-namespace "Gst"))
|
|
(defvar *gstapp* (gir:require-namespace "GstApp"))
|
|
|
|
(defun cast-with-videobox (&optional stream-num)
|
|
(gir:invoke (*gstreamer* 'init) '())
|
|
(let* ((pipeline (gir:invoke (*gstreamer* "Pipeline" 'new) "video-pipeline"))
|
|
(source (gir:invoke (*gstreamer* "ElementFactory" 'make) (if stream-num
|
|
"pipewiresrc"
|
|
"videotestsrc") "source"))
|
|
(convert (gir:invoke (*gstreamer* "ElementFactory" 'make) "videoconvert" "convert"))
|
|
(tee (gir:invoke (*gstreamer* "ElementFactory" 'make) "tee" "tee"))
|
|
(queue1 (gir:invoke (*gstreamer* "ElementFactory" 'make) "queue" "queue1"))
|
|
(queue2 (gir:invoke (*gstreamer* "ElementFactory" 'make) "queue" "queue2"))
|
|
(sink (gir:invoke (*gstreamer* "ElementFactory" 'make) "autovideosink" "sink"))
|
|
(appsink (gir:invoke (*gstreamer* "ElementFactory" 'make) "appsink" "appsink"))
|
|
)
|
|
(when stream-num
|
|
;; Set pipewiresrc properties, such as the path
|
|
(setf (gir:property source 'path) (format nil "~A" stream-num)))
|
|
|
|
;; Add and link elements in the pipeline
|
|
(gir:invoke (pipeline 'add) source)
|
|
(gir:invoke (pipeline 'add) convert)
|
|
(gir:invoke (pipeline 'add) tee)
|
|
(gir:invoke (pipeline 'add) queue1)
|
|
(gir:invoke (pipeline 'add) queue2)
|
|
(gir:invoke (pipeline 'add) sink)
|
|
(gir:invoke (pipeline 'add) appsink)
|
|
|
|
(gir:invoke (source 'link) convert)
|
|
(gir:invoke (convert 'link) tee)
|
|
(gir:invoke (tee 'link) queue1)
|
|
(gir:invoke (tee 'link) queue2)
|
|
(gir:invoke (queue1 'link) sink)
|
|
(gir:invoke (queue2 'link) appsink)
|
|
|
|
;; Configure appsink
|
|
(setf (gir:property appsink "emit-signals") t
|
|
(gir:property appsink "max-buffers") 1
|
|
(gir:property appsink "drop") t)
|
|
|
|
(gir:invoke (pipeline 'set-state) (gir:nget *gstreamer* "State" :playing))
|
|
|
|
;; Example: Move the video 10 pixels down and 20 pixels to the right
|
|
(values pipeline appsink)))
|
|
|
|
(defun process-frame (sample)
|
|
(format t ">>> got to process sample with ~A~%" sample)
|
|
(let* ((buffer (gir:invoke (sample 'get-buffer)))
|
|
(info (gir:invoke (sample 'get-info)))
|
|
(caps (gir:invoke (sample 'get-caps)))
|
|
(caps-struct (gir:invoke (caps 'get-structure) 0))
|
|
(width (gir:invoke ((gir:invoke (caps-struct 'get-value) "width") 'get-int)))
|
|
(height (gir:invoke ((gir:invoke (caps-struct 'get-value) "height") 'get-int))))
|
|
(multiple-value-bind (found map-info) (gir:invoke (buffer 'map) (gir:nget *gstreamer* "MapFlags" :read))
|
|
(format t ">>>> the buffer has offset ~A~%" (gir:field buffer 'offset))
|
|
(format t ">>>> what's in struct? ~A~%" (gir:invoke (caps-struct 'to-string)))
|
|
(format t ">>>> the fields are width ~A, height ~A~%" width height)
|
|
(format t ">>>> and map result are ~A and ~A~%" found map-info)
|
|
(when found
|
|
(let ((data (gir:field map-info 'data))
|
|
(size (gir:field map-info 'size)))
|
|
(format t ">>>> and struct info? ~A~%" map-info)
|
|
; (format t ">>>> and data has size ~A and buf ~A~%" size (or data "empty data"))
|
|
)))
|
|
;; Unmap the memory when done
|
|
;; (gir:invoke (info 'unmap) map-info)
|
|
))
|
|
|
|
(defun start-processing (appsink)
|
|
(gir:connect appsink "new-sample"
|
|
(lambda (appsink)
|
|
(format t ">> got printed object ~A~%" appsink)
|
|
(format t ">> got printed class ~A~%" (gir:gir-class-of appsink))
|
|
(format t ">> trying to get method on sink ~A~%" (gir:nget appsink 'pull-sample))
|
|
(let ((sample (gir:invoke (appsink 'pull-sample))))
|
|
(when sample
|
|
(process-frame sample)))
|
|
|
|
|
|
(gir:nget *gstreamer* "FlowReturn" :ok))))
|
|
|
|
(defun try-run ()
|
|
(multiple-value-bind (pipeline appsink) (cast-with-videobox)
|
|
(format t "got appsink ~A" appsink)
|
|
(start-processing appsink)
|
|
(loop
|
|
(sleep 1))))
|
|
|
|
;(try-run)
|