Wire up groups and listen to output configuration events

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);

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;

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);
 }

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))))

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

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)))

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))))

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"))

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)

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)))

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*))

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

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)))

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.

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)

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"))))