;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;___________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Scrolling
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Hubertus Hohl
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/scrolling.lisp
;;; File Creation Date: 6/11/90 10:30:11
;;; Last Modification Time: 01/29/91 16:43:57
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;___________________________________________________________________________

(in-package :xit)


;____________________________________________________________________________
;
;                           Scrollable Window Mixin
;____________________________________________________________________________

;;; The area of a window that has output (e.g. graphics or subwindows) on 
;;; is called the extent of the window. The geometry of window's extent 
;;; is determined by two methods: extent-origin and extent-size.
;;; 
;;; Scrolling a window horizontally or vertically means moving the position 
;;; of the extent's origin with respect to the window. This is performed by 
;;; the methods scroll-to and scroll-relative. When implementing these methods
;;; for specific contact classes (together with any other methods that modify 
;;; window's extent) care must be taken to update interaction-objects
;;; that visualize extent's position (i.e. scroll-bars, panners, ...).

(defclass scrollable-window-mixin ()
  ((origin :type point :initform (point 0 0)
	   :documentation "origin of window's extent")))

;;;
;;; scrolling methods: to be specialized by subclasses
;;;

(defmethod extent-origin ((self scrollable-window-mixin))
  "Returns origin of window's extent relative to window's origin."
  (with-slots (origin) self
     origin))

(defmethod extent-size ((self scrollable-window-mixin))
  "Returns current width and height of window's extent."
  (values 16 16)) ; to be changed by subclasses

(defmethod scroll-to ((self scrollable-window-mixin) &optional x y)
  "Scroll to specified position (relative to window's origin).
   (a value of nil for x and/or y means not to scroll this direction)"
  (declare (ignore x y))
  self)

(defmethod scroll-relative ((self scrollable-window-mixin) dx dy)
  "Scroll specified amount relative to current position.
   Positive (negative) values indicate right (left) and/or bottom (top) directions."
  (declare (ignore dx dy))
  self)

(defmethod x-raster ((self scrollable-window-mixin))
  "Returns horizontal raster unit length.
   (e.g character-width of a text-oriented window)"
  16)

(defmethod y-raster ((self scrollable-window-mixin))
  "Returns vertical raster unit length.
  (e.g line-height of a text-oriented window)"
  16)

;;;
;;; the following is called by scroll-to and scroll-relative 
;;; to compute (and constraint) the new scroll position.
;;;
 
(defmethod new-scroll-position ((self scrollable-window-mixin) x y
				&optional (mode :absolute))
  ;; returns new coordinates of extent's origin (or nil if unchanged)
  (declare (type (member :absolute :relative) mode)
	   (values new-x new-y))
  (let* ((origin (extent-origin self))
	 (ox (point-x origin))
	 (oy (point-y origin))
	 new-x new-y)
    (multiple-value-bind (extent-width extent-height) (extent-size self)
      (if (eq mode :absolute)
	  (values
	    (and x
		 (/= ox
		     (setq new-x
			   (max (min 0 (- (x-raster self) extent-width))
				(min 0 x))))
		 new-x)
	    (and y
		 (/= oy
		     (setq new-y
			   (max (min 0 (- (y-raster self) extent-height))
				(min 0 y))))
		 new-y))
	  (values
	    (and x
		 (not (zerop x))
		 (/= ox 
		     (setq new-x
			   (max (min 0 (- (x-raster self) extent-width))
				(min (+ ox x) 0))))
		 new-x)
	    (and y
		 (not (zerop y))
		 (/= oy 
		     (setq new-y
			   (max (min 0 (- (y-raster self) extent-height))
				(min (+ oy y) 0))))
		 new-y))))))

;;;
;;; extended scrolling methods that call scroll-to, scroll-relative, x/y-raster
;;;

(defmethod scroll-x-raster ((self scrollable-window-mixin) &optional raster-units pixels)
  "Scroll <raster-units> or <pixels> amount horizontally.
   Positive (negative) values indicate scrolling right (left)."
  (scroll-relative self
		   (if raster-units
		       (* raster-units (x-raster self))
		       (or pixels
			   (x-raster self)))
		   0))

(defmethod scroll-y-raster ((self scrollable-window-mixin) &optional raster-units pixels)
  "Scroll <raster-units> or <pixels> amount vertically.
   Positive (negative) values indicate scrolling downwards (upwards)."
  (scroll-relative self
		   0
		   (if raster-units
		       (* raster-units (y-raster self))
		       (or pixels
			   (y-raster self)))))

(defmethod scroll-home ((self scrollable-window-mixin))
  "Scroll to origin of window's extent."
  (scroll-to self 0 0))

(defmethod scroll-x-screenful ((self scrollable-window-mixin)
			       &optional (screenfulls 1))
  "Scroll amount of <screenfulls> horizontally.
   Positive (negative) values indicate scrolling right (left)."
  self)  ; to be filled by subclasses

(defmethod scroll-y-screenful ((self scrollable-window-mixin)
			       &optional (screenfulls 1))
  "Scroll amount of <screenfulls> vertically.
   Positive (negative) values indicate scrolling downwards (upwards)."
  self)  ; to be filled by subclasses

(defmethod scroll-x-percent ((self scrollable-window-mixin) percent)
  "Scroll to <percent> percent of window's horizontal extent."
  (multiple-value-bind (width height) (extent-size self)
    (declare (ignore height))
    (scroll-to self (- (round (* width percent))))))

(defmethod scroll-y-percent ((self scrollable-window-mixin) percent)
  "Scroll to <percent> percent of window's vertical extent."
  (multiple-value-bind (width height) (extent-size self)
    (declare (ignore width))
    (scroll-to self nil (- (round (* height percent))))))

(defmethod scroll-to-border ((self scrollable-window-mixin) direction)
  "Scroll to specified boundary (:north, :south, :east or :west) 
   of window's extent."
  (case direction
    (:north (scroll-to self nil 0))
    (:south (multiple-value-bind  (width height) (extent-size self)
	      (declare (ignore width))
	      (scroll-to self nil (- height))))
    (:west (scroll-to self 0))
    (:east (multiple-value-bind (width height) (extent-size self)
	     (declare (ignore height))
	     (scroll-to self (- width))))))


