;;; -*- Mode:Common-Lisp; Package:X11; Base:10; Fonts:(CPTFONT TR10B TR10BI TR10I CPTFONTB) -*-

;;;                           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
;;; -----------------------------------------------------------------------------------------------
;;; 03/29/89	WJB	Patch 1.67; Prevent COPY-AREA from drawing outside parent's boundries (again).
;;; 03/02/89    DAN     Patch 1.30; Fix COPY-AREA to check if there is a destination-box-to-copy before
;;;			doing an ADD-REFRESH-REGION.
;;; 02/17/88	WJB	Patch 1.15; Prevent COPY-AREA from writing outside parent window boundaries.
;;; 01/18/89    LGO     Fix error exit from get-image.
;;; 01/13/89    DAN     Fixed CLEAR-TO-BACKGROUND1 *and1 *COPY-AREA to check for INPUT-ONLY windows.
;;; 12/22/88	LGO	Don't use displaced-index-offset in put-image, because bitblt can't handle it.
;;; 12/16/88	WJB	In COPY-AREA delete nil items from src-boxes-to-copy.
;;; 12/16/88    LGO     1Get drawable origin right in put-image.*
;;; 12/16/88    LGO     Allow get-image to get window borders.
;;; 12/16/88    LGO     Ensure width & height are consistent with length in put-image.
;;; 12/16/88    LGO     Don't flip bits in put-image.
;;; 12/16/88    LGO     Fix GET-IMAGE to return a correctly formated reply.
;;; 12/15/88    LGO     Fix clip-mask origin calculations in copy-area
;;; 12/15/88    LGO     Fix incorrect lambda lst in copy-plane.
;;; 12/14/88    LGO     In get-image, get the temporary pixmap from a resource
;;; 12/14/88    LGO     Use bitblt instead of copy-area in Get-Image.
;;; 12/13/88    LGO     Fixed get-image to correctly check for unobscured regions
;;; 11/28/88    LGO     Fixed COPY-AREA to handle unmapped children correctly
;;; 10/21/88    DAN     Fixed COPY-PLANE to check the foreground and background.
;;; 10/17/88	LGO	Fix copy-area to handle overlapping areas correctly
;;; 10/11/88	WJB	Wrapped perform-graphics around CLEAR-TO-BACKGROUND code.
;;;  9/28/88	WJB	Allow CREATE-PIXMAP to be called with a NIL drawable.
;;;  9/26/88    LGO	Fix copy-area to tile obscured regions with background
;;;  9/26/88    LGO	Report correct graphics-exposure-event x/y/width/height from copy-area.
;;;  9/26/88    LGO	Fix copy-area to clip to the source window correctly.
;;;  9/22/88    LGO	Add clipping to clear-to-background.
;;;  9/22/88    LGO     Implement GRAPHICS-EXPOSURE-EVENT and no-exposure-event
;;;  9/07/88    LGO     Ensure expose-event always gets called from clear-to-background
;;;  9/07/88    LGO     Correct useage of WINDOW-BACKGROUND in CLEAR-TO-BACKGROUND  
;;;  8/24/88    DAN     Added call to REMOVE-RESOURCE to FREE-PIXMAP.
;;;  8/09/88    DAN     Added optional arg DO-EXPOSURE-EVENTS to COPY-AREA.
;;;  6/06/88    TWE	Fixed CLEAR-TO-BACKGROUND to handle its BOOL argument correctly.
;;;  5/05/88    TWE	Replaced calls to GET-DRAWABLE-ARRAY to DEVICE-PRIVATE-ARRAY since that
;;;			does the same thing.  Fixed CLEAR-TO-BACKGROUND to do expose events
;;;			correctly.  Replaced references to *monochrome-server-trace* to call the
;;;			server-trace function instead.  Reformated (CONTROL-META-Q) all code in
;;;			this file.
;;;  4/26/88    TWE	Added a call to VALIDATE-BACKING-STORE in copy-area.
;;;  4/04/88    KDB	Did QUERY-BEST-SIZE.
;;;  3/22/88    KDB	Implemented COPY-PLANE.
;;;  4/04/88    KDB	Hacked some of GET and PUT-IMAGE requests. They are still incomplete.
;;;  3/22/88    KDB	Created the CREATE-PIXMAP-FOR-CLIENT and CREATE-PIXMAP Request.
;;;  3/21/88    KDB	Added FREE-PIXMAP Request.
;;;  3/08/88    DAN	Fixed copy-area to set up DST-BOX even if DST is a pixmap.
;;;  2/08/88    KDB	Added clear-to-background and copy-area.  Need to add backing store stuff.
;;;  1/13/88    TWE	Changed references to tv:initial-lisp-listener to
;;;			*monochrome-server-trace*.  Removed the permanent-p argument from
;;;			create-pixmap.  This was really a hack used by the graphics
;;;			primitives to determine if drawing went to the screen or not.
;;; 12/15/87    TWE	Moved requests from the REQUESTS file.

;;; Clear area


1;;;DOCUMENTATION ALERT
;;;
;;;Backing-planes indicates (with one bits) which bit planes of the window
;;;hold dynamic data that must be preserved in backing-stores and during
;;;save-unders.  Backing-pixel specifies what value to use in planes not
;;;covered by backing-planes.  The server is free to only save the
;;;specified bit planes in the backing-store or save-under, and regenerate
;;;the remaining planes with the specified pixel value.  Any "extraneous"
;;;bits (beyond the specified depth of the window) in these values are
;;;simply ignored.*
	
