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

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

;;; gc -- as all objects mapped on X resources it is an object of a screen
;;;       rather than a display. The gc is created with the initial listofvalue
;;;       in the mask object 'data'. Data can be #f in which case server 
;;;       defaults will be used.
(module gc)

(include "../include/requests.sch")
(include "../include/masks.sch")
(include "../include/util.sch")
(include "../include/lw-objects.sch")

(include "../macros/extend-syntax.sc")
(include "../macros/define-class.sc")

(define-class (gc data drawable &optional id)
  (locals
   (scr (drawable 'screen))
   (value-mask (make-gc-value-mask)) )
  (inherit (resource scr (if (null? id)
			     #f
			     (car id))))
  (methods
   (drawable (lambda () drawable))	; Needed by some requests.
   (screen (lambda () scr))		; Needed by graphics operations.
   (mask (lambda () value-mask))
   
   ;; Messages mapped directly on requests
   (queryfont (lambda rest		  ; #47: QueryFont (also in font)
		(send-queryfont me scr rest) ))
   (querytextextents (lambda (str . rest) ;#48: QueryTextExtents (also in font)
		       (send-querytextextents me str scr rest) ))
   (creategc (lambda (data . rest)	               ; #55: CreateGC
	       (value-mask 'or-mask! data)
	       (send-creategc me data scr rest) ))
   (changegc (lambda (data . rest)   		       ; #56: ChangeGC
	       (value-mask 'or-mask! data)
	       (send-changegc me data scr rest) ))   
   (copygc (lambda (source data . rest)	               ; #57: CopyGC
	     (value-mask 'or-mask! data)
	     (send-CopyGC source me data scr rest) ))
   (setdashes (lambda (offset dash-list . rest)        ; #58: SetDashes
		(send-setdashes me offset dash-list scr rest) ))
   (setcliprectangles (lambda (ordering x-orig y-orig  ; #59: SetClipRectangles
					rec-list . rest) 
			(send-setcliprectangles ordering me x-orig y-orig
						rec-list scr rest) ))
   (freegc (lambda rest			               ; #60: FreeGC
	     (me 'scix-denounce-id!)
	     (send-freegc me scr rest) ))
   )
  
  ;; The init routine
  (init (me 'creategc data)
	(if (or (null? id)		; i e top-level 
		(number? (car id)) )	; i e id given by server
	    (me 'scix-announce-id! me) )) )