(FILECREATED " 5-Mar-85 15:55:46" {ERIS}<LISPUSERS>AREAFILL.;2 4813   

      changes to:  (FNS FILLWITHTEXTURE)

      previous date: " 5-Mar-85 10:45:38" {ERIS}<LISPUSERS>AREAFILL.;1)


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

(PRETTYCOMPRINT AREAFILLCOMS)

(RPAQQ AREAFILLCOMS ((MACROS PopPosition PushPosition)
		     (FNS FILLWITHTEXTURE SCANLINESEEDFILL)))
(DECLARE: EVAL@COMPILE 

(PUTPROPS PopPosition MACRO [(STACK X Y)
			     (LET ((PAIR (pop STACK)))
			       (SETQ X (fetch (POSITION XCOORD) of PAIR))
			       (SETQ Y (fetch (POSITION YCOORD) of PAIR])

(PUTPROPS PushPosition MACRO ((X Y STACK)
			      (push STACK (CREATEPOSITION X Y))))
)
(DEFINEQ

(FILLWITHTEXTURE
  [LAMBDA (BitmapOrWindow Texture X Y BoundaryValue)         (* hdj " 5-Mar-85 15:53")
    (LET [(COPYBM (COND
		    ((WINDOWP BitmapOrWindow)
		      (LET [(SCRBM (BITMAPCREATE (WINDOWPROP BitmapOrWindow (QUOTE WIDTH))
						 (WINDOWPROP BitmapOrWindow (QUOTE HEIGHT]
			(BITBLT BitmapOrWindow 0 0 SCRBM)
			SCRBM))
		    (T (COPYALL BitmapOrWindow]
      (SCANLINESEEDFILL COPYBM X Y BoundaryValue BoundaryValue)
      (BITBLT BitmapOrWindow 0 0 COPYBM 0 0 NIL NIL (QUOTE INPUT)
	      (QUOTE INVERT))
      (BITBLT COPYBM 0 0 COPYBM 0 0 NIL NIL (QUOTE MERGE)
	      (QUOTE TEXTURE)
	      Texture)
      (BITBLT COPYBM 0 0 BitmapOrWindow 0 0 NIL NIL (QUOTE INPUT)
	      (QUOTE PAINT))
      BitmapOrWindow])

(SCANLINESEEDFILL
  [LAMBDA (BitmapOrWindow X Y BoundaryValue FillValue)       (* hdj "30-Jan-85 15:01")
    (PROG (Xcoord Ycoord STACK SaveX SaveY XLeft XRight XMax YMax)
          [if (BITMAPP BitmapOrWindow)
	      then (SETQ XMax (SUB1 (BITMAPWIDTH BitmapOrWindow)))
		   (SETQ YMax (SUB1 (BITMAPHEIGHT BitmapOrWindow)))
	    else [SETQ XMax (SUB1 (WINDOWPROP BitmapOrWindow (QUOTE WIDTH]
		 (SETQ YMax (SUB1 (WINDOWPROP BitmapOrWindow (QUOTE HEIGHT]
                                                             (* "initialize stack")
          (PushPosition X Y STACK)
          (while STACK
	     do                                              (* get seed pixel and set to new value)
		(PopPosition STACK SaveX SaveY)
		(BITMAPBIT BitmapOrWindow SaveX SaveY FillValue) 
                                                             (* fill span to right of seed pixel)
		(SETQ XRight XMax)
		(for Xcoord from (ADD1 SaveX) while (ILEQ Xcoord XMax)
		   do (if (NEQ (BITMAPBIT BitmapOrWindow Xcoord SaveY)
			       BoundaryValue)
			  then (BITMAPBIT BitmapOrWindow Xcoord SaveY FillValue)
			else                                 (* save the extreme right pixel)
			     (SETQ XRight (SUB1 Xcoord))
			     (RETURN)))                      (* fill span to left of seed pixel)
		(SETQ XLeft 0)
		(for Xcoord from (SUB1 SaveX) by -1 while (IGEQ Xcoord 0)
		   do (if (NEQ (BITMAPBIT BitmapOrWindow Xcoord SaveY)
			       BoundaryValue)
			  then (BITMAPBIT BitmapOrWindow Xcoord SaveY FillValue)
			else                                 (* save the extreme left pixel)
			     (SETQ XLeft (ADD1 Xcoord))
			     (RETURN)))                      (* Push seed points for scan line above.
							     *)
		[COND
		  ((ILESSP SaveY YMax)
		    (SETQ Ycoord (ADD1 SaveY))
		    (for Xcoord from XLeft to XRight
		       when [AND (NEQ (BITMAPBIT BitmapOrWindow Xcoord Ycoord)
				      BoundaryValue)
				 (OR (EQ Xcoord XRight)
				     (OR (EQ (BITMAPBIT BitmapOrWindow (ADD1 Xcoord)
							Ycoord)
					     BoundaryValue)
					 (EQ (BITMAPBIT BitmapOrWindow (ADD1 Xcoord)
							Ycoord)
					     FillValue]
		       do (PushPosition Xcoord Ycoord STACK]
                                                             (* Push seed points for scan line below.
							     *)
		(COND
		  ((IGREATERP SaveY 0)
		    (SETQ Ycoord (SUB1 SaveY))
		    (for Xcoord from XLeft to XRight
		       when [AND (NEQ (BITMAPBIT BitmapOrWindow Xcoord Ycoord)
				      BoundaryValue)
				 (OR (EQ Xcoord XRight)
				     (OR (EQ (BITMAPBIT BitmapOrWindow (ADD1 Xcoord)
							Ycoord)
					     BoundaryValue)
					 (EQ (BITMAPBIT BitmapOrWindow (ADD1 Xcoord)
							Ycoord)
					     FillValue]
		       do (PushPosition Xcoord Ycoord STACK])
)
(PUTPROPS AREAFILL COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (747 4734 (FILLWITHTEXTURE 757 . 1569) (SCANLINESEEDFILL 1571 . 4732)))))
STOP