(ZWEI:DEFINE-INDENTATION INTERSECT-WITH-CHILDREN (1 1))
(defun CLEAR-TO-BACKGROUND  (state window x y width height exposures)
  "	2window: WINDOW*
	2x, y: INT16*
	2width, height: CARD16*
	2exposures: BOOL*

	2Errors: Window, Value, Match*

	2The x and y coordinates are relative to the window's origin, and*
	2specify the upper left corner of the rectangle.  If width is zero, it*
	2is replaced with the current width of the window minus x.  If height is*
	2zero, it is replaced with the current height of the window minus y.  If*
	2the window has a defined background tile, the rectangle is tiled with a*
	2plane-mask of all ones and function of Copy.  If the window has*
	2background None, the contents of the window are not changed.  In either*
	2case, if exposures is True, then one or more exposure events are*
	2generated for regions of the rectangle that are either visible or are*
	2being retained in a backing store.  *"
  
  (IF (EQL (WINDOW.CLASS WINDOW) INPUT-ONLY)	;1It is a Match error to use an InputOnly window in this request.*
      (BAD-MATCH)
    ;1;ELSE . OK*
    (PERFORM-GRAPHICS (WINDOW)
      (LET ((WINDOW-WIDTH  (WINDOW.WIDTH  WINDOW))
            (WINDOW-HEIGHT (WINDOW.HEIGHT WINDOW))
	    abs-x abs-y)
        (WHEN (ZEROP WIDTH)         (SETQ WIDTH  (- WINDOW-WIDTH  X)))
        (WHEN (ZEROP HEIGHT)        (SETQ HEIGHT (- WINDOW-HEIGHT Y)))
        (server-trace "~%IN CLEAR-AREA, at (~D,~D), width=~D, height=~D"
                      ABS-X ABS-Y WIDTH HEIGHT)
	;1; Clip to window*
	(when (minusp x) (incf width x)  (setq x 0))
	(when (minusp y) (incf height y) (setq y 0))
	(when (> (+ x width)  window-width)  (setq width  (- window-width  x)))
	(when (> (+ y height) window-height) (setq height (- window-height y)))
	;;1 OFFSET X AND Y*
	(setq ABS-X         (+ X (WINDOW.ABSOLUTE-INSIDE-X  WINDOW))
	      ABS-Y         (+ Y (WINDOW.ABSOLUTE-INSIDE-Y  WINDOW)))
	;1; IF  THE WINDOW HAS A DEFINED BACKGROUND TILE, THE RECTANGLE IS TILED WITH A*
        ;1;PLANE-MASK OF ALL ONES AND FUNCTION OF COPY.  IF THE WINDOW HAS*
        ;1;BACKGROUND NONE, THE CONTENTS OF THE WINDOW ARE NOT CHANGED.*
        (LET* ((BACKGROUND-TILE (WINDOW-BACKGROUND WINDOW))
               (BACKGROUND-TILE-ARRAY (if (eql BACKGROUND-TILE universal-none)
					  (setq background-tile nil)
					(PIXMAP.ARRAY BACKGROUND-TILE)))
               (TILE-WIDTH (IF BACKGROUND-TILE
			       (PIXMAP.WIDTH BACKGROUND-TILE)
			     ;1;ELSE*
			     0))
               (TILE-HEIGHT (IF BACKGROUND-TILE
                                (PIXMAP.HEIGHT BACKGROUND-TILE)
			      ;1;ELSE*
			      0))
               (BACKING-STORE (and (WINDOW.BACKING-STORE-valid WINDOW) (WINDOW.BACKING-STORE WINDOW))))
          
          ;1;  MAPPED? WE NEED TO CHECK ON VISIBILITY/MAPPING..*
          (IF (AND (WINDOW.MAPPED-P WINDOW)
                   (NOT (EQL (window.class window) input-only)))
              (FLET ((INTERSECT-WITH-CHILDREN (WINDOW-BOXES)
                       (WHEN (WINDOW.FIRST-CHILD WINDOW)
                         (LET ((CHILD      (WINDOW.FIRST-CHILD WINDOW))
                               (LAST-CHILD (WINDOW.LAST-CHILD  WINDOW)))
                           (LOOP
                             (WHEN (AND (WINDOW.MAPPED-P CHILD)
                                        (NOT (EQL (window.class child) input-only)))
                               (SETQ WINDOW-BOXES (SUBTRACT-BOX WINDOW-BOXES (MAKE-WINDOW-BOX CHILD))))
                             (WHEN (EQ CHILD LAST-CHILD)
                               (RETURN NIL))
                             (SETQ CHILD (WINDOW.NEXT-SIB CHILD)))))
                       WINDOW-BOXES))
		(IF  (EQL T (WINDOW.OCCLUSION-STACK WINDOW))	;1 FULLY VISIBLE*
		     (PROGN
		       (IF (NULL (WINDOW.FIRST-CHILD WINDOW))
			   ;1; Easy case -- window doesn't have any children.*
						;1 TELL CLIENT WE ARE LOSING IT...*
			   (EXPOSE-EVENT STATE WINDOW abs-X abs-Y WIDTH HEIGHT 0 exposures)
                         ;1;ELSE*
                         ;1; Window has children.  We must be careful not to touch them.  Note*
                         ;1; that we don't need to deal with painting the background since this*
                         ;1; is done in the EXPOSE-EVENT function (which is called by*
                         ;1; EXPOSE-EVENTS).*
                         (EXPOSE-EVENTS
                           STATE WINDOW (INTERSECT-WITH-CHILDREN
                                          (LIST (MAKE-BOX :LEFT ABS-X :TOP ABS-Y
                                                          :WIDTH WIDTH  :HEIGHT HEIGHT)))
                           EXPOSURES)))
		  ;1;ELSE*
		  ;1; OCCLUSION-STACK IS EITHER NIL OR LIST-OF-BOXES*
		  (PROGN
		    (WHEN BACKING-STORE		;1  maintain hidden part.*
		      (WHEN BACKGROUND-TILE	;1Tile the background store.*
			(X-BITBLT GX-COPY WIDTH HEIGHT BACKGROUND-TILE-ARRAY
				  (MOD X TILE-WIDTH) (MOD Y TILE-HEIGHT)
				  (PIXMAP.ARRAY BACKING-STORE) X Y)))
		    (WHEN (WINDOW.OCCLUSION-STACK WINDOW)	;1 BOXES  ARE VISIBLE*
		      ;1; What we want to do here is to take the box specified by the user, and*
		      ;1; find out what parts of the window that are visible that correspond*
		      ;1; with this.  We then take this and interset it with the children (if*
		      ;1; any) to get a list of boxes that are visible and are only part of this*
		      ;1; window.*
		      (EXPOSE-EVENTS STATE WINDOW (INTERSECT-WITH-CHILDREN
						    (SET-INTERSECT-BOXES
						      (WINDOW.OCCLUSION-STACK WINDOW)
						      (MAKE-BOX :LEFT ABS-X :TOP ABS-Y
								:WIDTH WIDTH  :HEIGHT HEIGHT)))
				     EXPOSURES)))))
	    ;1;ELSE WINDOW NOT MAPPED BUT MAY HAVE BACKING STORE*
	    (WHEN BACKING-STORE		
	      (EXPOSE-EVENT STATE WINDOW ABS-X ABS-Y WIDTH HEIGHT 0 exposures)
	      (WHEN BACKGROUND-TILE  
		(X-BITBLT GX-COPY WIDTH HEIGHT BACKGROUND-TILE-ARRAY
			  (MOD X TILE-WIDTH) (MOD Y TILE-HEIGHT)
			  (PIXMAP.ARRAY BACKING-STORE) X Y))))
          ;1;ELSE  THE CONTENTS OF THE WINDOW ARE NOT CHANGED.*
          )))))

(defreq Clear-To-Background ((exposures BOOL)
			     (window WINDOW)
			     (x INT16)
			     (y INT16)
			     (width CARD16)
			     (height CARD16))
  (setq exposures (= exposures true))
  (clear-to-background state  window x y width height exposures))


;1;; GRAPHICS-EXPOSURE AND NO-EXPOSURE EVENTS*
(DEFUN GRAPHICS-EXPOSURE-EVENT (STATE DRAWABLE X Y WIDTH HEIGHT COUNT MAJOR-OPCODE
                                &OPTIONAL (MINOR-OPCODE 0))
  "	2DRAWABLE: DRAWABLE*
	2X, Y, WIDTH, HEIGHT: CARD16*
	2COUNT: CARD16*
	2MAJOR-OPCODE: CARD8*
	2MINOR-OPCODE: CARD16*

	2REPORTED TO CLIENTS SELECTING GRAPHICS-EXPOSURES IN A GRAPHICS CONTEXT.*
	2GENERATED WHEN A DESTINATION REGION COULD NOT BE COMPUTED DUE TO AN*
	2OBSCURED OR OUT-OF-BOUNDS SOURCE REGION.  ALL OF THE REGIONS EXPOSED BY*
	2A GIVEN GRAPHICS REQUEST ARE GUARANTEED TO BE REPORTED CONTIGUOUSLY.*
	2IF COUNT IS ZERO THEN NO MORE GRAPHICSEXPOSURE EVENTS FOR THIS WINDOW*
	2FOLLOW; IF COUNT IS NON-ZERO THEN AT LEAST THAT MANY MORE*
	2GRAPHICSEXPOSURE EVENTS FOR THIS WINDOW FOLLOW (AND POSSIBLY MORE).*

	2THE X AND Y COORDINATES ARE RELATIVE TO DRAWABLE'S ORIGIN, AND SPECIFY*
	2THE UPPER LEFT CORNER OF A RECTANGLE.  THE WIDTH AND HEIGHT SPECIFY THE*
	2EXTENT OF THE RECTANGLE.*

	2THE MAJOR AND MINOR OPCODES IDENTIFY THE GRAPHICS REQUEST USED.  FOR*
	2THE CORE PROTOCOL, MAJOR-OPCODE IS ALWAYS COPYAREA OR COPYPLANE AND*
	2MINOR-OPCODE IS ALWAYS ZERO.*"
  (LET ((event (make-event-graphics-exposure
		 :type graphics-expose-event
		 :drawable drawable
		 :x x :y y
		 :width width :height height
		 :count count
		 :major-event major-opcode
		 :minor-event minor-opcode)))
    (server-trace "~%GRAPHICS-ExposURE event for DRAWABLE ~16R, (~D,~D) (W,H)=(~d,~d) Count ~d"
                  (DRAWABLE.ID DRAWABLE) x y width height count)
    (try-client-events state event 1 0 CANT-BE-FILTERED nil)))

