From b361dff67136d1c4c587227a57152c762c214a21 Mon Sep 17 00:00:00 2001 From: Stuart Dilts Date: Sat, 19 Oct 2024 21:41:08 -0600 Subject: [PATCH] Wire up groups and output change events Add group objects, which represent the set of frame trees that are currently being displayed. Each frame tree is associated with an output, and should follow the output whenever it moves or changes resolution. + The frame trees are associated with the outputs using their name, which should be unique across different monitors, even of the same type. That might not be the case though, and it will need to be changed. The name was chosen to make debugging easier. + Nothing related to switching the current group is implemented, which will probably require some refactoring. --- heart/include/hrt/hrt_output.h | 2 +- heart/src/output.c | 6 ++++- lisp/bindings/hrt-bindings.lisp | 12 +++++----- lisp/bindings/package.lisp | 7 +++++- lisp/bindings/wrappers.lisp | 5 ++++ lisp/group.lisp | 42 +++++++++++++++++++++++++++++++++ lisp/main.lisp | 3 ++- lisp/objects.lisp | 15 ++++++++++-- lisp/output.lisp | 26 ++++++++++++++++---- lisp/package.lisp | 5 +++- lisp/state.lisp | 37 ++++++++++++++++++++++++++++- lisp/tree/tree-interface.lisp | 7 ++++++ mahogany.asd | 3 ++- 13 files changed, 150 insertions(+), 20 deletions(-) create mode 100644 lisp/group.lisp diff --git a/heart/include/hrt/hrt_output.h b/heart/include/hrt/hrt_output.h index 4928d32..e542079 100644 --- a/heart/include/hrt/hrt_output.h +++ b/heart/include/hrt/hrt_output.h @@ -22,7 +22,7 @@ struct hrt_output { struct hrt_output_callbacks { void (*output_added)(struct hrt_output *output); void (*output_removed)(struct hrt_output *output); - void (*output_layout_changed)(struct hrt_output *output); + void (*output_layout_changed)(); }; bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callbacks *callbacks); diff --git a/heart/src/output.c b/heart/src/output.c index dc69f9f..afade67 100644 --- a/heart/src/output.c +++ b/heart/src/output.c @@ -128,7 +128,11 @@ static void handle_output_manager_test(struct wl_listener *listener, void *data) } static void handle_output_layout_changed(struct wl_listener *listener, void *data) { - wlr_log(WLR_DEBUG, "Output Layout changed"); + struct hrt_server *server = + wl_container_of(listener, server, output_layout_changed); + // struct wlr_output_layout *output_layout = data; + + server->output_callback->output_layout_changed(); } bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callbacks *callbacks) { diff --git a/lisp/bindings/hrt-bindings.lisp b/lisp/bindings/hrt-bindings.lisp index 385ff3b..0f17e52 100644 --- a/lisp/bindings/hrt-bindings.lisp +++ b/lisp/bindings/hrt-bindings.lisp @@ -123,7 +123,7 @@ See themes section of man xcursor(3) to find where to find valid cursor names." (cffi:defcstruct hrt-output-callbacks (output-added :pointer #| function ptr void (struct hrt_output *) |#) (output-removed :pointer #| function ptr void (struct hrt_output *) |#) - (output-layout-changed :pointer #| function ptr void (struct hrt_output *) |#)) + (output-layout-changed :pointer #| function ptr void () |#)) (cffi:defcfun ("hrt_output_init" hrt-output-init) :bool (server (:pointer (:struct hrt-server))) @@ -144,16 +144,16 @@ set the width and height of views." (x (:pointer :int)) (y (:pointer :int))) -(cffi:defcfun ("hrt_output_name" hrt-output-name) (:pointer :char) +(cffi:defcfun ("hrt_output_name" hrt-output-name) :string ;; (:pointer :char) (output (:pointer (:struct hrt-output)))) -(cffi:defcfun ("hrt_output_make" hrt-output-make) (:pointer :char) +(cffi:defcfun ("hrt_output_make" hrt-output-make) :string ;; (:pointer :char) (output (:pointer (:struct hrt-output)))) -(cffi:defcfun ("hrt_output_model" hrt-output-model) (:pointer :char) +(cffi:defcfun ("hrt_output_model" hrt-output-model) :string ;; (:pointer :char) (output (:pointer (:struct hrt-output)))) -(cffi:defcfun ("hrt_output_serial" hrt-output-serial) (:pointer :char) +(cffi:defcfun ("hrt_output_serial" hrt-output-serial) :string ;; (:pointer :char) (output (:pointer (:struct hrt-output)))) ;; next section imported from file build/include/hrt/hrt_server.h @@ -198,5 +198,5 @@ set the width and height of views." (cffi:defcfun ("hrt_server_finish" hrt-server-finish) :void (server (:pointer (:struct hrt-server)))) -(cffi:defcfun ("hrt_server_scene_tree" hrt-server-scene-tree) :pointer #| (:struct wlr-scene-tree) |# +(cffi:defcfun ("hrt_server_scene_tree" hrt-server-scene-tree) :pointer #| (:struct wlr-scene-tree) |# (server (:pointer (:struct hrt-server)))) diff --git a/lisp/bindings/package.lisp b/lisp/bindings/package.lisp index a10706c..08af1f0 100644 --- a/lisp/bindings/package.lisp +++ b/lisp/bindings/package.lisp @@ -10,13 +10,18 @@ #:view-destroyed #:hrt-seat #:hrt-output + #:hrt-output-name + #:hrt-output-make + #:hrt-output-model + #:hrt-output-serial #:hrt-keypress-info ;; output callbacks #:output-added #:output-removed - #:output-mode-changed + #:output-layout-changed ;; output methods: #:output-resolution + #:output-position ;; seat callbacks #:button-event #:wheel-event #:keyboard-keypress-event #:hrt-server diff --git a/lisp/bindings/wrappers.lisp b/lisp/bindings/wrappers.lisp index 8666dbb..acaf886 100644 --- a/lisp/bindings/wrappers.lisp +++ b/lisp/bindings/wrappers.lisp @@ -10,3 +10,8 @@ (declare (type cffi:foreign-pointer output)) (with-return-by-value ((width :int) (height :int)) (hrt-output-resolution output width height))) + +(defun output-position (output) + (declare (type cffi:foreign-pointer output)) + (with-return-by-value ((x :int) (y :int)) + (hrt-output-position output x y))) diff --git a/lisp/group.lisp b/lisp/group.lisp new file mode 100644 index 0000000..cd634fe --- /dev/null +++ b/lisp/group.lisp @@ -0,0 +1,42 @@ +(in-package #:mahogany) + + + +(defun group-add-output (group output) + (declare (type mahogany-output output) + (type mahogany-group group)) + (with-accessors ((output-map mahogany-group-output-map)) group + (multiple-value-bind (x y) (hrt:output-position (mahogany-output-hrt-output output)) + (multiple-value-bind (width height) (hrt:output-resolution (mahogany-output-hrt-output output)) + (setf (gethash (mahogany-output-full-name output) output-map) + (make-basic-tree :x x :y y :width width :height height)) + (log-string :trace "Group map: ~S" output-map))))) + +(defun group-reconfigure-outputs (group outputs) + "Re-examine where the outputs are and adjust the trees that are associated with them +to match." + (with-accessors ((output-map mahogany-group-output-map)) group + (loop for mh-output across outputs + do (with-accessors ((full-name mahogany-output-full-name) + (hrt-output mahogany-output-hrt-output)) + mh-output + (alexandria:when-let ((tree (gethash full-name output-map))) + (multiple-value-bind (x y) (hrt:output-position hrt-output) + (mahogany/tree:set-position (root-tree tree) x y)) + (multiple-value-bind (width height) (hrt:output-resolution hrt-output) + (mahogany/tree:set-dimensions (root-tree tree) width height))))))) + + +(defun group-remove-output (group output) + (declare (type mahogany-output output) + (type mahogany-group group)) + (remhash (mahogany-output-full-name output) (mahogany-group-output-map group))) + +(defun group-add-view (group view) + (declare (type mahogany-group group)) + (push view (mahogany-group-views group))) + +(defun group-remove-view (group view) + (declare (type mahogany-group group)) + (with-accessors ((view-list mahogany-group-views)) group + (setf view-list (remove view view-list :test #'cffi:pointer-eq)))) diff --git a/lisp/main.lisp b/lisp/main.lisp index 72fabba..b3b6adb 100644 --- a/lisp/main.lisp +++ b/lisp/main.lisp @@ -39,7 +39,8 @@ (server '(:struct hrt-server))) (init-callback-struct output-callbacks (:struct hrt-output-callbacks) (output-added handle-new-output) - (output-removed handle-output-removed)) + (output-removed handle-output-removed) + (output-layout-changed handle-output-layout-change)) (init-callback-struct seat-callbacks (:struct hrt-seat-callbacks) (button-event cursor-callback) (wheel-event cursor-callback) diff --git a/lisp/objects.lisp b/lisp/objects.lisp index 492daaa..b6bc41e 100644 --- a/lisp/objects.lisp +++ b/lisp/objects.lisp @@ -1,7 +1,13 @@ (in-package #:mahogany) -(defstruct (mahogany-output (:constructor make-mahogany-output (hrt-output))) - (hrt-output cffi:null-pointer :type cffi:foreign-pointer :read-only t)) +(defstruct (mahogany-output (:constructor %make-mahogany-output (hrt-output full-name))) + (hrt-output cffi:null-pointer :type cffi:foreign-pointer :read-only t) + (full-name "" :type string :read-only t)) + +(defstruct (mahogany-group (:constructor make-mahogany-group (name))) + (name "" :type string) + (output-map (make-hash-table :test 'equal) :type hash-table :read-only t) + (views nil :type list)) (defclass mahogany-state () ((hrt-server :type hrt-server @@ -10,6 +16,8 @@ (key-state :type key-state :initform (make-key-state nil) :accessor mahogany-state-key-state) + (current-group :type mahogany-group + :accessor mahogany-current-group) (keybindings :type list :initform nil :reader mahogany-state-keybindings) @@ -19,6 +27,9 @@ :adjustable t :fill-pointer t) :accessor mahogany-state-outputs) + (groups :type vector + :accessor mahogany-state-groups + :initform (make-array 0 :element-type 'mahogany-group :adjustable t :fill-pointer t)) (views :type list :initform nil :reader mahogany-state-views))) diff --git a/lisp/output.lisp b/lisp/output.lisp index 4899583..67a0ea5 100644 --- a/lisp/output.lisp +++ b/lisp/output.lisp @@ -1,10 +1,26 @@ (in-package #:mahogany) +(defun %get-output-full-name (hrt-output) + (let ((make (hrt-output-make hrt-output)) + (name (hrt-output-name hrt-output)) + (serial (hrt-output-serial hrt-output)) + (model (hrt-output-model hrt-output))) + (concatenate 'string + (or name "") + (or make "") + (or model "") + (or serial "")))) + +(defun construct-mahogany-output (hrt-output) + (let ((name (%get-output-full-name hrt-output))) + (%make-mahogany-output hrt-output name))) + (cffi:defcallback handle-new-output :void ((output (:pointer (:struct hrt-output)))) - (log-string :trace "New output added") - (vector-push-extend (make-mahogany-output output) (mahogany-state-outputs *compositor-state*))) + (let ((mh-output (construct-mahogany-output output))) + (mahogany-state-output-add *compositor-state* mh-output))) (cffi:defcallback handle-output-removed :void ((output (:pointer (:struct hrt-output)))) - (log-string :trace "Output removed") - (with-accessors ((outputs mahogany-state-outputs)) *compositor-state* - (setf outputs (delete output outputs :key #'mahogany-output-hrt-output)))) + (mahogany-state-output-remove *compositor-state* output)) + +(cffi:defcallback handle-output-layout-change :void () + (mahogany-state-output-reconfigure *compositor-state*)) diff --git a/lisp/package.lisp b/lisp/package.lisp index f016038..3949212 100644 --- a/lisp/package.lisp +++ b/lisp/package.lisp @@ -25,6 +25,7 @@ #:frame-height #:frame-parent #:tree-container + #:make-basic-tree #:root-tree #:tree-frame #:tree-children @@ -43,7 +44,9 @@ #:frame-view #:frame-modes #:fit-view-into-frame - #:leafs-in)) + #:leafs-in + #:set-dimensions + #:set-position)) (defpackage #:mahogany/keyboard (:use :cl diff --git a/lisp/state.lisp b/lisp/state.lisp index 59894f1..397c659 100644 --- a/lisp/state.lisp +++ b/lisp/state.lisp @@ -1,6 +1,9 @@ (in-package #:mahogany) -;; (defmethod initialize-instance :after ((object mahogany-state) &key &allow-other-keys)) +(defmethod initialize-instance :after ((object mahogany-state) &key &allow-other-keys) + (let ((default-group (make-mahogany-group "DEFAULT"))) + (setf (slot-value object 'current-group) default-group) + (vector-push-extend default-group (mahogany-state-groups object)))) (defun server-state-reset (state) (declare (type mahogany-state state)) @@ -21,13 +24,45 @@ (unless (key-state-active-p (mahogany-state-key-state state)) (server-keystate-reset state))) +(defun mahogany-state-output-add (state mh-output) + (declare (type mahogany-state state) + (type mahogany-output mh-output)) + (with-accessors ((outputs mahogany-state-outputs) + (groups mahogany-state-groups)) + state + (log-string :trace "New output added ~S" (mahogany-output-full-name mh-output)) + (vector-push-extend mh-output outputs) + (loop for g across groups + do (group-add-output g mh-output)))) + +(defun mahogany-state-output-remove (state hrt-output) + (with-accessors ((outputs mahogany-state-outputs) + (groups mahogany-state-groups)) + state + (let ((mh-output (find hrt-output outputs + :key #'mahogany-output-hrt-output + :test #'cffi:pointer-eq))) + (log-string :trace "Output removed ~S" (mahogany-output-full-name mh-output)) + ;; TODO: Is there a better way to remove an item from a vector when we know the index? + (loop for g across groups + do (group-remove-output g mh-output)) + (setf outputs (delete mh-output outputs))))) + +(defun mahogany-state-output-reconfigure (state) + (log-string :trace "Output layout changed!") + (with-accessors ((groups mahogany-state-groups)) state + (loop for g across groups + do (group-reconfigure-outputs g (mahogany-state-outputs state))))) + (defun mahogany-state-view-add (state view) (declare (type mahogany-state state)) (push view (slot-value state 'views)) + (group-add-view (mahogany-current-group state) view) (log-string :trace "Views: ~S" (slot-value state 'views))) (defun mahogany-state-view-remove (state view) (declare (type mahogany-state state)) (with-slots (views) state + (group-remove-view (mahogany-current-group state) view) (setf views (remove view views :test #'cffi:pointer-eq)) (log-string :trace "Views: ~S" views))) diff --git a/lisp/tree/tree-interface.lisp b/lisp/tree/tree-interface.lisp index 2579bfe..f4f1a95 100644 --- a/lisp/tree/tree-interface.lisp +++ b/lisp/tree/tree-interface.lisp @@ -120,6 +120,13 @@ a view assigned to it.")) ;; the root frame's parent will be a tree-container: (typep (frame-parent frame) 'tree-container)) +(defun make-basic-tree (&key (x 0) (y 0) (width 100) (height 100)) + (let ((container (make-instance 'tree-container)) + (frame (make-instance 'view-frame :x x :y y :width width :height height))) + (setf (frame-parent frame) container) + (setf (root-tree container) frame) + (values container frame))) + (snakes:defgenerator leafs-in (frame) (check-type frame frame) (if (typep frame 'tree-frame) diff --git a/mahogany.asd b/mahogany.asd index f9dd40a..fa30e7c 100644 --- a/mahogany.asd +++ b/mahogany.asd @@ -41,9 +41,10 @@ (:file "frame" :depends-on ("tree-interface")) (:file "view" :depends-on ("tree-interface")))) (:file "objects" :depends-on ("package")) + (:file "group" :depends-on ("objects" "bindings")) (:file "state" :depends-on ("objects" "keyboard")) (:file "globals" :depends-on ("state" "objects" "system")) - (:file "output" :depends-on ("objects" "bindings")) + (:file "output" :depends-on ("objects" "bindings" "state")) (:file "view" :depends-on ("globals" "state" "objects" "bindings")) (:file "input" :depends-on ("state" "keyboard")) (:file "main" :depends-on ("bindings" "keyboard" "input" "package"))))