;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(MEDFNB hl12B hl12bi) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.

;;; Change history:
;;;
;;;  Date       Author	Description
;;; -------------------------------------------------------------------------------------
;;; 05/10/89    DAN     Fix COPY-GC to check for clip-rectangle in destination-gc.
;;; 04/04/89	WJB	Patch 1.70; In CREATE-DEFAULT-GC, initialize the screen slot 
;;; 12/113*/88    LGO     1Decode graphics-exposures correctly in change-gcontext*
;;; 12/113*/88    LGO     1Cache the default font.*
;;; 12/018*/88    LGO     1Make copy-gc propagate the clip-origin to the clip-rectangle*
;;; 12/018*/88    LGO     1Replace gcontext.rectangle-list with gcontext.clip-rectangle*
;;; 12/07/88    LGO     Check for valid gcontext pixmap in change-gc-components1.*
;;;  9/30/88    LGO     Ensure GC tile and stipple are have tiled pixmaps
;;;  9/29/88    LGO     COPY-GC was copying all fields, regardless of the value mask.  Fixed.
;;;  9/29/88	WJB	Initialize RECTANGLE-LIST slot in CREATE-SCRATCH-GC
;;;  9/08/88    DAN     Fixed FREE-GC to clear the cache.
;;;  8/15/88	WJB	In CREATE-SCRATCH-GC removed the initialization of :FONT to
;;;			*DEFAULT-CURSOR-FONT* (which is a string).  Also used
;;;			allocate-resource rather than using-resource.  Re-worked the code a bit too.
;;;			Added FREE-SCRATCH-GC, just for completeness.
;;;  7/28/88    DAN	Added CREATE-SCRATCH-GC, GET-SCRATCH-GC, and CREATE-PRIVATE-GC.
;;;  4/14/88    TWE	Changed change-gc-components to set the clip-mask to NIL when the
;;;			clip-mask is being set to None.
;;;  3/03/88    TWE	Create a new function CREATE-DEFAULT-GC so that a scratch GC can
;;;			be created at initialization time for cursors.
;;;  1/22/88    TWE	Altered the GC requests to reset the rectangle-list back to the
;;;			default value when the clip-mask is being changed.  Also fixed a
;;;			bad cond clause in copy-gc.  Also altered those requests to
;;;			handle a new slot in the gc named FOREGROUND-TILE.  There is no
;;;			need to create one every time we do a graphics operation.
;;;  1/20/88    TWE	Modified change-gc-components to allow for an opaque-stippled
;;;			fill style.
;;; 12/15/87    TWE	Moved requests from the REQUESTS file.

(DEFUN CREATE-FOREGROUND-TILE (GCONTEXT)
  "Create a simple foreground tile for a GCONTEXT."
  ;; 1HACK ALERT!*  Note that the create-pixmap function takes a drawable as its
  ;; first argument, but we are passing a gcontext.  We can get away with
  ;; this since the create-pixmap function only uses the drawable to set up
  ;; the trait of the pixmap, which we don't use.
  (PIXMAP.ARRAY (CREATE-PIXMAP GCONTEXT 1 1 GCONTEXT
                               (GCONTEXT.FOREGROUND-PIXEL GCONTEXT))))

