(FILECREATED "11-AUG-83 12:35:38" {PHYLUM}<LISPCORE>SOURCES>HLDISPLAY.;70
 81763  

      changes to:  (FNS EDITBM)

      previous date: "20-JUL-83 14:28:41" {PHYLUM}<LISPCORE>SOURCES>HLDISPLAY.;69)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT HLDISPLAYCOMS)

(RPAQQ HLDISPLAYCOMS
 ((* GRID functions)
	(FNS GRID GRIDXCOORD GRIDYCOORD LEFTOFGRIDCOORD BOTTOMOFGRIDCOORD EDITBMSCROLLFN SHADEGRIDBOX)
	(* Low level compatibility and extensions)
	(FNS CLEAR INSIDE?)
	(EXPORT (* Mouse selection code)
		(FNS MOUSESTATE-EXPR MOUSESTATE-NAME)
		(PROP ARGNAMES MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE LASTKEYSETSTATE)
		(DECLARE: DOCOPY (MACROS MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE 
					 LASTKEYSETSTATE))
		(DECLARE: DONTCOPY (MACROS WITHIN))
		(ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)))
	(* High Level Display utilities)
	(FNS DECODEBUTTONS)
	(FNS GETPOSITION GETBOXPOSITION DSPYSCREENTOWINDOW DSPXSCREENTOWINDOW GETREGION GETBOXREGION 
	     MOVEBOX DRAWGRAYBOX BLTHLINE BLTVLINE SETCORNER)
	(FNS NEAREST/PT/ON/GRID PTON10GRID NEAREST/MULTIPLE)
	(EXPORT (MACROS IABS))
	(CURSORS CROSSHAIRS EXPANDINGBOX 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 
		   EDITSHADEREPAINTFN GRAYBOXAREA \SHADEBITS READHOTSPOT WBOX)
	      (DECLARE: DONTCOPY (RECORDS BUTTON)
			(MACROS BITMASK UPDATE/BM/DISPLAY))
	      (DECLARE: DONTEVAL@LOAD DOCOPY (VARS (DARKBITSHADE 23130)
						   (NORMALGRIDSQUARE 16)
						   (NOTINUSEGRAY 42405)
						   (EDITBMMENU)
						   (EDITBMWINDOWMENU)
						   (GRIDSIZEMENU)))
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE 
							    NOTINUSEGRAY EDITBMMENU))
	      (CONSTANTS (GRIDTHICKNESS 2)
			 (MINGRIDSQUARE 8)
			 (MAXGRIDWIDTH 199)
			 (MAXGRIDHEIGHT 175)
			 (BMWINDOWSHADE 33410)))
	(FNS EXPANDBITMAP)
	(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)                                          (* rrb "20-JUN-82 16:56")

                                                             (* Do scrolling for the bitmap editor.)

    (PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0)
		    (DYGRID 0)
		    GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT GRIDINTERIOR EBMXLIMIT EBMYLIMIT 
		    EBMXOFFSET EBMYOFFSET BM 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 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))
                                                             (* Make a horizontal adjustment)

		      (COND
			((FLOATP DX)
			  (printout
 PROMPTWINDOW "Thumbing isn't implemented yet." T))
			((ILESSP DX 0)                       (* moving to the left.)

                                                             (* determine how many grid points to move.)

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

			      (RETURN)))
			  (WINDOWPROP W (QUOTE XOFFSET)
				      (SETQ EBMXOFFSET (IPLUS EBMXOFFSET DXGRID)))
                                                             (* move image to the left.)

			  (BITBLT W (IPLUS GILEFT (ITIMES 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 (ITIMES (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)))
                                                             (* move image to the right.)

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

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

		      (COND
			((FLOATP DY)
			  (printout
 PROMPTWINDOW "Thumbing isn't implemented yet." T))
			((ILESSP DY 0)                       (* determine how many squares to move down.)

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

			      (RETURN)))
			  (WINDOWPROP W (QUOTE YOFFSET)
				      (SETQ EBMYOFFSET (IPLUS EBMYOFFSET DYGRID)))
			  (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 (IDIFFERENCE
									    WHEIGHT DY))
								    GRIDSPEC)))
			  (COND
			    ((NOT (IGREATERP DYGRID 0))      (* bottom edge is at the bottom margin)

			      (RETURN)))
			  (WINDOWPROP W (QUOTE YOFFSET)
				      (SETQ EBMYOFFSET (IDIFFERENCE EBMYOFFSET DYGRID)))
			  (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)))
		      (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

(CLEAR

  [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])

(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])
)
(* FOLLOWING DEFINITIONS EXPORTED)





