335 lines
15 KiB
Common Lisp
335 lines
15 KiB
Common Lisp
(load (sb-ext:posix-getenv "ASDF"))
|
|
(asdf:load-system 'dbus)
|
|
|
|
(defpackage
|
|
#:screencasting
|
|
(:use #:cl)
|
|
(:export call-with-all-predefined))
|
|
(in-package #:screencasting)
|
|
|
|
;; https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.ScreenCast.html
|
|
(defconstant +screen-cast-interface+ "org.freedesktop.portal.ScreenCast")
|
|
(defconstant +request-interface+ "org.freedesktop.portal.Request")
|
|
|
|
;; some iolib tutorial https://pages.cs.wisc.edu/~psilord/blog/data/iolib-tutorial/tutorial.html
|
|
;; i hoped it would help me understand the 'publish-events'
|
|
|
|
;; i'm not sure how to do interactive calls,
|
|
;; since maybe i need to "publish objects"
|
|
;; and that means the callbacks are set in stone?
|
|
;; i guess i could try to do a Notification call in the callback on screenshot request?
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(dbus:with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
|
|
(notification "org.freedesktop.Notifications" "Notify"
|
|
"Test" 0 "" "Test" "This is a test; I repeat, this is a test." '() '() -1)))
|
|
|
|
(defun send-notification (bus message)
|
|
(dbus:with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
|
|
(notification "org.freedesktop.Notifications" "Notify"
|
|
"Test" 0 "" "Test" (or message "This is a test; I repeat, this is a test.") '() '() -1)))
|
|
|
|
;; i guess i could pass both bus and
|
|
|
|
(defun call-screencast ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(let*
|
|
((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
|
|
(request-name "yayay")
|
|
(resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-name)))
|
|
(dbus:define-dbus-object request-object
|
|
(:path resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t "Got response ~S with results ~S~%" id results)
|
|
(send-notification bus "yayaya from the first response"))
|
|
|
|
(format T "Will try to listen on ~A~%" resp-path)
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(dbus:add-match bus :type :signal
|
|
:interface +request-interface+)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "CreateSession"
|
|
'(("handle_token" ((:string) "yayay"))
|
|
("session_handle_token" ((:string) "hohoyyy")))))
|
|
(dbus:publish-objects bus)))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
;; let's then try to move macroses that define 'request' to outside?
|
|
;; they would take bus, create expected request-response listener
|
|
|
|
(alexandria:with-gensyms (lala)
|
|
(format nil "i-got-gensym-~S" lala))
|
|
|
|
;; well this notification library has interactive "register callback"
|
|
;; for multiple callbacks on Notification signals
|
|
;; https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/signals.lisp
|
|
;; basicly loop starts and one signal-handler that calls all currently registered
|
|
;; i guess for my case i'll want separate with-open-bus?
|
|
;; how would i then exit the publish-objects loop?
|
|
;; am i really expected to exit it?
|
|
;; alright, let's try to start publish objects and after that registering stuff
|
|
;; to do the call?
|
|
(defun do-request (bus)
|
|
(let*
|
|
((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
|
|
(request-name "yayay")
|
|
(resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-name)))
|
|
(dbus:define-dbus-object request-object
|
|
(:path resp-path))
|
|
(dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface "org.freedesktop.portal.Request")
|
|
(format t "Got response ~A with results ~A~%" id results)
|
|
(send-notification bus "yayaya from the first response"))
|
|
(format T "Will try to make a call for ~A~%" resp-path)
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop "org.freedesktop.portal.Screenshot" "Screenshot"
|
|
""
|
|
'(("handle_token" ((:string) "yayay")))))
|
|
(dbus:add-match bus :type :signal
|
|
:interface "org.freedesktop.portal.Request")
|
|
(dbus:publish-objects bus)))
|
|
|
|
(defvar *running-bus*)
|
|
(do-request *running-bus*)
|
|
|
|
(defun run-bus ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(setq *running-bus* bus)
|
|
(dbus:publish-objects bus))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
;; well, i suppose i would need to open multiple connections?
|
|
;; let's do something like this https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/dbus-protocol.lisp#L27
|
|
;; (defmacro with-dbus-method-inovaction ((result-var method &rest args) &body body)
|
|
;; (alexandria:with-gensyms (bus notifications-object)
|
|
;; `(dbus:with-open-bus (,bus (dbus:session-server-addresses))
|
|
;; (dbus:with-introspected-object (,notifications-object ,bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
|
|
;; (let ((,result-var (,notifications-object "org.freedesktop.Notifications" ,method ,@args)))
|
|
;; ,@body)))))
|
|
|
|
;; but. this supposes result-var being a resulting value
|
|
;; and i'd want to what? pass in a callback to register?
|
|
|
|
;; alright, let's have function startup new bus connection for each call
|
|
;; but then try to do these multiple calls
|
|
|
|
(defun call-screencast-method (method-name params)
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(let*
|
|
((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
|
|
(request-name "yayay")
|
|
(resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-name)))
|
|
(dbus:define-dbus-object request-object
|
|
(:path resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t "Got response ~S with results ~S~%" id results)
|
|
(format t "before sending notification")
|
|
(send-notification bus "yayaya from the first response")
|
|
(format t "ending signal handler")
|
|
(force-output))
|
|
|
|
(format T "Will try to listen on ~A~%" resp-path)
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(dbus:add-match bus :type :signal
|
|
:interface +request-interface+)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ method-name ; "CreateSession"
|
|
params
|
|
;; '(("handle_token" ((:string) "yayay"))
|
|
;; ("session_handle_token" ((:string) "hohoyyy")))
|
|
))
|
|
(dbus:publish-objects bus '(request-object) )))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
'(call-screencast-method "CreateSession"
|
|
'(("handle_token" ((:string) "yayay"))
|
|
("session_handle_token" ((:string) "hohoyyy"))))
|
|
|
|
|
|
;; well, that seems to keep runnning in the background?
|
|
;; but i still would have to register objects for all responses before call to publish
|
|
;; so, let's read the publish method and figure out a way to clear this thing
|
|
;; let's search online for examples? i really didn't make myself a favor by picking CL
|
|
;; huh? it prints first line, and then doesn't print the rest?
|
|
;; ok, maybe i can add more objects? and whole program should be what?
|
|
;; starting before the publish-objects but potentially running stuff in the callbacks?
|
|
;; to call add-match and call, and define-dbus-signal-handler ?
|
|
;; sounds strange
|
|
;; i think i need help, it seems that all objects should be registered before calling publish
|
|
|
|
;; let's first try "additionally registering more stuff after publish"
|
|
;; for that 'publish' should be done outside
|
|
|
|
;; this tries to define new handler inside of callback
|
|
;; maybe-maybe this is the problem?
|
|
(defun call-two-methods ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(let*
|
|
((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
|
|
(request-create-session-name "createSessionReq")
|
|
(resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-create-session-name))
|
|
(request-select-sources "selectSourcesReq")
|
|
(select-sources-resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-select-sources))
|
|
(session-handle-hardcoded "yayay")
|
|
(session-handle-path (concatenate 'string "/org/freedesktop/portal/desktop/session/"
|
|
requester-name
|
|
"/"
|
|
session-handle-hardcoded)))
|
|
(dbus:define-dbus-object request-object
|
|
(:path resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t "Got response ~S with results ~S~%" id results)
|
|
(send-notification bus "yayaya from the first response")
|
|
(format t "About sto send SelectSources with path ~S~%" session-handle-path)
|
|
(force-output)
|
|
|
|
(dbus:define-dbus-object select-sources-request-obj
|
|
(:path select-sources-resp-path))
|
|
(dbus:define-dbus-signal-handler (select-sources-request-obj response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t ">> Got inside of SelectSources callback"))
|
|
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "SelectSources"
|
|
session-handle-path ; hardcoded session-handle
|
|
`(("handle_token" ((:string) ,request-select-sources)))))
|
|
(format t "Still first callback, after calling SelectSources")
|
|
(force-output))
|
|
|
|
(format T "Will try to listen on ~A~%" resp-path)
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(dbus:add-match bus :type :signal
|
|
:interface +request-interface+)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "CreateSession"
|
|
`(("handle_token" ((:string) ,request-create-session-name))
|
|
("session_handle_token" ((:string) ,session-handle-hardcoded)))))
|
|
(dbus:publish-objects bus)))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
|
|
;; let's define ALL beforehand?
|
|
(defun call-with-all-predefined ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (dbus:session-server-addresses))
|
|
(let*
|
|
((requester-name (cl-ppcre:regex-replace "\\." (dbus:bus-name bus) "_" :start 1))
|
|
(request-create-session-name "createSessionReq")
|
|
(resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-create-session-name))
|
|
(request-select-sources "selectSourcesReq")
|
|
(select-sources-resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-select-sources))
|
|
(request-start "startReq")
|
|
(start-resp-path (concatenate 'string "/org/freedesktop/portal/desktop/request/"
|
|
requester-name
|
|
"/"
|
|
request-start))
|
|
(session-handle-hardcoded "yayay")
|
|
(session-handle-path (concatenate 'string "/org/freedesktop/portal/desktop/session/"
|
|
requester-name
|
|
"/"
|
|
session-handle-hardcoded)))
|
|
(dbus:define-dbus-object request-object
|
|
(:path resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (request-object response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t "Got response ~S with results ~S~%" id results)
|
|
(send-notification bus "yayaya from the first response")
|
|
(format t "About sto send SelectSources with path ~S~%" session-handle-path)
|
|
(force-output)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "SelectSources"
|
|
session-handle-path ; hardcoded session-handle
|
|
`(("handle_token" ((:string) ,request-select-sources)))))
|
|
(format t "Still first callback, after calling SelectSources~%")
|
|
(force-output))
|
|
|
|
(dbus:define-dbus-object select-sources-request-obj
|
|
(:path select-sources-resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (select-sources-request-obj response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t ">> Got inside of SelectSources callback ~A ~A~%" id results)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "Start"
|
|
session-handle-path
|
|
"parent-window"
|
|
`(("handle_token" ((:string) , request-start)))))
|
|
(format t ">> Still inside SelectSources callback, after calling Start~%")
|
|
(force-output))
|
|
|
|
(dbus:define-dbus-object start-request-obj
|
|
(:path start-resp-path))
|
|
|
|
(dbus:define-dbus-signal-handler (start-request-obj response) ((id :uint32) (results (:ARRAY (:DICT-ENTRY :STRING :VARIANT))))
|
|
(:interface +request-interface+)
|
|
(format t ">> Got inside of Start callback ~A ~A~%" id results))
|
|
|
|
(format T "Will try to listen on ~A~%" resp-path)
|
|
(format T "Bus connection name ~A~%" (dbus:bus-name bus))
|
|
(dbus:add-match bus :type :signal
|
|
:interface +request-interface+)
|
|
(dbus:with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop +screen-cast-interface+ "CreateSession"
|
|
`(("handle_token" ((:string) ,request-create-session-name))
|
|
("session_handle_token" ((:string) ,session-handle-hardcoded)))))
|
|
(dbus:publish-objects bus)))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
|
|
;; ok
|
|
;; >> Got inside of Start callback 0 ((streams
|
|
;; ((43
|
|
;; ((position (0 0)) (size (1920 1080)))))))
|
|
;; interesting. now what do do with the streams?
|
|
;; An array of PipeWire streams. Each stream consists of a PipeWire node ID (the first element in the tuple, and a Vardict of properties.
|
|
;; ok, now i need to figure out how
|
|
;; yeah, nix shell nixpkgs#qpwgraph
|
|
;; with this tool i see new 'out' node, maybe i can even already connect to it with
|
|
;; some program?
|
|
;; yes. enefedov@LLF33A87M:~/Documents/personal/learning-screen-share$ gst-launch-1.0 pipewiresrc path=43 ! videoconvert ! autovideosink
|
|
|
|
;; cool.
|
|
;; now i want to have a window with this video stream created by my program
|
|
;; this is new level of "i have no idea where to go"
|
|
;; https://github.com/death/dbus/issues/31
|
|
;; asked my question about multiple async dbus requests
|
|
|