From 88ab22dcd4fb7ccb2255045f2e2227846f5c4c19 Mon Sep 17 00:00:00 2001 From: Stuart Dilts Date: Sun, 7 Apr 2024 16:49:52 -0600 Subject: [PATCH 1/3] hrt: partially hook up output layout change listener --- heart/include/hrt/hrt_output.h | 1 + heart/include/hrt/hrt_server.h | 1 + heart/src/output.c | 8 ++++++++ lisp/bindings/hrt-bindings.lisp | 4 +++- 4 files changed, 13 insertions(+), 1 deletion(-) diff --git a/heart/include/hrt/hrt_output.h b/heart/include/hrt/hrt_output.h index 19ff78a..4928d32 100644 --- a/heart/include/hrt/hrt_output.h +++ b/heart/include/hrt/hrt_output.h @@ -22,6 +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); }; bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callbacks *callbacks); diff --git a/heart/include/hrt/hrt_server.h b/heart/include/hrt/hrt_server.h index 9878cc2..6ea9be8 100644 --- a/heart/include/hrt/hrt_server.h +++ b/heart/include/hrt/hrt_server.h @@ -30,6 +30,7 @@ struct hrt_server { struct wl_listener new_output; struct wlr_output_manager_v1 *output_manager; struct wlr_output_layout *output_layout; + struct wl_listener output_layout_changed; struct wl_listener output_manager_apply; struct wl_listener output_manager_test; struct wl_listener output_manager_destroy; diff --git a/heart/src/output.c b/heart/src/output.c index 5e1f0fa..dc69f9f 100644 --- a/heart/src/output.c +++ b/heart/src/output.c @@ -127,6 +127,10 @@ 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"); +} + bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callbacks *callbacks) { server->output_callback = callbacks; server->new_output.notify = handle_new_output; @@ -136,6 +140,9 @@ bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callback server->scene = wlr_scene_create(); server->scene_layout = wlr_scene_attach_output_layout(server->scene, server->output_layout); + server->output_layout_changed.notify = handle_output_layout_changed; + wl_signal_add(&server->output_layout->events.change, &server->output_layout_changed); + server->output_manager = wlr_output_manager_v1_create(server->wl_display); if(!server->output_manager) { @@ -156,6 +163,7 @@ bool hrt_output_init(struct hrt_server *server, const struct hrt_output_callback void hrt_output_destroy(struct hrt_server *server) { wlr_scene_node_destroy(&server->scene->tree.node); + wl_list_remove(&server->output_layout_changed.link); // The output layout gets destroyed when the display does: // wlr_output_layout_destroy(server->output_layout); } diff --git a/lisp/bindings/hrt-bindings.lisp b/lisp/bindings/hrt-bindings.lisp index fd48dc7..385ff3b 100644 --- a/lisp/bindings/hrt-bindings.lisp +++ b/lisp/bindings/hrt-bindings.lisp @@ -122,7 +122,8 @@ 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-removed :pointer #| function ptr void (struct hrt_output *) |#) + (output-layout-changed :pointer #| function ptr void (struct hrt_output *) |#)) (cffi:defcfun ("hrt_output_init" hrt-output-init) :bool (server (:pointer (:struct hrt-server))) @@ -170,6 +171,7 @@ set the width and height of views." (new-output (:struct wl-listener)) (output-manager :pointer #| (:struct wlr-output-manager-v1) |# ) (output-layout :pointer #| (:struct wlr-output-layout) |# ) + (output-layout-changed (:struct wl-listener)) (output-manager-apply (:struct wl-listener)) (output-manager-test (:struct wl-listener)) (output-manager-destroy (:struct wl-listener)) From 0b4704247591303e24af86dff7ec22ebc2c4068b Mon Sep 17 00:00:00 2001 From: Stuart Dilts Date: Fri, 10 May 2024 12:40:38 -0600 Subject: [PATCH 2/3] Add set-position generic function Add single function to set both the x and y coordinate so of an object and use it. --- lisp/interfaces/view-interface.lisp | 3 +++ lisp/tree/frame.lisp | 13 +++++++------ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/interfaces/view-interface.lisp b/lisp/interfaces/view-interface.lisp index c280c91..4dd5028 100644 --- a/lisp/interfaces/view-interface.lisp +++ b/lisp/interfaces/view-interface.lisp @@ -34,3 +34,6 @@ (print-unreadable-object (object stream :type t) (with-slots (x y) object (format stream ":x ~S :y ~S" x y)))) + +(defgeneric set-position (object x y) + (:documentation "Set the x-y position of the object")) diff --git a/lisp/tree/frame.lisp b/lisp/tree/frame.lisp index 49780a8..8fa6e23 100644 --- a/lisp/tree/frame.lisp +++ b/lisp/tree/frame.lisp @@ -36,12 +36,10 @@ (tmp-y (frame-y frame1)) (tmp-width (frame-width frame1)) (tmp-height (frame-height frame1))) - (setf (frame-x frame1) (frame-x frame2) - (frame-y frame1) (frame-y frame2)) + (set-position frame1 (frame-x frame2) (frame-y frame2)) (set-dimensions frame1 (frame-width frame2) (frame-height frame2)) - (setf (frame-x frame2) tmp-x - (frame-y frame2) tmp-y) + (set-position frame2 tmp-x tmp-y) (set-dimensions frame2 tmp-width tmp-height)) (let ((frame1-parent (frame-parent frame1)) @@ -101,6 +99,10 @@ (setf (frame-width frame) width (frame-height frame) height)) +(defmethod set-position ((frame frame) x y) + (setf (frame-x frame) x + (frame-y frame) y)) + (defmethod split-frame-h :before ((frame frame) &key ratio direction) (declare (ignore frame direction)) (when ratio @@ -141,8 +143,7 @@ of FRAME to those of ROOT." (setf (frame-parent frame) (frame-parent root)) ;; don't bother with an if-statement to see which values to change: (set-dimensions frame (frame-width root) (frame-height root)) - (setf (frame-x frame) (frame-x root) - (frame-y frame) (frame-y root))) + (set-position frame (frame-x root) (frame-y root))) (defun binary-split-h (frame ratio direction parent-type) "Split a frame in two, with the resulting parent frame of type parent-frame. From 66735b9a2d1a779c0a5295e8b5be92a2bfb4dec8 Mon Sep 17 00:00:00 2001 From: Stuart Dilts Date: Sat, 19 Oct 2024 21:41:08 -0600 Subject: [PATCH 3/3] 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"))))