;;;-*- Mode: Lisp; Package: CCL -*-

;;; -----------------------------------------------------------------------------------
;;; WINDOW-AVOIDANCE-MIXIN, when mixed in with a window class, affects the zoomed size
;;; and position of a window in such a way as to avoid being overlapped by other window
;;; classes, provided certain conditions are met. This is very useful when working with 
;;; tool palette windoids. 
;;;
;;; An instance of a given window/windoid class (AWCI) will be avoided if
;;;    1) at least part of the AWCI is outside of the window's area
;;;    2) the AWCI is close to an edge of the screen
;;;    3) the *longest* side of the AWCI is the one closest to the edge
;;;
;;; This allows the user to position any AWCIs along the edges of the screen,
;;; then zoom a window to occupy the free space between them. Any AWCIs in the
;;; middle of this free area (i.e. not near to any edge) will be treated as "free"
;;; AWCIs. Rule (1) makes it possible to use the full size of the screen, if the
;;; user so wishes.
;;;
;;; The user can customize the behaviour by specializing VIEW-AVOIDANCE-BOUNDARIES.
;;;
;;; AVOID-WINDOIDS-MIXIN is a specialization of WINDOW-AVOIDANCE-MIXIN which is used
;;; to avoid windoids.
;;; -----------------------------------------------------------------------------------
;;;    
;;;    Peter Bengtson
;;;    Igor Technologies
;;;    http://www.igortech.pi.se


;;; Revisions:
;;;   96-FEB-12: Renamed this file to "avoidance.lisp".
;;;              - Removed the IN-PACKAGE and EXPORT calls.
;;;   96-FEB-08: Adam Alpern. Generalized code.
;;;              - renamed VIEW-NON-WINDOID-BOUNDARIES to
;;;                view-avoidance-boundaries
;;;              - avoid-windoids-mixin is now a subclass of
;;;                window-avoidance-mixin. Can take a :Avoid
;;;                initarg which should be a list of window/windoid
;;;                classnames to avoid
;;;   96-JAN-28: VIEW-NON-WINDOID-BOUNDARIES is now a method
;;;   96-JAN-28: First version


(in-package :ccl)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (export '(avoid-windoids-mixin
            window-avoidance-mixin
            view-avoidance-boundaries)
         :ccl))


(defclass window-avoidance-mixin ()
  ((avoid :initarg :avoid :initform nil :accessor avoid)))

(defclass avoid-windoids-mixin (window-avoidance-mixin) ()
  (:default-initargs :avoid '(windoid)))


(defun view-boundaries (view)
  (let* ((top (point-v (view-position view)))
         (left (point-h (view-position view)))
         (bottom (+ top (point-v (view-size view))))
         (right (+ left (point-h (view-size view)))))
    (values top left bottom right)))

(defun horizontal-side-longest-p (top left bottom right)
  (> (- right left) (- bottom top)))

(defun near-left-screen-edge-p (top left bottom right)
  (and (not (horizontal-side-longest-p top left bottom right))
       (< left (- right left))))

(defun near-top-screen-edge-p (top left bottom right)
  (and (horizontal-side-longest-p top left bottom right)
       (< top (- bottom top))))

(defun near-right-screen-edge-p (top left bottom right)
  (and (not (horizontal-side-longest-p top left bottom right))
       (< (- *screen-width* right) (- right left))))

(defun near-bottom-screen-edge-p (top left bottom right)
  (and (horizontal-side-longest-p top left bottom right)
       (< (- *screen-height* bottom) (- bottom top))))


(defmethod view-avoidance-boundaries ((self window-avoidance-mixin))
  (when (avoid self)
    (multiple-value-bind (stop sleft sbottom sright)
                         (view-boundaries self)
      (let* ((top    (point-v *window-default-zoom-position*))
             (left   (point-h *window-default-zoom-position*))
             (bottom (+ top (point-v *window-default-zoom-size*)))
             (right  (+ left (point-h *window-default-zoom-size*)))
             windows)
        (dolist (class (avoid self))
          (setq windows
                (append (windows :class class
                                 :include-invisibles nil
                                 :include-windoids t)
                        windows)))
        (let ((fn #'(lambda (w)
                      (multiple-value-bind (wtop wleft wbottom wright)
                                           (view-boundaries w)
                        (cond ((and (>= wtop stop) (>= wleft sleft)
                                    (<= wbottom sbottom) (<= wright sright))
                               nil)
                              ((near-left-screen-edge-p wtop wleft wbottom wright)
                               (setq left (max left (+ wright 4))))
                              ((near-right-screen-edge-p wtop wleft wbottom wright)
                               (setq right (min right (- wleft 4))))
                              ((near-top-screen-edge-p wtop wleft wbottom wright)
                               (setq top (max top (+ wbottom 22))))
                              ((near-bottom-screen-edge-p wtop wleft wbottom wright)
                               (setq bottom (min bottom (- wtop 14))))
                              (t nil))))))
          (unwind-protect
            (dolist (w windows)
              (funcall fn w))
            (ccl::cheap-free-list windows)))
        (values left top bottom right)))))

(defmethod window-default-zoom-position ((self window-avoidance-mixin))
  (multiple-value-bind (left top bottom right)
                       (view-avoidance-boundaries self)
    (declare (ignore bottom right))
    (make-point left top)))

(defmethod window-default-zoom-size ((self window-avoidance-mixin))
  (multiple-value-bind (left top bottom right)
                       (view-avoidance-boundaries self)
    (make-point (- right left) (- bottom top))))



#|

(defclass avoidance-fred-window (window-avoidance-mixin fred-window ) ())

(make-instance 'avoidance-fred-window
  :avoid '(windoid listener))

(defclass avoidance-listener (window-avoidance-mixin listener) ())

(make-instance 'avoidance-listener
  :avoid '(fred-window))

|#