(DEFUN NO-EXPOSURE-EVENT (STATE DRAWABLE MAJOR-OPCODE  &OPTIONAL (MINOR-OPCODE 0))
  "	2DRAWABLE: DRAWABLE*
	2MAJOR-OPCODE: CARD8*
	2MINOR-OPCODE: CARD16*

	2REPORTED TO CLIENTS SELECTING GRAPHICS-EXPOSURES IN A GRAPHICS CONTEXT.*
	2GENERATED WHEN A GRAPHICS REQUEST THAT MIGHT PRODUCE GRAPHICSEXPOSURE*
	2EVENTS DOES NOT PRODUCE ANY.  THE DRAWABLE SPECIFIES THE DESTINATION*
	2USED FOR THE GRAPHICS REQUEST.*
	
	2THE MAJOR AND MINOR OPCODES IDENTIFY THE GRAPHICS REQUEST USED.  FOR*
	2THE CORE PROTOCOL, MAJOR-OPCODE IS ALWAYS COPYAREA OR COPYPLANE AND*
	2MINOR-OPCODE IS ALWAYS ZERO.*"
  (LET ((event (make-event-no-exposure
		 :type no-expose-event
		 :drawable drawable
		 :major-event major-opcode
		 :minor-event minor-opcode)))
    (server-trace "~%No-Exposure event for DRAWABLE x~16R"
		  (DRAWABLE.ID DRAWABLE))
    (try-client-events state event 1 0 CANT-BE-FILTERED nil)))