(* Mouse selection code)


(DEFINEQ

(MOUSESTATE-EXPR

  [LAMBDA (EXPR MOUSEONLYFLG)                                (* rrb "13-JUN-82 11:53")


          (* 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))
		    ([for
 I in
 EXPR always
 (AND (ATOM I)
						(NEQ I (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)
						     (for
 X in
 (CDR EXPR) collect
 (MOUSESTATE-NAME

										    X]
			       [AND (LIST (QUOTE EQ
)
					  (CONS (QUOTE LOGOR)
						(for
 X in
 (CDR EXPR) collect
 (MOUSESTATE-NAME
 X)))
					  (LIST (QUOTE LOGAND)
						(QUOTE LASTMOUSEBUTTONS)
						(CONS (QUOTE LOGOR)
						      (for
 X in
 (CDR EXPR) collect
 (MOUSESTATE-NAME

										     X]
			       [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)
			     (for
 OPT in
 (CDR EXPR) collect
 (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))
(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

(GETPOSITION

  [LAMBDA (WINDOW CURSOR)                                    (* rmk: "18-JUL-83 13:13")

                                                             (* 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))
		 ((OR (type?
 WINDOW WINDOW)
		      (\DISPLAYSTREAMP WINDOW))
		   (create
 POSITION
			   XCOORD _(LASTMOUSEX WINDOW)
			   YCOORD _(LASTMOUSEY WINDOW)))
		 [(EQ WINDOW T)
		   (create
 POSITION
			   XCOORD _(LASTMOUSEX (TTYDISPLAYSTREAM))
			   YCOORD _(LASTMOUSEY (TTYDISPLAYSTREAM]
		 (T (\ILLEGAL.ARG WINDOW])

(GETBOXPOSITION

  [LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG)          (* rrb "14-MAY-82 11:59")


          (* 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.)



    (RESETFORM (CURSOR BOXCURSOR)
	       (AND PROMPTMSG (PROMPTPRINT PROMPTMSG))
	       [COND
		 ((AND (FIXP ORGX)
		       (FIXP ORGY))                          (* origin given, snap cursor to nearest corner.)

		   (GETMOUSESTATE)
		   (\SETCURSORPOSITION (COND
					 ((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT WIDTH 2)))
					   (IPLUS ORGX WIDTH))
					 (T ORGX))
				       (COND
					 ((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT HEIGHT 2)))
					   (IPLUS ORGY HEIGHT))
					 (T ORGY]
	       (until
 (MOUSESTATE (NOT UP)))
	       [COND
		 ((AND (FIXP ORGX)
		       (FIXP ORGY))                          (* origin given, snap cursor to nearest corner.)

		   (GETMOUSESTATE)
		   [COND
		     ((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT WIDTH 2)))
		       (SETQ ORGX (IPLUS ORGX WIDTH))
		       (SETQ WIDTH (IMINUS WIDTH]
		   (COND
		     ((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT HEIGHT 2)))
		       (SETQ ORGY (IPLUS ORGY HEIGHT))
		       (SETQ HEIGHT (IMINUS HEIGHT]
	       (CURSOR CROSSHAIRS)
	       (SETQ ORGX LASTMOUSEX)
	       (SETQ ORGY LASTMOUSEY)
	       (COND
		 [[ERSETQ (first
 (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX WIDTH)
					      (IPLUS ORGY HEIGHT))
			     until
 (MOUSESTATE UP) unless
 (AND (IEQP ORGX LASTMOUSEX)
							       (IEQP ORGY LASTMOUSEY))
			     do
 (COND
				  ((LASTMOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
				    (until
 (MOUSESTATE (NOT RIGHT)))
                                                             (* switch to drag nearest corner)

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

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

					(SETQ ORGY (IPLUS ORGY HEIGHT))
					(SETQ HEIGHT (IMINUS HEIGHT]
				    (\SETCURSORPOSITION ORGX ORGY))
				  (T (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX WIDTH)
						  (IPLUS ORGY HEIGHT))
                                                             (* Erase old box, make new one)

				     (DRAWGRAYBOX
 (SETQ ORGX LASTMOUSEX)
						  (SETQ ORGY LASTMOUSEY)
						  (IPLUS ORGX WIDTH)
						  (IPLUS ORGY HEIGHT]
		   (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX WIDTH)
				(IPLUS ORGY HEIGHT))
		   (AND PROMPTMSG (CLRPROMPT))
		   (COND
		     (WINDOW (create
 POSITION
				     XCOORD _(DSPXSCREENTOWINDOW
 (IMIN ORGX (IPLUS ORGX WIDTH))
								 WINDOW)
				     YCOORD _(DSPYSCREENTOWINDOW
 (IMIN ORGY (IPLUS ORGY HEIGHT))
								 WINDOW)))
		     (T (create
 POSITION
				XCOORD _(IMIN ORGX (IPLUS ORGX WIDTH))
				YCOORD _(IMIN ORGY (IPLUS ORGY HEIGHT]
		 (T                                          (* ^E take down box)

		    (DRAWGRAYBOX
 ORGX ORGY (IPLUS ORGX WIDTH)
				 (IPLUS ORGY HEIGHT))
		    (ERROR!])

(DSPYSCREENTOWINDOW

  [LAMBDA (Y DS)                                             (* rrb "14-MAY-82 11:34")

                                                             (* transforms an y coordinate from screen coordinates 

							     into window coordinates)

    (IDIFFERENCE Y (fetch
 \SFYOFFSET of
 (\SFInsureDisplayStream DS])

(DSPXSCREENTOWINDOW

  [LAMBDA (X DS)                                             (* rrb "14-MAY-82 11:35")

                                                             (* transforms an x coordinate from screen coordinates 

							     into window coordinates)

    (IDIFFERENCE X (fetch
 \SFXOFFSET of
 (\SFInsureDisplayStream DS])

(GETREGION

  [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG)
                                                             (* rrb "29-APR-83 09:09")

                                                             (* accepts region from the user.)

    (RESETFORM (CURSOR EXPANDINGBOX)
	       (PROG [BASEX BASEY OPPX OPPY BASEPT OPPT NEWMOUSEX NEWMOUSEY
			    (NEWREGFNS (COND
					 ((LISTP NEWREGIONFN)
					   NEWREGIONFN)
					 (NEWREGIONFN (LIST NEWREGIONFN))
					 (T NIL]
		     (COND
		       ((AND INITREGION (PROGN               (* A region to use if user bugs yellow)

					       (until
 (MOUSESTATE (NOT UP)))
					       (LASTMOUSESTATE MIDDLE)))
                                                             (* Pull from closest corner, ie.

							     set BASEX,Y to be opposite corner)

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

							     right)

			     (swap
 BASEX OPPX)))
			 (SETQ BASEY (fetch
 (REGION BOTTOM) of
 INITREGION))
			 (SETQ OPPY (IPLUS BASEY (fetch
 (REGION HEIGHT) of
 INITREGION)))
			 (COND
			   ((ILESSP LASTMOUSEY (IPLUS BASEY (IQUOTIENT (fetch
 (REGION HEIGHT)
									  of
 INITREGION)
								       2)))
			     (swap
 BASEY OPPY)))             (* Now draw the initial box)

			 )
		       (T (until
 (MOUSESTATE (NOT UP)))
			  (SETQ BASEX LASTMOUSEX)
			  (SETQ BASEY LASTMOUSEY)
			  (SETQ OPPX BASEX)
			  (SETQ OPPY BASEY)))                (* if the new region fns is a list, apply them in 

							     order.)

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

			   (SETQ BASEPT (APPLY* FN (create
 POSITION
							   XCOORD _ BASEX
							   YCOORD _ BASEY)
						NIL NEWREGIONFNARG))
			   (SETQ BASEX (fetch
 XCOORD of
 BASEPT))
			   (SETQ BASEY (fetch
 YCOORD of
 BASEPT))
			   (SETQ OPPT (APPLY* FN BASEPT (create
 POSITION
								XCOORD _ OPPX
								YCOORD _ OPPY)
					      NEWREGIONFNARG))
			   (SETQ OPPX (fetch
 XCOORD of
 OPPT))
			   (SETQ OPPY (fetch
 YCOORD of
 OPPT)))
		     (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)
		     (COND
		       [[ERSETQ (until
 (MOUSESTATE UP) unless
 (AND (IEQP OPPX LASTMOUSEX)
								   (IEQP OPPY LASTMOUSEY))
				   do
 (COND
					((MOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
					  (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]
					  (\SETCURSORPOSITION OPPX OPPY)
					  (COND
					    (NEWREGFNS       (* takedown box because user functions may change any of

							     its coordinates.)

						       (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)
						       (for
 FN in
 NEWREGFNS
							  do
 
                                                             (* call user fn on new base pt)

							     (SETQ BASEPT
							       (APPLY* FN
								       (create
 POSITION
									       XCOORD _ BASEX
									       YCOORD _ BASEY)
								       NIL NEWREGIONFNARG))
							     (SETQ BASEX (fetch
 XCOORD of
 BASEPT))
							     (SETQ BASEY (fetch
 YCOORD of
 BASEPT))
							     (SETQ OPPT
							       (APPLY* FN BASEPT
								       (create
 POSITION
									       XCOORD _ OPPX
									       YCOORD _ OPPY)
								       NEWREGIONFNARG))
							     (SETQ OPPX (fetch
 XCOORD of
 OPPT))
							     (SETQ OPPY (fetch
 YCOORD of
 OPPT)))
                                                             (* draw box back)

						       (DRAWGRAYBOX
 BASEX BASEY OPPX OPPY)))
					  (SETCORNER
 BASEX BASEY OPPX OPPY))
					(T (COND
					     [NEWREGIONFN (SETQ OPPT
							    (create
 POSITION
								    XCOORD _ LASTMOUSEX
								    YCOORD _ LASTMOUSEY smashing

											 OPPT))
							  (for
 FN in
 NEWREGFNS
							     do
 (SETQ OPPT
								  (APPLY* FN BASEPT OPPT 
									  NEWREGIONFNARG))
								(COND
								  ((NOT (POSITIONP OPPT))
								    (ERROR 
							   "non-POSITION returned by NEWREGIONFN"
									   OPPT))
								  (T (SETQ NEWMOUSEX
								       (fetch
 XCOORD of
 OPPT))
								     (SETQ NEWMOUSEY
								       (fetch
 YCOORD of
 OPPT]
					     (T (SETQ NEWMOUSEX LASTMOUSEX)
						(SETQ NEWMOUSEY LASTMOUSEY)))
					   (COND
					     ((OR (NEQ NEWMOUSEX OPPX)
						  (NEQ NEWMOUSEY OPPY))
                                                             (* refresh if position changes.)

					       (MOVEBOX
 BASEX BASEY OPPX OPPY NEWMOUSEX NEWMOUSEY)
					       (SETQ OPPX NEWMOUSEX)
                                                             (* save for next pass)

					       (SETQ OPPY NEWMOUSEY)
					       (SETCORNER
 BASEX BASEY OPPX OPPY]
                                                             (* erase box image.)

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

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

(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])

(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)                                    (* jds "28-APR-82 09:25")

                                                             (* Put a gray box in window W 

							     (or on screen, if W_NIL))

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

(BLTHLINE

  [LAMBDA (Y XA XB W)                                        (* bvm: "31-MAY-82 14:00")

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

(BLTVLINE

  [LAMBDA (X YA YB W)                                        (* bvm: "31-MAY-82 14:06")

    (BITBLT NIL NIL NIL (OR W (SCREENBITMAP))
	    X
	    (IMIN YA YB)
	    2
	    (IABS (IDIFFERENCE YB YA))
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    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

(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)

(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 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)
          (if
 PR
	      then
 (SETQ PL (fetch
 LEFT of
 PR))
		   (SETQ PB (fetch
 BOTTOM of
 PR))
		   (SETQ PH (fetch
 HEIGHT of
 PR))
		   (SETQ PW (fetch
 WIDTH of
 PR))
	    else
 (SETQ PL (SETQ PB 0))
		 (SETQ PW (fetch
 BITMAPWIDTH of
 P))
		 (SETQ PH (fetch
 BITMAPHEIGHT of
 P)))
          (if
 QR
	      then
 (SETQ QL (fetch
 LEFT of
 QR))
		   (SETQ QB (fetch
 BOTTOM of
 QR))
		   (SETQ QW (fetch
 WIDTH of
 QR))
		   (SETQ QH (fetch
 HEIGHT of
 QR))
	    else
 (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)                                           (* rrb "11-AUG-83 12:34")

                                                             (* 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)
					   (IQUOTIENT (IDIFFERENCE SCREENWIDTH BMWWIDTH)
						      2)
					   (IQUOTIENT (IDIFFERENCE SCREENHEIGHT BMWHEIGHT)
						      2)
					   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)
          (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)                                                (* rrb "31-MAR-83 17:34")

                                                             (* 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)))
		  (DISPLAYREGION (WINDOWPROP W (QUOTE DISPLAYREGION]
          (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 be editting.")))
							       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)
					       (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)
				     (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]
			           (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
					    W)
			           (UPDATE/BM/DISPLAY BM W)
			           (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.")
									    (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 (CLEAR
 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 (CLEAR
 BM)
						  T)
					   (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION
 W)
						  NIL))
				   (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
					    W)
				   (GRID
 GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
					 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)
                                                             (* rrb " 2-AUG-82 10:59")

                                                             (* initializes the display for the bitmap editor.)

    (DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
	     WINDOW)
    (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)        (* rrb "17-JUN-82 12:45")


          (* 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 (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))
          (EDITBMREPAINTFN
 BMEDITWINDOW NIL ZEROBMFLG])

(EDITBMREPAINTFN

  [LAMBDA (WIN REGION ZEROBM)                                (* edited: "17-SEP-82 09:34")

                                                             (* 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.)

          (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)             (* rrb "17-JUN-82 11:48")

                                                             (* 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
			      (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-JUN-83 10:05")

                                                             (* allows the editing of a shade.)

    (OR (FIXP SHADE)
	(SETQ SHADE WHITESHADE))
    [PROG ((GRIDSPEC (CREATEREGION 90 15 30 30))
	   (GRIDINTERIOR (CREATEREGION 90 15 120 120))
	   (QUITREGION (CREATEREGION 125 150 50 20))
	   (SHADEREGION (CREATEREGION 10 185 272 100))
	   X Y SEDW DS)
          (SETQ DS (WINDOWPROP (SETQ SEDW (CREATEW (GETBOXREGION
 300 300 NIL NIL NIL 
							"Indicate position of Shade edit window.")))
			       (QUOTE DSP)))
          (WINDOWPROP SEDW (QUOTE CLOSEFN)
		      (QUOTE DON'T
))
          (WINDOWPROP SEDW (QUOTE REPAINTFN)
		      (QUOTE EDITSHADEREPAINTFN))
          (WINDOWPROP SEDW (QUOTE QUITREGION)
		      QUITREGION)
          (WINDOWPROP SEDW (QUOTE GRIDSPEC)
		      GRIDSPEC)
          (WINDOWPROP SEDW (QUOTE GRIDINTERIOR)
		      GRIDINTERIOR)
          (WINDOWPROP SEDW (QUOTE SHADE)
		      SHADE)
          (WINDOWPROP SEDW (QUOTE SHADEREGION)
		      SHADEREGION)
          (EDITSHADEREPAINTFN
 SEDW)
          (do
 (DSPFILL SHADEREGION SHADE (QUOTE TEXTURE)
		       DS)
	      (until
 (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do
 (BLOCK))
	      (COND
		((LASTMOUSESTATE RIGHT)
		  (DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY)))
		((EQ (QUOTE STOP)
		     (until
 (MOUSESTATE UP) bind
 (XPIXEL YPIXEL)
			do
 [COND
			     [(INSIDE?
 GRIDINTERIOR (SETQ X (LASTMOUSEX DS))
				       (SETQ Y (LASTMOUSEY DS)))
			       (COND
				 ((AND (STRICTLY/BETWEEN (SETQ XPIXEL (GRIDXCOORD
 X GRIDSPEC))
							 -1 4)
				       (STRICTLY/BETWEEN (SETQ YPIXEL (GRIDYCOORD
 Y GRIDSPEC))
							 -1 4))
				   (SHADEGRIDBOX
 XPIXEL YPIXEL (COND
						   ((LASTMOUSESTATE LEFT)
						     DARKBITSHADE)
						   (T WHITESHADE))
						 (QUOTE REPLACE)
						 GRIDSPEC
						 (QUOTE POINT)
						 DS)
				   [SETQ SHADE
				     (COND
				       [(LASTMOUSESTATE LEFT)
					 (LOGOR SHADE (BITMASK (IPLUS (ITIMES 4 (IDIFFERENCE 3 YPIXEL)
									      )
								      XPIXEL]
				       (T (LOGAND SHADE (LOGXOR 65535
								(BITMASK (IPLUS (ITIMES 4
											(IDIFFERENCE
											  3 YPIXEL))
										XPIXEL]
				   (WINDOWPROP SEDW (QUOTE SHADE)
					       SHADE]
			     ((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.)

						  (WINDOWPROP SEDW (QUOTE CLOSEFN)
							      NIL)
						  (CLOSEW SEDW)
						  (RETURN (QUOTE STOP]
			   (BLOCK)))
		  (RETURN]
    SHADE])

(EDITSHADEREPAINTFN

  [LAMBDA (WIN)                                              (* rrb "17-JUN-83 10:06")

    (PROG [(GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
	   (SHADE (WINDOWPROP WIN (QUOTE 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)
			       4)
		       (ITIMES (fetch
 HEIGHT of
 GRIDSPEC)
			       4)
		       2 BLACKSHADE WIN)
          (GRID
 GRIDSPEC 4 4 (QUOTE POINT)
		WIN)
          (for
 I from
 0 to
 15 unless
 (ZEROP (LOGAND SHADE (BITMASK I)))
	     do
 (SHADEGRIDBOX
 (IREMAINDER I 4)
			      (IDIFFERENCE 3 (IQUOTIENT I 4))
			      DARKBITSHADE
			      (QUOTE REPLACE)
			      GRIDSPEC
			      (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)     (* rrb "16-JUN-82 16:14")

                                                             (* 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
			(QUOTE POINT)
			W])

(READHOTSPOT

  [LAMBDA (BM GRIDSPEC GRIDINTERIOR DS)                      (* rrb "16-JUN-82 11:26")

    (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
			(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
					(QUOTE POINT)
					DS)))
		(SHADEGRIDBOX
 (SETQ XPIXEL (GRIDXCOORD
 (LASTMOUSEX DS)
						       GRIDSPEC))
			      (SETQ YPIXEL (GRIDYCOORD
 (LASTMOUSEY DS)
						       GRIDSPEC))
			      NOTINUSEGRAY
			      (QUOTE REPLACE)
			      GRIDSPEC
			      (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])
)
(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)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE NOTINUSEGRAY EDITBMMENU)
)
)
(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])
)
(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))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2292 14671 (GRID 2302 . 4963) (GRIDXCOORD 4965 . 5478) (GRIDYCOORD 5480 . 5997) (
LEFTOFGRIDCOORD 5999 . 6346) (BOTTOMOFGRIDCOORD 6348 . 6585) (EDITBMSCROLLFN 6587 . 13803) (
SHADEGRIDBOX 13805 . 14669)) (14723 15288 (CLEAR 14733 . 14951) (INSIDE? 14953 . 15286)) (15359 18735 
(MOUSESTATE-EXPR 15369 . 18099) (MOUSESTATE-NAME 18101 . 18733)) (20800 21724 (DECODEBUTTONS 20810 . 
21722)) (21725 35556 (GETPOSITION 21735 . 22583) (GETBOXPOSITION 22585 . 26182) (DSPYSCREENTOWINDOW 
26184 . 26536) (DSPXSCREENTOWINDOW 26538 . 26890) (GETREGION 26892 . 32969) (GETBOXREGION 32971 . 
33494) (MOVEBOX 33496 . 33914) (DRAWGRAYBOX 33916 . 34282) (BLTHLINE 34284 . 34557) (BLTVLINE 34559 . 
34832) (SETCORNER 34834 . 35554)) (35557 36760 (NEAREST/PT/ON/GRID 35567 . 36038) (PTON10GRID 36040 . 
36359) (NEAREST/MULTIPLE 36361 . 36758)) (38516 41612 (\SW2BM 38526 . 40426) (COMPOSEREGS 40428 . 
40987) (TRANSLATEREG 40989 . 41610)) (41650 78494 (EDITBM 41660 . 48999) (EDITBMCLOSEFN 49001 . 49336)
 (TILEAREA 49338 . 49933) (EDITBMBUTTONFN 49935 . 59385) (\EDITBM/PUTUP/DISPLAY 59387 . 59911) (
\EDITBMHOWMUCH 59913 . 60746) (EDITBMRESHAPEFN 60748 . 65122) (EDITBMREPAINTFN 65124 . 66556) (
UPDATE/SHADE/DISPLAY 66558 . 66980) (UPDATE/BM/DISPLAY/SELECTED/REGION 66982 . 67986) (SHOWBUTTON 
67988 . 68466) (RESETGRID 68468 . 69255) (\READBMDIMENSIONS 69257 . 70195) (EDITSHADE 70197 . 73210) (
EDITSHADEREPAINTFN 73212 . 74281) (GRAYBOXAREA 74283 . 74969) (\SHADEBITS 74971 . 76034) (READHOTSPOT 
76036 . 77743) (WBOX 77745 . 78492)) (79626 81545 (EXPANDBITMAP 79636 . 81543)))))
STOP