;;; 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 nil 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 2 (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)) ;; 'child
(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 2 (nth 4 window)) size))  ;; 'set-size

(defun wa-set-flag   (window flag)  (setcar (nthcdr 1 (nth 4 window)) flag))  ;; 'set-size

(defvar wa-failed nil)

(defun wa-error (format-string &rest args)
  (setq wa-failed t)
  (apply 'message (propertize format-string 'face 'secondary-selection)
         args)
  (throw 'wa-error nil))

(defun wa-win-error (win format-string &rest args)
  (wa-set-flag win (concat "FAILED: " (apply 'format format-string args)))
  (apply 'wa-error format-string args))

(defun wa-set-child-windows (parent vertical &rest sizes)
  (unless wa-failed (assert (< 1 (length sizes)) t))
  (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)
    parent))

(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)))
    (wa-set-flag win 'FAILED)
    ;; Top window
    (when (and wset wrmin)
      (unless (<= wrmin wset)
        (wa-win-error win "Window %s set size too small=%d, min=%d" (wa-name win) wset wrmin)))
    (when (and wset wrmax)
      (unless (>= wrmax wset)
        (wa-win-error win "Window %s set size too large=%d, max=%s" (wa-name win) wset wrmax)))
    ;; All
    (when (and wumax wrmin)
      (unless (<= wrmin wumax)
        (wa-win-error win "Window %s is too small, min=%d, but can be max=%d" (wa-name win) wrmin wumax)))
    (when (and wrmax wumin)
      (unless (>= wrmax wumin)
        (wa-win-error win "Window %s's childs are too small, max=%d, but can be min=%d" (wa-name win) wrmax wumin)))
    (wa-set-flag win 'OK)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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-init-fail-flag (win)
  (wa-set-flag win 'INIT)
  (dolist (c (wa-child win))
    (wa-init-fail-flag 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))
    (unless wa-failed (assert (or (not cmin) (<= 1 cmin)) t))
    (unless wa-failed (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-resulting (win strategy)
  "Walk down compute resulting sizes and apply them."
  ;; NOTE: This is the part that can tie into the C functions. This
  ;; computes the sizes to apply level by level when going down.
  ;;
  ;; To apply it to the C level I suggest implementing a function in C
  ;; that accept a list of sizes, one size per window on that
  ;; level. Walk the C structures in parallell with this when applying
  ;; the sizes. (I do not think it is necessary to have this code in
  ;; C.)
  (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 (wa-error "Unknown strategy: %s" strategy)))
      ;; Check
      (let ((w 0))
        (dolist (c childs)
          (let ((wset (wa-wset c)))
            (unless wa-failed (assert (<= 0 wset) t))
            (setq w (+ w wset))))
        (unless (= w (wa-wset win))
          (wa-error "Bad set sizes child sum w=%d, win width=%d" w (wa-wset win))))
      ;; Call the suggested C level function here for example.
      ;; .......
      ;; Walk down
      (dolist (c childs)
        (wa-compute-resulting c strategy)))))


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

(defvar wa-root-window nil)

(defun wa-add-test-childs ()
  (wa-set-child-windows wa-root-window t
                         '(nil 12)
                         '(14 nil)
                         '(nil nil)
                         '(3 nil)
                         )
  (wa-set-child-windows (car (wa-child wa-root-window)) t
                        '(nil nil)
                        '(8 15))
  )

;; (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)

;; Setup
(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" 43 15 nil))
(setq wa-root-window (wa-make-window "Root" 18 15 nil))
(setq wa-root-window (wa-make-window "Root" 15 15 nil))

(wa-add-test-childs)
(wa-init-fail-flag     wa-root-window)
(setq wa-failed nil)

;; Show state now in case we want to stop on errors
(describe-variable    'wa-root-window)

;; Compute required, may fail.
(catch 'wa-error
  (wa-compute-required wa-root-window)

  ;; Now it should not fail
  (wa-compute-resulting  wa-root-window 'eq-sizes))

;; Show final state
(describe-variable    'wa-root-window)
(with-current-buffer (help-buffer)
  (hi-lock-face-buffer "\"FAILED.*\"" 'hi-red-b)
  (hi-lock-face-buffer "OK" 'hi-green)
  (hi-lock-face-buffer "INIT" 'hi-blue))


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