(DEFUN CREATE-DEFAULT-GC (GC-ID DESTINATION DRAWABLE)
  (MAKE-GCONTEXT
    :ID GC-ID
    :TYPE GCONTEXT-RESOURCE-TYPE
    :DEVICE-PRIVATE DESTINATION
    :DEPTH (DRAWABLE-DEPTH DRAWABLE)
    :TRAIT (DRAWABLE.TRAIT DRAWABLE)
    :SCREEN (DRAWABLE-TRAIT.SCREEN (DRAWABLE.TRAIT DRAWABLE)) 
    :ALU GX-COPY
    :PLANE-MASK 1                      ; Only 1 plane for monochrome
    :FOREGROUND-PIXEL 0
    :BACKGROUND-PIXEL 1
    :LINE-WIDTH 0
    :LINE-STYLE LINE-STYLE-SOLID
    :CAP-STYLE   CAP-STYLE-BUTT
    :JOIN-STYLE JOIN-STYLE-MITER
    :FILL-STYLE FILL-STYLE-SOLID
    :FILL-RULE FILL-RULE-EVEN-ODD
    :ARC-MODE ARC-PIE-SLICE
    
    ;; Pixmap filled with the foreground color.  We could have done this by
    ;; initializing the tile to NIL, but the value of the tile isn't
    ;; supposed to change when the foreground color changes.
    :TILE (CREATE-PIXMAP DRAWABLE 1 1 
                         (DRAWABLE-TRAIT.DEPTH (DRAWABLE.TRAIT DRAWABLE)) 0)
    
    :STIPPLE NIL                       ;pixmap filled with ones
    ;; Assume some fixed width font.
    :FONT (or *default-font*
	      (setq *default-font*
		    (OPEN-FONT 0 *default-font-name* (LENGTH *default-font-name*) 0 NIL)))
    :SUBWINDOW-MODE SUBWINDOW-MODE-CLIP-BY-CHILDREN
    :GRAPHICS-EXPOSURES T
    :CLIP-P NIL
    :clip-rectangle nil
    :CLIP-MASK NIL
    :DASH-OFFSET 0
    :NUM-IN-DASH-LIST 2
    :DASH (MAKE-ARRAY 2 :ELEMENT-TYPE 'INTEGER :INITIAL-ELEMENT 4)))

(defreq Create-GC ((gc-id NEWID)
		   (drawable DRAWABLE)
		   (value-mask (BITMASK All-GC-Component-Masks))
		   (:long))
  ;; Create the Gcontext with the default values as specified by the protocol spec.
  (let* ((destination (IF (= (DRAWABLE.TYPE DRAWABLE) DRAW-WINDOW-RESOURCE-TYPE)
                          ;; Get the device information from the screen associated
                          ;; with this window.
                          (SCREEN.DEV-PRIVATE (DRAWABLE-TRAIT.SCREEN
                                                (WINDOW.TRAIT DRAWABLE)))
                        ;;1ELSE*
                        (PIXMAP.ARRAY DRAWABLE)))
         (gc (create-default-gc gc-id  destination drawable)))
    (server-trace "~%In CREATE-GC: foreground= ~d background= ~d" (gcontext.foreground-pixel gc)
                  (gcontext.background-pixel gc))
    ;;(PUSH gc user:gclist)
    (setf (gcontext.foreground-tile gc) (create-foreground-tile gc))
    (change-gc-components gc state value-mask longs long-offset)
    (store-resource gc-id GC)))

(defreq Change-GC ((gc GCONTEXT)
		   (value-mask (BITMASK All-GC-Component-Masks))
		   (:long))
  (change-gc-components gc state value-mask longs long-offset))

(defun change-gc-components (gc state value-mask longs index)
  (server-trace-value-mask value-mask longs index
			   '#(function plane-mask foreground background
			      line-width line-style cap-style join-style fill-style
			      fill-rule tile stipple ts-x ts-y font subwindow-mode
			      exposures clip-x clip-y clip-mask dash-offset dashes
			      arc-mode))
  (process-values
    (value-mask longs index)
    (val)
    (((GC-Function (CARD8 GX-Clear GX-And GX-And-Reverse GX-Copy GX-And-Inverted
			  GX-Noop GX-Xor GX-Or GX-Nor GX-Equiv GX-Invert GX-Or-Reverse
			  GX-Copy-Inverted GX-Or-Inverted GX-Nand GX-Set))
      (setf (gcontext.alu gc) val)
      )
     ((GC-Plane-Mask CARD32)
      (setf (gcontext.plane-mask gc) val)
      )
     ((GC-Foreground CARD32)
      (setf (gcontext.foreground-pixel gc) val)
      (setf (gcontext.foreground-tile gc) (create-foreground-tile gc))
      )
     ((GC-Background CARD32)
      (setf (gcontext.background-pixel gc) val)
      )
     ((GC-Line-Width CARD16)
      (setf (gcontext.line-width gc) val)
      )
     ((GC-Line-Style (CARD8 Line-Style-Solid Line-Style-On-Off-Dash Line-Style-Double-Dash))
      (setf (gcontext.line-style gc) val)
      )
     ((GC-Cap-Style (CARD8 Cap-Style-Not-Last Cap-Style-Butt
			   Cap-Style-Round Cap-Style-Projecting))
      (setf (gcontext.cap-style gc) val)
      )
     ((GC-Join-Style (CARD8 Join-Style-Miter Join-Style-Round Join-Style-Bevel))
      (setf (gcontext.join-style gc) val)
      )
     ((GC-Fill-Style (CARD8 Fill-Style-Solid Fill-Style-Tiled Fill-Style-Stippled
                            Fill-Style-Opaque-Stippled))
      (setf (gcontext.fill-style gc) val)
      )
     ((GC-Fill-Rule (CARD8 Fill-Rule-Even-Odd Fill-Rule-Winding))
      (setf (gcontext.fill-rule gc) val)
      )
     ((GC-Tile PIXMAP)
      (setf (gcontext.tile gc) (tile-pixmap val))
      )
     ((GC-Stipple PIXMAP)
      (setf (gcontext.stipple gc) (tile-pixmap val))
      )
     ((GC-Pix-X-Origin INT16)
      (setf (point.x (gcontext.pattern-Originp gc)) val)
      )
     ((GC-Pix-Y-Origin INT16)
      (setf (point.y (gcontext.pattern-Originp gc)) val)
      )
     ((GC-Font FONT)
      (setf (gcontext.font gc) val)
      )
     ((GC-Subwindow-Mode (CARD8 Subwindow-Mode-Clip-By-Children
				Subwindow-Mode-Include-Inferiors))
      (setf (gcontext.subWindow-Mode gc) val)
      )
     ((GC-Graphics-Exposures BOOL)
      (setf (gcontext.graphics-Exposures gc) (plusp val))
      )
     ((GC-Clip-X-Origin INT16)
      (setf (point.x (gcontext.clip-Origin gc)) val)
      (when (gcontext.clip-p gc)
	(setf (box.left (gcontext.clip-rectangle gc)) val))
      )
     ((GC-Clip-Y-Origin INT16)
      (setf (point.y (gcontext.clip-Origin gc)) val)
      (when (gcontext.clip-p gc)
	(setf (box.top (gcontext.clip-rectangle gc)) val))
      )
     ((GC-Clip-Mask (ONEOF PIXMAP 0))
      ;; Changing the clip-mask means that the rectangle list isn't meaningful anymore.
      (IF (EQL val 0)
          (setf (gcontext.clip-rectangle gc) nil
		(gcontext.clip-mask gc) nil
                (gcontext.clip-p    gc) nil)
          ;;1ELSE*
          (setf (gcontext.clip-mask gc) val)
	  (setf (gcontext.clip-rectangle gc)
		(make-box
		  :left  (point.x (gcontext.clip-origin gc))
		  :top   (point.y (gcontext.clip-origin gc))
		  :width (pixmap.width val)
		  :height (pixmap.height val)))
	  (setf (gcontext.clip-p    gc) T)))
     ((GC-Dash-Offset CARD16)
      (setf (gcontext.dash-offset gc) val))
     ((GC-Dash-List CARD8)
      ;; See if we need to create a dash array or not.
      (when (or (not (eq :unbound (gcontext.dash gc)))
                (< (length (gcontext.dash gc)) 2))
        (setf (gcontext.dash gc) (make-array 2 :element-type 'integer)))
      (setf (aref (gcontext.dash gc) 0) val)
      (setf (aref (gcontext.dash gc) 1) val)
      (setf (gcontext.num-In-Dash-List gc) 2)
      )
     ((GC-Arc-Mode (CARD8 Arc-Chord Arc-Pie-Slice))
      (setf (gcontext.arc-mode gc) val)
      ))))

(defreq Copy-GC ((src-gc GCONTEXT)
		 (dst-gc GCONTEXT)
		 (value-mask (MASKBITS All-GC-Component-Masks CARD32)))
  (copy-gc src-gc dst-gc value-mask))

(defun copy-gc (src-gc dst-gc value-mask)
  "Copies components from the src-gc to dst-gc. The value-mask specifies which componenets
 to copy, as in Create-gc. The two gcontexts must have the same root and the same depth"
  (cond ((neq (gcontext.screen src-gc) (gcontext.screen dst-gc))
	 (bad-match))
	((neq (gcontext.depth src-gc) (gcontext.depth dst-gc))
         (bad-match ))
	(t
	 (when (logtest GC-Function Value-Mask)
	   (setf (gcontext.alu dst-gc) (gcontext.alu src-gc)))
	 
	 (when (logtest gc-plane-mask value-mask)
	   (setf  (gcontext.plane-mask dst-gc)  (gcontext.plane-mask src-gc)))
	 
	 (when (logtest gc-foreground value-mask)
	   (setf  (gcontext.foreground-pixel dst-gc)  (gcontext.foreground-pixel src-gc))
	   (setf  (gcontext.foreground-tile  dst-gc)  (gcontext.foreground-tile  src-gc)))
	 
	 (when (logtest gc-background value-mask)
	   (setf  (gcontext.background-pixel dst-gc) 	   (gcontext.background-pixel src-gc)))
	 
	 (when (logtest gc-line-width value-mask)
	   (setf  (gcontext.line-width dst-gc) 	   (gcontext.line-width src-gc)))
	 
	 (when (logtest gc-line-style value-mask)
	   (setf  (gcontext.line-style src-gc) 	   (gcontext.line-style dst-gc)))
	 
	 (when (logtest gc-cap-style value-mask)
	   (setf   (gcontext.cap-style dst-gc)	   (gcontext.cap-style src-gc)))
	 
	 (when (logtest gc-join-style value-mask )
	   (setf  (gcontext.join-style dst-gc)	   (gcontext.join-style src-gc)))
	 
	 (when (logtest gc-fill-style value-mask)
	   (setf  (gcontext.fill-style dst-gc)	   (gcontext.fill-style src-gc)))
	 
	 (when (logtest gc-fill-rule value-mask)
	   (setf  (gcontext.fill-style dst-gc)	   (gcontext.fill-style src-gc)))
	 
	 (when (logtest gc-tile value-mask)
	   (setf  (gcontext.tile dst-gc)	   (gcontext.tile src-gc)))
	 
	 (when (logtest gc-stipple value-mask )
	   (setf  (gcontext.stipple dst-gc)	   (gcontext.stipple src-gc)))
	 
	 (when (logtest gc-arc-mode value-mask )
	   (setf  (gcontext.arc-mode dst-gc)	   (gcontext.arc-mode src-gc)))
	 
	 (when (logtest GC-Pix-X-Origin value-mask) 
	   (setf  (point.x (gcontext.pattern-Originp dst-gc))
		  (point.x (gcontext.pattern-Originp src-gc))))
	 
	 
	 (when (logtest GC-Pix-y-Origin value-mask) 
	   (setf  (point.y (gcontext.pattern-Originp dst-gc))
		  (point.y (gcontext.pattern-Originp src-gc))))
	 
	 (when (logtest gc-font value-mask )
	   (setf  (gcontext.font dst-gc)	           (gcontext.font src-gc)))
	 
	 (when (logtest gc-subwindow-mode value-mask)
	   (setf   (gcontext.subwIndow-mode dst-gc)	    (gcontext.subwindow-mode src-gc)))
	 
	 (when (logtest gc-graphics-exposures value-mask)
	   (setf (gcontext.graphics-exposures dst-gc)      (gcontext.graphics-exposures src-gc)))
	 
	 (when (logtest gc-clip-x-origin value-mask)
	   (setf (point.x (gcontext.clip-origin dst-gc)) (point.x (gcontext.clip-origin src-gc))))
	 
	 (when (logtest gc-clip-y-origin value-mask)
	   (setf (point.y (gcontext.clip-origin dst-gc)) (point.y (gcontext.clip-origin src-gc))))
	 
	 (when (logtest gc-clip-mask value-mask)
	   (setf (gcontext.clip-rectangle dst-gc)    (copy-box (gcontext.clip-rectangle src-gc))
		 (gcontext.clip-mask dst-gc)         (gcontext.clip-mask src-gc)
		 (gcontext.clip-p dst-gc)            (gcontext.clip-p src-gc)))

	 (when (logtest value-mask (logior gc-clip-mask gc-clip-x-origin gc-clip-y-origin))
	   ;1; Adjust clip mask to new origin*
           ;1; Make sure there is a dst-gc*
           (WHEN (gcontext.clip-rectangle dst-gc)
             (let ((rectangle (gcontext.clip-rectangle dst-gc))
                   (origin (gcontext.clip-origin dst-gc)))
               (setf (box.left rectangle) (point.x origin)
                     (box.top  rectangle) (point.y origin)))))

	 (when (logtest gc-dash-offset value-mask)
	   (setf   (gcontext.dash-offset dst-gc)	   (gcontext.dash-offset src-gc)))
	 
	 (when (logtest gc-dash-list value-mask)
	   (setf   (aref (gcontext.dash dst-gc) 0)     (aref (gcontext.dash src-gc) 0)
		   (aref (gcontext.dash dst-gc) 1)    (aref (gcontext.dash dst-gc) 1)
		   (gcontext.num-In-Dash-List dst-gc) (gcontext.num-In-Dash-List src-gc)))
	 
	 (when (logtest gc-arc-mode value-mask)
	   (setf   (gcontext.arc-mode dst-gc)	   (gcontext.arc-mode src-gc))))))


(defreq Free-GC ((:solo)
		 (gc GCONTEXT))
  (free-gc gc))


(defun free-gc (gc)
  "deletes the association between the resrouce id and the gcontext and
   destroys the gcontext"
  (let ((id (gcontext.id gc)))
    (remove-resource id :gcontext)
    (setq gc nil)))


(DEFUN create-scratch-gc (screen depth)
  "2Like CreateGC, but doesn't do the default tile or stipple,
since we can't create them without already having a GC.  any code
using the tile or stipple has to set them explicitly anyway,
since the state of the scratch gc is unknown.  This is OK
because ChangeGC() has to be able to deal with NULL tiles and
stipples anyway (in case the CreateGC() call has provided a 
value for them -- we can't set the default tile until the
client-supplied attributes are installed, since the fgPixel
is what fills the default tile.  (maybe this comment should
go with CreateGC() or ChangeGC().)*"
  
  (let ((new-gc (alloc-gcontext)))
    (setf (gcontext.screen new-gc) screen)
    (setf (gcontext.depth new-gc)  depth)
    (setf (gcontext.alu new-gc)    GX-COPY)
    (setf (gcontext.plane-mask new-gc) (LOGNOT 0))
    (setf (gcontext.serial-number new-gc) 0)
    (setf (gcontext.foreground-pixel new-gc) 0)
    (setf (gcontext.background-pixel new-gc) 1)
    (setf (gcontext.line-width new-gc) 0)
    (setf (gcontext.line-style new-gc) LINE-STYLE-SOLID)
    (setf (gcontext.cap-style new-gc) CAP-STYLE-BUTT)
    (setf (gcontext.join-style new-gc) JOIN-STYLE-MITER)
    (setf (gcontext.fill-style new-gc) FILL-STYLE-SOLID)
    (setf (gcontext.fill-rule new-gc) FILL-RULE-EVEN-ODD)
    (setf (gcontext.arc-mode new-gc) ARC-PIE-SLICE)
    ;;(setf (gcontext.font new-gc) *default-cursor-font*)
    (setf (gcontext.font new-gc) NIL)
    (setf (gcontext.tile new-gc) NIL)
    (setf (gcontext.stipple new-gc) NIL)
    (setf (gcontext.subwindow-mode new-gc) Subwindow-Mode-Clip-By-Children)
    (setf (gcontext.graphics-exposures new-gc) T)
    (setf (gcontext.clip-p new-gc) nil)
    (setf (gcontext.clip-mask new-gc) nil)
    (setf (gcontext.client-clip-type new-gc) NIL)
    (setf (gcontext.clip-rectangle new-gc) nil)
    (setf (gcontext.num-in-dash-list new-gc) 2)
    (setf (gcontext.dash new-gc) (MAKE-ARRAY 2 :element-type 'integer))
    (setf (gcontext.dash-offset new-gc) 0)
    
    (SETF (point.x (gcontext.pattern-Originp new-gc)) 0)
    (SETF (point.y (gcontext.pattern-Originp new-gc)) 0)
    (SETF (point.x (gcontext.clip-Origin new-gc)) 0)
    (SETF (point.y (gcontext.clip-Origin new-gc)) 0)
    (setf (aref (gcontext.dash new-gc) 0) 4)
    (setf (aref (gcontext.dash new-gc) 1) 4)
    (let ((font-id (gcontext.font new-gc)))	;Workaround a compiler bug (??)
      (when font-id
	(INCF (font-record.reference-count font-id))))
    ;1; necessary, because open of default font could fail*
    (SETF (gcontext.state-changes new-gc) -1)
;    (*pScreen->CreateGC)(pGC);
    (server-trace "~%In CREATE-SCRATCH-GC: foreground= ~d background= ~d"
                  (gcontext.foreground-pixel new-gc)
                  (gcontext.background-pixel new-gc))	;1dbg*
;    (PUSH new-gc user:gclist)                   ;1dbg*
    new-gc))


(defun free-scratch-gc (scratch-gc)
  (dealloc-gcontext scratch-gc))


(DEFUN get-scratch-gc (depth screen)
;1; sets reasonable defaults if we can get a pre-allocated one, use it and mark it as used.*
;1; If we can't, create one out of whole cloth. (The Velveteen GC -- if you use it often enough it will become real.)*
  (LET ((gc (LOOP for i from 0 below (screen.num-depths screen)
		  for gc = (AREF (screen.gc-per-depth screen) i)
		  when (AND (= (gcontext.depth gc) depth)
			    (NOT (LOGAND (screen.rgf screen) (EXPT 2 (1+ i)))))
		  do
		  (SETF (screen.rgf screen) (LOGIOR (screen.rgf screen)
						    (EXPT 2 (1+ i))))
		  (SETF (gcontext.alu gc) GX-COPY)
		  (SETF (gcontext.plane-mask gc) (LOGNOT 0))
		  (SETF (gcontext.serial-number gc) 0)
		  (SETF (gcontext.foreground-pixel gc) 0)
		  (SETF (gcontext.background-pixel gc) 1)
		  (SETF (gcontext.line-width gc) 0)
		  (SETF (gcontext.line-style gc) LINE-STYLE-SOLID)
		  (SETF (gcontext.cap-style gc) CAP-STYLE-BUTT)
		  (SETF (gcontext.join-style gc) JOIN-STYLE-MITER)
		  (SETF (gcontext.fill-style gc) FILL-STYLE-SOLID)
		  (SETF (gcontext.fill-rule gc) FILL-RULE-EVEN-ODD)
		  (SETF (gcontext.arc-mode gc) ARC-CHORD)
		  (SETF (point.x (gcontext.pattern-Originp gc)) 0)
		  (SETF (point.y (gcontext.pattern-Originp gc)) 0)
		  (SETF (gcontext.subwindow-mode gc) Subwindow-Mode-Clip-By-Children)
		  (SETF (gcontext.graphics-exposures gc) NIL)
		  (SETF (point.x (gcontext.clip-Origin gc)) 0)
		  (SETF (point.y (gcontext.clip-Origin gc)) 0)
		  ;1; can't change clip type, because we might drop storage.*
		  (SETF (gcontext.state-changes gc) -1)
		  RETURN gc)))
    (UNLESS gc
      (SETQ gc (create-scratch-gc screen depth))
      (SETF (gcontext.graphics-exposures gc) nil))
    gc))

(DEFUN create-private-gc (drawable mask value)
  ;1;Create a GC private to the Sun DDX code. Such a GC is unhampered*
  ;1;by any shadow GC and should only be used by functions which know*
  ;1;what they are doing. This substitutes the old CreateGC function*
  ;1;in the drawable's screen's vector and calls the DIX CreateGC*
  ;1;function. Once done, it restores the CreateGC vector to its*
  ;1;proper state and returns the GCPtr CreateGC gave back.*
  ;1; Results*
  ;1;   A pointer to the new GC.*
  ;1; Side Effects:*
  ;1;   The GC's graphicsExposures field is set FALSE.*
  (LET ((gc (get-scratch-gc (drawable-depth drawable) (drawable-screen drawable)))
        (state (CAR (global-state.states *globals*)))
        (val (MAKE-ARRAY 1 :initial-element value))
        (false-val (MAKE-ARRAY 1 :initial-element FALSE)))
    (change-gc-components gc state mask val 0)
    (change-gc-components gc state GC-GRAPHICS-EXPOSURES false-val 0)
    gc))