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


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

;;(defun wa-make-window (width wumin wumax height hmin hmax)
(defun wa-make-window (name width wumin wumax)
  (list (list 'name name)            ;; Easier communication ...
        (list 'child nil)            ;; Child windows
        (list 'usr-size wumin wumax) ;; Restrictions
        (list 'req-size nil nil)     ;; Slot for computated requirements, wumin wumax
        (list 'set-size width)       ;; Slot for setting new size
        ))

;; Fix-me: Make defmacro to make those getters setters... - including
;; checks...

(defun wa-name  (window) (nth 1 (nth 0 window))) ;; 'name
(defun wa-child (window) (nth 1 (nth 1 window))) ;; 'child
(defun wa-wumin (window) (nth 1 (nth 2 window))) ;; 'usr-size
(defun wa-wumax (window) (nth 2 (nth 2 window))) ;; 'usr-size
(defun wa-wrmin (window) (nth 1 (nth 3 window))) ;; 'req-size
(defun wa-wrmax (window) (nth 2 (nth 3 window))) ;; 'req-size
(defun wa-wset  (window) (nth 1 (nth 4 window))) ;; 'set-size

(defun wa-set-name   (window name)  (setcar (nthcdr 1 (nth 0 window)) name))  ;; 'name
(defun wa-set-child  (window child) (setcar (nthcdr 1 (nth 1 window)) child)) ;; 'name
(defun wa-set-wumin  (window wumin) (setcar (nthcdr 1 (nth 2 window)) wumin)) ;; 'usr-size
(defun wa-set-wumax  (window wumax) (setcar (nthcdr 2 (nth 2 window)) wumax)) ;; 'usr-size
(defun wa-set-wrmin  (window wumin) (setcar (nthcdr 1 (nth 3 window)) wumin)) ;; 'req-size
(defun wa-set-wrmax  (window wumax) (setcar (nthcdr 2 (nth 3 window)) wumax)) ;; 'req-size
(defun wa-set-wset   (window size)  (setcar (nthcdr 1 (nth 4 window)) size))  ;; 'set-size

(defun wa-set-child-windows (parent vertical &rest sizes)
  (let (children
        (num 0))
    (setq children (mapcar (lambda (size)
                             (setq num (1+ num))
                             (if vertical
                                 (wa-make-window (format "%s-%d" (wa-name parent) num)
                                                 nil
                                                 (nth 0 size)
                                                 (nth 1 size))
                               ))
                           sizes))
    (wa-set-child parent children)))

(defun wa-check-fit (win)
  (let ((wumin (wa-wumin win))
        (wumax (wa-wumax win))
        (wrmin (wa-wrmin win))
        (wrmax (wa-wrmax win))
        (wset  (wa-wset win)))
    ;; Top window
    (when (and wset wrmin)
      (unless (<= wrmin wset)
        (error "Window %s set size too small=%d, min=%d" (wa-name win) wset wrmin)))
    (when (and wset wrmax)
      (unless (>= wrmax wset)
        (error "Window %s set size too large=%d, max=%s" (wa-name win) wset wrmax)))
    ;; All
    (when (and wumax wrmin)
      (unless (<= wrmin wumax)
        (error "Window %s is too small, min=%d, but can be max=%d" (wa-name win) wrmin wumax)))
    (when (and wrmax wumin)
      (unless (<= wrmax wumin)
        (error "Window %s's childs are too small, max=%d, but can be min=%d" (wa-name win) wrmax wumin)))))


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

(defun wa-clear-computed (win)
  (wa-set-wrmin win nil)
  (wa-set-wrmax win nil)
  (wa-set-wset  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))
        (wumin (wa-wumin win))
        (wumax (wa-wumax win))
        (cmin 0)
        (cmax nil))
    (when childs
      ;; Clear childs set sizes, we do not know them here
      (dolist (c childs) (wa-set-wset c nil))
      (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 wumin (setq cmin (max wumin (or cmin wumin))))
    (when wumax (setq cmax (min wumax (or cmax wumax))))
    ;; Sanity
    (when (= cmin 0) (setq cmin 1))
    (assert (or (not cmin) (<= 1 cmin)) t)
    (assert (or (not cmax) (<= 1 cmax)) t)
    (wa-set-wrmin win cmin)
    (wa-set-wrmax win cmax)
    (wa-check-fit win)
    (list (wa-wrmin win)
          (wa-wrmax win))))

(defun wa-compute-wanted (win strategy)
  "Walk down compute sizes."
  (when (wa-child win)
    (let ((cmin   (wa-wrmin  win))
          (cmax   (wa-wrmax  win))
          (width  (wa-wset 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 ((wrmin (wa-wrmin c)))
               (when (and wrmin (<= goal wrmin))
                 (wa-set-wset c (wa-wrmin c))
                 (setq rest-childs (delete c rest-childs))
                 (setq rest-width (- rest-width (wa-wrmin c))))))
           (setq goal (/ rest-width (length childs)))
           ;; Check child max requirements
           (dolist (c (copy-sequence rest-childs))
             (let ((wrmax (wa-wrmax c)))
               (when (and wrmax (>= goal wrmax))
                 (wa-set-wset c (wa-wrmax c))
                 (setq rest-childs (delete c rest-childs))
                 (setq rest-width (- rest-width (wa-wrmax 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)
          (let ((wset (wa-wset c)))
            (assert (<= 0 wset) t)
            (setq w (+ w wset))))
        (unless (= w (wa-wset win))
          (error "Bad set sizes child sum w=%d, win width=%d" w (wa-wset win))))
      ;; Walk down
      (dolist (c childs)
        (wa-compute-wanted c strategy)))))

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

(defvar wa-root-window nil)

(defun wa-add-test-childs ()
  (wa-set-child-windows wa-root-window t
                         '(nil nil)
                         '(14 nil)
                         '(nil nil)
                         '(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" 15 15 nil))
(setq wa-root-window (wa-make-window "Root" 18 15 nil))

;; (wa-child wa-root-window)
;; (wa-wset wa-root-window)
;; (wa-wumin wa-root-window)
;; (wa-wumax 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