;; scvp.jl -- sensible animated viewport scroll
;; $Id$

;; Copyright (C) 2000 Walter C. Pelissero <walter@pelissero.org>

;; This file is not yet part of sawmill.

;; This module is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 2, or (at your
;; option) any later version.

;; This module is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with sawmill; see the file COPYING.  If not, write to the
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; Usage:
;;	(require 'scvp)

(defcustom scvp-max-time 1000
  "Max time in milliseconds to scroll between viewports."
  :group workspace
  :type number
  :range (1 . nil))

(defcustom scvp-max-steps 64
  "Maximum number of steps in which to scroll between viewports (less steps = faster scrolling)."
  :group workspace
  :type number
  :range (1 . nil))

(defun scvp-scroll-viewport (x y)
  "Scroll between viewports taking care of system load.  This function
replaces set-viewport implementing an algorithm that gives the feeling
of smooth scrolling between viewports.  The function scrolls in at
most scvp-max-steps steps and within scvp-max-time, freeing the user
from fine tuning scvp-max-steps according to every possible load
condition.  The viewport-moved-hook is called appropriately only at
the end of the warp, avoiding funny behaviors like playing the same
warp sound one hundred times."
  (let ((end-epoch (+ (current-utime) (* scvp-max-time 1000)))
	(step-time (quotient scvp-max-time scvp-max-steps))
	(step-count scvp-max-steps)
	(xstep (quotient (- x viewport-x-offset) scvp-max-steps))
	(ystep (quotient (- y viewport-y-offset) scvp-max-steps)))
    (if (and (= xstep 0) (= ystep 0))
	(setq step-count 0))
    (with-server-grabbed
     (let ((old-hook viewport-moved-hook))
       (setq viewport-moved-hook '())
       (unwind-protect
	   (while (> step-count 0)
	     (scvp-orig-set-viewport (- x (* xstep step-count))
				     (- y (* ystep step-count)))
	     (setq step-count (min (quotient (- end-epoch (current-utime)) step-time)
				   (- step-count 1))))
	 (setq viewport-moved-hook old-hook))))
    (scvp-orig-set-viewport x y)))

(defvar scvp-orig-set-viewport set-viewport)
(setq set-viewport scvp-scroll-viewport)