Wire up groups and outptu change events

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