Re: animated cursors

["Mark A. Tapia" <markt@dgp.toronto.edu>]

On Tue Mar 22, Nichole Denise Pinkard  writes:
  I have created an animated cursor resource (ACURS) in ResEdit. 
  Unfortunately, I have not been able to figure out how to use it in MCL. 
  Has anyone used animated cursors in MCL?  All of the MCL documentationon
  cursors is about regular cursor resources (CURS) and these functions do not
  accept an ACURS resource.

The following code, written by  Derek White, uses acur resources and the
CURS resources in a resource file.

mark

---> start of code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;      animated-cursor.lisp
;;
;;      3/9/93 Derek White
;;
;;      'acur' resources specify a sequence of cursors to cycle through
;;      to get spinning ball cursors, etc.
;;      'acur' resources are documented in the MPW manuals (they are
;;      essentially a count followed by an array of 'CURS' resource ids)
;;      The 'acur' reource and the 'CURS' resources it refers to must exist
;;      in an open resource file.
;;
;;      The finder seems to use 'acur' #6500, so you could copy it to your
;;      resource file.
;;
;;      with-animated-cursor id-or-object       &body           [macro]
;;      This form automatically spins the cursor according to id-or-object.
;;      (Use this like with-cursor).
;;      Cursor spins when update-cursor is called and null-event-handlers
;;      call update-cursor.  This happens a little slowly, so you may want
;;      call (update-cursor) or event-dispatch yourself.
;;
;;      id-or-object    Can be an integer specifying the id of the 'acur'
;;                      resource to use, or it can be an animated-cursor object 
you
;;                      may have gotten with make-animated-cursor.
;;
;;      make-animated-cursor id                 [function]
;;      id      An integer specifying the id of the 'acur'
;;              resource to use.
;;
;;      This file is stand alone (no dependencies on my world, etc.)
 
(in-package ccl)
 
(export '( with-animated-cursor
           make-animated-cursor
           ))
 
(defrecord (acur :handle)
  (count :integer)
  (pad :integer)
  ; Array is [id-0, pad, id-1, pad,...], so multiply n by 2 to get the nth id.
  (array (array :integer 40))) ; the array is actually variable.
 
(defclass animated-cursor ()
  ((count :reader animated-cursor-count :initarg :count)
   (stamp :accessor animated-cursor-stamp :initform 0)
   (index :accessor animated-cursor-index :initarg :index)
   (ids :reader animated-cursor-ids :initarg :ids)))
 
(defun make-animated-cursor (acur-id)
  ; Make an animated-cursor corresponding to the 'acur' resource.
  ; This gets and releases the resource.
  (let ((acur-hdl nil))
    (check-type acur-id integer)
    (unwind-protect
      (progn
        (setf acur-hdl (#_GetResource :|acur| acur-id))
        (let ((err (#_ResError)))
          (unless (eql 0 err)
            (%err-disp err)))
        (when (%null-ptr-p acur-hdl)
          (error "'acur' resource #~d does not exist." acur-id))
        (let* ((count (href acur-hdl :acur.count))
               (ids (make-array count :element-type 'integer)))
          (dotimes (n count)
            (setf (svref ids n) (href acur-hdl (acur.array (* n 2)))))
          (make-instance 'animated-cursor
            :count count
            :ids ids
            :index (aref ids 0))))
      (when (and acur-hdl (not (%null-ptr-p acur-hdl)))
        (#_ReleaseResource acur-hdl)))))
 
(defconstant $rotate-delay 120)
 
(defun rotate-animated-cursor (animated-cursor)
  (without-interrupts
   (let ((new-stamp (get-internal-real-time)))
     (when (> new-stamp (+ $rotate-delay (animated-cursor-stamp
                                          animated-cursor)))
       (setf (animated-cursor-stamp animated-cursor) new-stamp)
       (let ((index (+ 1 (animated-cursor-index animated-cursor))))
         (when (>= index (animated-cursor-count animated-cursor))
           (setf index 0))
         (setf (animated-cursor-index animated-cursor) index)
         (set-cursor (aref (animated-cursor-ids animated-cursor) index)))))))
 
(defmacro with-animated-cursor (id-or-object &body body)
  ; id-or-object is usually the 'acur' resource id to use,
  ; but it can be an animated-cursor object.
  ; During the execution of body, the cursor will cycle through the
  ; cursors specified by the 'acur' resource.
  (let ((var (gensym)))
    `(let ((,var ,id-or-object))
       (when (integerp ,var)
         (setf ,var (make-animated-cursor ,var)))
       (with-cursor #'(lambda ()
                        (rotate-animated-cursor ,var))
         ,@body))))
 
#| - tests:
 
(with-animated-cursor 6500
  (let ((x 10))
    (dotimes (i 9999999999999)
      ; (update-cursor)
      (setf x (+ x i))
      (when (> x 9999)
        (setf x 0)))))
 
(with-animated-cursor 6500
  )
   (make-animated-cursor 1000)
|#