(FILECREATED "19-Sep-85 17:44:23" {DSK}<LISPFILES>HLDISPLAY.;6
 105820 

      changes to:  (FNS EDITBMSCROLLFN GRID GRIDXCOORD GRIDYCOORD LEFTOFGRIDCOORD BOTTOMOFGRIDCOORD 
			SHADEGRIDBOX INSIDE? MOUSESTATE-EXPR MOUSESTATE-NAME DECODEBUTTONS 
			PTDIFFERENCE PTPLUS GETPOSITION GETBOXPOSITION DSPYSCREENTOWINDOW 
			DSPXSCREENTOWINDOW GETREGION \GETREGION.PACKPTS \GETREGION.CHECKBASEPT 
			\GETREGION.CHECKOPPT \GETREGIONTRACKWITHBOX \UPDATEXYANDBOX GETBOXREGION 
			\TRACKWITHBOX MOVEBOX DRAWGRAYBOX BLTHLINE BLTVLINE SETCORNER MOUSECONFIRM 
			NEAREST/PT/ON/GRID PTON10GRID NEAREST/MULTIPLE \SW2BM COMPOSEREGS 
			TRANSLATEREG EDITBM EDITBMCLOSEFN TILEAREA EDITBMBUTTONFN 
			\EDITBM/PUTUP/DISPLAY \EDITBMHOWMUCH EDITBMRESHAPEFN EDITBMREPAINTFN 
			UPDATE/SHADE/DISPLAY UPDATE/BM/DISPLAY/SELECTED/REGION SHOWBUTTON RESETGRID 
			\READBMDIMENSIONS EDITSHADE \BITMAPFROMTEXTURE EDITSHADEREPAINTFN GRAYBOXAREA 
			\SHADEBITS READHOTSPOT WBOX \CLEARBM EXPANDBITMAP SHRINKBITMAP \FAST4BIT)
		   (VARS DASHEDSHADE \4BITEXPANSIONTABLE)

      previous date: " 4-Sep-85 21:03:00" {DSK}<LISPFILES>HLDISPLAY.;4)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT HLDISPLAYCOMS)

(RPAQQ HLDISPLAYCOMS
 ((* GRID functions)
	(FNS GRID GRIDXCOORD GRIDYCOORD LEFTOFGRIDCOORD BOTTOMOFGRIDCOORD EDITBMSCROLLFN SHADEGRIDBOX)
	(* Low level compatibility and extensions)
	(FNS INSIDE?)
	[COMS (* Mouse selection code)
	      (FNS MOUSESTATE-EXPR MOUSESTATE-NAME)
	      (PROP ARGNAMES MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE LASTKEYSETSTATE)
	      (EXPORT (DECLARE: DOCOPY (MACROS MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE 
					       LASTKEYSETSTATE))
		      (DECLARE: DONTCOPY (MACROS WITHIN))
		      (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS]
	(* High Level Display utilities)
	(FNS DECODEBUTTONS)
	(FNS PTDIFFERENCE PTPLUS)
	(COMS (* User interaction for regions, etc)
	      (FNS GETPOSITION GETBOXPOSITION DSPYSCREENTOWINDOW DSPXSCREENTOWINDOW GETREGION 
		   \GETREGION.PACKPTS \GETREGION.CHECKBASEPT \GETREGION.CHECKOPPT 
		   \GETREGIONTRACKWITHBOX \UPDATEXYANDBOX GETBOXREGION \TRACKWITHBOX MOVEBOX 
		   DRAWGRAYBOX BLTHLINE BLTVLINE SETCORNER)
	      (FNS MOUSECONFIRM)
	      (CURSORS MOUSECONFIRMCURSOR))
	(FNS NEAREST/PT/ON/GRID PTON10GRID NEAREST/MULTIPLE)
	(EXPORT (MACROS IABS))
	(UGLYVARS DASHEDSHADE)
	(CURSORS CROSSHAIRS EXPANDINGBOX FORCEPS BOXCURSOR LOCKEDSPOT OLDEXPANDINGBOX LowerLeftCursor 
		 UpperRightCursor UpperLeftCursor LowerRightCursor)
	(FNS \SW2BM COMPOSEREGS TRANSLATEREG)
	(COMS (* Bitmap and shade editors)
	      (FNS EDITBM EDITBMCLOSEFN TILEAREA EDITBMBUTTONFN \EDITBM/PUTUP/DISPLAY \EDITBMHOWMUCH 
		   EDITBMRESHAPEFN EDITBMREPAINTFN UPDATE/SHADE/DISPLAY 
		   UPDATE/BM/DISPLAY/SELECTED/REGION SHOWBUTTON RESETGRID \READBMDIMENSIONS EDITSHADE 
		   \BITMAPFROMTEXTURE EDITSHADEREPAINTFN GRAYBOXAREA \SHADEBITS READHOTSPOT WBOX 
		   \CLEARBM)
	      (DECLARE: DONTCOPY (RECORDS BUTTON)
			(MACROS BITMASK UPDATE/BM/DISPLAY))
	      (DECLARE: DONTEVAL@LOAD DOCOPY (VARS (DARKBITSHADE 23130)
						   (NORMALGRIDSQUARE 16)
						   (NOTINUSEGRAY 42405)
						   (EDITBMMENU)
						   (EDITBMWINDOWMENU)
						   (GRIDSIZEMENU)
						   (CLICKWAITTIME 250)))
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE 
							    NOTINUSEGRAY EDITBMMENU CLICKWAITTIME))
	      (CONSTANTS (GRIDTHICKNESS 2)
			 (MINGRIDSQUARE 8)
			 (MAXGRIDWIDTH 199)
			 (MAXGRIDHEIGHT 175)
			 (BMWINDOWSHADE 33410)))
	(FNS EXPANDBITMAP SHRINKBITMAP \FAST4BIT)
	(UGLYVARS \4BITEXPANSIONTABLE)))



(* GRID functions)


