From 8fa61723cdd00f41798b5e5290c9ac737fa50bf9 Mon Sep 17 00:00:00 2001
From: Stuart Dilts <stuart.dilts@gmail.com>
Date: Sat, 19 Oct 2024 21:41:08 -0600
Subject: [PATCH] Wire up groups and outptu change events

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