;;; win-alg.el --- Window size computation
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2009-08-12 Wed
;; Version: 0.1
;; Last-Updated: 2009-08-12 Wed
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Window creation etc

;;(defun wa-make-window (width wmin wmax height hmin hmax)
(defun wa-make-window (name width wmin wmax)
  (list (list 'name name)            ;; Easier communication ...
        (list 'child nil)            ;; Child windows
        (list 'size width wmin wmax) ;; Old size and restrictions
        (list 'compsize nil nil)     ;; Slot for computation, wmin wmax
        (list 'set-size nil)         ;; Slot for setting, wmin wmax
        ))

;; Fix-me: Make defmacro to make those getters setters... - including
;; checks...
(defun wa-name  (window) (nth 1 (nth 0 window)))
(defun wa-child (window) (nth 1 (nth 1 window)))
(defun wa-width (window) (nth 1 (nth 2 window)))
(defun wa-wmin  (window) (nth 2 (nth 2 window)))
(defun wa-wmax  (window) (nth 3 (nth 2 window)))
(defun wa-wcmin (window) (nth 1 (nth 3 window)))
(defun wa-wcmax (window) (nth 2 (nth 3 window)))
(defun wa-wset  (window) (nth 1 (nth 4 window)))

(defun wa-set-name   (window name)  (setcar (nthcdr 1 (nth 0 window)) name))
(defun wa-set-child  (window child) (setcar (nthcdr 1 (nth 1 window)) child))
(defun wa-set-width  (window width) (setcar (nthcdr 1 (nth 2 window)) width))
(defun wa-set-wmin   (window wmin)  (setcar (nthcdr 2 (nth 2 window)) wmin))
(defun wa-set-wmax   (window wmax)  (setcar (nthcdr 3 (nth 2 window)) wmax))
(defun wa-set-wcmin  (window wmin)  (setcar (nthcdr 1 (nth 3 window)) wmin))
(defun wa-set-wcmax  (window wmax)  (setcar (nthcdr 2 (nth 3 window)) wmax))
(defun wa-set-wset   (window size)  (setcar (nthcdr 1 (nth 4 window)) size))

(defun wa-set-child-windows (parent vertical &rest sizes)
  (dolist (s sizes) (assert (= 3 (length s)) t))
  (let* ((tot-given (apply '+ (mapcar (lambda (s) (car s)) (cdr sizes))))
         (par-size       (if vertical (wa-width parent) (wa-height parent)))
         ;;(par-other-size (if vertical (wa-height parent) (wa-width parent)))
         (real-sizes (copy-sequence sizes))
         children
         (num 0))
    (setcar (nth 1 real-sizes) (- par-size tot-given))
    (setq children (mapcar (lambda (size)
                             (setq num (1+ num))
                             (if vertical
                                 (wa-make-window (format "%s-%d" (wa-name parent) num)
                                                 (nth 0 size)
                                                 (nth 1 size)
                                                 (nth 2 size))
                               ;;(wa-make-window size par-other-size)
                               ))
                           real-sizes))
    (wa-set-child parent children)))

(defun wa-check-fit (win)
  (let ((wmin (wa-wmin win))
        (wmax (wa-wmax win))
        (wcmin (wa-wcmin win))
        (wcmax (wa-wcmax win)))
    (when (and wmax wcmin)
      (unless (<= wcmin wmax)
        (error "Window %s is too small, min=%d, but can be max=%d" (wa-name win) wcmin wmax)))
    (when (and wcmax wmin)
      (unless (<= wcmax wmin)
        (error "Window %s's childs are too small, max=%d, but can be min=%d" (wa-name win) wcmax wmin)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Computation of sizes

(defun wa-clear-computed (win)
  (wa-set-wcmin win nil)
  (wa-set-wcmax win nil)
  (dolist (c (wa-child win))
    (wa-clear-computed c)))

(defun wa-compute-required (win)
  "Walk up collecting needed sizes."
  (let ((childs (wa-child win))
        (wmin (wa-wmin win))
        (wmax (wa-wmax win))
        (cmin 0)
        (cmax nil))
    (when childs
      (dolist (c childs)
        (let* ((res (wa-compute-required c))
               (res-min (nth 0 res))
               (res-max (nth 1 res)))
          ;; Just sum the MIN
          (setq cmin (+ cmin res-min))
          (if res-max
              ;; ... ok, let us sum MAX to see how big we can be ...
              (if (numberp cmax)
                  (setq cmax (+ cmax res-max))
                (setq cmax res-max))
            ;; Hurray, at least one child can grow!
            (setq cmax nil)))))
    (when wmin (setq cmin (max wmin (or cmin wmin))))
    (when wmax (setq cmax (min wmax (or cmax wmax))))
    (wa-set-wcmin win cmin)
    (wa-set-wcmax win cmax)
    (wa-check-fit win)
    (list (wa-wcmin win)
          (wa-wcmax win))))

(defun wa-compute-wanted (win strategy)
  "Walk down compute sizes."
  ;; Set root window size
  (unless (wa-wset win) (wa-set-wset win (wa-width win)))
  (let ((cmin   (wa-wcmin  win))
        (cmax   (wa-wcmax  win))
        (width  (wa-width win))
        (childs (wa-child win))
        )
  (case strategy
    ('eq-sizes
     (let (
           (rest-width width)
           (goal (/ width (length childs)))
           (rest-childs (copy-sequence childs)))
       ;; Clear childs
       (dolist (c childs) (wa-set-wset c nil))
       ;; Check child min requirements
       (dolist (c (copy-sequence rest-childs))
         (let ((wcmin (wa-wcmin c)))
           (when (and wcmin (<= goal wcmin))
             (wa-set-wset c (wa-wcmin c))
             (setq rest-childs (delete c rest-childs))
             (setq rest-width (- rest-width (wa-wcmin c))))))
       (setq goal (/ rest-width (length childs)))
       ;; Check child max requirements
       (dolist (c (copy-sequence rest-childs))
         (let ((wcmax (wa-wcmax c)))
           (when (and wcmax (>= goal wcmax))
             (wa-set-wset c (wa-wcmax c))
             (setq rest-childs (delete c rest-childs))
             (setq rest-width (- rest-width (wa-wcmax c))))))
       (setq goal (/ rest-width (length childs)))
       ;; Distribute the rest, taking care of roundings
       (wa-set-wset (car rest-childs)
                   (- rest-width (* goal (1- (length rest-childs)))))
       (dolist (c (cdr rest-childs))
         (wa-set-wset c goal))))
    (t (error "Unknown rule: %s" rule)))
  ;; Check
  (let ((w 0))
    (dolist (c childs)
      (setq w (+ w (wa-wset c))))
    (unless (= w (wa-wset win))
      (error "Bad set sizes child sum w=%d, win width=%d" w (wa-wset win))))
  ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Testing part

(defvar wa-root-window nil)

(defun wa-add-test-childs ()
  (wa-set-child-windows wa-root-window t
                         '(nil nil nil)
                         '(5 4 nil)
                         '(8 nil nil)
                         '(4 3 nil)
                         ))

(setq wa-root-window (wa-make-window "Root" 80 nil nil))
(setq wa-root-window (wa-make-window "Root" 80 nil 8))
(setq wa-root-window (wa-make-window "Root" 80 nil 6))
(setq wa-root-window (wa-make-window "Root" 80 5 nil))
(setq wa-root-window (wa-make-window "Root" 80 15 nil))

;; (wa-child wa-root-window)
;; (wa-width wa-root-window)
;; (wa-wmin wa-root-window)
;; (wa-wmax wa-root-window)
;; (wa-clear-computed wa-root-window)

(wa-add-test-childs)
(wa-compute-required wa-root-window)
(wa-compute-wanted   wa-root-window 'eq-sizes)
(describe-variable 'wa-root-window)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; win-alg.el ends here