[STUMP] [PATCH] add head resizing facility

[Vitaly Mayatskikh]

This patch adds resize-head function for heads resizing :)

diff --git a/screen.lisp b/screen.lisp
index 19eebdb..8edec95 100644
--- a/screen.lisp
+++ b/screen.lisp
@@ -523,15 +523,17 @@ FOCUS-WINDOW is an extra window used for 
_NET_SUPPORTING_WM_CHECK."
 ;; 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)))
@@ -622,6 +624,18 @@ FOCUS-WINDOW is an extra window used for 
_NET_SUPPORTING_WM_CHECK."
           (scale-head screen oh nh)
           (add-head screen nh))))
 
+(defun resize-head (number x y width height)
+  (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)))
+
 ;;; Screen commands
 
 (defcommand snext () ()
diff --git a/tile-group.lisp b/tile-group.lisp
index 483aa25..98fd8f0 100644
--- a/tile-group.lisp
+++ b/tile-group.lisp
@@ -568,15 +568,17 @@ LEAF. Return tree with leaf removed."
   provided, reposition the TREE as well."
   (let* ((tw (tree-width tree))
          (th (tree-height tree))
-         (wf (/ 1 (/ tw w)))
-         (hf (/ 1 (/ th h)))
-         (xo (if x (- x (tree-x tree)) 0))
-         (yo (if y (- y (tree-y tree)) 0)))
+         (wf (/ w tw))
+         (hf (/ h th))
+         (xo (if x x 0))
+         (yo (if y 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) 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) 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))))

-- 
wbr, Vitaly