diff --git a/.gitignore b/.gitignore index dac1f48..6b1a341 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ /*~ /.direnv/ +#*# diff --git a/asking-for-help-with-screencast.lisp b/asking-for-help-with-screencast.lisp new file mode 100644 index 0000000..66f958c --- /dev/null +++ b/asking-for-help-with-screencast.lisp @@ -0,0 +1,10 @@ +(load (sb-ext:posix-getenv "ASDF")) +(asdf:load-system 'dbus) + +(defpackage #:screencasting (:use #:cl)) +(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") + diff --git a/flake.nix b/flake.nix index 7872598..37a6260 100644 --- a/flake.nix +++ b/flake.nix @@ -19,10 +19,18 @@ hash = "sha256-xbg3tPYfRNGJo+9F/58w2bDeZqV33Z871+ClSg4ACPk="; }; }); - sbcl' = pkgs.sbcl.withPackages (ps: [ ps.alexandria dbus' ]); + sbcl' = pkgs.sbcl.withPackages (ps: [ ps.alexandria + dbus' + ps.cl-cffi-gtk + ps.sdl2 + ps.cl-opengl + ]); in { devShells.default = pkgs.mkShell { + SDL_VIDEODRIVER="wayland"; + WAYLAND_DISPLAY="wayland-1"; + EGL_PLATFORM="wayland"; buildInputs = [ sbcl' ]; diff --git a/gtk-playground.lisp b/gtk-playground.lisp new file mode 100644 index 0000000..826e21f --- /dev/null +++ b/gtk-playground.lisp @@ -0,0 +1,23 @@ +(load (sb-ext:posix-getenv "ASDF")) +(asdf:load-system 'cl-cffi-gtk) + +(defpackage #:gtkStuff (:use #:cl)) +(in-package #:gtkStuff) + + +(gtk:cl-cffi-gtk-build-info) ; yay, this works, cool + +(defun example-window-simple () + (gtk:within-main-loop + (let (;; Create a toplevel window. + (window (gtk:gtk-window-new :toplevel))) + ;; Signal handler for the window to handle the signal "destroy". + (gobject:g-signal-connect window "destroy" + (lambda (widget) + (declare (ignore widget)) + (gtk:leave-gtk-main))) + ;; Show the window. + (gtk:gtk-widget-show-all window)))) + +;; yay, this works. good. + diff --git a/maybe-screencast.lisp b/maybe-screencast.lisp index 1925638..3b2e3bb 100644 --- a/maybe-screencast.lisp +++ b/maybe-screencast.lisp @@ -6,17 +6,19 @@ ;; 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.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? -(with-open-bus (bus (session-server-addresses)) - (with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications") +(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) - )) + "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") @@ -46,7 +48,7 @@ (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 "org.freedesktop.portal.Request") + :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")) @@ -117,3 +119,213 @@ ;; 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 + diff --git a/notes.org b/notes.org index 09fe6b9..dc92ab5 100644 --- a/notes.org +++ b/notes.org @@ -31,3 +31,97 @@ $ nix shell nixpkgs#kdePackages.qttools ** now let's read about calling methods * the receiving of the signals + +* all the different tabs i had + +** searching github for 'get-managed-objects usage +https://github.com/search?q=get-managed-objects&type=code + +** searchin github for 'define-singlan-handler usage examples +https://github.com/search?q=dbus%3Adefine-dbus-signal-handler&type=code + +** example in cl-notify of calling a method 'with-introspected-object +https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/dbus-protocol.lisp#L27 +#+begin_src lisp + (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))))) +#+end_src + +** example in cl-notify of working with signals +https://github.com/Lautaro-Garcia/cl-notify/blob/main/src/signals.lisp + +they register single handler, and add callbacks dynamically & call +them from the registered function + +** dbus library example for publishing objects +https://github.com/death/dbus/blob/master/examples/publish.lisp + +** my request for help with interactive async calls +https://github.com/death/dbus/issues/31 + +** old ticket on dbus repo about enabling introspection +https://github.com/death/dbus/issues/23 + +** example of signal-handler in stumpwm-thingy +https://github.com/lokedhs/stumpwm-dbus/blob/9cf0b52876111e777da27a42e3c81269b97c0005/src/pidgin.lisp#L16 + +** ref for symbold in dbus package +https://quickref.common-lisp.net/dbus.html#The-dbus_002fconnections-system + +** blog article with basics of usage +https://blog.macrolet.net/posts/DBus-and-PolicyKit-from-Common-Lisp.html + +** big article about iolib +https://pages.cs.wisc.edu/~psilord/blog/data/iolib-tutorial/tutorial.html + +it's the one that's used to create multiplexer for communication +i tried to figure out what it means to have event-loops + +** docs on dbus Screenshots portal +https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.Screenshot.html + +the methods and stuff + +** docs on dbus type system +https://dbus.freedesktop.org/doc/dbus-specification.html#type-system + +i.e how to understand types of methods and properties + +#+begin_src lisp + CL-USER> (dbus:sigexp "xsaysas") +(:INT64 :STRING (:ARRAY :BYTE) :STRING (:ARRAY :STRING)) +#+end_src + +function signature explanation can show what should lisp types be +https://github.com/death/dbus/issues/17#issuecomment-418920440 + +** example of flameshot how they get Screenshot via dbus +https://github.com/flameshot-org/flameshot/blob/c1dac52231024174faa68a29577129ebca125dff/src/utils/screengrabber.cpp#L59 + +** dbus methods for Notification +https://specifications.freedesktop.org/notification-spec/notification-spec-latest.html#signals + + +** dbus methods of ScreenCast +https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.ScreenCast.html +how to start them etc + +** dbus spec on Request & Response for the async methods +https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.Request.html#org-freedesktop-portal-request + +** repo for xdg-portal for wayland +https://github.com/emersion/xdg-desktop-portal-wlr + +** the python snippet to check that ScreenCast via xdg-portal works +https://gitlab.gnome.org/-/snippets/19 + +* [2024-07-20 Sat] + +** and now i want to try to get display of stuff into gtk window, i guess + +** doc about cl bindings to gtk3 +https://www.crategus.com/books/cl-gtk/gtk-tutorial.html#example-window-simple-c diff --git a/sdl2-playground.lisp b/sdl2-playground.lisp new file mode 100644 index 0000000..9281def --- /dev/null +++ b/sdl2-playground.lisp @@ -0,0 +1,131 @@ +(load (sb-ext:posix-getenv "ASDF")) +(asdf:load-system 'sdl2) + +(defpackage #:sdl2stuff (:use #:cl)) +(in-package #:sdl2stuff) + +;; https://search.nixos.org/packages?channel=unstable&from=0&size=50&buckets=%7B%22package_attr_set%22%3A%5B%22sbclPackages%22%5D%2C%22package_license_set%22%3A%5B%5D%2C%22package_maintainers_set%22%3A%5B%5D%2C%22package_platforms%22%3A%5B%5D%7D&sort=relevance&type=packages&query=sdl2 + +;; https://github.com/lispgames/cl-sdl2 + + + +(require :sdl2) +(require :cl-opengl) + +(defun basic-test () + "The kitchen sink." + (sdl2:with-init (:everything) + (format t "Using SDL Library Version: ~D.~D.~D~%" + sdl2-ffi:+sdl-major-version+ + sdl2-ffi:+sdl-minor-version+ + sdl2-ffi:+sdl-patchlevel+) + (finish-output) + + (sdl2:with-window (win :flags '(:shown :opengl)) + (sdl2:with-gl-context (gl-context win) + (let ((controllers ()) + (haptic ())) + + ;; basic window/gl setup + (format t "Setting up window/gl.~%") + (finish-output) + (sdl2:gl-make-current win gl-context) + (gl:viewport 0 0 800 600) + (gl:matrix-mode :projection) + (gl:ortho -2 2 -2 2 -2 2) + (gl:matrix-mode :modelview) + (gl:load-identity) + (gl:clear-color 0.0 0.0 1.0 1.0) + (gl:clear :color-buffer) + + (format t "Opening game controllers.~%") + (finish-output) + ;; open any game controllers + (loop :for i :upto (- (sdl2:joystick-count) 1) + :do (when (sdl2:game-controller-p i) + (format t "Found gamecontroller: ~a~%" + (sdl2:game-controller-name-for-index i)) + (let* ((gc (sdl2:game-controller-open i)) + (joy (sdl2:game-controller-get-joystick gc))) + (setf controllers (acons i gc controllers)) + (when (sdl2:joystick-is-haptic-p joy) + (let ((h (sdl2:haptic-open-from-joystick joy))) + (setf haptic (acons i h haptic)) + (sdl2:rumble-init h)))))) + + ;; main loop + (format t "Beginning main loop.~%") + (finish-output) + (sdl2:with-event-loop (:method :poll) + (:keydown (:keysym keysym) + (let ((scancode (sdl2:scancode-value keysym)) + (sym (sdl2:sym-value keysym)) + (mod-value (sdl2:mod-value keysym))) + (cond + ((sdl2:scancode= scancode :scancode-w) (format t "~a~%" "WALK")) + ((sdl2:scancode= scancode :scancode-s) (sdl2:show-cursor)) + ((sdl2:scancode= scancode :scancode-h) (sdl2:hide-cursor))) + (format t "Key sym: ~a, code: ~a, mod: ~a~%" + sym + scancode + mod-value))) + + (:keyup (:keysym keysym) + (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape) + (sdl2:push-event :quit))) + + (:mousemotion (:x x :y y :xrel xrel :yrel yrel :state state) + (format t "Mouse motion abs(rel): ~a (~a), ~a (~a)~%Mouse state: ~a~%" + x xrel y yrel state)) + + (:controlleraxismotion + (:which controller-id :axis axis-id :value value) + (format t "Controller axis motion: Controller: ~a, Axis: ~a, Value: ~a~%" + controller-id axis-id value)) + + (:controllerbuttondown (:which controller-id) + (let ((h (cdr (assoc controller-id haptic)))) + (when h + (sdl2:rumble-play h 1.0 100)))) + + (:idle () + (gl:clear :color-buffer) + (gl:begin :triangles) + (gl:color 1.0 0.0 0.0) + (gl:vertex 0.0 1.0) + (gl:vertex -1.0 -1.0) + (gl:vertex 1.0 -1.0) + (gl:end) + (gl:flush) + (sdl2:gl-swap-window win)) + + (:quit () t)) + + (format t "Closing opened game controllers.~%") + (finish-output) + ;; close any game controllers that were opened as well as any haptics + (loop :for (i . controller) :in controllers + :do (sdl2:game-controller-close controller) + (sdl2:haptic-close (cdr (assoc i haptic))))))))) + +;; getting error "Couldn't find matching GLX visual" +;; $ sudo apt install libgl1-mesa-dev libglu1-mesa-dev +;; $ sudo apt install mesa-utils +;; $ glxinfo | grep "direct rendering" +;; Yes +;; $ sudo apt install libsdl2-2.0-0 libsdl2-dev +;; glxinfo | grep "OpenGL" +;; sudo apt install libegl1-mesa-dev libwayland-dev libxkbcommon-dev +;; sudo apt install libwayland-egl1-mesa +;; added to shell + ;; SDL_VIDEODRIVER="wayland"; + ;; WAYLAND_DISPLAY="wayland-1"; + ;; EGL_PLATFORM="wayland"; +;; well, still not working +(sdl2:with-init (:video) + (let ((win (sdl2:create-window :title "SDL2 Window" :x :centered :y :centered :w 800 :h 600 :flags '(:shown)))) + (sdl2:with-event-loop (:method :poll) + (:quit () t) + (:idle () + (sdl2:delay 100)))))