;;;; panes.lisp

(in-package :climi)

(defclass scroller-pane (composite-pane)
  ((scroll-bar :type (member t :vertical :horizontal)
	       :initform t
	       :initarg :scroll-bar
	       :accessor scroller-pane-scroll-bar)
   (viewport   :initform nil)
   (vscrollbar :initform nil)
   (hscrollbar :initform nil))
  (:default-initargs
   :background +white+))

(defmethod compose-space ((pane scroller-pane) &key width height)
  (declare (ignore width height))
  (with-slots (viewport vscrollbar hscrollbar) pane
    (if viewport
        (let ((req
               ; v-- where does this requirement come from?
               ;     a: just an arbitrary default
		(make-space-requirement
                :width 300 :height 300 :max-width +fill+ :max-height +fill+
                :min-width 30
                :min-height 30)
		#+nil
		(make-space-requirement :height +fill+ :width +fill+)))
          (when vscrollbar
            (setq req (space-requirement+*
                        (space-requirement-combine #'max
                              req
                              (compose-space vscrollbar))
                        :height     *scrollbar-thickness*
                        :min-height *scrollbar-thickness*
                        :max-height *scrollbar-thickness*)))
          (when hscrollbar
            (setq req (space-requirement+*
                        (space-requirement-combine #'max
                              req
                              (compose-space hscrollbar))
                        :width     *scrollbar-thickness*
                        :min-width *scrollbar-thickness*
                        :max-width *scrollbar-thickness*)))
          req)
        (make-space-requirement))))

(defmethod allocate-space ((pane scroller-pane) width height)
  (with-slots (viewport vscrollbar hscrollbar) pane
    (let ((viewport-width  (if vscrollbar (- width  *scrollbar-thickness*) width))
          (viewport-height (if hscrollbar (- height *scrollbar-thickness*) height)))
      
      (when vscrollbar
        (setf (sheet-transformation vscrollbar)
              (make-translation-transformation 0 0))
        (allocate-space vscrollbar
                        *scrollbar-thickness*
                        (if hscrollbar (- height *scrollbar-thickness*) height)))
      (when hscrollbar
        (move-sheet hscrollbar
                    (if vscrollbar
                        *scrollbar-thickness*
                        0)
                    (- height *scrollbar-thickness*))
        (allocate-space hscrollbar
                        (if vscrollbar (- width *scrollbar-thickness*) width)
                        *scrollbar-thickness*))
      ;;
      ;; Recalculate the gadget-values of the scrollbars
      ;;
      (when vscrollbar
        (let* ((scrollee (first (sheet-children viewport)))
               (min 0)
               (max (- (max (space-requirement-height (compose-space scrollee))
                            viewport-height)
                       viewport-height))
               (ts  viewport-height)
               (val (if (zerop (gadget-max-value vscrollbar))
                        0
                        (* (/ (gadget-value vscrollbar) (gadget-max-value vscrollbar))
                           max))))
          (setf (gadget-min-value vscrollbar) min
                (gadget-max-value vscrollbar) max
                (scroll-bar-thumb-size vscrollbar) ts
                (gadget-value vscrollbar :invoke-callback nil) val)))
      
      (when hscrollbar
        (let* ((scrollee (first (sheet-children viewport)))
               (min 0)
               (max (- (max (space-requirement-width (compose-space scrollee))
                            viewport-width)
                       viewport-width))
               (ts  viewport-width)
               (val (if (zerop (gadget-max-value hscrollbar))
                        0
                        (* (/ (gadget-value hscrollbar) (gadget-max-value hscrollbar))
                           max))))
          (setf (gadget-min-value hscrollbar) min
                (gadget-max-value hscrollbar) max
                (scroll-bar-thumb-size hscrollbar) ts
                (gadget-value hscrollbar :invoke-callback nil) val)))

      (when viewport
        (setf (sheet-transformation viewport)
              (make-translation-transformation
                   (+ 5 (if vscrollbar *scrollbar-thickness* 0))
                   (+ 5 0)))
        (allocate-space viewport
                        (- viewport-width 10)
                        (- viewport-height 10))))))