(DEFUN COPY-AREA (STATE GC SRC-DRAWABLE SRC-X SRC-Y DST-DRAWABLE DST-X DST-Y WIDTH HEIGHT
                  &optional (do-exposure-events T))
  "2  SRC-DRAWABLE, DST-DRAWABLE: DRAWABLE
    GC: GCONTEXT
    SRC-X, SRC-Y: INT16
    WIDTH, HEIGHT: CARD16
    DST-X, DST-Y: INT16

    ERRORS: DRAWABLE, GCONTEXT, MATCH

    COMBINES THE SPECIFIED RECTANGLE OF SRC-DRAWABLE WITH THE SPECIFIED
    RECTANGLE OF DST-DRAWABLE.  THE SRC-X AND SRC-Y COORDINATES ARE
    RELATIVE TO SRC-DRAWABLE'S ORIGIN, DST-X AND DST-Y ARE RELATIVE TO
    DST-DRAWABLE'S ORIGIN, EACH PAIR SPECIFYING THE UPPER LEFT CORNER OF
    THE RECTANGLE.  

    IF REGIONS OF THE SOURCE RECTANGLE ARE OBSCURED AND HAVE NOT BEEN
    RETAINED IN BACKING-STORE, OR IF REGIONS OUTSIDE THE BOUNDARIES OF THE
    SOURCE DRAWABLE ARE SPECIFIED, THEN THOSE REGIONS ARE NOT COPIED, BUT
    THE FOLLOWING OCCURS ON ALL CORRESPONDING DESTINATION REGIONS THAT ARE
    EITHER VISIBLE OR ARE RETAINED IN BACKING-STORE.
       
        IF THE DST-DRAWABLE
    IS A WINDOW WITH A BACKGROUND OTHER THAN NONE, THESE CORRESPONDING
    DESTINATION REGIONS ARE TILED (WITH PLANE-MASK OF ALL ONES AND FUNCTION
    COPY) WITH THAT BACKGROUND.  REGARDLESS OF TILING, AND WHETHER THE
    DESTINATION IS A WINDOW OR A PIXMAP, IF GRAPHICS-EXPOSURES IN GC IS
    TRUE THEN GRAPHICSEXPOSURE EVENTS FOR ALL CORRESPONDING DESTINATION
    REGIONS ARE GENERATED.

    IF GRAPHICS-EXPOSURES IS TRUE BUT NO DESTINATION??? REGIONS ARE EXPOSED, THEN A
    NOEXPOSURE EVENT IS GENERATED.

    GC COMPONENTS: ALU, PLANE-MASK, SUBWINDOW-MODE,
    GRAPHICS-EXPOSURES, CLIP-X-ORIGIN, CLIP-Y-ORIGIN, CLIP-MASK*"
  
  (COND
    ((EVENP (GCONTEXT.PLANE-MASK GC))       1; IF A ZERO BIT IS SET THEN GETOUTATOWN.*
     (IF do-exposure-events (NO-EXPOSURE-EVENT STATE  DST-DRAWABLE COPY-AREA-OPCODE)))
    ((OR (AND (WINDOW-P SRC-DRAWABLE) (EQL (WINDOW.CLASS  SRC-DRAWABLE) INPUT-ONLY))
         (AND (WINDOW-P DST-DRAWABLE) (EQL (WINDOW.CLASS  DST-DRAWABLE) INPUT-ONLY)))
     ;1; IF NEITHER ARE WINDOWS, DON'T WORRY ABOUT INPUTONLY*
     ;1; An INPUT-ONLY window cannot be used as a source or destination*
     ;1; in a graphics operation.*
     (BAD-MATCH))
    (T ;1;ELSE*
     ;1; IF REGIONS OUTSIDE THE BOUNDARIES OF THE SOURCE DRAWABLE*
     ;1; ARE SPECIFIED, THEN THOSE REGIONS ARE NOT COPIED.*
     (WHEN (< SRC-X 0) (INCF WIDTH  SRC-X)  (SETQ SRC-X 0))
     (WHEN (< SRC-Y 0) (INCF HEIGHT SRC-Y)  (SETQ SRC-Y 0))
     
     ;1; Make sure that the backing stores are up-to-date.*
     (WHEN (WINDOW-P SRC-DRAWABLE)
       (VALIDATE-BACKING-STORE SRC-DRAWABLE))
     (WHEN (WINDOW-P DST-DRAWABLE)
       (VALIDATE-BACKING-STORE DST-DRAWABLE))
     
     (LET*  ((SRC-ARRAY      (DEVICE-PRIVATE-ARRAY SRC-DRAWABLE))  ;1; USE DEVICE-PRIVATE FOR CONSISTEENVY*
             (SRC-WINDOW-P   (WINDOW-P SRC-DRAWABLE))
             ;1; THERE SURE ARE A LOT OF IF TESTS BELOW. WOULD BE NICE TO SIMPLIFY....*
             (ABS-SRC-X      (IF SRC-WINDOW-P (+ SRC-X (WINDOW.ABSOLUTE-inside-X SRC-DRAWABLE)) SRC-X))
             (ABS-SRC-Y      (IF SRC-WINDOW-P (+ SRC-Y (WINDOW.ABSOLUTE-inside-Y SRC-DRAWABLE)) SRC-Y))
             ;1; THE SRC-X AND SRC-Y COORDINATES ARE RELATIVE TO SRC-DRAWABLE'S ORIGIN*
;1;;             (SRC-WIDTH          (IF SRC-WINDOW-P  (WINDOW.WIDTH  SRC-DRAWABLE) (PIXMAP.WIDTH  SRC-DRAWABLE)))*
;1;;             (SRC-HEIGHT         (IF SRC-WINDOW-P  (WINDOW.HEIGHT SRC-DRAWABLE) (PIXMAP.HEIGHT SRC-DRAWABLE)))*
             (SRC-OS-BOXES       (IF SRC-WINDOW-P  (WINDOW.OCCLUSION-STACK  SRC-DRAWABLE) T))
             (SRC-BOXES-TO-COPY  NIL)
             SRC-BOX
;1;;             (SRC-BG-TILE        (IF SRC-WINDOW-P (WINDOW-BACKGROUND SRC-DRAWABLE) NIL))*
;1;;             (SRC-BG-TILE-ARRAY  (IF SRC-BG-TILE  (PIXMAP.ARRAY SRC-BG-TILE) NIL))*
             (SRC-BACKING-STORE  (and SRC-WINDOW-P
				      (WINDOW.BACKING-STORE-valid SRC-DRAWABLE)
				      (WINDOW.BACKING-STORE SRC-DRAWABLE)))
             
             ;1;DESTINATION SETUP*
             (DST-ARRAY           (DEVICE-PRIVATE-ARRAY DST-DRAWABLE))
             (DST-WINDOW-P        (WINDOW-P DST-DRAWABLE))
             (ABS-DST-X           (IF DST-WINDOW-P (+ DST-X (WINDOW.ABSOLUTE-inside-X DST-DRAWABLE)) DST-X))
             (ABS-DST-Y           (IF DST-WINDOW-P (+ DST-Y (WINDOW.ABSOLUTE-inside-Y DST-DRAWABLE)) DST-Y))
             ;1; THE DST-X AND DST-Y COORDINATES ARE RELATIVE TO DST-DRAWABLE'S ORIGIN*
;1;;             (DST-WIDTH           (IF DST-WINDOW-P (WINDOW.WIDTH  DST-DRAWABLE) (PIXMAP.WIDTH  DST-DRAWABLE)))*
;1;;             (DST-HEIGHT          (IF DST-WINDOW-P (WINDOW.HEIGHT DST-DRAWABLE) (PIXMAP.HEIGHT DST-DRAWABLE)))*
             (DST-OS-BOXES        (IF DST-WINDOW-P (WINDOW.OCCLUSION-STACK DST-DRAWABLE) T))
             DST-BOX
             (DST-BOXES-TO-COPY    NIL)
             
;1;;             (DST-BG-TILE         (IF DST-WINDOW-P (WINDOW-BACKGROUND DST-DRAWABLE) NIL))*
;1;;             (DST-BG-TILE-ARRAY   (IF DST-BG-TILE (PIXMAP.ARRAY DST-BG-TILE) NIL))*
             (DST-BACKING-STORE   (and DST-WINDOW-P
				       (WINDOW.BACKING-STORE-valid DST-DRAWABLE)
				       (WINDOW.BACKING-STORE  DST-DRAWABLE)))
             ;1; DO SOURCE AND DESTINATION HAVE THE SAME ..*
             ;1; GC COMPONENTS *
             (ALU                 (GCONTEXT.ALU GC))
             (ACCOUNT-FOR-KIDS-P   (EQL SUBWINDOW-MODE-CLIP-BY-CHILDREN (GCONTEXT.SUBWINDOW-MODE GC)))
             (GRAPHICS-EXPOSURES (and do-exposure-events (GCONTEXT.GRAPHICS-EXPOSURES GC)))
;1;;             (CLIP-P              (GCONTEXT.CLIP-P GC))*
             ;1; LIST OF CLIPPING REGIONS.  THESE HAVE ALREADY BEEN ADJUSTED BY THE CLIP-ORIGIN.*
             ;1; THE CLIP-MASK RESTRICTS WRITES TO THE DESTINATION DRAWABLE.*
             (CLIP-MASK          (GCONTEXT.CLIP-MASK GC))
             ;1;IF CLIP-MASK IS NONE, THEN PIXELS ARE ALWAYS DRAWN*
             ;1; EVENT VALUES*
             (MAJOR-OPCODE COPY-AREA-OPCODE)        ;1 IF COPY PLANE, THEN OPCODE IS COPY-PLANE-OPCODE (63)*
             INTERSECTING-BOXES
             ;1; USED TO ALIGN THE X AND Y POSITION OF THE SOURCE SO IT MATCHES THE DESTINATION X Y.*
             ALIGN-X
             ;1; DITTO MAYBE WE CAN, HOWEVER, GET BY WITH JUST SRC-X, AND Y REBOUND...*
             ALIGN-Y)
       ;1; IF BACKING STORE MAKE ME INTO A BACKING STORE PIXMAP TO SIMPLIFY LIFE..*
       (when DST-BACKING-STORE
	 (setq dst-array (pixmap.array dst-backing-store)
	       abs-dst-x dst-x abs-dst-y dst-y
	       dst-os-boxes t))
       (setq dst-box (MAKE-BOX :LEFT ABS-DST-X :TOP ABS-DST-Y :WIDTH WIDTH  :HEIGHT HEIGHT))
       (WHEN SRC-BACKING-STORE
	 (SETQ SRC-ARRAY (pixmap.array SRC-BACKING-STORE)
	       ABS-SRC-X SRC-X ABS-SRC-Y SRC-Y
	       SRC-OS-BOXES  T))
       (setq src-box (MAKE-BOX :LEFT ABS-SRC-X :TOP ABS-SRC-Y :WIDTH WIDTH :HEIGHT HEIGHT))
       (when (eq src-os-boxes t)
	 (setq src-os-boxes
	       (list (cond (src-backing-store
			    (make-box :left 0 :top 0
				      :right (window.width src-drawable)
				      :bottom (window.height src-drawable)))
			   (src-window-p
			    (make-window-box-interior src-drawable))
			   (t
			    (make-box :left 0 :top 0
				      :right (pixmap.width src-drawable)
				      :bottom (pixmap.height src-drawable)))))))
       (SETQ  SRC-BOXES-TO-COPY
              (and SRC-OS-BOXES
		   (SET-INTERSECT-BOXES SRC-OS-BOXES SRC-BOX)))
       ;1; DEAL WITH CHILDREN WHO MAY BE OCCLUDING SOURCE-BOX*
       (WHEN (AND ACCOUNT-FOR-KIDS-P SRC-WINDOW-P (not src-backing-store))
	 (loop for child being the xwindow-children of src-drawable
	       when (AND (window.mapped-p child)
                         (NOT (EQL (window.class child) input-only))) do
	       (SETQ SRC-BOXES-TO-COPY (SUBTRACT-BOX SRC-BOXES-TO-COPY (MAKE-WINDOW-BOX CHILD)))))
       
        1;*;1 IF THE DST-DRAWABLE IS A WINDOW WITH A BACKGROUND OTHER THAN*
        ;;1NONE, THESE* 1CORRESPONDING* 1DESTINATION REGIONS ARE TILED (WITH*
        ;;1PLANE-MASK OF ALL ONES AND* 1FUNCTION* 1COPY) WITH THAT*
        ;;1BACKGROUND.  REGARDLESS OF TILING, AND WHETHER* 1THE*
        ;;1DESTINATION IS A WINDOW OR A PIXMAP.*
       (when (eq dst-os-boxes t)
	 (setq dst-os-boxes
	       (list (cond (dst-backing-store
			    (make-box :left 0 :top 0
				      :right (window.width dst-drawable)
				      :bottom (window.height dst-drawable)))
			   (dst-window-p
			    (make-window-box-interior dst-drawable))
			   (t
			    (make-box :left 0 :top 0
				      :right (pixmap.width dst-drawable)
				      :bottom (pixmap.height dst-drawable)))))))
       (SETQ DST-BOXES-TO-COPY
	     (and DST-OS-BOXES
		  (SET-INTERSECT-BOXES DST-OS-BOXES DST-BOX)))
       ;1; DEAL WITH CHILDREN WHO MAY BE OCCLUDING SOURCE-BOX*
       (WHEN (AND ACCOUNT-FOR-KIDS-P DST-WINDOW-P)
	 (loop for child being the xwindow-children of dst-drawable
	       when (AND (window.mapped-p child)
                         (NOT (EQL (window.class child) input-only))) do
	       (SETQ DST-BOXES-TO-COPY (SUBTRACT-BOX DST-BOXES-TO-COPY (MAKE-WINDOW-BOX CHILD)))))
       ;1; SAVE THE FOLLOWING X AND Y SO WE CAN RE-ALIGN LATER WHEN WE GRAB THE SOURCE BITS!*
       (SETQ ALIGN-X  (- ABS-DST-X ABS-SRC-X)
             ALIGN-Y  (- ABS-DST-Y ABS-SRC-Y))
       (SETQ SRC-BOXES-TO-COPY (DELETE NIL (THE LIST SRC-BOXES-TO-COPY) :TEST #'EQ))
       ;1; ALIGN SRC-X Y TO DESTINATION BOX COORDINATES*
       (DOLIST (C-BOX SRC-BOXES-TO-COPY)
	 (translate-box c-box align-x align-y))
       (translate-box src-box align-x align-y)
       (when (AND dst-backing-store dst-boxes-to-copy)   ;1;Make sure there IS a destination box.*
	 (assert (not (cdr dst-boxes-to-copy))) ;1; There can be only one box...*
	 (add-refresh-region dst-drawable (translate-box (copy-box (car dst-boxes-to-copy))
							 (WINDOW.ABSOLUTE-inside-X DST-DRAWABLE)
							 (WINDOW.ABSOLUTE-inside-y DST-DRAWABLE))))
       (Cond ((NOT SRC-BOXES-TO-COPY)       ;1 NO NEED TO COPY AS EVERYTHING OCCLUDED OR NOT MAPPED AND NO BS.*
              (WHEN GRAPHICS-EXPOSURES
		(NO-EXPOSURE-EVENT  STATE DST-DRAWABLE MAJOR-OPCODE)))
             ((NOT (SETQ INTERSECTING-BOXES (SET-INTERSECT-BOX-SETS DST-BOXES-TO-COPY SRC-BOXES-TO-COPY)))
              (WHEN GRAPHICS-EXPOSURES		;1 IF NO SRC AND DST 'OVERLAP', CAN'T DO IT.*
		(NO-EXPOSURE-EVENT  STATE DST-DRAWABLE MAJOR-OPCODE)))
             
             ;1; WHAT ABOUT THE CASE OF BACKGROUND TILE AND OVERLAP???*
             
             ;1; RENDER THE DESTINATION *
             (CLIP-MASK                     ;1 IF THERE IS A CLIP-MASK, CLIP OUR COMPOSITE BOXES.. *
              ;1; IF A CLIP-MASK AND NO INTERSECTION OF CLIP-MASK-BOX AND  INTERSECTED SRC AND DST BOXES.*
              ;1; WE ASSUME THAT INTERSECTING-BOXES VARIABLE HAS A VALUE IF WE MADE IT THIS FAR IN THE COND.*
              (LET* ((CLIP-ORIGIN (GCONTEXT.CLIP-ORIGIN GC))
		     (CLIP-X-ORG  (POINT.X CLIP-ORIGIN))
		     (CLIP-Y-ORG  (POINT.Y CLIP-ORIGIN))
                     (CLIP-ARRAY  (PIXMAP.ARRAY CLIP-MASK))
                     (CLIP-BOX    (MAKE-BOX :LEFT  CLIP-X-ORG
                                            :TOP   CLIP-Y-ORG
                                            :WIDTH (PIXMAP.WIDTH CLIP-MASK)
                                            :HEIGHT (PIXMAP.HEIGHT CLIP-MASK))))
	1             *;1; THE TILE/STIPPLE AND CLIP ORIGINS ARE INTERPRETED RELATIVE TO THE*
	1             *;1; ORIGIN OF WHATEVER DESTINATION DRAWABLE IS SPECIFIED IN A GRAPHICS REQUEST.*
		(when dst-window-p
		  (incf clip-x-org (WINDOW.ABSOLUTE-INSIDE-X DST-DRAWABLE))
		  (incf clip-y-org (WINDOW.ABSOLUTE-INSIDE-Y DST-DRAWABLE)))
                (PROGN (SETQ INTERSECTING-BOXES (SET-INTERSECT-BOXES INTERSECTING-BOXES CLIP-BOX))
                       (IF (null INTERSECTING-BOXES)
			   (NO-EXPOSURE-EVENT STATE DST-DRAWABLE MAJOR-OPCODE)
			 ;1; IF ANY BOXES LEFT TO RENDER DO SO 'UNDER MASK'*
			 (DOLIST (THE-BOX  INTERSECTING-BOXES)
			   (LET* ((LEFT    (BOX.LEFT   THE-BOX))
				  (TOP     (BOX.TOP    THE-BOX))
				  (WIDTH   (BOX.WIDTH  THE-BOX))
				  (HEIGHT  (BOX.HEIGHT THE-BOX))
				  (x (- LEFT ALIGN-X))
				  (y (- TOP ALIGN-Y)))
			     ;1; Making width or height negative causes bitblt to copy from bottom to top or right to left*
			     (when (> left x) (setq width (- width)))
			     (when (> top y) (setq height (- height)))
			     ;1;MUST REVERT TO OLD SRC COORDINATES TO GET BOXES OF SOURCE REGION.*
			     (BITBLT-UNDER-MASK ALU WIDTH HEIGHT
						CLIP-ARRAY (- LEFT clip-x-org) (- TOP clip-y-org)
						SRC-ARRAY x y
						DST-ARRAY  LEFT  TOP)))
			 (let ((boxes (set-subtract-boxes (list src-box) intersecting-boxes)))
			   (when (and dst-window-p boxes)
			     (expose-events state dst-drawable boxes nil))
			   (WHEN GRAPHICS-EXPOSURES
			     ;1; Graphics exposure events are sent when a destination region could *
			     ;1; not be computed do to an obscured or out-of-bounds source region.*
			     (if boxes
				 (loop for count downfrom (length (cdr boxes))
				       for box in boxes do
				       (graphics-exposure-event state dst-drawable
								(box.left box)  (box.top box)
								(box.width box) (box.height box)
								count major-opcode))
			       (no-exposure-event state dst-drawable major-opcode))))))))
             
             (t ;1;ELSE DON'T CLIP*
              (DOLIST (THE-BOX  INTERSECTING-BOXES)
                (LET* ((LEFT    (BOX.LEFT   THE-BOX))
		       (TOP     (BOX.TOP    THE-BOX))
		       (WIDTH   (BOX.WIDTH  THE-BOX))
		       (HEIGHT  (BOX.HEIGHT THE-BOX))
		       (x (- LEFT ALIGN-X))
		       (y (- TOP ALIGN-Y)))
		  ;1; Making width or height negative causes bitblt to copy from bottom to top or right to left*
		  (when (> left x) (setq width (- width)))
		  (when (> top y) (setq height (- height)))
                  (X-BITBLT ALU WIDTH HEIGHT
			    SRC-ARRAY x y
			    DST-ARRAY LEFT TOP)))
	      (when (or graphics-exposures dst-window-p)
		(let ((boxes (set-subtract-boxes (list src-box) intersecting-boxes)))
		  (when (and dst-window-p boxes)
		    (expose-events state dst-drawable boxes nil))
		    ;1; Graphics exposure events are sent when a destination region could *
		1    *;1; not be computed do to an obscured or out-of-bounds source region.*
		  (when graphics-exposures
		    (if boxes
			(loop for count downfrom (length (cdr boxes))
			      for box in boxes do
			      (graphics-exposure-event state dst-drawable
						       (box.left box)  (box.top box)
						       (box.width box) (box.height box)
						       count major-opcode))
		      (no-exposure-event state dst-drawable major-opcode)))))))))))


(defreq Copy-Area ((src-drawable DRAWABLE)
		   (dst-drawable DRAWABLE)
		   (gc GCONTEXT)
		   (src-x INT16)
		   (src-y INT16)
		   (dst-x INT16)
		   (dst-y INT16)
		   (width CARD16)
		   (height CARD16))
  (if (and (eq (drawable-screen src-drawable) (drawable-screen dst-drawable))
	   (eq (drawable-depth  src-drawable) (drawable-depth  dst-drawable)))  ;1may be diff depths*
      (perform-dual-graphics (gc src-drawable dst-drawable)
	(copy-area STATE gc src-drawable src-x src-y dst-drawable dst-x dst-y width height))
      ;1;ELSE  Src-drawable must have the same root and the same depth*
      ;1;      as dst-drawable (else a Match error).*
      (Bad-Match)))


    
(defreq Copy-Plane ((src-drawable DRAWABLE)
		    (dst-drawable DRAWABLE)
		    (gc GCONTEXT)
		    (src-x INT16)
		    (src-y INT16)
		    (dst-x INT16)
		    (dst-y INT16)
		    (width CARD16)
		    (height CARD16)
		    (bit-plane CARD32))
  (cond ((or (zerop bit-plane) (logtest bit-plane (1- bit-plane)))
	 (Bad-Value bit-plane))
	((neq (drawable.trait src-drawable) (drawable.trait dst-drawable))
	 (Bad-Match))
	(t
	 (perform-dual-graphics (gc src-drawable dst-drawable)
	   (copy-plane state gc src-drawable src-x src-y dst-drawable dst-x dst-y width height)))))

(defun copy-plane (state gc src-drawable  src-x src-y dst-drawable dst-x dst-y width height)
  "	src-drawable, dst-drawable: DRAWABLE
	gc: GCONTEXT
	src-x, src-y: INT16
	width, height: CARD16
	dst-x, dst-y: INT16
	bit-plane: CARD32

	Src-drawable must have the same root as dst-drawable (else a Match
	error), but need not have the same depth.  Bit-plane must have exactly
	one bit set (else a Value error).  Effectively, a pixmap of the same
	depth as dst-drawable and with size specified by the source region is
	formed used the foreground/background pixels in gc (foreground
	everywhere the bit-plane in src-drawable contains a one bit, background
	everywhere the bit-plane contains a zero bit), and the equivalent of a
	CopyArea is performed, with all the same expsuore semantics.  This can
	also be thought of as using the specified region of the source
	bit-plane as a stipple with a fill-style of OpaqueStippled for filling
	a rectangular area of the destination."
  
;;    if fg == 1 and bg ==0, we can do an ordinary CopyArea.
;;    if fg == bg, we can do a CopyArea with alu = ReduceRop(alu, fg)
;;    if fg == 0 and bg == 1, we use the same rasterop, with
;;	source operand inverted.

  ;;(when (and (= bit-plane 1) (plusp (logand (gcontext.plane-mask gc) 1)))
  ;; For the monochrome case, we simply call copy-area
  (LET ((fg  (gcontext.foreground-pixel gc))
        (bg  (gcontext.background-pixel gc))
        (alu (gcontext.alu gc)))
    (COND ((AND (= fg 1) (= bg 0))
           (copy-area state gc src-drawable src-x src-y dst-drawable dst-x dst-y width height))
          ((= fg bg)
           (SETF (gcontext.alu gc) (reduce-raster-ops alu fg))
           (copy-area state gc src-drawable src-x src-y dst-drawable dst-x dst-y width height)
           (SETF (gcontext.alu gc) alu))
          (t ;1ELSE  (fg = 0, bg = 1)*
           (SETF (gcontext.alu gc) (inverted-alu alu))
           (copy-area state gc src-drawable src-x src-y dst-drawable dst-x dst-y width height)
           (SETF (gcontext.alu gc) alu)))))

;;;(defreq Create-Pixmap ((depth CARD8)
;;;		       (pixmap NEWID)
;;;		       (drawable PIXWIN)
;;;		       (width (CARD16 0))
;;;		       (height (CARD16 0)))
;;;  )

;;;(MACROEXPAND-1 '(defreq Create-Pixmap ((depth CARD8)
;;;		       (pixmap NEWID)
;;;		       (drawable PIXWIN)
;;;		       (width (CARD16 0))
;;;		       (height (CARD16 0)))
;;;  ))
;1;; The following is the expanded version of the previous macro call, except*
;1;; for the fix to the depth check.*

;1; THIS FUNCTION IS A HACKED VERSION THAT IS USED INTERNALLY BY THE*
;1; SERVER. THE FOLLOWING FUNCTION IS WHAT YOU GET WHEN THE THE*
;1; CLIENT DOES A  CREATE-PIXMAP REQUEST IN CLX.*
(DEFUN CREATE-PIXMAP (DRAWABLE WIDTH HEIGHT DEPTH &OPTIONAL (INITIAL-ELEMENT 0))
  (WHEN (TYPEP DEPTH 'GCONTEXT)
    ;1; Make the pixmap the same depth as the graphics context.*
    (SETQ DEPTH (GCONTEXT.DEPTH DEPTH)))
  (MAKE-PIXMAP :WIDTH WIDTH
               :HEIGHT HEIGHT
               :TRAIT (AND DRAWABLE (DRAWABLE.TRAIT DRAWABLE))
               :CLIP-MASK NIL
               :ARRAY (CREATE-PIXMAP-ARRAY WIDTH HEIGHT DEPTH INITIAL-ELEMENT)
               :TYPE PIXMAP-RESOURCE-TYPE))

(DEFUN CREATE-PIXMAP-FOR-CLIENT ( DEPTH PIXMAP DRAWABLE WIDTH HEIGHT  ) ;1&OPTIONAL (INITIAL-ELEMENT 0)*
  "2PIXMAP: PIXMAP
   drawable: DRAWABLE
   depth: CARD8
   width, height: CARD16
  
  Creates a pixmap, and assigns the identifier pid to it.
  The initial contents of the pixmap are undefined.*"
  
  (if (AND (WINDOW-P DRAWABLE) (eql (window.class DRAWABLE) Input-Only))
      ;1; It is legal to pass an InputOnly window as a drawable to this request.*
      (BAD-MATCH)
      ;1;ELSE*
      (LET ((BAD-WID-OR-HI (OR (ZEROP WIDTH) (ZEROP HEIGHT))))
        (IF BAD-WID-OR-HI 
            ;1; Width and height must be non-zero (else a Value error). *
            (BAD-VALUE BAD-WID-OR-HI)
            ;1;ELSE*
            (IF (NOT (EQL DEPTH (CAR *SCREEN-ROOT-DEPTHS*)))    ;1 HACK ALERT. *
                ;1; Depth must be one of the depths supported by root of  drawable (else a Value error).*
                (BAD-VALUE DEPTH)
                ;1;ELSE*
                ;1; (PROGN*
                ;1;   (WHEN (TYPEP DEPTH 'GCONTEXT)*
                ;1; Make the pixmap the same depth as the graphics context.*
                ;1;     (SETQ DEPTH (GCONTEXT.DEPTH DEPTH)))*
                ;1; (setf (PIXMAP.id PIXMAP) PIXMAP)*
                (STORE-RESOURCE pixmap
                                (MAKE-PIXMAP
                                  :id pixmap
                                  :WIDTH WIDTH
                                  :HEIGHT HEIGHT
                                  :TRAIT (DRAWABLE.TRAIT DRAWABLE)
                                  :CLIP-MASK NIL
                                  :ARRAY (CREATE-PIXMAP-ARRAY WIDTH HEIGHT DEPTH)
                                  :TYPE PIXMAP-RESOURCE-TYPE)))))))


(defreq Create-Pixmap ((depth CARD8)
		       (pixmap NEWID)
		       (drawable PIXWIN)
		       (width (CARD16 0))
		       (height (CARD16 0)))
  (CREATE-PIXMAP-FOR-CLIENT DEPTH PIXMAP DRAWABLE WIDTH HEIGHT))

(DEFUN FREE-PIXMAP (PIXMAP)
  "2Deletes the association between the resource id and the pixmap.  The
  pixmap storage will be freed when no other resource references it.*"
  (let ((id (PIXMAP.id PIXMAP)))
    (remove-resource id :drawable)
    (setq PIXMAP nil)))

(defreq Free-Pixmap ((:solo)
		     (pixmap PIXMAP))
  (FREE-PIXMAP PIXMAP))


(defun box-not-inside-drawable-p (box-x box-y box-width box-height drawable-left drawable-top drawable-right drawable-bot)
  "2Small routine used internal to get-image. Returns T is a box is  NOT wholly
   contained within the drawable boundaries*"	
  (or (< box-x drawable-left)		
      (< box-y drawable-top)
      (> (+ box-x box-width)  drawable-right)
      (> (+ box-y box-height) drawable-bot)))

;1test code*
	    
;1;;(setq  rect-x 50 rect-y 50  width 50  height 50  drawable-x 0 drawable-y 0  drawable-right 200  drawable-bot 50)*

;1;;(box-not-inside-drawable-p rect-x rect-y width height drawable-x drawable-y drawable-right drawable-bot)*
	 

(defreq Get-Image ((:graphics)
		   (format (CARD8 XYPixmap-Format ZPixmap-Format))
		   (drawable DRAWABLE)
		   (x INT16)
		   (y INT16)
		   (width CARD16)
		   (height CARD16)
		   (plane-mask CARD32))
  (Get-Image state format drawable x y width height plane-mask))

(defun Get-Image (state format drawable x y width height plane-mask)
  "
    =>
	depth: CARD8
	visual: VISUALID or None
	data: LISTofBYTE

	Errors: Drawable, Value, Match

	Returns the contents of the given rectangle of the drawable in the
	given format.  The x and y coordinates are relative to the drawable's
	origin, and define the upper left corner of the rectangle.  If XYPixmap
	is specified, only the bit planes specified in plane-mask are
	transmitted, with the planes appearing from most to least significant
	in bit order.  If ZPixmap is specified, then bits in all planes not
	specified in plane-mask transmitted as zero.  Range checking is not
	performed on plane-mask; extraneous bits are simpy ignored.  The
	returned depth is as specified when the drawable was created, and is
	the same as a depth component in a FORMAT structure (in the connection
	setup), not a bits-per-pixel component. 


           note that:

	This request is not 'general purpose' in the same sense as other
	graphics-related requests.  It is intended specifically for rudimentary
	hardcopy support."
  (let* ((window-p         (window-p drawable))
	 (pixmap-p         (not window-p))
	 (drawable-x       (if window-p (window.absolute-x-corner drawable) 0)) ;1outside *
	 (drawable-y       (if window-p (window.absolute-y-corner drawable) 0))
	 (bwidth	   (if window-p (window.bwidth drawable) 0))
	 (drawable-right   (if window-p (+ drawable-x (window.width drawable) bwidth bwidth)
                               ;1;else*
			       (pixmap.width drawable)))	
	 (drawable-bot     (if window-p (+ drawable-y (window.height drawable) bwidth bwidth)
                               ;1;else*
			       (pixmap.height drawable)))
	 (rect-x           (+ x drawable-x bwidth))
	 (rect-y           (+ y drawable-y bwidth))
         
         (visual     (IF window-p (GETHASH (window.visual drawable) *resources*) NIL))
;	 (vclass     (if visual (visual.class visual) nil))
         (vid        (IF visual (visual.vid visual) 0))
         (depth      (IF window-p (drawable-depth drawable) 1))
         (backing-store (and window-p
			     (window.backing-store-valid drawable)
			     (window.backing-store drawable)))
         (temp-gc (make-gcontext 
                                 :depth  depth
                                 :alu    GX-COPY
                                 :plane-mask plane-mask
                                 :serial-number 0
                                 :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
                                 :font nil
                                 :tile NIL
                                 :stipple NIL
                                 :pattern-originp (make-point)
                                 :subwindow-mode Subwindow-Mode-Clip-By-Children
                                 :graphics-exposures NIL
                                 :clip-mask NIL
                                 :clip-origin (make-point)
                                 :client-clip-type NIL
                                 :num-in-dash-list 2
                                 :dash (MAKE-ARRAY 2 :element-type 'integer)
                                 :dash-offset 0)))
    (SETF (point.x (gcontext.pattern-Originp temp-gc)) 0)
    (SETF (point.y (gcontext.pattern-Originp temp-gc)) 0)
    (SETF (point.x (gcontext.clip-Origin temp-gc)) 0)
    (SETF (point.y (gcontext.clip-Origin temp-gc)) 0)
    (setf (aref (gcontext.dash temp-gc) 0) 4)
    (setf (aref (gcontext.dash temp-gc) 1) 4)
    (using-resource (temp-pixmap pixmap drawable width height 1 nil) ;1; no initial element*
      (COND (pixmap-p                    ;1If the drawable is a pixmap, then the given rectangle must be wholly*
	     (IF (box-not-inside-drawable-p rect-x rect-y width height drawable-x
					    drawable-y drawable-right drawable-bot)
		 (return-from get-image (bad-match))
	       ;1;ELSE*
	       ;1;*(copy-area state temp-gc drawable x y temp-pixmap 0 0 width height)
	       (x-bitblt gx-copy width height
			 (pixmap.array drawable) x y
			 (pixmap.array temp-pixmap) 0 0)))
	    (window-p				;1 If the drawable is a window*
	     (IF (OR (NOT (window.mapped-p drawable))	;1the window must be mapped,*
		     (NOT (or backing-store
			      (EQL T (window.occlusion-stack drawable))	;1fully visible?*
			      (loop for box in (window.occlusion-stack drawable)
				    unless (box-not-inside-drawable-p
					     rect-x rect-y width height
					     (box.left box) (box.top box) (box.right box) (box.bottom box))
				    return t)))
		     (box-not-inside-drawable-p rect-x rect-y width height
						drawable-x drawable-y drawable-right drawable-bot))
		 (return-from get-image (bad-match))
	       ;1;ELSE*
						;1return the contents of the window here!!!*
	       ;1; If the window has a backing-store, then the backing-store contents are*
	       ;1; returned for regions of the window that are obscured by non-inferior*
	       ;1; windows, but otherwise the returned contents of such obscured regions*
	       ;1; are undefined.  Also undefined are the returned contents of visible*
	       ;1; regions of inferiors of different depth than the specified window.*
	       (IF backing-store
		   ;1;*(copy-area state temp-gc backing-store x y temp-pixmap 0 0 width height NIL)
		   (x-bitblt gx-copy width height
			     (pixmap.array backing-store) x y
			     (pixmap.array temp-pixmap) 0 0)
		 ;;1ELSE*
		 ;1;*(copy-area state temp-gc drawable x y temp-pixmap 0 0 width height NIL))
		 (x-bitblt gx-copy width height
			   (device-private-array drawable)
			   (+ x (window.absolute-inside-x drawable))
			   (+ y (window.absolute-inside-y drawable))
			   (pixmap.array temp-pixmap) 0 0))
	       )))
      (let* ((line-width  (ceiling (tv:round-up-to-32 width) 8))
	     (line-length (ceiling (array-dimension (pixmap.array temp-pixmap) 1) 8))
	     (reply-length (* height line-width))
	     (reply-vector (MAKE-ARRAY (* height line-length)
				       :element-type 'card8
				       ;1; The following is not Common Lisp.*
				       :displaced-to (pixmap.array temp-pixmap))))
	(COND ((OR (EQL format ZPIXMAP-FORMAT)
		   (AND (EQL format XYPIXMAP-FORMAT)
			(= depth 1)))
	       (format-reply (state (ceiling reply-length 4))
		 :byte depth
		 :long vid)
	       (SERVER-PUSH STATE)
	       (loop repeat height
		     for i upfrom 0 by line-length
		     do (server-string-out state reply-vector (+ i line-width) i))
	       (server-reply-pad reply-length state)
	       (SERVER-PUSH STATE))
	      (t				;1format = XYPIXMAP-FORMAT AND depth not = 1*
	       (ERROR "3GET-IMAGE not yet implemented for XYPIXMAP-FORMAT and depth = ~d*" depth)))))))

(defun put-image (state drawable gc  depth  width height drawable-x drawable-y
                  left-pad format bytes byte-offset length)
  "
	If Bitmap format is used, then depth must be one (else a Match error)
	and the image must be in XYFormat.  The foreground pixel in gc defines
	the source for one bits in the image, and the background pixel defines
	the source for the zero bits.

;;;	For XYPixmap and ZPixmap, depth must match the depth of drawable (else
;;;	a Match error).  For XYPixmap, the image must be sent in XYFormat .  For
;;;	ZPixmap, the image must be sent in the ZFormat defined for the given
;;;	depth.

	The left-pad must be zero for ZPixmap format (else a Match error).  For
	Bitmap and XYPixmap format, left-pad must be less than
	bitmap-scanline-pad as given in the server connection setup info (else
	a Match error).  The first left-pad bits in every scanline are to be
	ignored by the server; the actual image begins that many bits into the
	data.  The width argument defines the width of the actual image, and
	does not include left-pad.

	GC components: function, plane-mask, subwindow-mode, clip-x-origin,
	clip-y-origin, clip-mask

	GC mode-dependent components: foreground, background"
  
  (cond ((and (eql format xybitmap-format)  (not (eql depth 1)))
	 (bad-match))
	((and (or (eql format zpixmap-format) (eql format xypixmap-format))    ;1 bitmap -format *
	       (not (eql depth (drawable-trait.depth (drawable.trait drawable)))))
	  (bad-match))
	((and (eql format zpixmap-format)
		   (not (zerop left-pad)))
	      (bad-match))
	((and (or (eql format xybitmap-format) (eql format xypixmap-format))
	      (>= left-pad  (car *pixmap-format-scanline-pads* )))     ;1 bitmap-scanline-pad))*
	 (bad-match))
	((not (= length (ceiling (* height (tv:round-up-to-32 (* width depth))) 8)))
	 (bad-value width))
	((and (not (zerop width)) (not (zerop height)) (= depth 1))
	 (let ((fake-pixmap (make-pixmap
			      :width width
			      :height height
			      :array (MAKE-ARRAY
				       (list height (tv:round-up-to-32 (+ width
									  left-pad)))
				       :element-type 'bit
				       ;1; The following is not Common Lisp.*
;1;*				       :displaced-to bytes
;1;*				       :displaced-index-offset (* 8 byte-offset)
				       )
			      :type Pixmap-Resource-Type)))
	   (replace ;1; bitblt doesn't grok displaced-index-offset, so we gotta copy it (grumble....)*
	     (make-array length :element-type 'card8 :displaced-to (pixmap.array fake-pixmap))
	     bytes :start2 byte-offset :end2 (+ byte-offset length))
	   (if (eql format XYBitmap-Format)
	       (copy-plane state gc fake-pixmap left-pad 0 drawable drawable-x drawable-y width height)
	     ;1;ELSE*
	     (copy-area  state gc fake-pixmap left-pad 0 drawable drawable-x drawable-y
			 width height))))))

(ZWEI:DEFINE-INDENTATION BYTE-FLIP (1 1))

(defreq Put-Image ((:graphics)
		   (format (CARD8 XYBitmap-Format XYPixmap-Format ZPixmap-Format))
		   (drawable DRAWABLE)
		   (gc GCONTEXT)
		   (width CARD16)
		   (height CARD16)
		   (dst-x INT16)
		   (dst-y INT16)
		   (left-pad CARD8)
		   (depth CARD8)
		   (:byte))
  (put-image state drawable gc depth width height dst-x dst-y left-pad format bytes byte-offset length))

(DEFUN QueryBestSize (STATE CLASS DRAWABLE WIDTH HEIGHT)
  
  "	class: {Cursor, Tile, Stipple}
	drawable: DRAWABLE
	width, height: CARD16
    =>
	width, height: CARD16

	Errors: Drawable, Value, Match

	Returns the ''best'' size that is ''closest'' to the argument size.  For
	Cursor, this is the largest size that can be fully displayed.  For
	Tile, this is the size that can be tiled ''fastest''.  For Stipple, this
	is the size that can be stippled ''fastest''.

	For Cursor, the drawable indicates the desired screen.  For Tile and
	Stipple, the drawable indicates screen, and also possibly window class
	and depth; an InputOnly window cannot be used as the drawable for Tile
	or Stipple (else a Match error)."
  
  (IF (AND (WINDOW-P DRAWABLE)
           (OR (EQL CLASS  Tile-Shape ) (EQL CLASS Stipple-Shape))
           (eql (window.class DRAWABLE) Input-Only))
      (BAD-MATCH)
      ;1;ELSE*
      (LET (BEST-WID BEST-HI)
	(cond ((EQL CLASS Cursor-Shape )     (SETQ BEST-WID WIDTH     BEST-HI HEIGHT))
	      ((EQL CLASS Tile-Shape   )     (SETQ BEST-WID WIDTH     BEST-HI HEIGHT))
	      ((EQL CLASS Stipple-Shape)     (SETQ BEST-WID WIDTH     BEST-HI HEIGHT)))
	(FORMAT-REPLY (STATE )
		      :WORD BEST-WID
		      :WORD BEST-HI)
        (SERVER-PUSH STATE))))


(defreq Query-Best-Size ((class (CARD8 Cursor-Shape Tile-Shape Stipple-Shape))
			 (drawable DRAWABLE)
			 (width CARD16)
			 (height CARD16))
  (QueryBestSize STATE CLASS DRAWABLE WIDTH HEIGHT))