;;; -*- package: ccl -*-
;*********************************************************************
;*                                                                   *
;*    W I T H   C H A S I N G   A R R O W S                          *
;*                                                                   *
;*********************************************************************
   ;* Author    : Alexander Repenning (alexandr@agentsheets.com)     *
   ;*             http://www.agentsheets.com                         *
   ;* Copyright : (c) 1996-2003, AgentSheets Inc.                    *
   ;* Filename  : with-chasing-arrows.lisp                           *
   ;* Updated   :  09/01/03                                          *
   ;* Version   :                                                    *
   ;*   1.0     :  09/17/01                                          *
   ;*   1.0.1   :  01/21/01 #_SendControlMessage parameter changed   *
   ;*   2.0     :  04/14/03 Carbon                                   *
   ;*   2.0.1   :  09/01/03 with-focused-view                        *
   ;* HW/SW     : PowerPC G4, MCL 5, OS X 10.2.5                     *
   ;* Abstract  : progress indication wrapper                        *
   ;*                                                                *
   ;******************************************************************

(in-package :ccl)


(export '(with-chasing-arrows))


(defun WITH-CHASING-ARROWS (Window Where Function) "
  in:  Window window;
       Where point; 
       Function lambda ();
  out: Result t.
  Display an animated set of chasing arrows into <Window> at location <Where>
  while calling <Function>"
  (with-focused-view Window
    (with-pstrs ((Title "Progress"))
      (rlet ((Rect :rect :topleft Where :botRight (add-points Where #@(16 16))))
        ;; put Chasing Arrows into window
        (let* ((Control (#_NewControl (wptr Window) Rect Title t 0 0 10 #$kControlChasingArrowsProc 0))
               (Animation-Process 
                ;; don't rely on idle cycles: start independent animation process
                (process-run-function
                 '(:name "chasing arrows"
                   :quantum 1
                   :priority 0)
                 #'(lambda ()
                     (loop
                       (#_SendControlMessage Control #$kControlMsgIdle (%null-ptr)) 
                       (sleep 0.01) )))))
          (prog1
            (funcall Function)
            (process-abort Animation-Process)
            (#_DisposeControl Control)))))))



#| Examples:

(defparameter *Window* (make-instance 'window :color-p t))

(with-chasing-arrows *Window* #@(50 50) #'(lambda () (sleep 2)))


|#