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

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

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

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

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