(DEFINEQ

(GRID

  [LAMBDA (GRIDSPEC WIDTH HEIGHT BORDER DS GRIDSHADE)        (* rrb "21-MAR-83 18:27")

                                                             (* draws a grid)

    (PROG ((X0 (fetch
 (REGION LEFT) of
 GRIDSPEC))
	   (Y0 (fetch
 (REGION BOTTOM) of
 GRIDSPEC))
	   (SQWIDTH (fetch
 (REGION WIDTH) of
 GRIDSPEC))
	   (SQHEIGHT (fetch
 (REGION HEIGHT) of
 GRIDSPEC))
	   (GRIDSHADE (COND
			((TEXTUREP GRIDSHADE))
			(T BLACKSHADE)))
	   LINELENGTH TWICEBORDER)
          (COND
	    ((OR (ZEROP BORDER)
		 (NULL BORDER))                              (* don't draw anything.)

	      (RETURN))
	    ((NUMBERP BORDER)
	      (SETQ TWICEBORDER (ITIMES BORDER 2))
	      (PROGN 

          (* draw vertical lines use BITBLT so that we don't have to correct for the width of the line since line drawing will

	  put the coordinate in the middle.)



		     (BITBLT NIL NIL NIL DS X0 Y0 BORDER (SETQ LINELENGTH (ITIMES HEIGHT SQHEIGHT))
			     (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     GRIDSHADE)
		     (for
 X from
 (IDIFFERENCE (IPLUS X0 SQWIDTH)
					      BORDER)
			to
 (IDIFFERENCE (IPLUS X0 (ITIMES (SUB1 WIDTH)
							  SQWIDTH))
					BORDER)
			by
 SQWIDTH do
 (BITBLT NIL NIL NIL DS X Y0 TWICEBORDER LINELENGTH
					      (QUOTE TEXTURE)
					      (QUOTE REPLACE)
					      GRIDSHADE))
		     (BITBLT NIL NIL NIL DS (IDIFFERENCE (IPLUS X0 (ITIMES WIDTH SQWIDTH))
							 BORDER)
			     Y0 BORDER LINELENGTH (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     GRIDSHADE))
	      (PROGN                                         (* draw horizontal lines)

		     (BITBLT NIL NIL NIL DS X0 Y0 (SETQ LINELENGTH (ITIMES WIDTH SQWIDTH))
			     BORDER
			     (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     GRIDSHADE)
		     (for
 Y from
 (IDIFFERENCE (IPLUS Y0 SQHEIGHT)
					      BORDER)
			to
 (IDIFFERENCE (IPLUS Y0 (ITIMES (SUB1 HEIGHT)
							  SQHEIGHT))
					BORDER)
			by
 SQHEIGHT do
 (BITBLT NIL NIL NIL DS X0 Y LINELENGTH TWICEBORDER
					       (QUOTE TEXTURE)
					       (QUOTE REPLACE)
					       GRIDSHADE))
		     (BITBLT NIL NIL NIL DS X0 (IDIFFERENCE (IPLUS Y0 (ITIMES HEIGHT SQHEIGHT))
							    BORDER)
			     LINELENGTH BORDER (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     GRIDSHADE)))
	    [(EQ BORDER (QUOTE POINT))                       (* put a point in the lower left corner of each box)

	      (for
 X from
 X0 to
 (IPLUS X0 (ITIMES WIDTH SQWIDTH)) by
 SQWIDTH
		 do
 (for
 Y from
 Y0 to
 (IPLUS Y0 (ITIMES HEIGHT SQHEIGHT)) by
 SQHEIGHT
		       do
 (BITMAPBIT DS X Y 1]
	    (T (\ILLEGAL.ARG BORDER])

(GRIDXCOORD

  [LAMBDA (XPOS GRIDSPEC)                                    (* rrb "21-MAR-83 13:04")

    (PROG [(GX (IDIFFERENCE XPOS (fetch
 (REGION LEFT) of
 GRIDSPEC]
                                                             (* because (IQUOTIENT -1 2) is 0 instead of -1 like we 

							     would like)

          (RETURN (COND
		    ((IGEQ GX 0)
		      (IQUOTIENT GX (fetch
 (REGION WIDTH) of
 GRIDSPEC)))
		    (T (SUB1 (IQUOTIENT GX (fetch
 (REGION WIDTH) of
 GRIDSPEC])

(GRIDYCOORD

  [LAMBDA (YPOS GRIDSPEC)                                    (* rrb "21-MAR-83 13:07")

    (PROG [(GY (IDIFFERENCE YPOS (fetch
 (REGION BOTTOM) of
 GRIDSPEC]
                                                             (* because (IQUOTIENT -1 2) is 0 instead of -1 like we 

							     would like)

          (RETURN (COND
		    ((IGEQ GY 0)
		      (IQUOTIENT GY (fetch
 (REGION HEIGHT) of
 GRIDSPEC)))
		    (T (SUB1 (IQUOTIENT GY (fetch
 (REGION HEIGHT) of
 GRIDSPEC])

(LEFTOFGRIDCOORD

  [LAMBDA (GRIDX GRIDSPEC)                                   (* rrb "19-MAR-82 09:20")

                                                             (* returns the Left position of a grid location.)

    (IPLUS (fetch
 (REGION LEFT) of
 GRIDSPEC)
	   (ITIMES (fetch
 (REGION WIDTH) of
 GRIDSPEC)
		   GRIDX])

(BOTTOMOFGRIDCOORD

  [LAMBDA (GRIDY GRIDSPEC)                                   (* rrb "19-MAR-82 09:38")

    (IPLUS (fetch
 (REGION BOTTOM) of
 GRIDSPEC)
	   (ITIMES (fetch
 (REGION HEIGHT) of
 GRIDSPEC)
		   GRIDY])

(EDITBMSCROLLFN

  [LAMBDA (W DX DY)                                          (* AJB "19-Sep-85 17:44")

                                                             (* Do scrolling for the bitmap editor.)

    (PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0)
		    (DYGRID 0)
		    EXTENT EXTENTWIDTH EXTENTHEIGHT GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT 
		    GRIDINTERIOR EBMXLIMIT EBMYLIMIT EBMXOFFSET EBMYOFFSET BM BITMAPWIDTH 
		    BITMAPHEIGHT BITSWIDE BITSHIGH DXOFFSET DYOFFSET)
          (SETQ GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
          (SETQ REG (WINDOWPROP W (QUOTE REGION)))
          (SETQ WHEIGHT (WINDOWPROP W (QUOTE HEIGHT)))
          (SETQ WWIDTH (WINDOWPROP W (QUOTE WIDTH)))
          (SETQ GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
          (SETQ EBMXOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
          (SETQ EBMYOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
          (SETQ BM (WINDOWPROP W (QUOTE BM)))
          (SETQ BITMAPWIDTH (fetch
 BITMAPWIDTH of
 BM))
          (SETQ BITMAPHEIGHT (fetch
 BITMAPHEIGHT of
 BM))
          (SETQ BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
          (SETQ BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
          (SETQ DXOFFSET (WINDOWPROP W (QUOTE DXOFFSET)))
          (SETQ DYOFFSET (WINDOWPROP W (QUOTE DYOFFSET)))
          (SETQ EBMXLIMIT (IPLUS EBMXOFFSET BITSWIDE))
          (SETQ EBMYLIMIT (IPLUS EBMYOFFSET BITSHIGH))
          (COND
	    (GRIDSPEC (SETQ GILEFT (fetch
 (REGION LEFT) of
 GRIDINTERIOR))
		      (SETQ GIBOTTOM (fetch
 (REGION BOTTOM) of
 GRIDINTERIOR))
		      (SETQ GIHEIGHT (fetch
 (REGION HEIGHT) of
 GRIDINTERIOR))
		      (SETQ GWIDTH (fetch
 (REGION WIDTH) of
 GRIDSPEC))
		      (SETQ GHEIGHT (fetch
 (REGION HEIGHT) of
 GRIDSPEC))
		      (SETQ EXTENT (WINDOWPROP W (QUOTE EXTENT)))
		      (SETQ EXTENTWIDTH (fetch
 (REGION WIDTH) of
 EXTENT))
		      (SETQ EXTENTHEIGHT (fetch
 (REGION HEIGHT) of
 EXTENT))
                                                             (* Make a horizontal adjustment)

		      (COND
			((FLOATP DX)                         (* Horizontal thumbing)

			  [WINDOWPROP W (QUOTE XOFFSET)
				      (SETQ EBMXOFFSET (FIX (TIMES (IDIFFERENCE BITMAPWIDTH BITSWIDE)
								   DX]
			  (replace
 (REGION LEFT) of
 EXTENT with
 (IMINUS (QUOTIENT (TIMES EBMXOFFSET 
										      EXTENTWIDTH)
										  BITMAPWIDTH)))
			  (BITBLT NIL 0 0 W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE GRIDINTERIOR)
			  (RESETGRID
 BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W))
			((ILESSP DX 0)                       (* moving to the left.)

                                                             (* determine how many grid points to move.)

			  (SETQ DXGRID (IMIN (GRIDXCOORD
 (IMINUS DX)
							 GRIDSPEC)
					     (IDIFFERENCE BITMAPWIDTH EBMXLIMIT)))
			  (COND
			    ((NOT (IGREATERP DXGRID 0))      (* right edge is at the right margin)

			      (RETURN)))
			  (WINDOWPROP W (QUOTE XOFFSET)
				      (SETQ EBMXOFFSET (IPLUS EBMXOFFSET DXGRID)))
                                                             (* update EXTENT bar)

			  (replace
 (REGION LEFT) of
 EXTENT
			     with
 (IMAX (IMINUS (QUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH)
							  BITMAPWIDTH))
					(IMINUS EXTENTWIDTH)))
                                                             (* move image to the left.)

			  (BITBLT W (IPLUS GILEFT (TIMES DXGRID GWIDTH))
				  GIBOTTOM W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
				  (QUOTE REPLACE)
				  NIL GRIDINTERIOR)          (* clear the newly exposed area.)

			  (BITBLT NIL 0 0 W (IPLUS GILEFT (TIMES (IDIFFERENCE BITSWIDE DXGRID)
								 GWIDTH))
				  GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE GRIDINTERIOR)
			  (RESETGRID
 BM GRIDSPEC DXGRID BITSHIGH (IDIFFERENCE BITSWIDE DXGRID)
				     0 W))
			((ILESSP 0 DX)                       (* determine how many grid point to the left to move.)

			  (SETQ DXGRID (IMIN EBMXOFFSET (GRIDXCOORD
 DX GRIDSPEC)))
			  (COND
			    ((NOT (IGREATERP DXGRID 0))      (* left edge is at the left margin)

			      (RETURN)))
			  (WINDOWPROP W (QUOTE XOFFSET)
				      (SETQ EBMXOFFSET (IDIFFERENCE EBMXOFFSET DXGRID)))
                                                             (* update REGION bar)

			  (replace
 (REGION LEFT) of
 EXTENT
			     with
 (IMIN (IMINUS (IQUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH)
							   BITMAPWIDTH))
					0))                  (* move image to the right.)

			  (BITBLT W GILEFT GIBOTTOM W (IPLUS GILEFT (TIMES DXGRID GWIDTH))
				  GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
				  (QUOTE REPLACE)
				  NIL GRIDINTERIOR)          (* clear the newly exposed area.)

			  (BITBLT NIL 0 0 W GILEFT GIBOTTOM (TIMES DXGRID GWIDTH)
				  GIHEIGHT
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE)
			  (RESETGRID
 BM GRIDSPEC DXGRID BITSHIGH 0 0 W)))
                                                             (* Make a vertical adjustment)

		      (COND
			((FLOATP DY)                         (* Vertical Thumbing)

			  [WINDOWPROP W (QUOTE YOFFSET)
				      (SETQ EBMYOFFSET (FIX (TIMES (IDIFFERENCE BITMAPHEIGHT BITSHIGH)
								   (FDIFFERENCE 1.0 DY]
                                                             (* set EXTENT bar)

			  (replace
 (REGION BOTTOM) of
 EXTENT with
 (IMINUS (QUOTIENT (TIMES EBMYOFFSET 
										     EXTENTHEIGHT)
										    BITMAPHEIGHT)))
                                                             (* Clear Window)

			  (BITBLT NIL 0 0 W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE GRIDINTERIOR)   (* Repaint the image using grid function)

			  (RESETGRID
 BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W))
			((ILESSP DY 0)                       (* determine how many squares to move down.)

			  (SETQ DYGRID (IMIN (IDIFFERENCE (fetch
 (BITMAP BITMAPHEIGHT) of
 BM)
							  EBMYLIMIT)
					     (GRIDYCOORD
 (IMIN GIHEIGHT (IMINUS DY))
							 GRIDSPEC)))
			  (COND
			    ((NOT (IGREATERP DYGRID 0))      (* top edge is at the top margin)

			      (RETURN)))
			  (WINDOWPROP W (QUOTE YOFFSET)
				      (SETQ EBMYOFFSET (IPLUS EBMYOFFSET DYGRID)))
			  (replace
 (REGION BOTTOM) of
 EXTENT
			     with
 (IMAX (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT)
							  BITMAPHEIGHT))
					(IMINUS EXTENTHEIGHT)))
			  (BITBLT W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT))
				  W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
				  (QUOTE REPLACE)
				  NIL GRIDINTERIOR)
			  (BITBLT NIL 0 0 W GILEFT (IPLUS GIBOTTOM (ITIMES (IDIFFERENCE BITSHIGH 
											DYGRID)
									   GHEIGHT))
				  SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE GRIDINTERIOR)
			  (RESETGRID
 BM GRIDSPEC BITSWIDE DYGRID 0 (IDIFFERENCE BITSHIGH DYGRID)
				     W))
			((ILESSP 0 DY)                       (* moving up; determine how may grid squares to move.)

			  (SETQ DYGRID (IMIN EBMYOFFSET (GRIDYCOORD
 (IMIN GIHEIGHT DY)
								    GRIDSPEC)))
			  (COND
			    ((NOT (IGREATERP DYGRID 0))      (* bottom edge is at the bottom margin)

			      (RETURN)))
			  (WINDOWPROP W (QUOTE YOFFSET)
				      (SETQ EBMYOFFSET (IDIFFERENCE EBMYOFFSET DYGRID)))
			  (replace
 (REGION BOTTOM) of
 EXTENT
			     with
 (IMIN (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT)
							  BITMAPHEIGHT))
					0))
			  (BITBLT W GILEFT GIBOTTOM W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT))
				  SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
				  (QUOTE REPLACE)
				  NIL GRIDINTERIOR)
			  (BITBLT NIL 0 0 W GILEFT GIBOTTOM (fetch
 (REGION WIDTH) of
 GRIDINTERIOR)
				  (ITIMES DYGRID GHEIGHT)
				  (QUOTE TEXTURE)
				  (QUOTE REPLACE)
				  WHITESHADE)
			  (RESETGRID
 BM GRIDSPEC BITSWIDE DYGRID 0 0 W)))
		      (COND
			((WINDOWPROP W (QUOTE GRIDON))
			  (GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
				W)))
		      [COND
			([OR (ILESSP EBMXOFFSET DXOFFSET)
			     (ILESSP EBMYOFFSET DYOFFSET)
			     [IGREATERP (IPLUS EBMXOFFSET BITSWIDE)
					(IPLUS DXOFFSET (WINDOWPROP W (QUOTE BMDISPLAYWIDTH]
			     (IGREATERP (IPLUS EBMYOFFSET BITSHIGH)
					(IPLUS DYOFFSET (WINDOWPROP W (QUOTE BMDISPLAYHEIGHT]
                                                             (* Adjust the display region left lower corner so the 

							     selected region is near the center.)

			  [WINDOWPROP W (QUOTE DXOFFSET)
				      (SETQ DXOFFSET (IMAX 0
							   (IMIN (IDIFFERENCE (fetch
 (BITMAP 
										      BITMAPWIDTH)
										 of
 BM)
									      (WINDOWPROP
										W
										(QUOTE BMDISPLAYWIDTH)
										))
								 (IDIFFERENCE
								   (IPLUS EBMXOFFSET
									  (LRSH BITSWIDE 1))
								   (LRSH (WINDOWPROP W (QUOTE 
										   BMDISPLAYWIDTH))
									 1]
			  (WINDOWPROP W (QUOTE DYOFFSET)
				      (SETQ DYOFFSET (IMAX 0
							   (IMIN (IDIFFERENCE (fetch
 (BITMAP 
										     BITMAPHEIGHT)
										 of
 BM)
									      (WINDOWPROP
										W
										(QUOTE 
										  BMDISPLAYHEIGHT)))
								 (IDIFFERENCE
								   (IPLUS EBMYOFFSET
									  (LRSH BITSHIGH 1))
								   (LRSH (WINDOWPROP W (QUOTE 
										  BMDISPLAYHEIGHT))
									 1]
		      (UPDATE/BM/DISPLAY BM W])

(SHADEGRIDBOX

  [LAMBDA (X Y SHADE OPERATION GRIDSPEC GRIDBORDER DS)       (* rrb "13-JUN-82 16:48")

                                                             (* shades the interior of a grid box.)

    (PROG ((BORDER (OR (FIXP GRIDBORDER)
		       0)))
          (BITBLT NIL NIL NIL DS (IPLUS (LEFTOFGRIDCOORD
 X GRIDSPEC)
					BORDER)
		  (IPLUS (BOTTOMOFGRIDCOORD
 Y GRIDSPEC)
			 BORDER)
		  (IDIFFERENCE (fetch
 (REGION WIDTH) of
 GRIDSPEC)
			       (ITIMES BORDER 2))
		  (IDIFFERENCE (fetch
 (REGION HEIGHT) of
 GRIDSPEC)
			       (ITIMES BORDER 2))
		  (QUOTE TEXTURE)
		  OPERATION SHADE)                           (* if this is POINT grid, set lower left corner.)

          (COND
	    ((EQ GRIDBORDER (QUOTE POINT))
	      (BITMAPBIT DS (LEFTOFGRIDCOORD
 X GRIDSPEC)
			 (BOTTOMOFGRIDCOORD
 Y GRIDSPEC)
			 1])
)



(* Low level compatibility and extensions)


(DEFINEQ

(INSIDE?

  [LAMBDA (BOX X Y)                                          (* rrb "19-MAR-82 09:32")

    (AND (WITHIN (OR X LASTMOUSEX)
		 (fetch
 (REGION LEFT) of
 BOX)
		 (fetch
 (REGION WIDTH) of
 BOX))
	 (WITHIN (OR Y LASTMOUSEY)
		 (fetch
 (REGION BOTTOM) of
 BOX)
		 (fetch
 (REGION HEIGHT) of
 BOX])
)



(* Mouse selection code)


(DEFINEQ

(MOUSESTATE-EXPR

  [LAMBDA (EXPR MOUSEONLYFLG)                                (* rrb " 5-Apr-84 17:05")


          (* if MOUSEONLYFLG is non-NIL, the testing should be done only on the mouse buttons. MOUSEONLYFLG will be passed in 

	  as T by MOUSESTATE but will get reset if any of the names are not mouse button names.)



    (PROG (NAMEMASK (MOUSEBUTTONMASK 7))
          (RETURN (COND
		    [(NLISTP EXPR)
		      (COND
			[(EQ EXPR (QUOTE UP))
			  (LIST (QUOTE ZEROP)
				(COND
				  (MOUSEONLYFLG (LIST (QUOTE LOGAND)
						      MOUSEBUTTONMASK
						      (QUOTE LASTMOUSEBUTTONS)))
				  (T (QUOTE LASTMOUSEBUTTONS]
			(T 

          (* MOUSEONLYFLG can be ignored on this branch because it is generating code for the case where the user is listing 

	  the button names and if he includes keyset names you want to include them anyway.)



			   (LIST (QUOTE NEQ
)
				 (LIST (QUOTE LOGAND)
				       (QUOTE LASTMOUSEBUTTONS)
				       (MOUSESTATE-NAME
 EXPR))
				 0]
		    ((EQ (CAR EXPR)
			 (QUOTE ONLY))
		      (COND
			((SETQ NAMEMASK (MOUSESTATE-NAME
 (CADR EXPR)
							 MOUSEONLYFLG)))
			((SETQ NAMEMASK (MOUSESTATE-NAME
 (CADR EXPR)
							 NIL))
                                                             (* non-mouse buttons were named, use all keys.)

			  (SETQ MOUSEONLYFLG NIL)))
		      (LIST (QUOTE EQ
)
			    (COND
			      (MOUSEONLYFLG (LIST (QUOTE LOGAND)
						  MOUSEBUTTONMASK
						  (QUOTE LASTMOUSEBUTTONS)))
			      (T (QUOTE LASTMOUSEBUTTONS)))
			    NAMEMASK))
		    ([EVERY EXPR (FUNCTION (LAMBDA (X)
				(AND (ATOM X)
				     (NEQ X (QUOTE UP]       (* Cant use LOGx trick for UP as it is a disjunct not a

							     key selector)

		      (SELECTQ (CAR EXPR)
			       [OR (LIST (QUOTE NEQ
)
					 0
					 (LIST (QUOTE LOGAND)
					       (QUOTE LASTMOUSEBUTTONS)
					       (CONS (QUOTE LOGOR)
						     (MAPCAR (CDR EXPR)
							     (FUNCTION MOUSESTATE-NAME]
			       [AND (LIST (QUOTE EQ
)
					  (CONS (QUOTE LOGOR)
						(MAPCAR (CDR EXPR)
							(FUNCTION MOUSESTATE-NAME)))
					  (LIST (QUOTE LOGAND)
						(QUOTE LASTMOUSEBUTTONS)
						(CONS (QUOTE LOGOR)
						      (MAPCAR (CDR EXPR)
							      (FUNCTION MOUSESTATE-NAME]
			       [NOT (COND
				      ((CDDR EXPR)
					(SHOULDNT)))
				    (LIST (QUOTE ZEROP)
					  (LIST (QUOTE LOGAND)
						(QUOTE LASTMOUSEBUTTONS)
						(MOUSESTATE-NAME
 (CADR EXPR]
			       (HELP (CAR EXPR)
				     " unrecognized mouse key operator")))
		    (T (CONS (CAR EXPR)
			     (MAPCAR (CDR EXPR)
				     (FUNCTION (LAMBDA (OPT)
					 (MOUSESTATE-EXPR
 OPT MOUSEONLYFLG])

(MOUSESTATE-NAME

  [LAMBDA (KEYNAME MOUSEONLYFLG)                             (* rrb "13-JUN-82 11:17")

                                                             (* return the numeric code for a mouse or keyset key.)

    (SELECTQ KEYNAME
	     ((LEFT RED)
	       4)
	     ((RIGHT BLUE)
	       2)
	     ((YELLOW MIDDLE)
	       1)
	     (COND
	       ((NOT MOUSEONLYFLG)                           (* if wants mouse only, return NIL)

		 (SELECTQ KEYNAME
			  (LEFTKEY 128)
			  (LEFTMIDDLEKEY 64)
			  (MIDDLEKEY 32)
			  (RIGHTMIDDLEKEY 16)
			  (RIGHTKEY 8)
			  (HELP KEYNAME " is not a recognized key name."])
)

(PUTPROPS MOUSESTATE ARGNAMES
 (BUTTONFORM))

(PUTPROPS LASTMOUSESTATE ARGNAMES
 (BUTTONFORM))

(PUTPROPS UNTILMOUSESTATE ARGNAMES
 (BUTTONFORM INTERVAL))

(PUTPROPS KEYSETSTATE ARGNAMES
 (BUTTONFORM))

(PUTPROPS LASTKEYSETSTATE ARGNAMES
 (BUTTONFORM))
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOCOPY 
(DECLARE: EVAL@COMPILE 
[PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN)
				       (QUOTE (GETMOUSESTATE))
				       (MOUSESTATE-EXPR (CAR ARGS)
							T]
(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS)
						      T)))
[PUTPROPS UNTILMOUSESTATE MACRO (ARGS (COND [(AND (CDR ARGS)
						  (CADR ARGS)
						  (NEQ (CADR ARGS)
						       T))
					     (* time argument is given and is not T or NIL; compile 
						in time keeping loop.)
					     (LIST (QUOTE PROG)
						   [LIST (LIST (QUOTE TIMEOUT)
							       (LIST (QUOTE IPLUS)
								     (QUOTE (CLOCK 0))
								     (LIST (QUOTE OR)
									   (LIST (QUOTE NUMBERP)
										 (CADR ARGS))
									   100)))
							 (QUOTE (NOWTIME (CLOCK 0]
						   (QUOTE LP)
						   [LIST (QUOTE COND)
							 (LIST (CONS (QUOTE MOUSESTATE)
								     (LIST (CAR ARGS)
									   T))
							       (QUOTE (RETURN T]
						   [QUOTE (COND ((IGREATERP (CLOCK0 NOWTIME)
									    TIMEOUT)
								 (RETURN NIL))
								(T (\BACKGROUND]
						   (QUOTE (GO LP]
					    (T (LIST (QUOTE PROG)
						     NIL
						     (QUOTE LP)
						     [LIST (QUOTE COND)
							   (LIST (CONS (QUOTE MOUSESTATE)
								       (LIST (CAR ARGS)
									     T))
								 (QUOTE (RETURN T]
						     (QUOTE (\BACKGROUND))
						     (QUOTE (GO LP]
[PUTPROPS KEYSETSTATE MACRO (ARGS (LIST (QUOTE PROGN)
					(QUOTE (GETMOUSESTATE))
					(MOUSESTATE-EXPR (CAR ARGS]
[PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS]
)
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 
[PUTPROPS WITHIN MACRO ((A B C)
	   (AND (IGEQ A B)
		(ILESSP A (IPLUS B C]
)
)

(ADDTOVAR GLOBALVARS
 LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)


(* END EXPORTED DEFINITIONS)




(* High Level Display utilities)


(DEFINEQ

(DECODEBUTTONS

  [LAMBDA (BUTTONSTATE)
    (DECLARE
 (GLOBALVARS LASTMOUSEBUTTONS))                  (* rrb " 9-JAN-82 14:20")

                                                             (* return a list of the buttons and keys that are down 

							     from a button state.)

    (OR (SMALLP BUTTONSTATE)
	(SETQ BUTTONSTATE LASTMOUSEBUTTONS))
    (NCONC (AND (NEQ 0 (LOGAND BUTTONSTATE 4))
		(CONS (QUOTE LEFT)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 2))
		(CONS (QUOTE RIGHT)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 1))
		(CONS (QUOTE MIDDLE)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 128))
		(CONS (QUOTE LEFTKEY)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 64))
		(CONS (QUOTE LEFTMIDDLEKEY)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 32))
		(CONS (QUOTE MIDDLEKEY)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 16))
		(CONS (QUOTE RIGHTMIDDLEKEY)))
	   (AND (NEQ 0 (LOGAND BUTTONSTATE 8))
		(CONS (QUOTE RIGHTKEY])
)
(DEFINEQ

(PTDIFFERENCE

  [LAMBDA (PT1 PT2)                                          (* rrb "24-JAN-83 14:54")

                                                             (* adds two positions)

    (create
 POSITION
	    XCOORD _(DIFFERENCE (fetch
 (POSITION XCOORD) of
 PT1)
				(fetch
 (POSITION XCOORD) of
 PT2))
	    YCOORD _(DIFFERENCE (fetch
 (POSITION YCOORD) of
 PT1)
				(fetch
 (POSITION YCOORD) of
 PT2])

(PTPLUS

  [LAMBDA (PT1 PT2)                                          (* rrb "24-JAN-83 14:54")

                                                             (* adds two positions)

    (create
 POSITION
	    XCOORD _(PLUS (fetch
 (POSITION XCOORD) of
 PT1)
			  (fetch
 (POSITION XCOORD) of
 PT2))
	    YCOORD _(PLUS (fetch
 (POSITION YCOORD) of
 PT1)
			  (fetch
 (POSITION YCOORD) of
 PT2])
)



(* User interaction for regions, etc)


(DEFINEQ

(GETPOSITION

  [LAMBDA (WINDOW CURSOR)                                    (* rmk: "31-AUG-83 16:22")

                                                             (* reads a point from a WINDOW if non-NIL or the 

							     screen. Will change to cursor if given.)

    (RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
	       (until
 (MOUSESTATE LEFT))
	       (until
 (MOUSESTATE (NOT LEFT)))
	       (COND
		 ((NULL WINDOW)
		   (create
 POSITION
			   XCOORD _ LASTMOUSEX
			   YCOORD _ LASTMOUSEY))
		 ((SETQ WINDOW (OR (DISPLAYSTREAMP (\OUTSTREAMARG WINDOW))
				   (\ILLEGAL.ARG WINDOW)))
		   (create
 POSITION
			   XCOORD _(LASTMOUSEX WINDOW)
			   YCOORD _(LASTMOUSEY WINDOW])

(GETBOXPOSITION

  [LAMBDA (BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG)    (* AJB "19-Sep-85 17:35")


          (* gets a box position, returning the lower left corner. During the moving the outline of the box is displayed.

	  If ORGX is given, the box is originally drawn at that location and the nearest corner to the cursor is snapped to 

	  the cursor position.)



    (DECLARE
 (SPECVARS . T))
    (RESETFORM (CURSOR BOXCURSOR)
	       (PROG [(MOUSEDOWNFLG (MOUSESTATE (OR LEFT MIDDLE]
		     (COND
		       ((AND (FIXP ORGX)
			     (FIXP ORGY))                    (* origin given, move cursor to nearest corner.)

			 [COND
			   ((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT BOXWIDTH 2)))
			     (SETQ ORGX (IPLUS ORGX BOXWIDTH))
			     (SETQ BOXWIDTH (IMINUS BOXWIDTH]
			 [COND
			   ((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT BOXHEIGHT 2)))
			     (SETQ ORGY (IPLUS ORGY BOXHEIGHT))
			     (SETQ BOXHEIGHT (IMINUS BOXHEIGHT]
			 (\SETCURSORPOSITION ORGX ORGY))
		       (T (SETQ ORGX LASTMOUSEX)
			  (SETQ ORGY LASTMOUSEY)))
		     (AND PROMPTMSG (PROMPTPRINT PROMPTMSG))
		 TRACKLP                                     (* track the cursor with a box ghost until the left or 

							     middle button changes.)

		     (\TRACKWITHBOX
)
		     [COND
		       ((AND (NULL MOUSEDOWNFLG)
			     (LASTMOUSESTATE (NOT UP)))
			 (SETQ MOUSEDOWNFLG T)
			 (CURSOR CROSSHAIRS))
		       ((AND MOUSEDOWNFLG (LASTMOUSESTATE UP))
			 (AND PROMPTMSG (CLRPROMPT))
			 (RETURN (COND
				   (WINDOW (create
 POSITION
						   XCOORD _(DSPXSCREENTOWINDOW
 (IMIN ORGX
										     (IPLUS ORGX 
											 BOXWIDTH))
									       WINDOW)
						   YCOORD _(DSPYSCREENTOWINDOW
 (IMIN ORGY
										     (IPLUS ORGY 
											BOXHEIGHT))
									       WINDOW)))
				   (T (create
 POSITION
					      XCOORD _(IMIN ORGX (IPLUS ORGX BOXWIDTH))
					      YCOORD _(IMIN ORGY (IPLUS ORGY BOXHEIGHT]
		     (GO TRACKLP])

(DSPYSCREENTOWINDOW

  [LAMBDA (Y DS)                                             (* rmk: "26-AUG-83 14:08")

                                                             (* transforms an y coordinate from screen coordinates 

							     into window coordinates)

    (IDIFFERENCE Y (fetch
 DDYOFFSET of
 (\GETDISPLAYDATA DS])

(DSPXSCREENTOWINDOW

  [LAMBDA (X DS)                                             (* rmk: "26-AUG-83 14:08")

                                                             (* transforms an x coordinate from screen coordinates 

							     into window coordinates)

    (IDIFFERENCE X (fetch
 DDXOFFSET of
 (\GETDISPLAYDATA DS])

(GETREGION

  [LAMBDA (MINWIDTH MINHEIGHT OLDREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS)
                                                             (* AJB "19-Sep-85 17:33")


          (* accepts region from the user. INITCORNERS lets caller specify size of initial ghost box. It is a list of the form

	  (BASEX BASEY OPPX OPPY))



    (RESETFORM (CURSOR EXPANDINGBOX)
	       (PROG [BASEX BASEY OPPX OPPY OLDMOUSEX OLDMOUSEY INITLEFT INITRIGHT INITBOTTOM INITTOP
			    (BASEPT (create
 POSITION))
			    (OPPT (create
 POSITION))
			    NEWMOUSEX NEWMOUSEY DOWNFLG BEGCLOCK (NOTTIMEDOUT T)
			    (MINWIDTH (COND
					((FIXP MINWIDTH))
					(T 0)))
			    (MINHEIGHT (COND
					 ((FIXP MINHEIGHT))
					 (T 0)))
			    (NEWREGFNS (COND
					 ((LISTP NEWREGIONFN)
					   NEWREGIONFN)
					 (NEWREGIONFN (LIST NEWREGIONFN))
					 (T NIL]
		     (DECLARE
 (SPECVARS . T))                (* set up the initial box to prompt with.)

		     [COND
		       [INITCORNERS                          (* setup box by initcorners.)

				    (COND
				      ((AND (EQ 4 (LENGTH INITCORNERS))
					    (for
 X in
 INITCORNERS always
 (FIXP X)))
					(SETQ BASEX (CAR INITCORNERS))
					(SETQ BASEY (CADR INITCORNERS))
					(SETQ OPPX (CADDR INITCORNERS))
					(SETQ OPPY (CADDDR INITCORNERS)))
				      (T (\ILLEGAL.ARG INITCORNERS]
		       (T                                    (* start with the cursor in the lower right corner of 

							     the ghost box.)

			  (GETMOUSESTATE)
			  (SETQ OPPX LASTMOUSEX)
			  (SETQ OPPY LASTMOUSEY)
			  [COND
			    ((ILESSP (SETQ BASEX (IDIFFERENCE OPPX MINWIDTH))
				     0)

          (* arrange things so that the whole box if possible is on the screen. If this is not possible, the lower right 

	  corner is on the screen.)



			      (SETQ OPPX (SUB1 (IMIN MINWIDTH SCREENWIDTH)))
			      (SETQ BASEX (IDIFFERENCE OPPX MINWIDTH]
			  (COND
			    ((IGEQ (SETQ BASEY (IPLUS OPPY MINHEIGHT))
				   SCREENHEIGHT)

          (* if the top corner would be off the screen, move the bottom corner as low as necessary but limited to the bottom 

	  of the screen.)



			      (SETQ OPPY (IMAX 0 (IDIFFERENCE SCREENHEIGHT MINHEIGHT)))
			      (SETQ BASEY (IPLUS OPPY MINHEIGHT]
		     (\SETCURSORPOSITION OPPX OPPY)          (* wait for the user to put down the first corner.)

		     (\GETREGIONTRACKWITHBOX
)
		     [COND
		       ((AND OLDREGION (LASTMOUSESTATE MIDDLE))
                                                             (* switch the nearest corner of OLDREGION to the cursor

							     and track it.)

                                                             (* Pull from closest corner, ie.

							     set BASEX,Y to be opposite corner)

			 (SETQ BASEX (COND
			     ((ILESSP (SETQ OPPX LASTMOUSEX)
				      (IQUOTIENT [IPLUS (SETQ INITLEFT (fetch
 (REGION LEFT)
									  of
 OLDREGION))
							(SETQ INITRIGHT (IPLUS INITLEFT
									       (fetch
 (REGION WIDTH)
										  of
 OLDREGION]
						 2))         (* pointing at left half of box, so make origin be in 

							     right)

			       INITRIGHT)
			     (T                              (* pointing at right half of box,)

				INITLEFT)))
			 (SETQ BASEY (COND
			     ((ILESSP (SETQ OPPY LASTMOUSEY)
				      (IQUOTIENT [IPLUS (SETQ INITBOTTOM (fetch
 (REGION BOTTOM)
									    of
 OLDREGION))
							(SETQ INITTOP (IPLUS INITBOTTOM
									     (fetch
 (REGION HEIGHT)
										of
 OLDREGION]
						 2))
			       INITTOP)
			     (T INITBOTTOM]                  (* copy from variable into position for the constraint 

							     checks.)

		     (\GETREGION.PACKPTS
)
		     (\GETREGION.CHECKOPPT
 MINWIDTH MINHEIGHT NEWREGFNS BASEPT OPPT)
		     (SETQ OPPX (fetch
 (POSITION XCOORD) of
 OPPT))
		     (SETQ OPPY (fetch
 (POSITION YCOORD) of
 OPPT))
                                                             (* Now draw the initial box)

		     (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)
		     (\SETCURSORPOSITION OPPX OPPY)
		     (SETCORNER
 BASEX BASEY OPPX OPPY)
		     (SETQ BEGCLOCK (CLOCK 0))
		     (COND
		       [[ERSETQ (until
 (PROGN (GETMOUSESTATE)
					      (COND
						[NOTTIMEDOUT 
                                                             (* wait to see if user was clicking to mark a corner)

							     (COND
							       ((\CLOCKGREATERP BEGCLOCK 
										CLICKWAITTIME)
								 (SETQ NOTTIMEDOUT NIL]
						(DOWNFLG (LASTMOUSESTATE UP))
						((LASTMOUSESTATE (NOT UP))
                                                             (* mouse button when down, continue tracking until it 

							     goes up.)

						  (SETQ DOWNFLG T)
						  NIL)))
				   do
 (COND
					((LASTMOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
					  (CURSOR FORCEPS)
					  (until
 (MOUSESTATE (NOT RIGHT)))
                                                             (* Switch to nearest corner)

					  [COND
					    ((IGEQ (IABS (IDIFFERENCE LASTMOUSEX OPPX))
						   (IABS (IDIFFERENCE LASTMOUSEX BASEX)))
					      (SETQ BASEX (PROG1 OPPX (SETQ OPPX BASEX]
					  [COND
					    ((IGEQ (IABS (IDIFFERENCE LASTMOUSEY OPPY))
						   (IABS (IDIFFERENCE LASTMOUSEY BASEY)))
					      (SETQ BASEY (PROG1 OPPY (SETQ OPPY BASEY]
					  (\GETREGION.PACKPTS
)
					  (\GETREGION.CHECKBASEPT
 NEWREGFNS BASEPT)
					  (\GETREGION.CHECKOPPT
 MINWIDTH MINHEIGHT NEWREGFNS BASEPT 
								OPPT)
					  (SETCORNER
 BASEX BASEY OPPX OPPY)
					  (\UPDATEXYANDBOX
 T)
					  (\SETCURSORPOSITION OPPX OPPY))
					((OR (NEQ LASTMOUSEX OLDMOUSEX)
					     (NEQ LASTMOUSEY OLDMOUSEY))
                                                             (* the cursor has moved, check user constraints.)

					  (replace
 (POSITION XCOORD) of
 OPPT with
 (SETQ OLDMOUSEX 
										    LASTMOUSEX))
					  (replace
 (POSITION YCOORD) of
 OPPT with
 (SETQ OLDMOUSEY 
										    LASTMOUSEY))
					  (\GETREGION.CHECKOPPT
 MINWIDTH MINHEIGHT NEWREGFNS BASEPT 
								OPPT)
					  (\UPDATEXYANDBOX
 NIL]
                                                             (* erase box image.)

			 (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)
			 (RETURN (create
 REGION
					 LEFT _(IMIN BASEX OPPX)
					 BOTTOM _(IMIN BASEY OPPY)
					 WIDTH _(IABS (IDIFFERENCE OPPX BASEX))
					 HEIGHT _(IABS (IDIFFERENCE BASEY OPPY]
		       (T                                    (* ^E take down box.)

			  (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)
			  (ERROR!])

(\GETREGION.PACKPTS

  [LAMBDA NIL                                                (* rrb "12-Dec-83 18:01")

                                                             (* copy from variable into position for the constraint 

							     checks.)

    (replace
 (POSITION XCOORD) of
 BASEPT with
 BASEX)
    (replace
 (POSITION YCOORD) of
 BASEPT with
 BASEY)
    (replace
 (POSITION XCOORD) of
 OPPT with
 OPPX)
    (replace
 (POSITION YCOORD) of
 OPPT with
 OPPY])

(\GETREGION.CHECKBASEPT

  [LAMBDA (NEWREGFNS BASEPT)                                 (* rrb "12-Dec-83 16:13")

                                                             (* calls by GETREGION to check the constraints imposed 

							     on the base point by the user functions.)

                                                             (* if the new region fns is a list, apply them in 

							     order.)

    (bind
 USERPT for
 FN in
 NEWREGFNS
       do
                                                    (* call user fn on base pt)

                                                             (* copying the user return point is time cnsuming but 

							     necessary to isolate the system from user code.)

	  (SETQ USERPT (APPLY* FN BASEPT NIL NEWREGIONFNARG))
	  (COND
	    ((NOT (POSITIONP USERPT))
	      (ERROR "non-POSITION returned by NEWREGIONFN" USERPT))
	    (T (replace
 (POSITION XCOORD) of
 BASEPT with
 (fetch
 XCOORD of
 USERPT))
	       (replace
 (POSITION YCOORD) of
 BASEPT with
 (fetch
 YCOORD of
 USERPT])

(\GETREGION.CHECKOPPT

  [LAMBDA (MINWID MINHGHT NEWREGFNS BASEPT OPPT)             (* rrb "12-Dec-83 17:12")


          (* called by GETREGION to check the constraints imposed by the minimum sizes and user functions.

	  It assumes BASEPT and OPPT are POSITIONs set to the fixed corner BASEPT and moving corner OPPT.)



    (PROG ((BASEX (fetch
 (POSITION XCOORD) of
 BASEPT))
	   (BASEY (fetch
 (POSITION YCOORD) of
 BASEPT))
	   (OPPX (fetch
 (POSITION XCOORD) of
 OPPT))
	   (OPPY (fetch
 (POSITION YCOORD) of
 OPPT))
	   USERPT)                                           (* check for minimum height and width constraints.)

          (AND [COND
		 [(IGREATERP BASEX OPPX)
		   (COND
		     ((ILESSP (IDIFFERENCE BASEX OPPX)
			      MINWID)
		       (SETQ OPPX (IDIFFERENCE BASEX MINWID]
		 ((ILESSP (IDIFFERENCE OPPX BASEX)
			  MINWID)
		   (SETQ OPPX (IPLUS BASEX MINWID]
	       (replace
 (POSITION XCOORD) of
 OPPT with
 OPPX))
          (AND [COND
		 [(IGREATERP BASEY OPPY)
		   (COND
		     ((ILESSP (IDIFFERENCE BASEY OPPY)
			      MINHGHT)
		       (SETQ OPPY (IDIFFERENCE BASEY MINHGHT]
		 ((ILESSP (IDIFFERENCE OPPY BASEY)
			  MINHGHT)
		   (SETQ OPPY (IPLUS BASEY MINHGHT]
	       (replace
 (POSITION YCOORD) of
 OPPT with
 OPPY))
                                                             (* if the new region fns is a list, apply them in 

							     order.)

          (for
 FN in
 NEWREGFNS
	     do
 (SETQ USERPT (APPLY* FN BASEPT OPPT NEWREGIONFNARG))
		(COND
		  ((NOT (POSITIONP USERPT))
		    (ERROR "non-POSITION returned by NEWREGIONFN" USERPT))
		  (T (replace
 (POSITION XCOORD) of
 OPPT with
 (fetch
 XCOORD of
 USERPT))
		     (replace
 (POSITION YCOORD) of
 OPPT with
 (fetch
 YCOORD of
 USERPT])

(\GETREGIONTRACKWITHBOX

  [LAMBDA NIL                                                (* AJB "19-Sep-85 17:32")

    (DECLARE
 (GLOBALVARS DASHEDSHADE)
	     (LOCALVARS . T))                                (* tracks a box sized between BASEX BASEY and OPPX OPPY

							     until the left or middle mouse button go down.)

    (PROG (OLDCURSOR NOERROR XTEMP YTEMP OLDMOUSEX OLDMOUSEY POSTEMP THRUONCE
		     (WIDTH (IDIFFERENCE BASEX OPPX))
		     (HEIGHT (IDIFFERENCE BASEY OPPY)))
          (DRAWGRAYBOX
 OPPX OPPY BASEX BASEY NIL DASHEDSHADE)
                                                             (* go thru the loop at least once so that checking of 

							     user function against the first point is always done.)

          [SETQ NOERROR (ERSETQ (until
 (AND THRUONCE (MOUSESTATE (OR LEFT MIDDLE)))
				   do
 (SETQ THRUONCE T)
				      (COND
					((LASTMOUSESTATE RIGHT)
					  (SETQ OLDCURSOR (CURSOR FORCEPS))
					  (until
 (MOUSESTATE (NOT RIGHT)))
					  (CURSOR OLDCURSOR)
                                                             (* switch to drag nearest corner)

					  [COND
					    ((COND
						((IGREATERP BASEX OPPX)
						  (IGREATERP LASTMOUSEX (IQUOTIENT (IPLUS OPPX BASEX)
										   2)))
						(T (IGREATERP (IQUOTIENT (IPLUS OPPX BASEX)
									 2)
							      LASTMOUSEX)))
                                                             (* switch X)

					      (swap
 OPPX BASEX)
					      (SETQ WIDTH (IDIFFERENCE BASEX OPPX]
					  [COND
					    ((COND
						((IGREATERP BASEY OPPY)
						  (IGREATERP LASTMOUSEY (IQUOTIENT (IPLUS OPPY BASEY)
										   2)))
						(T (IGREATERP (IQUOTIENT (IPLUS OPPY BASEY)
									 2)
							      LASTMOUSEY)))
                                                             (* switch Y)

					      (swap
 OPPY BASEY)
					      (SETQ HEIGHT (IDIFFERENCE BASEY OPPY]
					  (\SETCURSORPOSITION OPPX OPPY))
					((OR (NEQ LASTMOUSEX OLDMOUSEX)
					     (NEQ LASTMOUSEY OLDMOUSEY))
                                                             (* the cursor has moved, check user constraints.)

					  (SETQ POSTEMP (IPLUS (SETQ OLDMOUSEX LASTMOUSEX)
							       WIDTH))
                                                             (* make sure the base corner {which is opposite the one

							     tracked with the mouse} is on the screen.)

					  (COND
					    ((IGREATERP POSTEMP (SUB1 SCREENWIDTH))
					      (SETQ POSTEMP (SUB1 SCREENWIDTH)))
					    ((ILESSP POSTEMP 0)
					      (SETQ POSTEMP 0)))
					  (replace
 (POSITION XCOORD) of
 BASEPT
					     with
 (COND
						    ((IGREATERP POSTEMP (SUB1 SCREENWIDTH))
						      (SUB1 SCREENWIDTH))
						    ((ILESSP POSTEMP 0)
						      0)
						    (T POSTEMP)))
					  (SETQ POSTEMP (IPLUS (SETQ OLDMOUSEY LASTMOUSEY)
							       HEIGHT))
					  (replace
 (POSITION YCOORD) of
 BASEPT
					     with
 (COND
						    ((IGREATERP POSTEMP (SUB1 SCREENHEIGHT))
						      (SETQ POSTEMP (SUB1 SCREENHEIGHT)))
						    ((ILESSP POSTEMP 0)
						      (SETQ POSTEMP 0))
						    (T POSTEMP)))
					  (\GETREGION.CHECKBASEPT
 NEWREGFNS BASEPT)
					  (SETQ YTEMP (fetch
 (POSITION YCOORD) of
 BASEPT))
					  (COND
					    ((NOT (AND (IEQP BASEX (SETQ XTEMP (fetch
 (POSITION
											XCOORD)
										  of
 BASEPT)))
						       (IEQP BASEY YTEMP)))
                                                             (* move the box)

					      (SETQ XTEMP (IDIFFERENCE XTEMP BASEX))
					      (SETQ YTEMP (IDIFFERENCE YTEMP BASEY))
					      (DRAWGRAYBOX
 OPPX OPPY BASEX BASEY NIL DASHEDSHADE)
                                                             (* Erase old box, make new one)

					      (DRAWGRAYBOX
 (SETQ OPPX (IPLUS OPPX XTEMP))
							   (SETQ OPPY (IPLUS OPPY YTEMP))
							   (SETQ BASEX (IPLUS BASEX XTEMP))
							   (SETQ BASEY (IPLUS BASEY YTEMP))
							   NIL DASHEDSHADE]
          (DRAWGRAYBOX
 OPPX OPPY BASEX BASEY NIL DASHEDSHADE)
          (COND
	    ((NULL NOERROR)                                  (* pass back ^E)

	      (ERROR!])

(\UPDATEXYANDBOX

  [LAMBDA (BASEPTCHANGE?)                                    (* rrb "12-Dec-83 18:36")


          (* moves the values in BASEPT and OPPT into the variables BASEX BASEY OPPX OPPY and updates the image on the screen 

	  if it has changed.)



    (PROG (TEMPX TEMPY)
          [COND
	    (BASEPTCHANGE?                                   (* the base point might have changed, check it too.)

			   (SETQ TEMPY (fetch
 (POSITION YCOORD) of
 BASEPT))
			   (COND
			     ((NOT (AND (IEQP BASEX (SETQ TEMPX (fetch
 (POSITION XCOORD)
								   of
 BASEPT)))
					(IEQP BASEY TEMPY)))
                                                             (* move the box)

			       (MOVEBOX
 OPPX OPPY BASEX BASEY (SETQ BASEX TEMPX)
					(SETQ BASEY TEMPY]
          (SETQ TEMPY (fetch
 (POSITION YCOORD) of
 OPPT))
          (COND
	    ((NOT (AND (IEQP OPPX (SETQ TEMPX (fetch
 (POSITION XCOORD) of
 OPPT)))
		       (IEQP OPPY TEMPY)))                   (* move the box)

	      (MOVEBOX
 BASEX BASEY OPPX OPPY (SETQ OPPX TEMPX)
		       (SETQ OPPY TEMPY))
	      (SETCORNER
 BASEX BASEY OPPX OPPY])

(GETBOXREGION

  [LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG)          (* edited: "17-SEP-82 09:36")

                                                             (* returns a region width by height positioned where 

							     user says.)

    (PROG ((POS (GETBOXPOSITION
 WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG)))
          (RETURN (create
 REGION
			  LEFT _(fetch
 (POSITION XCOORD) of
 POS)
			  BOTTOM _(fetch
 (POSITION YCOORD) of
 POS)
			  WIDTH _ WIDTH
			  HEIGHT _ HEIGHT])

(\TRACKWITHBOX

  [LAMBDA NIL                                                (* rrb "12-Dec-83 23:09")


          (* tracks the cursor with a box from corner ORGX ORGY with dimensions BOXWIDTH and BOXHEIGHT until the left or 

	  middle button changes. Implements the convention that the RIGHT button can be used to change corners.

	  Returns non-NIL unless an error occurred. Returns the result by setting freely the variable ORGX ORGY BOXWIDTH 

	  BOXHEIGHT)



    (PROG [OLDCURSOR ORGLEFTMIDDLE NOERROR (MLMASK (CONSTANT (LOGOR (MOUSESTATE-NAME
 (QUOTE LEFT))
								    (MOUSESTATE-NAME
 (QUOTE MIDDLE]
          (SETQ ORGLEFTMIDDLE (LOGAND MLMASK LASTMOUSEBUTTONS))
          (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX BOXWIDTH)
		       (IPLUS ORGY BOXHEIGHT))
          [SETQ NOERROR (ERSETQ (until
 (PROGN (GETMOUSESTATE)
					      (NEQ (LOGAND MLMASK LASTMOUSEBUTTONS)
						   ORGLEFTMIDDLE))
				   do
 (COND
					((LASTMOUSESTATE RIGHT)
					  (SETQ OLDCURSOR (CURSOR FORCEPS))
					  (until
 (MOUSESTATE (NOT RIGHT)))
					  (CURSOR OLDCURSOR)
                                                             (* switch to drag nearest corner)

					  [COND
					    ((COND
						[(IGREATERP BOXWIDTH 0)
						  (IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT 
											 BOXWIDTH 2]
						(T (IGREATERP (IPLUS ORGX (IQUOTIENT BOXWIDTH 2))
							      LASTMOUSEX)))
                                                             (* switch X)

					      (SETQ ORGX (IPLUS ORGX BOXWIDTH))
					      (SETQ BOXWIDTH (IMINUS BOXWIDTH]
					  [COND
					    ((COND
						[(IGREATERP BOXHEIGHT 0)
						  (IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT 
											BOXHEIGHT 2]
						(T (IGREATERP (IPLUS ORGY (IQUOTIENT BOXHEIGHT 2))
							      LASTMOUSEY)))
                                                             (* switch Y)

					      (SETQ ORGY (IPLUS ORGY BOXHEIGHT))
					      (SETQ BOXHEIGHT (IMINUS BOXHEIGHT]
					  (\SETCURSORPOSITION ORGX ORGY))
					(T (COND
					     ((NOT (AND (IEQP ORGX LASTMOUSEX)
							(IEQP ORGY LASTMOUSEY)))
                                                             (* the cursor has moved, move the box)

					       (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX BOXWIDTH)
							    (IPLUS ORGY BOXHEIGHT))
                                                             (* Erase old box, make new one)

					       (DRAWGRAYBOX
 (SETQ ORGX LASTMOUSEX)
							    (SETQ ORGY LASTMOUSEY)
							    (IPLUS ORGX BOXWIDTH)
							    (IPLUS ORGY BOXHEIGHT]
          (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX BOXWIDTH)
		       (IPLUS ORGY BOXHEIGHT))
          (COND
	    ((NULL NOERROR)                                  (* pass back ^E)

	      (ERROR!])

(MOVEBOX

  [LAMBDA (X1 Y1 X2 Y2 X3 Y3)                                (* rrb " 6-AUG-81 09:09")

                                                             (* moves the opposite corner of a box from {X2,Y2} to 

							     {X3,Y3}.)

    (BLTHLINE
 Y1 X2 X3)
    (BLTVLINE
 X1 Y2 Y3)
    (BLTHLINE
 Y2 X1 X2)
    (BLTHLINE
 Y3 X1 X3)
    (BLTVLINE
 X2 Y1 Y2)
    (BLTVLINE
 X3 Y1 Y3])

(DRAWGRAYBOX

  [LAMBDA (X1 Y1 X2 Y2 W SHADE)                              (* rrb "12-Dec-83 22:53")

                                                             (* Put a gray box in window W 

							     (or on screen, if W_NIL))

    (BLTHLINE
 Y1 X1 X2 W SHADE)
    (BLTVLINE
 X1 Y1 Y2 W SHADE)
    (BLTHLINE
 Y2 X1 X2 W SHADE)
    (BLTVLINE
 X2 Y1 Y2 W SHADE])

(BLTHLINE

  [LAMBDA (Y XA XB W SHADE)                                  (* rrb "12-Dec-83 22:53")

    (BITBLT NIL NIL NIL (OR W (SCREENBITMAP))
	    (IMIN XA XB)
	    Y
	    (IABS (IDIFFERENCE XB XA))
	    2
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (OR SHADE GRAYSHADE])

(BLTVLINE

  [LAMBDA (X YA YB W SHADE)                                  (* rrb "12-Dec-83 22:53")

    (BITBLT NIL NIL NIL (OR W (SCREENBITMAP))
	    X
	    (IMIN YA YB)
	    2
	    (IABS (IDIFFERENCE YB YA))
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (OR SHADE GRAYSHADE])

(SETCORNER

  [LAMBDA (X1 Y1 X2 Y2)                                      (* rrb " 4-NOV-81 15:32")

                                                             (* sets the cursor shape for the box from x1,y1 to x2, 

							     y2)

    (DECLARE
 (GLOBALVARS LowerLeftCursor LowerRightCursor UpperLeftCursor UpperRightCursor))
    (SETCURSOR (COND
		 ((IGREATERP X2 X1)                          (* moving to left)

		   (COND
		     ((IGREATERP Y2 Y1)                      (* moving up)

		       UpperRightCursor)
		     (T LowerRightCursor)))
		 (T                                          (* moving to right)

		    (COND
		      ((IGREATERP Y2 Y1)
			UpperLeftCursor)
		      (T LowerLeftCursor])
)
(DEFINEQ

(MOUSECONFIRM

  [LAMBDA (PROMPTSTRING HELPSTRING WINDOW DON'TCLEARWINDOWFLG)
                                                             (* bvm: "14-Dec-83 16:06")


          (* * Changes the cursor to a "little mouse"; prints a prompt; and waits for the user to press and then release a 

	  mouse button. If the LEFT was the final one release then return T otherwise return NIL -- uses PROMPTWINDOW unless 

	  provided a window * *)



    (DECLARE
 (GLOBALVARS MOUSECONFIRMCURSOR))
    (OR WINDOW (SETQ WINDOW PROMPTWINDOW))
    (COND
      [(OR (AND PROMPTSTRING (NEQ PROMPTSTRING T))
	   (NEQ HELPSTRING T))
	(FRESHLINE WINDOW)
	[COND
	  ((AND PROMPTSTRING (NEQ PROMPTSTRING T))
	    (printout WINDOW PROMPTSTRING)
	    (COND
	      ((NEQ HELPSTRING T)
		(SPACES 2 WINDOW]
	(COND
	  ((NEQ HELPSTRING T)
	    (printout WINDOW (OR HELPSTRING "Click LEFT to confirm, RIGHT to abort."]
      (T (SETQ DON'TCLEARWINDOWFLG T)))
    (PROG1 (RESETFORM (CURSOR MOUSECONFIRMCURSOR)
		      (until
 (MOUSESTATE (OR LEFT MIDDLE RIGHT)))
		      (bind
 (LEFTDOWN _(LASTMOUSESTATE LEFT)) until
 (MOUSESTATE UP)
			 do
                                  (* If buttons are still down, but not LEFT, user must 

							     have changed mind)

			    (SETQ LEFTDOWN (LASTMOUSESTATE LEFT))
			 finally
 (RETURN LEFTDOWN)))
	   (COND
	     ((NULL DON'TCLEARWINDOWFLG)
	       (CLEARW WINDOW])
)
(RPAQ MOUSECONFIRMCURSOR (CURSORCREATE (READBITMAP) 8 8))
(16 16
"GOOL"
"D@@D"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"ELID"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"D@@D"
"GOOL")(DEFINEQ

(NEAREST/PT/ON/GRID

  [LAMBDA (PT GRIDN)                                         (* rrb " 6-AUG-81 08:45")

                                                             (* finds the point on a grid of multiple GRIDN closest 

							     to PT.)

    (create
 POSITION
	    XCOORD _(NEAREST/MULTIPLE
 (fetch
 XCOORD of
 PT)
				      GRIDN)
	    YCOORD _(NEAREST/MULTIPLE
 (fetch
 YCOORD of
 PT)
				      GRIDN)
       smashing
 PT])

(PTON10GRID

  [LAMBDA (FIXEDPT MOVINGPT)                                 (* rrb " 6-AUG-81 08:45")

                                                             (* insists that a pt be on a 10 grid)

    (COND
      (MOVINGPT (NEAREST/PT/ON/GRID
 MOVINGPT 10))
      (T (NEAREST/PT/ON/GRID
 FIXEDPT 10])

(NEAREST/MULTIPLE

  [LAMBDA (X N)                                              (* rrb " 6-AUG-81 08:42")

                                                             (* finds the multiple of N that is nearest to X)

    (COND
      ((IGREATERP X 0)
	(ITIMES (IQUOTIENT (IPLUS X (IQUOTIENT N 2))
			   N)
		N))
      (T (ITIMES (IQUOTIENT (IDIFFERENCE X (IQUOTIENT N 2))
			    N)
		 N])
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS IABS MACRO (OPENLAMBDA (A)
				 (COND ((IGEQ A 0)
					A)
				       (T (IMINUS A]
)


(* END EXPORTED DEFINITIONS)

(READVARS DASHEDSHADE)
({(READBITMAP)(16 16
"@@OO"
"@@OO"
"@@OO"
"@@OO"
"@@OO"
"@@OO"
"@@OO"
"@@OO"
"OO@@"
"OO@@"
"OO@@"
"OO@@"
"OO@@"
"OO@@"
"OO@@"
"OO@@")})
(RPAQ CROSSHAIRS (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@GL@"
"AMG@"
"CAAH"
"FA@L"
"DA@D"
"LA@F"
"HA@B"
"OOON"
"HA@B"
"LA@F"
"DA@D"
"FA@L"
"CAAH"
"AMG@"
"@GL@")(RPAQ EXPANDINGBOX (CURSORCREATE (READBITMAP) 0 13))
(16 16
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"N@@@"
"O@@@"
"OHNG"
"OLLC"
"ONKM"
"O@BD"
"MHBD"
"IHKM"
"@LLC"
"@LNG"
"@F@@"
"@F@@")(RPAQ FORCEPS (CURSORCREATE (READBITMAP) 7 15))
(16 16
"@NG@"
"@JE@"
"@NG@"
"@DB@"
"@FF@"
"@CL@"
"@AH@"
"@AH@"
"@CL@"
"@FF@"
"ALCH"
"BDBD"
"BDBD"
"BDBD"
"BDBD"
"AHAH")(RPAQ BOXCURSOR (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@@@@"
"COOL"
"COOL"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"COOL"
"COOL"
"@@@@"
"@@@@")(RPAQ LOCKEDSPOT (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@@@@"
"COOL"
"COOL"
"C@@L"
"C@@L"
"CCLL"
"CCLL"
"CCLL"
"CCLL"
"C@@L"
"C@@L"
"COOL"
"COOL"
"@@@@"
"@@@@")(RPAQ OLDEXPANDINGBOX (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"OHCN"
"N@@N"
"O@AN"
"KHCJ"
"IMGB"
"@ON@"
"@DD@"
"@LF@"
"@DD@"
"@ON@"
"IMGB"
"KHCJ"
"O@AN"
"N@@N"
"OHCN")(RPAQ LowerLeftCursor (CURSORCREATE (READBITMAP) 0 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"OOL@"
"OON@")(RPAQ UpperRightCursor (CURSORCREATE (READBITMAP) 15 15))
(16 16
"@COO"
"@AOO"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@A"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ UpperLeftCursor (CURSORCREATE (READBITMAP) 0 15))
(16 16
"OOL@"
"OOH@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"H@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ LowerRightCursor (CURSORCREATE (READBITMAP) 15 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@A"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@COO"
"@GOO")(DEFINEQ

(\SW2BM

  [LAMBDA (P PR Q QR)                                        (* bas: "21-OCT-82 16:53")

                                                             (* Switches the areas of P and Q defined by the regions

							     PR and QR respectively)

    (PROG (PL PH PW PB QL QH QW QB)
          [COND
	    (PR (SETQ PL (fetch
 LEFT of
 PR))
		(SETQ PB (fetch
 BOTTOM of
 PR))
		(SETQ PH (fetch
 HEIGHT of
 PR))
		(SETQ PW (fetch
 WIDTH of
 PR)))
	    (T (SETQ PL (SETQ PB 0))
	       (SETQ PW (fetch
 BITMAPWIDTH of
 P))
	       (SETQ PH (fetch
 BITMAPHEIGHT of
 P]
          [COND
	    (QR (SETQ QL (fetch
 LEFT of
 QR))
		(SETQ QB (fetch
 BOTTOM of
 QR))
		(SETQ QW (fetch
 WIDTH of
 QR))
		(SETQ QH (fetch
 HEIGHT of
 QR)))
	    (T (SETQ QL (SETQ QB 0))
	       (SETQ QW (fetch
 BITMAPWIDTH of
 Q))
	       (SETQ QH (fetch
 BITMAPHEIGHT of
 Q]
          (PROG ((CL (IMAX (IMINUS PL)
			   (IMINUS QL)
			   0))
		 (CB (IMAX (IMINUS PB)
			   (IMINUS QB)
			   0)))
	        (PROG ((XP (IPLUS CL PL))
		       (YP (IPLUS CB PB))
		       (XQ (IPLUS CL QL))
		       (YQ (IPLUS CB QB))
		       CW CH)
		      (SETQ CW (IMIN (IDIFFERENCE (IMIN (fetch
 BITMAPWIDTH of
 P)
							(IPLUS PL PW))
						  XP)
				     (IDIFFERENCE (IMIN (fetch
 BITMAPWIDTH of
 Q)
							(IPLUS QL QW))
						  XQ)))
		      (SETQ CH (IMIN (IDIFFERENCE (IMIN (fetch
 BITMAPHEIGHT of
 P)
							(IPLUS PB PH))
						  YP)
				     (IDIFFERENCE (IMIN (fetch
 BITMAPHEIGHT of
 Q)
							(IPLUS QB QH))
						  YQ)))
		      (UNINTERRUPTABLY
                          (BITBLT P XP YP Q XQ YQ CW CH (QUOTE INPUT)
				  (QUOTE INVERT))
			  (BITBLT Q XQ YQ P XP YP CW CH (QUOTE INPUT)
				  (QUOTE INVERT))
			  (BITBLT P XP YP Q XQ YQ CW CH (QUOTE INPUT)
				  (QUOTE INVERT)))])

(COMPOSEREGS

  [LAMBDA (INNER OUTER)                                      (* rrb "19-MAR-82 09:35")

                                                             (* Converts INNER from OUTER relative coords to same 

							     units as OUTER -

							     inverse of TRANSLATEREGS)

    (create
 REGION
	    LEFT _(IPLUS (fetch
 (REGION LEFT) of
 OUTER)
			 (fetch
 (REGION LEFT) of
 INNER))
	    BOTTOM _(IPLUS (fetch
 (REGION BOTTOM) of
 OUTER)
			   (fetch
 (REGION BOTTOM) of
 INNER))
       using
 INNER])

(TRANSLATEREG

  [LAMBDA (INNER OUTER)                                      (* rrb "19-MAR-82 09:35")

                                                             (* Translates a nested INNER region to OUTER region 

							     relative coordinates)

    (create
 REGION
	    LEFT _(IDIFFERENCE (fetch
 (REGION LEFT) of
 INNER)
			       (fetch
 (REGION LEFT) of
 OUTER))
	    BOTTOM _(IDIFFERENCE (fetch
 (REGION BOTTOM) of
 INNER)
				 (fetch
 (REGION BOTTOM) of
 OUTER))
	    WIDTH _(fetch
 (REGION WIDTH) of
 INNER)
	    HEIGHT _(fetch
 (REGION HEIGHT) of
 INNER])
)



(* Bitmap and shade editors)


(DEFINEQ

(EDITBM

  [LAMBDA (BMSPEC)                                           (* AJB "19-Feb-85 14:59")

                                                             (* edits a bitmap)


          (* the edit part of the display is from 0 to MAXGRIDWIDTH in width and from 0 to MAXGRIDHEIGHT in height.

	  The commands and display area for the bitmap being edited are above the edit region.)



    (PROG (BMW BMWINTERIOR BMWWIDTH BMWHEIGHT WIDTH HEIGHT BM CR ORIGBM GRIDSQUARE ORIGBPP)
                                                             (* set ORIGBM to the input bitmap if any and BM to a 

							     copy of it for editting.)

          [COND
	    ((OR (EQ BMSPEC CursorBitMap)
		 (AND (EQ BMSPEC (QUOTE CursorBitMap))
		      (SETQ BMSPEC CursorBitMap)))           (* editting cursor, save old value and make changes to 

							     the original.)

	      (SETQ ORIGBM (BITMAPCOPY CursorBitMap))
	      (SETQ BM CursorBitMap))
	    [(BITMAPP BMSPEC)
	      (SETQ BM (BITMAPCOPY (SETQ ORIGBM BMSPEC]
	    [(LITATOM BMSPEC)
	      (COND
		([BITMAPP (SETQ ORIGBM (EVALV BMSPEC (QUOTE EDITBM]
                                                             (* use value.)

		  (SETQ BM (BITMAPCOPY ORIGBM)))
		(T (SETQ ORIGBM NIL)
		   (SETQ BM (\READBMDIMENSIONS
]
	    ((REGIONP BMSPEC)                                (* if BMSPEC is a region, treat it as a region of the 

							     screen.)

	      [SETQ BM (BITMAPCREATE (fetch
 (REGION WIDTH) of
 BMSPEC)
				     (fetch
 (REGION HEIGHT) of
 BMSPEC)
				     (BITSPERPIXEL (SCREENBITMAP]
                                                             (* note that bm has initial bits in it.)

	      (SETQ ORIGBM BMSPEC)
	      (BITBLT (SCREENBITMAP)
		      (fetch
 (REGION LEFT) of
 BMSPEC)
		      (fetch
 (REGION BOTTOM) of
 BMSPEC)
		      BM 0 0 NIL NIL (QUOTE INPUT)
		      (QUOTE REPLACE)))
	    ((WINDOWP BMSPEC)
	      (SETQ ORIGBM BMSPEC)
	      [SETQ BM (BITMAPCREATE (WINDOWPROP BMSPEC (QUOTE WIDTH))
				     (WINDOWPROP BMSPEC (QUOTE HEIGHT]
                                                             (* open the window and bring it to the top.)

	      (TOTOPW BMSPEC)
	      (SETQ CR (DSPCLIPPINGREGION NIL BMSPEC))
	      (BITBLT BMSPEC (fetch
 LEFT of
 CR)
		      (fetch
 BOTTOM of
 CR)
		      BM 0 0 (fetch
 WIDTH of
 CR)
		      (fetch
 HEIGHT of
 CR)))
	    (T                                               (* otherwise create a bitmap)

	       (SETQ BM (\READBMDIMENSIONS
]
          (SETQ HEIGHT (fetch
 BITMAPHEIGHT of
 BM))           (* get and use width in bits not pixels.)

          (SETQ WIDTH (fetch
 BITMAPWIDTH of
 BM))             (* calculate a default window size.)

                                                             (* start by calculating the grid size from the bitmap 

							     size.)

          (SETQ GRIDSQUARE (IMAX (IMIN (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES SCREENWIDTH 2)
									  3)
							       GRIDTHICKNESS)
						  WIDTH)
				       (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES SCREENHEIGHT 2)
									  3)
							       (ITIMES GRIDTHICKNESS 2))
						  (ADD1 HEIGHT))
				       NORMALGRIDSQUARE)
				 MINGRIDSQUARE))
          (SETQ BMWWIDTH (IMIN (IPLUS (ITIMES GRIDSQUARE WIDTH)
				      GRIDTHICKNESS)
			       (IQUOTIENT (ITIMES SCREENWIDTH 2)
					  3)))
          (SETQ BMWHEIGHT (IMIN (IPLUS (ITIMES HEIGHT (ADD1 GRIDSQUARE))
				       (ITIMES GRIDTHICKNESS 2)
				       1)
				(IQUOTIENT (ITIMES SCREENHEIGHT 2)
					   3)))
          (SETQ BMW (CREATEW (GETBOXREGION
 (WIDTHIFWINDOW BMWWIDTH)
					   (HEIGHTIFWINDOW BMWHEIGHT T)
					   NIL NIL NIL 
					   "Indicate the position for the Bitmap Edit window.")
			     "Bitmap Editor"))
          (WINDOWPROP BMW (QUOTE BM)
		      BM)
          (WINDOWPROP BMW (QUOTE SCROLLFN)
		      (FUNCTION EDITBMSCROLLFN))
          (WINDOWPROP BMW (QUOTE RESHAPEFN)
		      (FUNCTION EDITBMRESHAPEFN))
          (WINDOWPROP BMW (QUOTE REPAINTFN)
		      (FUNCTION EDITBMREPAINTFN))
          (WINDOWPROP BMW (QUOTE BUTTONEVENTFN)
		      (FUNCTION EDITBMBUTTONFN))
          (WINDOWPROP BMW (QUOTE CLOSEFN)
		      (FUNCTION EDITBMCLOSEFN))
          (WINDOWPROP BMW (QUOTE XOFFSET)
		      0)
          (WINDOWPROP BMW (QUOTE YOFFSET)
		      0)
          (WINDOWPROP BMW (QUOTE DXOFFSET)
		      0)
          (WINDOWPROP BMW (QUOTE DYOFFSET)
		      0)
          (WINDOWPROP BMW (QUOTE ORIGINALBITMAP)
		      ORIGBM)
          (WINDOWPROP BMW (QUOTE FINISHEDFLG)
		      NIL)
          (WINDOWPROP BMW (QUOTE GRIDON)
		      T)
          (SETQ ORIGBPP (fetch
 (BITMAP BITMAPBITSPERPIXEL) of
 BM))

          (* save the actual number of bits per pixel and set it to 1 in the bitmap being editted so that it can be BITBLT ed 

	  on the screen.)



          (replace
 (BITMAP BITMAPBITSPERPIXEL) of
 BM with
 1)
                                                             (* call reshapefn to initialize the display and values)

          (EDITBMRESHAPEFN
 BMW NIL NIL (NOT ORIGBM))         (* start a mouse process in case this process is the 

							     mouse process.)

          (SPAWN.MOUSE)
          (while
 (NOT (WINDOWPROP BMW (QUOTE FINISHEDFLG))) do
 (DISMISS 500))
                                                             (* remove the closefn before closing the window.)

          (WINDOWPROP BMW (QUOTE CLOSEFN)
		      NIL)
          (CLOSEW BMW)
          (replace
 (BITMAP BITMAPBITSPERPIXEL) of
 BM with
 ORIGBPP)
          (RETURN (COND
		    ((EQ T (WINDOWPROP BMW (QUOTE FINISHEDFLG)))
                                                             (* editor exited via ok, stuff contents into original 

							     bitmap.)

		      (COND
			((EQ BMSPEC CursorBitMap)            (* editting happened in original, leave it alone.)

			  CursorBitMap)
			((REGIONP ORIGBM)                    (* put it back into the screen.)

			  (BITBLT BM 0 0 (SCREENBITMAP)
				  (fetch
 (REGION LEFT) of
 ORIGBM)
				  (fetch
 (REGION BOTTOM) of
 ORIGBM)
				  (fetch
 (REGION WIDTH) of
 ORIGBM)
				  (fetch
 (REGION HEIGHT) of
 ORIGBM)
				  (QUOTE INPUT)
				  (QUOTE REPLACE))
			  BM)
			((WINDOWP ORIGBM)                    (* put it back into the window)

			  (BITBLT BM 0 0 ORIGBM (fetch
 (REGION LEFT) of
 CR)
				  (fetch
 (REGION BOTTOM) of
 CR)
				  (fetch
 (REGION WIDTH) of
 CR)
				  (fetch
 (REGION HEIGHT) of
 CR)
				  (QUOTE INPUT)
				  (QUOTE REPLACE))
			  BM)
			(ORIGBM (BITBLT BM 0 0 ORIGBM 0 0 WIDTH HEIGHT)
				[COND
				  ((AND BMSPEC (LITATOM BMSPEC))
                                                             (* if spec was an atom without a bm value, set it.

							     in the environment above EDITBM.)

				    (MARKASCHANGED BMSPEC (QUOTE VARS))
				    (STKEVAL (QUOTE EDITBM)
					     (LIST (QUOTE SETQQ)
						   BMSPEC BM]
				ORIGBM)
			(T BM)))
		    (T                                       (* error exit, if cursor return it to original value.)

		       (COND
			 ((EQ BMSPEC CursorBitMap)
			   (BITBLT ORIGBM NIL NIL CursorBitMap)))
		       (ERROR!])

(EDITBMCLOSEFN

  [LAMBDA (BMW)                                              (* rrb "21-MAR-83 18:58")

                                                             (* the close function for a bitmap edit window.

							     For now do what a STOP would have done.)

    (WINDOWPROP BMW (QUOTE FINISHEDFLG)
		(QUOTE KILL])

(TILEAREA

  [LAMBDA (LFT BTM WDTH HGHT SRCBM WIN)                      (* rrb "20-JUN-82 17:01")

                                                             (* lays tiles out in an area of a window.)

    (PROG ((X LFT)
	   (Y BTM)
	   (RGHT (IPLUS LFT WDTH))
	   (TOP (IPLUS BTM HGHT))
	   (W (fetch
 BITMAPWIDTH of
 SRCBM))
	   (H (fetch
 BITMAPHEIGHT of
 SRCBM)))
          (while
 (ILESSP X RGHT)
	     do
 (SETQ Y BTM)
		(while
 (ILESSP Y TOP)
		   do
 (BITBLT SRCBM 0 0 WIN X Y W H NIL (QUOTE REPLACE))
		      (add
 Y H))
		(add
 X W])

(EDITBMBUTTONFN

  [LAMBDA (W)                                                (* AJB " 4-Sep-85 20:58")

                                                             (* inner function of bitmap editor.)

    (PROG [GRIDX0 GRIDY0 BITMAPWIDTH BITMAPHEIGHT NEWGRIDSIZE PAINTW ORIGBM
		  (GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
		  (GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
		  (BM (WINDOWPROP W (QUOTE BM)))
		  (BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
		  (BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
		  (WREGION (WINDOWPROP W (QUOTE REGION)))
		  (XOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
		  (YOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
		  (DXOFFSET (WINDOWPROP W (QUOTE DXOFFSET)))
		  (DYOFFSET (WINDOWPROP W (QUOTE DYOFFSET)))
		  (DISPLAYREGION (WINDOWPROP W (QUOTE DISPLAYREGION)))
		  (EXTENT (WINDOWPROP W (QUOTE EXTENT]
          (SETQ GRIDX0 (fetch
 (REGION LEFT) of
 GRIDSPEC))
          (SETQ GRIDY0 (fetch
 (REGION BOTTOM) of
 GRIDSPEC))
          (SETQ BITMAPWIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BM))
          (SETQ BITMAPHEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BM))
                                                             (* mark the region of the bitmap that is being 

							     editted.)

          (COND
	    ((INSIDE?
 GRIDINTERIOR (LASTMOUSEX W)
		      (LASTMOUSEY W))                        (* if cursor is inside, shade it.)

	      (\SHADEBITS
 BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH))
	    ((INSIDE?
 DISPLAYREGION (LASTMOUSEX W)
		      (LASTMOUSEY W))                        (* Run the menu foe re-windowing into the whole bitmap)

	      (SELECTQ [MENU (COND
			       ((type?
 MENU EDITBMWINDOWMENU)
				 EDITBMWINDOWMENU)
			       ((SETQ EDITBMWINDOWMENU (create
 MENU
							       ITEMS _(QUOTE ((Move (QUOTE Move)
										    
						"Selects a different part of the bitmap to edit.")))
							       CENTERFLG _ T]
		       (Move                                 (* move the editing window's location on the bitmap.)

			     (PROG [(POS (GETBOXPOSITION
 BITSWIDE BITSHIGH
							 [IPLUS 4 (fetch
 LEFT of
 WREGION)
								(IDIFFERENCE XOFFSET
									     (WINDOWPROP
									       W
									       (QUOTE DXOFFSET]
							 (IPLUS (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
								(IDIFFERENCE YOFFSET
									     (WINDOWPROP
									       W
									       (QUOTE DYOFFSET)))
								4
								(fetch
 BOTTOM of
 WREGION]
			           [WINDOWPROP W (QUOTE XOFFSET)
					       (SETQ XOFFSET
						 (IMIN (IDIFFERENCE BITMAPWIDTH BITSWIDE)
						       (IMAX [IPLUS (WINDOWPROP W (QUOTE DXOFFSET))
								    (IDIFFERENCE (fetch
 XCOORD
										    of
 POS)
										 (IPLUS 4
											(fetch
 LEFT
											   of
 WREGION]
							     0]
			           [WINDOWPROP
				     W
				     (QUOTE YOFFSET)
				     (SETQ YOFFSET
				       (IMAX 0
					     (IMIN (IDIFFERENCE BITMAPHEIGHT BITSHIGH)
						   (IDIFFERENCE (IPLUS (WINDOWPROP W (QUOTE DYOFFSET))
								       (IDIFFERENCE
									 (fetch
 YCOORD of
 POS)
									 (IPLUS (fetch
 BOTTOM
										   of
 WREGION)
										4)))
								(WINDOWPROP W (QUOTE BMDISPLAYBOTTOM]
			           (replace
 (REGION LEFT) of
 EXTENT
				      with
 (IMINUS (QUOTIENT (TIMES XOFFSET (fetch
 (REGION WIDTH)
									       of
 EXTENT))
							     BITMAPWIDTH)))
			           (replace
 (REGION BOTTOM) of
 EXTENT
				      with
 (IMINUS (QUOTIENT (TIMES YOFFSET (fetch
 (REGION HEIGHT)
									       of
 EXTENT))
							     BITMAPHEIGHT)))
			           [COND
				     ([OR (ILESSP XOFFSET DXOFFSET)
					  (ILESSP YOFFSET DYOFFSET)
					  [IGREATERP (IPLUS XOFFSET BITSWIDE)
						     (IPLUS DXOFFSET (WINDOWPROP W (QUOTE 
										   BMDISPLAYWIDTH]
					  (IGREATERP (IPLUS YOFFSET BITSHIGH)
						     (IPLUS DYOFFSET (WINDOWPROP W (QUOTE 
										  BMDISPLAYHEIGHT]
                                                             (* Adjust the display region left lower corner so the 

							     selected region is near the center.)

				       [WINDOWPROP W (QUOTE DXOFFSET)
						   (SETQ DXOFFSET
						     (IMAX 0
							   (IMIN (IDIFFERENCE (fetch
 (BITMAP 
										      BITMAPWIDTH)
										 of
 BM)
									      (WINDOWPROP
										W
										(QUOTE BMDISPLAYWIDTH)
										))
								 (IDIFFERENCE
								   (IPLUS XOFFSET (LRSH BITSWIDE 1))
								   (LRSH (WINDOWPROP W (QUOTE 
										   BMDISPLAYWIDTH))
									 1]
				       (WINDOWPROP W (QUOTE DYOFFSET)
						   (SETQ DYOFFSET
						     (IMAX 0
							   (IMIN (IDIFFERENCE (fetch
 (BITMAP 
										     BITMAPHEIGHT)
										 of
 BM)
									      (WINDOWPROP
										W
										(QUOTE 
										  BMDISPLAYHEIGHT)))
								 (IDIFFERENCE
								   (IPLUS YOFFSET (LRSH BITSHIGH 1))
								   (LRSH (WINDOWPROP W (QUOTE 
										  BMDISPLAYHEIGHT))
									 1]
			           (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
					    W)
			           (UPDATE/BM/DISPLAY BM W)
			           (COND
				     ((WINDOWPROP W (QUOTE GRIDON))
				       (GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
					     W)))
			           (RESETGRID
 BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W)))
		       NIL))
	    ((LASTMOUSESTATE LEFT)
	      (UPDATE/BM/DISPLAY/SELECTED/REGION
 W)
	      [RESETFORM (CURSOR (CURSORCREATE BM (CURSORHOTSPOT)))
			 (until
 (MOUSESTATE (NOT LEFT]
	      (UPDATE/BM/DISPLAY/SELECTED/REGION
 W))
	    (T                                               (* the region being editted is inverted while the menu 

							     is active. Each command must make sure that it is 

							     recomplemented.)

	       (UPDATE/BM/DISPLAY/SELECTED/REGION
 W)
	       (SELECTQ [MENU (COND
				((type?
 MENU EDITBMMENU)
				  EDITBMMENU)
				(T (SETQ EDITBMMENU (create
 MENU
							    ITEMS _(QUOTE ((Paint (QUOTE Paint)
										  
						  "Calls the window PAINT command on the bitmap.")
									    (ShowAsTile (QUOTE 
										       ShowAsTile)
											
				       "tiles the upper part of the edit window with the bitmap.")
									    (Grid% On/Off
									      (QUOTE GridOnOff)
									      "Grid On/Off Switch")
									    (GridSize_(QUOTE 
											GridSize_)
									      
					  "Allows setting of the size of a bit in the edit area.")
									    (Reset (QUOTE Reset)
										   
			   "Sets the bitmap back to the state at the start of this edit session.")
									    (Clear (QUOTE Clear)
										   
								    "Sets the entire bitmap to 0")
									    (Cursor_(QUOTE Cursor_)
									      
					  "Puts the bitmap into the cursor and exits the editor.")
									    (OK (QUOTE OK)
										
								       "Leaves the edit session.")
									    (Stop (QUOTE Stop)
										  
			      "Restores the bitmap to its original values and leaves the editor.")))
							    CENTERFLG _ T]
			(OK (WINDOWPROP W (QUOTE FINISHEDFLG)
					T))
			(Stop (WINDOWPROP W (QUOTE FINISHEDFLG)
					  (QUOTE KILL)))
			[Reset                               (* allow the user to choose between everything or just 

							     visible part. This also give the user a chance to 

							     change their mind.)

			       (COND
				 ((SELECTQ (\EDITBMHOWMUCH
 BM BITSWIDE BITSHIGH "RESET how much?")
					   (VISIBLE (COND
						      [(SETQ ORIGBM (WINDOWPROP W (QUOTE 
										   ORIGINALBITMAP)))
							(COND
							  ((REGIONP ORIGBM)
							    (BITBLT (SCREENBITMAP)
								    (IPLUS XOFFSET
									   (fetch
 (REGION LEFT)
									      of
 ORIGBM))
								    (IPLUS YOFFSET
									   (fetch
 (REGION BOTTOM)
									      of
 ORIGBM))
								    BM XOFFSET YOFFSET BITSWIDE 
								    BITSHIGH (QUOTE INPUT)
								    (QUOTE REPLACE)))
							  (T (BITBLT ORIGBM XOFFSET YOFFSET BM 
								     XOFFSET YOFFSET BITSWIDE 
								     BITSHIGH]
						      (T (BITBLT NIL NIL NIL BM XOFFSET YOFFSET 
								 BITSWIDE BITSHIGH (QUOTE TEXTURE)
								 (QUOTE REPLACE)
								 WHITESHADE)))
						    T)
					   (WHOLE (COND
						    [(SETQ ORIGBM (WINDOWPROP W (QUOTE ORIGINALBITMAP)
									      ))
						      (COND
							((REGIONP ORIGBM)
							  (BITBLT (SCREENBITMAP)
								  (fetch
 (REGION LEFT) of
 ORIGBM)
								  (fetch
 (REGION BOTTOM)
								     of
 ORIGBM)
								  BM))
							(T (BITBLT ORIGBM NIL NIL BM]
						    (T (\CLEARBM
 BM)))
						  T)
					   (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION
 W)
						  NIL))
				   (\EDITBM/PUTUP/DISPLAY
 W BM GRIDSPEC GRIDINTERIOR BITSWIDE 
							  BITSHIGH]
			[Clear                               (* allow the user to choose between everything or just 

							     visible part. This also give the user a chance to 

							     change their mind.)

			       (COND
				 ((SELECTQ (\EDITBMHOWMUCH
 BM BITSWIDE BITSHIGH "CLEAR how much?")
					   (VISIBLE (BITBLT NIL NIL NIL BM XOFFSET YOFFSET BITSWIDE 
							    BITSHIGH (QUOTE TEXTURE)
							    (QUOTE REPLACE)
							    WHITESHADE)
						    T)
					   (WHOLE (\CLEARBM
 BM)
						  T)
					   (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION
 W)
						  NIL))
				   (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
					    W)
				   (COND
				     ((WINDOWPROP W (QUOTE GRIDON))
				       (GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
					     W)))
				   (UPDATE/BM/DISPLAY BM W]
			[GridOnOff (COND
				     ((NOT (WINDOWPROP W (QUOTE GRIDON)))
                                                             (* Turn Grid On)

				       (WINDOWPROP W (QUOTE GRIDON)
						   T)
				       (GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
					     W)
				       (UPDATE/BM/DISPLAY BM W))
				     (T                      (* Turn off grid)

					(WINDOWPROP W (QUOTE GRIDON)
						    NIL)
					(DSPFILL (create
 REGION
							 WIDTH _(ADD1 (fetch
 WIDTH GRIDINTERIOR))
							 HEIGHT _(ADD1 (fetch
 HEIGHT GRIDINTERIOR))
						    using
 GRIDINTERIOR)
						 WHITESHADE
						 (QUOTE REPLACE)
						 W)
					(RESETGRID
 BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W)
					(UPDATE/BM/DISPLAY BM W]
			[GridSize_                           (* sets the grid square size and calls the reshapefn.)

				   (COND
				     ([SETQ NEWGRIDSIZE
					 (NUMBERP (MENU (COND
							  ((TYPENAMEP GRIDSIZEMENU (QUOTE MENU))
							    GRIDSIZEMENU)
							  (T (SETQ GRIDSIZEMENU
							       (create
 MENU
								       ITEMS _(QUOTE (3 4 5 6 7 8 12 
											16 20 24 28 
											32))
								       MENUROWS _ 4]
				       (WINDOWPROP W (QUOTE GRIDSQUARE)
						   NEWGRIDSIZE)
				       (EDITBMRESHAPEFN
 W]
			(ShowAsTile                          (* tiles the upper part of the window with the bitmap 

							     so the user can see what it would be as a shade.)

				    (UPDATE/SHADE/DISPLAY
 BM W))
			[Paint                               (* call the window paint command on the contents of the

							     bitmap.)

			       [SETQ PAINTW (CREATEW (create
 REGION
							     LEFT _(IQUOTIENT (IDIFFERENCE 
										      SCREENWIDTH 
										      BITMAPWIDTH)
									      2)
							     BOTTOM _(IQUOTIENT (IDIFFERENCE 
										     SCREENHEIGHT 
										     BITMAPHEIGHT)
										2)
							     WIDTH _(WIDTHIFWINDOW BITMAPWIDTH)
							     HEIGHT _(HEIGHTIFWINDOW BITMAPHEIGHT NIL]
			       (OPENW PAINTW)
			       (BITBLT BM 0 0 PAINTW)
			       (PAINTW PAINTW)
			       (COND
				 ((MENU (create
 MENU
						ITEMS _(QUOTE ((YES T 
			      "Will put the newly painted bits back in the bitmap being editted.")
								(NO NIL 
			  "Will discard the painted bits, not changing the bitmap being editted.")))
						TITLE _ "Put change into bitmap?"
						CENTERFLG _ T))
				   (BITBLT PAINTW 0 0 BM)
				   (CLOSEW PAINTW)           (* set PAINTW so that space can be reclaimed)

				   (SETQ PAINTW)
				   (\EDITBM/PUTUP/DISPLAY
 W BM GRIDSPEC GRIDINTERIOR BITSWIDE 
							  BITSHIGH]
			(Cursor_                             (* Stuffs lower left part of image into the cursor and 

							     sets the hotspot.)

				 (READHOTSPOT
 BM GRIDSPEC GRIDINTERIOR W)
				 (WINDOWPROP W (QUOTE FINISHEDFLG)
					     T))
			(UPDATE/BM/DISPLAY/SELECTED/REGION
 W])

(\EDITBM/PUTUP/DISPLAY

  [LAMBDA (WINDOW BM GRIDSPEC GRIDINTERIOR BITSWIDE BITSHIGH)
                                                             (* AJB "14-Feb-85 13:43")

                                                             (* initializes the display for the bitmap editor.)

    (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
	     WINDOW)
    (COND
      ((WINDOWPROP WINDOW (QUOTE GRIDON))
	(GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
	      WINDOW)))
    (RESETGRID
 BM GRIDSPEC BITSWIDE BITSHIGH 0 0 WINDOW)
    (UPDATE/BM/DISPLAY BM WINDOW])

(\EDITBMHOWMUCH

  [LAMBDA (BM EDITWIDTH EDITHEIGHT TITLEQ)                   (* rrb "21-JUN-82 10:30")

                                                             (* asks the user how much to clear)

    (MENU (COND
	    ((OR (IGREATERP (fetch
 (BITMAP BITMAPWIDTH) of
 BM)
			    EDITWIDTH)
		 (IGREATERP (fetch
 (BITMAP BITMAPHEIGHT) of
 BM)
			    EDITHEIGHT))
	      (create
 MENU
		      TITLE _ TITLEQ
		      ITEMS _(QUOTE ((VisiblePart (QUOTE VISIBLE)
						  
					   "Operates on just the part visible in the edit region")
				      (WholeBitmap (QUOTE WHOLE)
						   "Operates on the entire bitmap")))
		      CENTERFLG _ T))
	    (T (create
 MENU
		       TITLE _ TITLEQ
		       ITEMS _(QUOTE ((WholeBitmap (QUOTE WHOLE)
						   "Operates on the entire bitmap")))
		       CENTERFLG _ T])

(EDITBMRESHAPEFN

  [LAMBDA (BMEDITWINDOW OLDIMAGE OLDREGION ZEROBMFLG)        (* AJB "26-Feb-85 19:56")


          (* allows the bitmap edit window to be reshaped to enlarge the editting area. This is also called to set up the 

	  image during initialization.)



    (PROG (BMWINTERIORWIDTH BMWINTERIORHEIGHT EDITAREABITWIDTH EDITAREABITHEIGHT GRIDSQUARE 
			    GRIDINTERIOR BITMAPWIDTH BMDISPLAYWIDTH BMDISPLAYBOTTOM BMDISPLAYHEIGHT 
			    BITMAPHEIGHT EXTENTHEIGHT EXTENTWIDTH (BM (WINDOWPROP BMEDITWINDOW
										  (QUOTE BM)))
			    (MINCOMMANDAREAWIDTH 30))
          (SETQ BITMAPWIDTH (fetch
 BITMAPWIDTH of
 BM))
          (SETQ BITMAPHEIGHT (fetch
 BITMAPHEIGHT of
 BM))
          (SETQ BMWINTERIORWIDTH (WINDOWPROP BMEDITWINDOW (QUOTE WIDTH)))
                                                             (* leave room at the top for the full size display 

							     area. But not more than half of the window.)

          (SETQ BMWINTERIORHEIGHT (IMAX (IDIFFERENCE (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
						     (IPLUS BITMAPHEIGHT GRIDTHICKNESS))
					(IQUOTIENT (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
						   2)))

          (* if the user hasn't set it, determine the grid size as the largest size which fits the interior but not larger 

	  than NORMALGRIDSQUARE nor smaller than MINGRIDSQUARE. If GRIDSQUARE was specified, reset it to NIL so that if 

	  reshaped it will be recalculated.)



          (SETQ GRIDSQUARE (OR (WINDOWPROP BMEDITWINDOW (QUOTE GRIDSQUARE)
					   NIL)
			       (IMAX (IMIN (IQUOTIENT BMWINTERIORWIDTH BITMAPWIDTH)
					   (IQUOTIENT BMWINTERIORHEIGHT BITMAPHEIGHT)
					   NORMALGRIDSQUARE)
				     MINGRIDSQUARE)))        (* calculate how many bits will be displayed at once.)

          (SETQ EDITAREABITWIDTH (IMIN (IQUOTIENT BMWINTERIORWIDTH GRIDSQUARE)
				       BITMAPWIDTH))
          (WINDOWPROP BMEDITWINDOW (QUOTE BITSWIDE)
		      EDITAREABITWIDTH)
          (SETQ EDITAREABITHEIGHT (IMIN (IQUOTIENT BMWINTERIORHEIGHT GRIDSQUARE)
					BITMAPHEIGHT))       (* calculate offset of display and command regions at 

							     the top of the window.)

          (WINDOWPROP BMEDITWINDOW (QUOTE BITSHIGH)
		      EDITAREABITHEIGHT)
          (SETQ BMDISPLAYBOTTOM (IPLUS (ITIMES GRIDSQUARE EDITAREABITHEIGHT)
				       GRIDTHICKNESS))
          (SETQ BMDISPLAYWIDTH (IMIN BITMAPWIDTH (IDIFFERENCE BMWINTERIORWIDTH MINCOMMANDAREAWIDTH)))

          (* put the offset -

	  the lower left coordinate -

	  in the same place unless the new shape allows more to be shown past the upper right corner.)



          (WINDOWPROP BMEDITWINDOW (QUOTE XOFFSET)
		      (IMIN (WINDOWPROP BMEDITWINDOW (QUOTE XOFFSET))
			    (IDIFFERENCE BITMAPWIDTH EDITAREABITWIDTH)))
          (WINDOWPROP BMEDITWINDOW (QUOTE YOFFSET)
		      (IMIN (WINDOWPROP BMEDITWINDOW (QUOTE YOFFSET))
			    (IDIFFERENCE BITMAPHEIGHT EDITAREABITHEIGHT)))
                                                             (* Center edit square)

          (SETQ GRIDINTERIOR (create
 REGION
				     LEFT _(IQUOTIENT (IDIFFERENCE BMWINTERIORWIDTH (ITIMES 
										 EDITAREABITWIDTH 
										       GRIDSQUARE))
						      2)
				     BOTTOM _(IQUOTIENT (IDIFFERENCE BMDISPLAYBOTTOM
								     (ITIMES EDITAREABITHEIGHT 
									     GRIDSQUARE))
							2)
				     WIDTH _(ITIMES EDITAREABITWIDTH GRIDSQUARE)
				     HEIGHT _(ITIMES EDITAREABITHEIGHT GRIDSQUARE)))
          (WINDOWPROP BMEDITWINDOW (QUOTE GRIDINTERIOR)
		      GRIDINTERIOR)
          (WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYBOTTOM)
		      BMDISPLAYBOTTOM)
          (WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYWIDTH)
		      BMDISPLAYWIDTH)
          (WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYHEIGHT)
		      (SETQ BMDISPLAYHEIGHT (IDIFFERENCE (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
							 BMDISPLAYBOTTOM)))
          (WINDOWPROP BMEDITWINDOW (QUOTE DISPLAYREGION)
		      (create
 REGION
			      LEFT _ 0
			      BOTTOM _ BMDISPLAYBOTTOM
			      WIDTH _ BMDISPLAYWIDTH
			      HEIGHT _ BMDISPLAYHEIGHT))
          (WINDOWPROP BMEDITWINDOW (QUOTE GRIDSPEC)
		      (create
 REGION
			      LEFT _(fetch
 (REGION LEFT) of
 GRIDINTERIOR)
			      BOTTOM _(fetch
 (REGION BOTTOM) of
 GRIDINTERIOR)
			      WIDTH _ GRIDSQUARE
			      HEIGHT _ GRIDSQUARE))
          (SETQ EXTENTHEIGHT (QUOTIENT (TIMES BITMAPHEIGHT (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT)))
				       EDITAREABITHEIGHT))
          [SETQ EXTENTWIDTH (IDIFFERENCE (QUOTIENT (TIMES BITMAPWIDTH BMWINTERIORWIDTH)
						   EDITAREABITWIDTH)
					 (WINDOWPROP BMEDITWINDOW (QUOTE BORDER]
          (WINDOWPROP BMEDITWINDOW (QUOTE EXTENT)
		      (CREATEREGION (MINUS (QUOTIENT (TIMES (WINDOWPROP BMEDITWINDOW (QUOTE XOFFSET))
							    EXTENTWIDTH)
						     BITMAPWIDTH))
				    (MINUS (QUOTIENT (TIMES (WINDOWPROP BMEDITWINDOW (QUOTE YOFFSET))
							    EXTENTHEIGHT)
						     BITMAPHEIGHT))
				    EXTENTWIDTH EXTENTHEIGHT))
          (EDITBMREPAINTFN
 BMEDITWINDOW NIL NIL])

(EDITBMREPAINTFN

  [LAMBDA (WIN REGION ZEROBM)                                (* AJB "21-Feb-85 17:19")

                                                             (* redisplays a bitmap editting window If ZEROBM is 

							     non-NIL, it doesn't bother to display the bits.)

    (PROG [(GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
	   (EDITAREABITWIDTH (WINDOWPROP WIN (QUOTE BITSWIDE)))
	   (EDITAREABITHEIGHT (WINDOWPROP WIN (QUOTE BITSHIGH)))
	   (BM (WINDOWPROP WIN (QUOTE BM]
          (CLEARW WIN)                                       (* gray the area above the edit grid that is not bitmap

							     display area.)

          (BITBLT NIL NIL NIL WIN (IPLUS (WINDOWPROP WIN (QUOTE BMDISPLAYWIDTH))
					 GRIDTHICKNESS)
		  (WINDOWPROP WIN (QUOTE BMDISPLAYBOTTOM))
		  NIL NIL (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  NOTINUSEGRAY)                              (* put in the display of the full sized bitmap.)

          (UPDATE/BM/DISPLAY BM WIN)                         (* put in grid markings.)

          (COND
	    ((WINDOWPROP WIN (QUOTE GRIDON))
	      (GRID
 GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT (QUOTE POINT)
		    WIN)))

          (* shade in the bits that are on. If the expectation is that most bits were on it would be faster to change 

	  RESETGRID to show both off and on bits and remove the previous call to GRID.)



          (OR ZEROBM (RESETGRID
 BM GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT 0 0 WIN])

(UPDATE/SHADE/DISPLAY

  [LAMBDA (BM WIN)                                           (* rrb "20-JUN-82 16:53")

                                                             (* displays BM as if it were a shade.)

    (PROG [(BOTTOM (WINDOWPROP WIN (QUOTE BMDISPLAYBOTTOM]
          (TILEAREA
 0 BOTTOM (WINDOWPROP WIN (QUOTE WIDTH))
		    (IDIFFERENCE (WINDOWPROP WIN (QUOTE HEIGHT))
				 BOTTOM)
		    BM WIN])

(UPDATE/BM/DISPLAY/SELECTED/REGION

  [LAMBDA (W)                                                (* rrb "17-JUN-82 11:19")

                                                             (* Shade the selected region of the bitmap display 

							     area.)

    (COND
      ([OR (IGREATERP (fetch
 (BITMAP BITMAPWIDTH) of
 (WINDOWPROP W (QUOTE BM)))
		      (WINDOWPROP W (QUOTE BITSWIDE)))
	   (IGREATERP (fetch
 (BITMAP BITMAPHEIGHT) of
 (WINDOWPROP W (QUOTE BM)))
		      (WINDOWPROP W (QUOTE BITSHIGH]         (* only invert the region being editted if it is less 

							     than the entire bitmap.)

	(BITBLT NIL 0 0 W (IDIFFERENCE (WINDOWPROP W (QUOTE XOFFSET))
				       (WINDOWPROP W (QUOTE DXOFFSET)))
		(IDIFFERENCE (IPLUS (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
				    (WINDOWPROP W (QUOTE YOFFSET)))
			     (WINDOWPROP W (QUOTE DYOFFSET)))
		(WINDOWPROP W (QUOTE BITSWIDE))
		(WINDOWPROP W (QUOTE BITSHIGH))
		(QUOTE TEXTURE)
		(QUOTE INVERT)
		BLACKSHADE])

(SHOWBUTTON

  [LAMBDA (BUTTON DS)                                        (* rrb "27-JUL-81 10:59")

                                                             (* displays a menu box and its title.)

    (PROG ((BLOCK (fetch
 (BUTTON REGION) of
 BUTTON)))
          (WBOX
 BLOCK NIL NIL DS)                            (* Display the title in the middle of the box)

          (CENTERPRINTINREGION (fetch
 (BUTTON LABEL) of
 BUTTON)
			       BLOCK DS])

(RESETGRID

  [LAMBDA (BM GRIDSPEC WIDTH HEIGHT ORGX ORGY W)             (* AJB " 1-Aug-85 09:38")

                                                             (* copies the contents of a bitmap into the edit 

							     display grid.)

    (bind
 (XOFFSET _(WINDOWPROP W (QUOTE XOFFSET)))
	  (YOFFSET _(WINDOWPROP W (QUOTE YOFFSET))) for
 Y from
 (OR ORGY 0)
       to
 (SUB1 (COND
		  (ORGY (IPLUS ORGY HEIGHT))
		  (T HEIGHT)))
       do
 (for
 X from
 (OR ORGX 0) to
 (SUB1 (COND
					     (ORGX (IPLUS ORGX WIDTH))
					     (T WIDTH)))
	     when
 (EQ (BITMAPBIT BM (IPLUS X XOFFSET)
				 (IPLUS Y YOFFSET))
		      1)
	     do
 (SHADEGRIDBOX
 X Y DARKBITSHADE (QUOTE REPLACE)
			      GRIDSPEC
			      (COND
				((NULL (WINDOWPROP W (QUOTE GRIDON)))
				  0)
				(T (QUOTE POINT)))
			      W])

(\READBMDIMENSIONS

  [LAMBDA NIL                                                (* rrb "24-AUG-82 10:42")

                                                             (* asks the user for dimensions of a bitmap and creates

							     it.)

    (PROG (WIDTH HEIGHT)
      WIDTHLP
          (PRIN1 "How wide would you like the bitmap to be? " T)
          (COND
	    ([NOT (NUMBERP (SETQ WIDTH (READ T]
	      (PRIN1 "?" T)
	      (TERPRI T)
	      (GO WIDTHLP))
	    ((ILESSP WIDTH 1)
	      (PRIN1 "WIDTH must be positive." T)
	      (TERPRI T)
	      (GO WIDTHLP)))
      HEIGHTLP
          (PRIN1 "How high would you like the bitmap to be? " T)
          (COND
	    ([NOT (NUMBERP (SETQ HEIGHT (READ T]
	      (PRIN1 "?" T)
	      (TERPRI T)
	      (GO HEIGHTLP))
	    ((ILESSP HEIGHT 1)
	      (PRIN1 "HEIGHT must be positive." T)
	      (TERPRI T)
	      (GO HEIGHTLP)))
          (RETURN (BITMAPCREATE WIDTH HEIGHT])

(EDITSHADE

  [LAMBDA (SHADE)                                            (* rrb "17-May-84 12:00")

                                                             (* allows the editing of a shade.)

    (PROG ([SHADEBM (COND
		      ((BITMAPP SHADE)
			(CREATETEXTUREFROMBITMAP SHADE))
		      ((FIXP SHADE)
			(\BITMAPFROMTEXTURE
 SHADE))
		      ((EQ SHADE T)
			(BITMAPCREATE 16 16))
		      ((NULL SHADE)
			(BITMAPCREATE 4 4))
		      (T (\ILLEGAL.ARG SHADE]
	   (QUITREGION (CREATEREGION 125 150 50 20))
	   (SHADEREGION (CREATEREGION 10 185 272 100))
	   BMWIDTH BMHEIGHT GRIDINTERIOR GRIDSPEC X Y SEDW DS BOXSIZE)
          (SETQ DS (WINDOWPROP (SETQ SEDW (CREATEW (GETBOXREGION
 300 300 NIL NIL NIL 
							"Indicate position of Shade edit window.")))
			       (QUOTE DSP)))
          (SETQ BMWIDTH (BITMAPWIDTH SHADEBM))
          (SETQ BMHEIGHT (BITMAPHEIGHT SHADEBM))
          (SETQ BOXSIZE (IMIN (IQUOTIENT 144 BMHEIGHT)
			      (IQUOTIENT 256 BMWIDTH)))
          (WINDOWPROP SEDW (QUOTE PROCESS)
		      (THIS.PROCESS))
          (WINDOWPROP SEDW (QUOTE REPAINTFN)
		      (QUOTE EDITSHADEREPAINTFN))
          (WINDOWPROP SEDW (QUOTE QUITREGION)
		      QUITREGION)
          (WINDOWPROP SEDW (QUOTE GRIDSPEC)
		      (SETQ GRIDSPEC (CREATEREGION (SETQ X (IQUOTIENT (IDIFFERENCE 292
										   (ITIMES BOXSIZE 
											  BMWIDTH))
								      2))
						   (SETQ Y (IQUOTIENT (IDIFFERENCE 150
										   (ITIMES BOXSIZE 
											 BMHEIGHT))
								      2))
						   BOXSIZE BOXSIZE)))
          [WINDOWPROP SEDW (QUOTE GRIDINTERIOR)
		      (SETQ GRIDINTERIOR (CREATEREGION X Y (ITIMES BOXSIZE BMWIDTH)
						       (ITIMES BOXSIZE BMHEIGHT]
          (WINDOWPROP SEDW (QUOTE SHADEBM)
		      SHADEBM)
          (WINDOWPROP SEDW (QUOTE SHADEREGION)
		      SHADEREGION)
          (WINDOWPROP SEDW (QUOTE XOFFSET)
		      0)
          (WINDOWPROP SEDW (QUOTE YOFFSET)
		      0)
          (EDITSHADEREPAINTFN
 SEDW)
          [RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEW)
					 SEDW))
		    (do
 (DSPFILL SHADEREGION (COND
				   ((EQ BMWIDTH 4)           (* bitblt doesn't like bitmaps that are not 16 by 16.0)

				     (CREATETEXTUREFROMBITMAP SHADEBM))
				   (T SHADEBM))
				 (QUOTE TEXTURE)
				 DS)
			(until
 (MOUSESTATE (OR LEFT MIDDLE RIGHT))
			   do
 (TOTOPW SEDW)
			      (BLOCK))
			(COND
			  [(LASTMOUSESTATE RIGHT)
			    (ERSETQ (DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY]
			  ((EQ (QUOTE STOP)
			       (until
 (MOUSESTATE UP) bind
 (XPIXEL YPIXEL)
				  do
 (TOTOPW SEDW)
				     [COND
				       [(INSIDE?
 GRIDINTERIOR (SETQ X (LASTMOUSEX DS))
						 (SETQ Y (LASTMOUSEY DS)))
					 (COND
					   ((AND (STRICTLY/BETWEEN (SETQ XPIXEL (GRIDXCOORD
 X 
											 GRIDSPEC))
								   -1 BMWIDTH)
						 (STRICTLY/BETWEEN (SETQ YPIXEL (GRIDYCOORD
 Y 
											 GRIDSPEC))
								   -1 BMHEIGHT))
					     (SHADEGRIDBOX
 XPIXEL YPIXEL (COND
							     ((LASTMOUSESTATE LEFT)
							       DARKBITSHADE)
							     (T WHITESHADE))
							   (QUOTE REPLACE)
							   GRIDSPEC
							   (QUOTE POINT)
							   DS)
					     (BITMAPBIT SHADEBM XPIXEL YPIXEL (COND
							  ((LASTMOUSESTATE LEFT)
							    1)
							  (T 0]
				       ((INSIDE?
 QUITREGION X Y)
					 (DSPFILL QUITREGION BLACKSHADE (QUOTE INVERT)
						  DS)
					 (RETURN (until
 (MOUSESTATE UP)
						    do
 (COND
							 ((NOT (INSIDE?
 QUITREGION (LASTMOUSEX DS)
									(LASTMOUSEY DS)))
							   (DSPFILL QUITREGION BLACKSHADE
								    (QUOTE INVERT)
								    DS)
							   (RETURN)))
						    finally
 (DSPFILL QUITREGION BLACKSHADE
								     (QUOTE INVERT)
								     DS)
                                                             (* close window.)

							    (RETURN (QUOTE STOP]
				     (BLOCK)))
			    (RETURN]
          (RETURN (COND
		    ((AND (OR (NUMBERP SHADE)
			      (NULL SHADE))
			  (EQ BMWIDTH 4)
			  (EQ BMHEIGHT 4))                   (* user passed in a number or NIL, give them a number 

							     back.)

		      (CREATETEXTUREFROMBITMAP SHADEBM))
		    (T SHADEBM])

(\BITMAPFROMTEXTURE

  [LAMBDA (FIXP)                                             (* rrb "16-May-84 14:56")

                                                             (* returns a 4 by 4 bitmap that contains the texture 

							     represented by FIXP.)

    (PROG ((SHADE (BITMAPCREATE 4 4)))
          [for
 X from
 0 to
 3
	     do
 (for
 Y from
 0 to
 3
		   do
 (COND
			([NOT (EQ 0 (LOGAND FIXP (\BITMASK (IPLUS (ITIMES (IDIFFERENCE 3 Y)
									  4)
								  X]
			  (BITMAPBIT SHADE X Y 1]
          (RETURN SHADE])

(EDITSHADEREPAINTFN

  [LAMBDA (WIN)                                              (* AJB "14-Feb-85 18:56")

                                                             (* redisplays an edit shade window.)

    (PROG ((GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
	   (SHADE (WINDOWPROP WIN (QUOTE SHADEBM)))
	   BMWIDTH BMHEIGHT)
          (SETQ BMWIDTH (BITMAPWIDTH SHADE))
          (SETQ BMHEIGHT (BITMAPHEIGHT SHADE))
          (SHOWBUTTON
 (create
 BUTTON
			      REGION _(WINDOWPROP WIN (QUOTE QUITREGION))
			      LABEL _(QUOTE QUIT)
			      HELP _ "Quits")
		      WIN)
          (GRAYBOXAREA
 (fetch
 LEFT of
 GRIDSPEC)
		       (fetch
 BOTTOM of
 GRIDSPEC)
		       (ITIMES (fetch
 WIDTH of
 GRIDSPEC)
			       BMWIDTH)
		       (ITIMES (fetch
 HEIGHT of
 GRIDSPEC)
			       BMHEIGHT)
		       2 BLACKSHADE WIN)
          (RESETGRID
 SHADE GRIDSPEC BMWIDTH BMHEIGHT 0 0 WIN)
          (GRID
 GRIDSPEC BMWIDTH BMHEIGHT (QUOTE POINT)
		WIN)
          (DSPFILL (WINDOWPROP WIN (QUOTE SHADEREGION))
		   SHADE
		   (QUOTE TEXTURE)
		   WIN])

(GRAYBOXAREA

  [LAMBDA (X Y WIDTH HEIGHT OUTLINESIZE TEXTURE DS)          (* rrb "13-JUN-82 17:41")

                                                             (* outlines an area with a gray box.)

    (COND
      ((FIXP OUTLINESIZE))
      ((NULL OUTLINESIZE)
	(SETQ OUTLINESIZE 1))
      (T (\ILLEGAL.ARG OUTLINESIZE)))
    (BITBLT NIL NIL NIL DS (IDIFFERENCE X OUTLINESIZE)
	    (IDIFFERENCE Y OUTLINESIZE)
	    (IPLUS WIDTH (ITIMES 2 OUTLINESIZE))
	    (IPLUS HEIGHT (ITIMES 2 OUTLINESIZE))
	    (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    (OR TEXTURE BLACKSHADE))
    (BITBLT NIL NIL NIL DS X Y WIDTH HEIGHT (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    (DSPTEXTURE NIL DS])

(\SHADEBITS

  [LAMBDA (BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH)     (* AJB "14-Feb-85 15:29")

                                                             (* cursor is inside the edit grid, so change the bit in

							     the bitmap, change the edit grid and redisplay the 

							     bitmap.)

    (bind
 (XPIXEL YPIXEL INTENSITY X Y) until
 (MOUSESTATE UP)
       when
 (AND [NEQ (AND [EQ XPIXEL (SETQ XPIXEL (IMAX 0 (IMIN BITSWIDE (GRIDXCOORD
 (SETQ X
											(LASTMOUSEX
											  W))
										      GRIDSPEC]
			   YPIXEL)
		      (SETQ YPIXEL (IMAX 0 (IMIN BITSHIGH (GRIDYCOORD
 (SETQ Y (LASTMOUSEY W))
								      GRIDSPEC]
		 (INSIDE?
 GRIDINTERIOR X Y))
       do
 [BITMAPBIT BM (IPLUS XPIXEL (WINDOWPROP W (QUOTE XOFFSET)))
		     (IPLUS YPIXEL (WINDOWPROP W (QUOTE YOFFSET)))
		     (SETQ INTENSITY (COND
			 ((LASTMOUSESTATE LEFT)
			   DARKBITSHADE)
			 (T WHITESHADE]
	  (UPDATE/BM/DISPLAY BM W)
	  (SHADEGRIDBOX
 XPIXEL YPIXEL INTENSITY (QUOTE REPLACE)
			GRIDSPEC
			(COND
			  ((NULL (WINDOWPROP W (QUOTE GRIDON)))
			    0)
			  (T (QUOTE POINT)))
			W])

(READHOTSPOT

  [LAMBDA (BM GRIDSPEC GRIDINTERIOR DS)                      (* AJB "14-Feb-85 17:16")

    (DECLARE
 (GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY))     (* reads the hotspot from the cursor and sets cursor)

    (UNTILMOUSESTATE UP)
    (PROG ((NOWCURSOR (CURSOR))
	   XPIXEL YPIXEL DOWNYET?)
          (CURSORPOSITION (create
 POSITION
				  XCOORD _(IPLUS (LEFTOFGRIDCOORD
 (SETQ XPIXEL (fetch
 CURSORHOTSPOTX
										  of
 NOWCURSOR))
								  GRIDSPEC)
						 (IQUOTIENT (fetch
 (REGION WIDTH) of
 GRIDSPEC)
							    2))
				  YCOORD _(IPLUS (BOTTOMOFGRIDCOORD
 (SETQ YPIXEL
								      (fetch
 CURSORHOTSPOTY
									 of
 NOWCURSOR))
								    GRIDSPEC)
						 (IQUOTIENT (fetch
 (REGION HEIGHT) of
 GRIDSPEC)
							    2)))
			  DS)
          (SHADEGRIDBOX
 XPIXEL YPIXEL NOTINUSEGRAY (QUOTE REPLACE)
			GRIDSPEC
			(COND
			  ((NULL (WINDOWPROP DS (QUOTE GRIDON)))
			    0)
			  (T (QUOTE POINT)))
			DS)
          (until
 (PROGN (GETMOUSESTATE)
			(AND DOWNYET? (MOUSESTATE UP)))
	     when
 (INSIDE?
 GRIDINTERIOR (LASTMOUSEX DS)
			   (LASTMOUSEY DS))
	     do
 (OR DOWNYET? (SETQ DOWNYET? (NEQ LASTMOUSEBUTTONS 0)))
		(COND
		  (XPIXEL (SHADEGRIDBOX
 XPIXEL YPIXEL (SELECTQ (BITMAPBIT BM XPIXEL YPIXEL)
							       (0 WHITESHADE)
							       (1 DARKBITSHADE)
							       (SHOULDNT))
					(QUOTE REPLACE)
					GRIDSPEC
					(COND
					  ((NULL (WINDOWPROP DS (QUOTE GRIDON)))
					    0)
					  (T (QUOTE POINT)))
					DS)))
		(SHADEGRIDBOX
 (SETQ XPIXEL (GRIDXCOORD
 (LASTMOUSEX DS)
						       GRIDSPEC))
			      (SETQ YPIXEL (GRIDYCOORD
 (LASTMOUSEY DS)
						       GRIDSPEC))
			      NOTINUSEGRAY
			      (QUOTE REPLACE)
			      GRIDSPEC
			      (COND
				((NULL (WINDOWPROP DS (QUOTE GRIDON)))
				  0)
				(T (QUOTE POINT)))
			      DS)
	     finally
 (CURSOR (CURSORCREATE BM XPIXEL YPIXEL])

(WBOX

  [LAMBDA (REG THCK TEXT DS)                                 (* rrb "19-MAR-82 09:38")

                                                             (* Draws a box around REG with bounding lines of 

							     THCKness)

    (OR THCK (SETQ THCK 2))
    (BITBLT NIL NIL NIL DS NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    BLACKSHADE REG)
    (BITBLT NIL NIL NIL DS (IPLUS (fetch
 (REGION LEFT) of
 REG)
				  THCK)
	    (IPLUS (fetch
 (REGION BOTTOM) of
 REG)
		   THCK)
	    (IDIFFERENCE (fetch
 (REGION WIDTH) of
 REG)
			 (ITIMES 2 THCK))
	    (IDIFFERENCE (fetch
 (REGION HEIGHT) of
 REG)
			 (ITIMES 2 THCK))
	    (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    (OR TEXT (DSPTEXTURE NIL DS])

(\CLEARBM

  [LAMBDA (BM TXT REG)                                       (* bas: "21-APR-81 15:39")

    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    (OR TXT WHITESHADE)
	    REG])
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD BUTTON
 (REGION LABEL HELP))
]

(DECLARE: EVAL@COMPILE 
[PUTPROPS BITMASK MACRO ((X)
	   (LLSH 1 (IDIFFERENCE 15 X]
[PUTPROPS UPDATE/BM/DISPLAY MACRO ((BM W)
	   (BITBLT BM (WINDOWPROP W (QUOTE DXOFFSET))
		   (WINDOWPROP W (QUOTE DYOFFSET))
		   W 0 (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
		   (WINDOWPROP W (QUOTE BMDISPLAYWIDTH))
		   1000 NIL (QUOTE REPLACE]
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 

(RPAQQ DARKBITSHADE
 23130)

(RPAQQ NORMALGRIDSQUARE
 16)

(RPAQQ NOTINUSEGRAY
 42405)

(RPAQQ EDITBMMENU
 NIL)

(RPAQQ EDITBMWINDOWMENU
 NIL)

(RPAQQ GRIDSIZEMENU
 NIL)

(RPAQQ CLICKWAITTIME
 250)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE NOTINUSEGRAY EDITBMMENU CLICKWAITTIME)
)
)
(DECLARE: EVAL@COMPILE 

(RPAQQ GRIDTHICKNESS
 2)

(RPAQQ MINGRIDSQUARE
 8)

(RPAQQ MAXGRIDWIDTH
 199)

(RPAQQ MAXGRIDHEIGHT
 175)

(RPAQQ BMWINDOWSHADE
 33410)

(CONSTANTS (GRIDTHICKNESS 2)
	   (MINGRIDSQUARE 8)
	   (MAXGRIDWIDTH 199)
	   (MAXGRIDHEIGHT 175)
	   (BMWINDOWSHADE 33410))
)
(DEFINEQ

(EXPANDBITMAP

  [LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR)                  (* rrb " 7-DEC-82 11:53")

                                                             (* (* bas: " 5-JUN-82 01:12") expands a bitmap 

							     WIDTHFACTOR time in the width direction and 

							     HEIGHTFACTOR times in the height direction.)

    (DECLARE
 (GLOBALVARS \4BITEXPANSIONTABLE))
    (OR WIDTHFACTOR (SETQ WIDTHFACTOR 4))
    (OR HEIGHTFACTOR (SETQ HEIGHTFACTOR 1))
    (PROG (NU SCR NUH NUW (BMH (fetch
 BITMAPHEIGHT of
 BITMAP))
	      (BMW (fetch
 BITMAPWIDTH of
 BITMAP)))
          [SETQ NU (BITMAPCREATE (SETQ NUW (ITIMES WIDTHFACTOR BMW))
				 (SETQ NUH (ITIMES HEIGHTFACTOR BMH]
          [COND
	    [(EQ WIDTHFACTOR 4)
	      (for
 I from
 0 to
 (SUB1 BMH) as
 C from
 0 by
 HEIGHTFACTOR
		 do
 (\FAST4BIT
 (\ADDBASE (fetch
 BITMAPBASE of
 BITMAP)
					 (ITIMES (IDIFFERENCE BMH (ADD1 I))
						 (fetch
 BITMAPRASTERWIDTH of
 BITMAP)))
			       (\ADDBASE (fetch
 BITMAPBASE of
 NU)
					 (ITIMES (IDIFFERENCE (fetch
 BITMAPHEIGHT of
 NU)
							      (ADD1 C))
						 (fetch
 BITMAPRASTERWIDTH of
 NU)))
			       (fetch
 BITMAPRASTERWIDTH of
 NU)
			       \4BITEXPANSIONTABLE)
		    (for
 I to
 (SUB1 HEIGHTFACTOR) do
 (BITBLT NU 0 C NU 0 (IPLUS C I)
							     NUW 1 (QUOTE INPUT)
							     (QUOTE REPLACE]
	    (T (SETQ SCR 0)
	       (for
 X from
 0 to
 (SUB1 BMW)
		  do
 (for
 I to
 WIDTHFACTOR
			do
 (BITBLT BITMAP X 0 NU SCR 0 1 BMH (QUOTE INPUT)
				   (QUOTE REPLACE))
			   (add
 SCR 1)))
	       (SETQ SCR NUH)
	       (for
 Y from
 (SUB1 BMH) to
 0 by
 -1 do
 (for
 I from
 0 to
 (SUB1 HEIGHTFACTOR)
						       do
 (BITBLT NU 0 Y NU 0 (SETQ SCR (SUB1 SCR))
								  NUW 1 (QUOTE INPUT)
								  (QUOTE REPLACE]
          (RETURN NU])

(SHRINKBITMAP

  [LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR DESTINATIONBITMAP)
                                                             (* hdj "27-Jun-85 14:58")

    (LET* [(BITSPP (BITSPERPIXEL BITMAP))
	   (WFACTOR (OR WIDTHFACTOR 4))
	   (HFACTOR (OR HEIGHTFACTOR 1))
	   (HEIGHT (BITMAPHEIGHT BITMAP))
	   (WIDTH (BITMAPWIDTH BITMAP))
	   (SCRATCH (BITMAPCREATE WIDTH (IQUOTIENT HEIGHT HFACTOR)
				  BITSPP))
	   (DESTINATION (OR DESTINATIONBITMAP (BITMAPCREATE (IQUOTIENT WIDTH WFACTOR)
							    (IQUOTIENT HEIGHT HFACTOR)
							    BITSPP]
          (BLTSHADE 0 DESTINATION)
          (for
 Y from
 0 to
 (SUB1 HEIGHT) do
 (BITBLT BITMAP 0 Y SCRATCH 0 (IQUOTIENT Y HFACTOR)
						    WIDTH 1 (QUOTE INPUT)
						    (QUOTE PAINT)))
          (for
 X from
 0 to
 (SUB1 WIDTH) do
 (BITBLT SCRATCH X 0 DESTINATION (IQUOTIENT X WFACTOR)
						   0 1 HEIGHT (QUOTE INPUT)
						   (QUOTE PAINT)))
      DESTINATION])

(\FAST4BIT

  [LAMBDA (A B N MAP)                                        (* rrb "16-May-84 16:18")

                                                             (* DECLARATIONS: (BLOCKRECORD NIBBLE 

							     ((N1 BITS 4) (N2 BITS 4) (N3 BITS 4) 

							     (N4 BITS 4))))

    (bind
 AW (I _ 0) for
 J from
 0
       do
 (SETQ AW (\ADDBASE A J))
	  (OR (IGREATERP N I)
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch
 N1 of
 AW)))
	  (OR (IGREATERP N (add
 I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch
 N2 of
 AW)))
	  (OR (IGREATERP N (add
 I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch
 N3 of
 AW)))
	  (OR (IGREATERP N (add
 I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch
 N4 of
 AW)))
	  (add
 I 1])
)
(READVARS \4BITEXPANSIONTABLE)
({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 })
(PUTPROPS HLDISPLAY COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3666 18287 (GRID 3676 . 6336) (GRIDXCOORD 6338 . 6851) (GRIDYCOORD 6853 . 7370) (
LEFTOFGRIDCOORD 7372 . 7719) (BOTTOMOFGRIDCOORD 7721 . 7958) (EDITBMSCROLLFN 7960 . 17419) (
SHADEGRIDBOX 17421 . 18285)) (18339 18684 (INSIDE? 18349 . 18682)) (18718 22007 (MOUSESTATE-EXPR 18728
 . 21371) (MOUSESTATE-NAME 21373 . 22005)) (24099 25023 (DECODEBUTTONS 24109 . 25021)) (25024 25912 (
PTDIFFERENCE 25034 . 25479) (PTPLUS 25481 . 25910)) (25959 50094 (GETPOSITION 25969 . 26677) (
GETBOXPOSITION 26679 . 28654) (DSPYSCREENTOWINDOW 28656 . 29001) (DSPXSCREENTOWINDOW 29003 . 29348) (
GETREGION 29350 . 35934) (\GETREGION.PACKPTS 35936 . 36451) (\GETREGION.CHECKBASEPT 36453 . 37570) (
\GETREGION.CHECKOPPT 37572 . 39411) (\GETREGIONTRACKWITHBOX 39413 . 43547) (\UPDATEXYANDBOX 43549 . 
44709) (GETBOXREGION 44711 . 45234) (\TRACKWITHBOX 45236 . 47984) (MOVEBOX 47986 . 48404) (DRAWGRAYBOX
 48406 . 48796) (BLTHLINE 48798 . 49080) (BLTVLINE 49082 . 49364) (SETCORNER 49366 . 50092)) (50095 
51527 (MOUSECONFIRM 50105 . 51525)) (51705 52908 (NEAREST/PT/ON/GRID 51715 . 52186) (PTON10GRID 52188
 . 52507) (NEAREST/MULTIPLE 52509 . 52906)) (54977 58039 (\SW2BM 54987 . 56853) (COMPOSEREGS 56855 . 
57414) (TRANSLATEREG 57416 . 58037)) (58077 100769 (EDITBM 58087 . 65355) (EDITBMCLOSEFN 65357 . 65692
) (TILEAREA 65694 . 66278) (EDITBMBUTTONFN 66280 . 78606) (\EDITBM/PUTUP/DISPLAY 78608 . 79187) (
\EDITBMHOWMUCH 79189 . 80022) (EDITBMRESHAPEFN 80024 . 85070) (EDITBMREPAINTFN 85072 . 86556) (
UPDATE/SHADE/DISPLAY 86558 . 86980) (UPDATE/BM/DISPLAY/SELECTED/REGION 86982 . 87986) (SHOWBUTTON 
87988 . 88469) (RESETGRID 88471 . 89321) (\READBMDIMENSIONS 89323 . 90260) (EDITSHADE 90262 . 94381) (
\BITMAPFROMTEXTURE 94383 . 94949) (EDITSHADEREPAINTFN 94951 . 96052) (GRAYBOXAREA 96054 . 96740) (
\SHADEBITS 96742 . 97873) (READHOTSPOT 97875 . 99795) (WBOX 99797 . 100544) (\CLEARBM 100546 . 100767)
) (101906 105592 (EXPANDBITMAP 101916 . 103828) (SHRINKBITMAP 103830 . 104784) (\FAST4BIT 104786 . 
105590)))))
STOP