(FILECREATED "24-Jun-85 11:24:20" {ERIS}<LISP>INTERMEZZO>PATCHES>LLDISPLAYPATCH.;2
 5553   

      changes to:  (FNS \BLTSHADE.COLORDISPLAY)

      previous date: "21-Jun-85 17:58:36" {ERIS}<LISP>INTERMEZZO>PATCHES>LLDISPLAYPATCH.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LLDISPLAYPATCHCOMS)

(RPAQQ LLDISPLAYPATCHCOMS
 ((FNS \BLTSHADE.COLORDISPLAY)))
(DEFINEQ

(\BLTSHADE.COLORDISPLAY

  [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
                                                             (* hdj "24-Jun-85 11:23")

                                                             (* BLTSHADE to color display stream)

    (DECLARE
 (
LOCALVARS
 . T))
    (
PROG
 (left top bottom right DESTINATIONNBITS DESTINATIONBITMAP (DESTDD (fetch
 IMAGEDATA
									       of
 STREAM)))
          (
SETQ
 DESTINATIONLEFT (\DSPTRANSFORMX DESTINATIONLEFT DESTDD))
          (
SETQ
 DESTINATIONBOTTOM (\DSPTRANSFORMY DESTINATIONBOTTOM DESTDD))
          [
PROGN
                                             (* compute limits based on clipping regions.)

		 (
SETQ
 left (fetch
 DDClippingLeft of
 DESTDD))
		 (
SETQ
 bottom (fetch
 DDClippingBottom of
 DESTDD))
		 (
SETQ
 right (fetch
 DDClippingRight of
 DESTDD))
		 (
SETQ
 top (fetch
 DDClippingTop of
 DESTDD))
		 (
COND

		   (CLIPPINGREGION                           (* hard case, two destination clipping regions: do 

							     calculations to merge them.)

				   (
PROG
 (CRLEFT CRBOTTOM)
				         [
SETQ
 left (
IMAX
 left (
SETQ
 CRLEFT
							    (\DSPTRANSFORMX (fetch
 LEFT of
 
										   CLIPPINGREGION)
									    DESTDD]
				         [
SETQ
 bottom (
IMAX
 bottom (
SETQ
 CRBOTTOM
							      (\DSPTRANSFORMY (fetch
 BOTTOM
										 of
 CLIPPINGREGION)
									      DESTDD]
				         [
SETQ
 right (
IMIN
 right (
IPLUS
 CRLEFT (fetch
 WIDTH
										  of
 CLIPPINGREGION]
				         (
SETQ
 top (
IMIN
 top (
IPLUS
 CRBOTTOM (fetch
 HEIGHT
										of
 CLIPPINGREGION]
          [
SETQ
 DESTINATIONNBITS (fetch
 (BITMAP BITMAPBITSPERPIXEL) of
 (
SETQ
 DESTINATIONBITMAP
									 (fetch
 DDDestination
									    of
 DESTDD]

          (* left, right top and bottom are the limits in destination taking into account Clipping Regions.

	  Clip to region in the arguments of this call.)



          [
PROGN
 (
SETQ
 left (
IMAX
 DESTINATIONLEFT left))
		 (
SETQ
 bottom (
IMAX
 DESTINATIONBOTTOM bottom))
		 [
COND

		   (WIDTH                                    (* WIDTH is optional)

			  (
SETQ
 right (
IMIN
 (
IPLUS
 DESTINATIONLEFT WIDTH)
					    right]
		 (
COND

		   (HEIGHT                                   (* HEIGHT is optional)

			   (
SETQ
 top (
IMIN
 (
IPLUS
 DESTINATIONBOTTOM HEIGHT)
					   top]
          (
COND

	    ((
OR
 (
ILEQ
 right left)
		 (
ILEQ
 top bottom))                          (* there is nothing to move.)

	      (
RETURN
)))
          [
SETQ
 TEXTURE (
COND

	      ((
NULL
 TEXTURE)
		(
DSPBACKCOLOR
 NIL STREAM))
	      ((
LITATOM
 TEXTURE)                             (* should be a color name)

		(
OR
 (COLORNUMBERP TEXTURE DESTINATIONNBITS T)
		    (
\ILLEGAL.ARG
 TEXTURE)))
	      [(
FIXP
 TEXTURE)                                (* if fixp use the low order bits as a color number.

							     This picks up the case of BLACKSHADE being used to 

							     INVERT.)

		(
OR
 (COLORNUMBERP TEXTURE DESTINATIONNBITS T)
		    (
LOGAND
 TEXTURE (
COND

			      ((
EQ
 DESTINATIONNBITS 4)
				15)
			      (T 255]
	      ((
LISTP
 TEXTURE)                               (* should be a list of levels rgb or hls.)

		(
OR
 (COLORNUMBERP TEXTURE)
		    (
\ILLEGAL.ARG
 TEXTURE)))
	      (T (
\ILLEGAL.ARG
 TEXTURE]                      (* filling an area with a texture.)

          (
SETQ
 left (
ITIMES
 DESTINATIONNBITS left))
          (
SETQ
 right (
ITIMES
 DESTINATIONNBITS right))
          (
SETQ
 TEXTURE (COLORTEXTUREFROMCOLOR# TEXTURE DESTINATIONNBITS))
                                                             (* easy case of black and white bitmap into black and 

							     white or color to color or texture filling.)

          (\INSURETOPWDS STREAM)

          (* We'd rather handle the slow case when we are interruptable, so we do it here as a heuristic.

	  But we might get interrupted before we go interruptable, so we do it there too.)



          (.WHILE.TOP.IF.DS. STREAM DESTINATIONNBITS         (* Just in case the user got in and screwed our window)

			     (
PROG
 ([PILOTBBT (
COND

						((type?
 PILOTBBT \SYSPILOTBBT)
						  \SYSPILOTBBT)
						(T (
SETQ
 \SYSPILOTBBT (create
 PILOTBBT]
				    (HEIGHT (
IDIFFERENCE
 top bottom)))
			           (replace
 PBTWIDTH of
 PILOTBBT with
 (
IDIFFERENCE
 right left))
			           (replace
 PBTHEIGHT of
 PILOTBBT with
 HEIGHT)
			           (
\BITBLTSUB
 PILOTBBT NIL left NIL DESTINATIONBITMAP left
					       (\SFInvert DESTINATIONBITMAP top)
					       HEIGHT
					       (
QUOTE
 TEXTURE)
					       (
OR
 OPERATION (ffetch
 (\DISPLAYDATA DDOPERATION)
								of
 DESTDD))
					       TEXTURE)))
          (
RETURN
 T])
)
(PUTPROPS LLDISPLAYPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (407 5468 (\BLTSHADE.COLORDISPLAY 417 . 5466)))))
STOP