;;;; panes.lisp

(in-package :climi)

;;; This however needs some rewrite for sure.

;;; We have:
;;;  - each client has a minimum, maximum and natural size
;;;  - it might be
;;;    . fixed size
;;;    . proportional size
;;;    . no size given
;;;    . fill

;;; A naïve implementation would allocate fixed space and proportional
;;; space proportional to the whole space available and then allocate
;;; possible fill space and finally allocate what is left to the
;;; unconstrainted panes in proportion to their "stretch-ability".

;;; We however remove the space allocation algorithm from the pane
;;; class to an "abstract" function.

(defun bobo (qs)
  )

#||
(:fixed n)
(:proportional n)
(:fill)
(:within min max natural)
||#

(dada
 ((major   width        height)
  (minor   height       width)
  (xbox    hbox         vbox)
  (xrack   hrack        vrack)
  (xically horizontally vertically)
  (major-spacing x-spacing y-spacing)
  (minor-spacing x-spacing y-spacing)  )

 (defmethod xically-content-sr** ((pane box-layout-mixin) client)
   (let (p)
     (let ((sr (if (box-client-pane client)
                   (compose-space (box-client-pane client))
                   (make-space-requirement :width 0 :min-width 0 :max-width 0
                                           :height 0 :min-height 0 :max-height 0))))
       (cond ((box-client-fillp client)
              (make-space-requirement
               :major     (space-requirement-major sr)
               :min-major (space-requirement-min-major sr)
               :max-major +fill+
               :minor     (space-requirement-minor sr)
               :min-minor (space-requirement-min-minor sr)
               :max-minor (space-requirement-max-minor sr)))
             ((setq p (box-client-fixed-size client))
              (make-space-requirement
               :major     p
               :min-major p
               :max-major p
               :minor     (if sr (space-requirement-minor sr) 0)
               :min-minor (if sr (space-requirement-min-minor sr) 0)
               :max-minor (if sr (space-requirement-max-minor sr) 0)))
             (t
              sr) ))))

 (defmethod xically-content-sr*** ((pane box-layout-mixin) client major)
   (let (p)
     (let ((sr (if (box-client-pane client)
                   (compose-space (box-client-pane client))
                   (make-space-requirement :width 0 :min-width 0 :max-width 0
                                           :height 0 :min-height 0 :max-height 0))))
       (cond ((box-client-fillp client)
              (make-space-requirement
               :major     (space-requirement-major sr)
               :min-major (space-requirement-min-major sr)
               :max-major +fill+
               :minor     (space-requirement-minor sr)
               :min-minor (space-requirement-min-minor sr)
               :max-minor (space-requirement-max-minor sr)))
             ((setq p (box-client-fixed-size client))
              (make-space-requirement
               :major     p
               :min-major p
               :max-major p
               :minor     (if sr (space-requirement-minor sr) 0)
               :min-minor (if sr (space-requirement-min-minor sr) 0)
               :max-minor (if sr (space-requirement-max-minor sr) 0)))
             ((setq p (box-client-proportion client))
              (make-space-requirement
               :major     (clamp (* p major)
                                 (space-requirement-min-major sr)
                                 (space-requirement-max-major sr))
               :min-major (space-requirement-min-major sr)
               :max-major (space-requirement-max-major sr)
               :minor     (if sr (space-requirement-minor sr) 0)
               :min-minor (if sr (space-requirement-min-minor sr) 0)
               :max-minor (if sr (space-requirement-max-minor sr) 0)))
             (t
              sr) ))))

 (defmethod box-layout-mixin/xically-compose-space ((pane box-layout-mixin))
   (let ((n (length (sheet-enabled-children pane))))
     (with-slots (major-spacing) pane
       (loop
           for client in (box-layout-mixin-clients pane)
           for sr = (xically-content-sr** pane client)
           sum (space-requirement-major sr) into major
           sum (space-requirement-min-major sr) into min-major
           sum (space-requirement-max-major sr) into max-major
           maximize (space-requirement-minor sr) into minor
           maximize (space-requirement-min-minor sr) into min-minor
           minimize (space-requirement-max-minor sr) into max-minor
           finally
             (return
               (space-requirement+*
                 (make-space-requirement
                   :major     major
                   :min-major (min min-major major)
                   :max-major (max max-major major)
                   :minor     minor
                   :min-minor (min min-minor minor)
                   :max-minor (max max-minor minor))
                 :min-major (* (1- n) major-spacing)
                 :max-major (* (1- n) major-spacing)
                 :major     (* (1- n) major-spacing)
                 :min-minor 0
                 :max-minor 0
                 :minor     0))))))

  (defmethod box-layout-mixin/xically-allocate-space-aux* ((box box-layout-mixin) width height)
   (declare (ignorable width height))
   (let ((children (reverse (sheet-enabled-children box))))
     (with-slots (major-spacing) box
       (let* ((content-srs (mapcar #'(lambda (c) (xically-content-sr*** box c major))
                                   (box-layout-mixin-clients box)))
              (allot       (mapcar #'ceiling (mapcar #'space-requirement-major content-srs)))
              (wanted      (reduce #'+ allot))
              (excess      (- major wanted
                              (* (1- (length children)) major-spacing))))
          (when *dump-allocate-space*
	    (format *trace-output* "~&;; ~S ~S~%"
		    'box-layout-mixin/xically-allocate-space-aux* box)
	    (format *trace-output* "~&;;   major = ~D, wanted = ~D, excess = ~D, allot = ~D.~%"
                   major wanted excess allot))

         (let ((qvector
                (mapcar
                 (lambda (c &aux p)
                   (cond
                     ((box-client-fillp c)
                      (vector 1 0 0))
                     (t
                      (vector 0 0
                              (abs (- (if (> excess 0)
                                          (space-requirement-max-major (xically-content-sr*** box c major))
                                          (space-requirement-min-major (xically-content-sr*** box c major)))
                                      (space-requirement-major (xically-content-sr*** box c major))))))))
                 (box-layout-mixin-clients box))))
           ;;
           (when *dump-allocate-space*
             (format *trace-output* "~&;;   old allotment = ~S.~%" allot)
             (format *trace-output* "~&;;   qvector = ~S.~%" qvector)
             (format *trace-output* "~&;;   qvector 0 = ~S.~%" (mapcar #'(lambda (x) (elt x 0)) qvector))
             (format *trace-output* "~&;;   qvector 1 = ~S.~%" (mapcar #'(lambda (x) (elt x 1)) qvector))
             (format *trace-output* "~&;;   qvector 2 = ~S.~%" (mapcar #'(lambda (x) (elt x 2)) qvector)))
           ;;
           (dotimes (j 3)
             (let ((sum (reduce #'+ (mapcar (lambda (x) (elt x j)) qvector))))
               (unless (zerop sum)
                 (setf allot
                       (mapcar (lambda (allot q)
                                 (let ((q (elt q j)))
                                   (let ((delta (ceiling (if (zerop sum) 0 (/ (* excess q) sum)))))
                                     (decf excess delta)
                                     (decf sum q)
                                     (+ allot delta))))
                               allot qvector))
		 (when *dump-allocate-space*
		   (format *trace-output* "~&;;   new excess = ~F, allotment = ~S.~%" excess allot)) )))
           ;;
	   (when *dump-allocate-space*
	     (format *trace-output* "~&;;   excess = ~F.~%" excess)
	     (format *trace-output* "~&;;   new allotment = ~S.~%" allot))

           (values allot
                   (mapcar #'ceiling (mapcar #'space-requirement-minor content-srs))) )))))

 (defmethod box-layout-mixin/xically-allocate-space-aux* :around ((box rack-layout-mixin) width height)
   (declare (ignorable width height))
   (multiple-value-bind (majors minors) (call-next-method)
     (values majors
             (mapcar (lambda (x) x minor) minors))))

 (defmethod box-layout-mixin/xically-allocate-space ((pane box-layout-mixin) width height)
   (with-slots (major-spacing) pane
     (multiple-value-bind (majors minors) (box-layout-mixin/xically-allocate-space-aux* pane width height)
       ;; now actually layout the children
       (let ((x 0))
         (loop
             for child in (box-layout-mixin-clients pane)
             for major in majors
             for minor in minors
             do
               #+nil (format *trace-output* "~&;;   child ~S at 0, ~D ~D x ~D~%" child x width height)
               (when (box-client-pane child)
                 (move-sheet (box-client-pane child)
                             ((lambda (major minor) height width) x 0)
                             ((lambda (major minor) width height) x 0))
                 (allocate-space (box-client-pane child)
                                 width height))
               (incf x major)
               (incf x major-spacing)))))))