(FILECREATED "13-Aug-85 14:39:25" {ERIS}<LISPCORE>SOURCES>HLDISPLAY.;14
 107746 

      changes to:  (FNS GETREGION)

      previous date: " 1-Aug-85 09:39:31" {ERIS}<LISPCORE>SOURCES>HLDISPLAY.;13)


(* 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 "26-Feb-85 19:42")

                                                             (* 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
 EMBXOFFSET (
FIX
 (
TIMES
 (
IDIFFERENCE
 BITMAPWIDTH BITSWIDE)
								   DX]
			  (replace
 (REGION LEFT) of
 EXTENT with
 (
IMINUS
 (
QUOTIENT
 (
TIMES
 EMBXOFFSET 
										      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
 EMBYOFFSET (
FIX
 (
TIMES
 (
IDIFFERENCE
 BITMAPHEIGHT BITSHIGH)
								   (
FDIFFERENCE
 1.0 DY]
                                                             (* set EXTENT bar)

			  (replace
 (REGION BOTTOM) of
 EXTENT with
 (
IMINUS
 (
QUOTIENT
 (
TIMES
 EMBYOFFSET 
										     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)    (* rrb "12-Dec-83 15:10")


          (* 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)
	       (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)
                                                             (* jow "13-Aug-85 14:37")


          (* 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]             (* set up the initial box to prompt with.)

		     [if
 INITCORNERS
			 then
                                (* setup box by initcorners.)

			      (if
 (
AND
 (
EQ
 4 (
LENGTH
 INITCORNERS))
				       (for
 X in
 INITCORNERS always
 (
FIXP
 X)))
				  then
 (
SETQ
 BASEX (
CAR
 INITCORNERS))
				       (
SETQ
 BASEY (
CADR
 INITCORNERS))
				       (
SETQ
 OPPX (
CADDR
 INITCORNERS))
				       (
SETQ
 OPPY (
CADDDR
 INITCORNERS))
				else
 (
\ILLEGAL.ARG
 INITCORNERS))
		       else
                                  (* 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                                                (* rrb "17-Jul-84 16:30")

    (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 (CONSTANT (SUB1 SCREENWIDTH)))
					      (SETQ POSTEMP (CONSTANT (SUB1 SCREENWIDTH]
					    ((ILESSP POSTEMP 0)
					      (SETQ POSTEMP 0)))
					  (replace
 (POSITION XCOORD) of
 BASEPT
					     with
 (COND
						    ((IGREATERP POSTEMP (CONSTANT (SUB1 SCREENWIDTH)))
						      (CONSTANT (SUB1 SCREENWIDTH)))
						    ((ILESSP POSTEMP 0)
						      0)
						    (T POSTEMP)))
					  (SETQ POSTEMP (IPLUS (SETQ OLDMOUSEY LASTMOUSEY)
							       HEIGHT))
					  (replace
 (POSITION YCOORD) of
 BASEPT
					     with
 (COND
						    [(IGREATERP POSTEMP (CONSTANT (SUB1 SCREENHEIGHT))
								)
						      (SETQ POSTEMP (CONSTANT (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)                                                (* hdj " 5-Jul-85 11:59")

                                                             (* 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)))
		  (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)))
			           (
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 (2758 18579 (GRID 2768 . 5672) (GRIDXCOORD 5674 . 6187) (GRIDYCOORD 6189 . 6706) (
LEFTOFGRIDCOORD 6708 . 7055) (BOTTOMOFGRIDCOORD 7057 . 7294) (EDITBMSCROLLFN 7296 . 17711) (
SHADEGRIDBOX 17713 . 18577)) (18631 18976 (INSIDE? 18641 . 18974)) (19010 22299 (MOUSESTATE-EXPR 19020
 . 21663) (MOUSESTATE-NAME 21665 . 22297)) (24391 25315 (DECODEBUTTONS 24401 . 25313)) (25316 26204 (
PTDIFFERENCE 25326 . 25771) (PTPLUS 25773 . 26202)) (26251 50873 (GETPOSITION 26261 . 26968) (
GETBOXPOSITION 26970 . 28912) (DSPYSCREENTOWINDOW 28914 . 29259) (DSPXSCREENTOWINDOW 29261 . 29606) (
GETREGION 29608 . 36648) (\GETREGION.PACKPTS 36650 . 37165) (\GETREGION.CHECKBASEPT 37167 . 38284) (
\GETREGION.CHECKOPPT 38286 . 40125) (\GETREGIONTRACKWITHBOX 40127 . 44332) (\UPDATEXYANDBOX 44334 . 
45494) (GETBOXREGION 45496 . 46019) (\TRACKWITHBOX 46021 . 48769) (MOVEBOX 48771 . 49189) (DRAWGRAYBOX
 49191 . 49581) (BLTHLINE 49583 . 49865) (BLTVLINE 49867 . 50149) (SETCORNER 50151 . 50871)) (50874 
52313 (MOUSECONFIRM 50884 . 52311)) (52491 53694 (NEAREST/PT/ON/GRID 52501 . 52972) (PTON10GRID 52974
 . 53293) (NEAREST/MULTIPLE 53295 . 53692)) (55763 59049 (\SW2BM 55773 . 57863) (COMPOSEREGS 57865 . 
58424) (TRANSLATEREG 58426 . 59047)) (59087 102617 (EDITBM 59097 . 66973) (EDITBMCLOSEFN 66975 . 67310
) (TILEAREA 67312 . 67907) (EDITBMBUTTONFN 67909 . 79556) (\EDITBM/PUTUP/DISPLAY 79558 . 80161) (
\EDITBMHOWMUCH 80163 . 80996) (EDITBMRESHAPEFN 80998 . 86452) (EDITBMREPAINTFN 86454 . 88030) (
UPDATE/SHADE/DISPLAY 88032 . 88454) (UPDATE/BM/DISPLAY/SELECTED/REGION 88456 . 89460) (SHOWBUTTON 
89462 . 89940) (RESETGRID 89942 . 90792) (\READBMDIMENSIONS 90794 . 91732) (EDITSHADE 91734 . 95853) (
\BITMAPFROMTEXTURE 95855 . 96421) (EDITSHADEREPAINTFN 96423 . 97600) (GRAYBOXAREA 97602 . 98288) (
\SHADEBITS 98290 . 99537) (READHOTSPOT 99539 . 101643) (WBOX 101645 . 102392) (\CLEARBM 102394 . 
102615)) (103754 107518 (EXPANDBITMAP 103764 . 105671) (SHRINKBITMAP 105673 . 106714) (\FAST4BIT 
106716 . 107516)))))
STOP