;;;
;;;              Copyright 1990 by Digital Equipment AB, Sweden
;;;
;;;                                  and
;;;
;;;                       Hakan Huss and Johan Ihren
;;;
;;;                           All Rights Reserved
;;;
;;;    Permission to use, copy, modify, and distribute this software and
;;;    its documentation for any purpose and without fee is hereby
;;;    granted, provided that the above copyright notice appear in all
;;;    copies and that both that copyright notice and this permis-
;;;    sion notice appear in supporting documentation, and that the
;;;    names of the copyright holders not be used in advertising in
;;;    publicity pertaining to distribution of the software without
;;;    specific, written prior permission. The copyright holders make no
;;;    representations about the suitability of this software for any
;;;    purpose. It is provided "as is" without express or implied warranty.
;;;
;;;    THE COPYRIGHT HOLDERS DISCLAIM ALL WARRANTIES WITH REGARD TO
;;;    THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANT-
;;;    ABILITY AND FITNESS, IN NO EVENT SHALL THE COPYRIGHT HOLDERS
;;;    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;;;    ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
;;;    PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
;;;    TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE
;;;    OR PERFORMANCE OF THIS SOFTWARE.
;;;
;;;    Authors: Hakan Huss, KTH and Johan Ihren, KTH
;;;

;;; The SCIX Cursor Object.

;;; $Header: /deneb/src0/johani/scix-0.96/src/RCS/cursor-object.sc,v 1.4 90/04/01 13:50:01 johani Exp $

(define-class (cursor fore-color back-color scr &optional id)
  (inherit (resource scr (if (null? id)
			     #f
			     (car id))))
  (methods
   (fore-color (lambda () fore-color))
   (back-color (lambda () back-color))

   (createcursor (lambda (src mask x-hot y-hot . rest) ; #93: CreateCursor
		   (send-CreateCursor me src mask fore-color back-color
				      x-hot y-hot scr rest) ))   
   (createglyphcursor (lambda (src mask src-char mask-char . rest) ; #94
			(send-createglyphcursor me src mask src-char
						mask-char fore-color
						back-color scr rest) ))   
   (freecursor (lambda rest			; #95: FreeCursor
		 (me 'scix-denounce-id!)
		 (send-freecursor me scr rest) ))
   (recolorcursor (lambda (f-color b-color . rest)	; #96: RecolorCursor
		    (set! fore-color f-color)
		    (set! back-color b-color)
		    (send-recolorcursor me fore-color back-color scr rest) )) )
  
  (init (if (or (null? id)		; i e top-level 
		(number? (car id)) )	; i e id given by server
	    (me 'scix-announce-id! me) ))
  )