;;;
;;;              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 Font Object.

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

(eval-when (compile eval load)
  (define-class (font fontname scr &optional id)
    (inherit (resource scr (if (null? id)
			       #f
			       (car id))))
    (methods
     (fontname (lambda () fontname))
     (openfont (lambda (font-name . rest)		; #45: OpenFont
		 (set! fontname font-name)
		 (send-openfont me font-name scr rest) ))
     (closefont (lambda rest			; #46: CloseFont
		  (me 'scix-denounce-id!)
		  (set! fontname #f)
		  (send-closefont me scr rest) ))
     (queryfont (lambda rest			; #47: QueryFont (also in gc)
		  (send-queryfont me scr rest) ))
     ;; #48: QueryTextExtents (also in gc)
     (querytextextents (lambda (string . rest)
			 (send-querytextextents me string scr rest) ))
     )
    ;; The small init routine
    (init (send-openfont me fontname scr)
	  (if (or (null? id)		; i e top-level 
		  (number? (car id)) )	; i e id given by server
	      (me 'scix-announce-id! me) ))
    )
  ) ;; End of eval-when