diff --git a/heart/include/hrt/hrt_output.h b/heart/include/hrt/hrt_output.h index 19ff78a..e542079 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)(); }; 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..afade67 100644 --- a/heart/src/output.c +++ b/heart/src/output.c @@ -127,6 +127,14 @@ static void handle_output_manager_test(struct wl_listener *listener, void *data) } +static void handle_output_layout_changed(struct wl_listener *listener, void *data) { + 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) { server->output_callback = callbacks; server->new_output.notify = handle_new_output; @@ -136,6 +144,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 +167,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..0f17e52 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 () |#)) (cffi:defcfun ("hrt_output_init" hrt-output-init) :bool (server (:pointer (:struct hrt-server))) @@ -143,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 @@ -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)) @@ -196,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/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/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/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. 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"))))