[STUMP] head-resizing facility

[Vitaly Mayatskikh]

Hello!

More that half year ago I've posted patch for heads resizing. It
allows, for example, to preserve upper part of screen for some
panel. Recently Ben has fixed a bug in resize-tree, which I've fixed
also in that patch, so it came to discussion again.

Basically, patch consist of 3 smaller patches which:

1. fixes behavior of frame-head.
2. fixes bug in resize-tree
3. adds new function: resize-head

Unfortunately, I don't remember exactly why frame-head required this
fix, but from what I see, it now determines head for frame using one
single point - a center of frame.

Ben fixed 'The value NIL is not of type STUMPWM::HEAD.' error in
function resize-tree, but the logic of resize-tree is incorrect for
head resizing. You can see it by applying only 2 hunks (w/o renewed
resize-tree), splitting head and resizing it. Renewed resize-tree
seems to work.

Note, if you'll resize head to some size and resize it back, there,
possibly, will be gaps between frames due to floating math truncations
bias.

diff --git a/head.lisp b/head.lisp
index 1c7adf2..c54e28d 100644
--- a/head.lisp
+++ b/head.lisp
@@ -72,15 +72,17 @@
 ;; work with overlapping heads. Would it be better to walk
 ;; up the frame tree?
 (defun frame-head (group frame)
-  (dolist (head (screen-heads (group-screen group)))
-    (when (and
-           (>= (frame-x frame) (frame-x head))
-           (>= (frame-y frame) (frame-y head))
-           (<= (+ (frame-x frame) (frame-width frame))
-               (+ (frame-x head) (frame-width head)))
-           (<= (+ (frame-y frame) (frame-height frame))
-               (+ (frame-y head) (frame-height head))))
-      (return head))))
+  (let ((center-x (+ (frame-x frame) (ash (frame-width frame) -1)))
+       (center-y (+ (frame-y frame) (ash (frame-height frame) -1))))
+    (dolist (head (screen-heads (group-screen group)))
+      (when (and
+            (>= center-x (frame-x head))
+            (>= center-y (frame-y head))
+            (<= center-x
+                (+ (frame-x head) (frame-width head)))
+            (<= center-y
+                (+ (frame-y head) (frame-height head))))
+       (return head)))))
 
 (defun group-heads (group)
   (screen-heads (group-screen group)))
@@ -150,6 +152,19 @@
         (head-width oh) (head-width nh)
         (head-height oh) (head-height nh)))
 
+(defun resize-head (number x y width height)
+  "Resize head number `number' to given dimension."
+  (let* ((screen (current-screen))
+        (oh (find number (screen-heads screen) :key 'head-number))
+        (nh (make-head :number number
+                       :x x :y y
+                       :width width
+                       :height height
+                       :window nil)))
+    (scale-head screen oh nh)
+    (mapc 'group-add-head (screen-groups screen))
+    (update-mode-lines screen)))
+
 (defun scale-screen (screen heads)
   "Scale all frames of all groups of SCREEN to match the dimensions
   of HEADS."
diff --git a/tile-group.lisp b/tile-group.lisp
index 47f0e99..5886232 100644
--- a/tile-group.lisp
+++ b/tile-group.lisp
@@ -562,17 +562,23 @@ LEAF. Return tree with leaf removed."
 
 (defun resize-tree (tree w h &optional (x (tree-x tree)) (y (tree-y tree)))
   "Scale TREE to width W and height H, ignoring aspect. If X and Y are
-  provided, reposition the TREE as well."
-  (let* ((tw (tree-width tree))
-         (th (tree-height tree))
-         (wf (/ w tw))
-         (hf (/ h th)))
-    (tree-iterate tree (lambda (f)
-                         (setf (frame-height f) (round (* (frame-height f) hf))
-                               (frame-y f) (+ (round (* (- (frame-y f) (tree-y 
tree)) hf)) y)
-                               (frame-width f) (round (* (frame-width f) wf))
-                               (frame-x f) (+ (round (* (- (frame-x f) (tree-x 
tree)) wf)) x))))
-    (dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree) 
(tree-height tree))))
+   provided, reposition the TREE as well."
+   (let* ((tw (tree-width tree))
+          (th (tree-height tree))
+         (wf (/ w tw))
+         (hf (/ h th))
+         (xo (or x 0))
+         (yo (or y 0))
+         (tx (tree-x tree))
+         (ty (tree-y tree)))
+     (tree-iterate tree (lambda (f)
+                          (setf (frame-height f) (round (* (frame-height f) 
hf))
+                               (frame-y f) (round (* (- (frame-y f) ty) hf))
+                                (frame-width f) (round (* (frame-width f) wf))
+                               (frame-x f) (round (* (- (frame-x f) tx) wf)))
+                          (incf (frame-y f) yo)
+                          (incf (frame-x f) xo)))
+     (dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree) 
(tree-height tree))))
 
 (defun remove-frame (tree leaf)
   "Return a new tree with LEAF and it's sibling merged into

-- 
wbr, Vitaly