(FILECREATED " 3-Mar-86 09:21:09" {ERIS}<LISPCORE>SOURCES>HLDISPLAY.;30 155043
changes to: (FNS SHRINKBITMAP)
previous date: "27-Feb-86 15:12:05" {ERIS}<LISPCORE>SOURCES>HLDISPLAY.;29)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 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 GETSCREENPOSITION GETBOXSCREENPOSITION
GETSCREENREGION GETBOXSCREENREGION)
(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 EDITBMTEXTURE)
(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) (* kbr: "26-Jan-86 12:04")
(* 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 MAXIMUMCOLOR)
(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)
(SETQ MAXIMUMCOLOR (MAXIMUMCOLOR (BITSPERPIXEL (DSPDESTINATION NIL DS))))
(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 MAXIMUMCOLOR))))
(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) (* kbr: "26-Jan-86 12:16")
(* Do scrolling for the bitmap editor.)
(PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0)
(DYGRID 0)
EXTENT EXTENTWIDTH EXTENTHEIGHT GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT
GRIDINTERIOR EBMXLIMIT EBMYLIMIT EBMXOFFSET EBMYOFFSET BM BITMAPWIDTH
BITMAPHEIGHT BITSWIDE BITSHIGH DXOFFSET DYOFFSET)
(SETQ GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
(SETQ REG (WINDOWPROP W (QUOTE REGION)))
(SETQ WHEIGHT (WINDOWPROP W (QUOTE HEIGHT)))
(SETQ WWIDTH (WINDOWPROP W (QUOTE WIDTH)))
(SETQ GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
(SETQ EBMXOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
(SETQ EBMYOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
(SETQ BM (WINDOWPROP W (QUOTE BM)))
(SETQ BITMAPWIDTH (fetch BITMAPWIDTH of BM))
(SETQ BITMAPHEIGHT (fetch BITMAPHEIGHT of BM))
(SETQ BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
(SETQ BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
(SETQ DXOFFSET (WINDOWPROP W (QUOTE DXOFFSET)))
(SETQ DYOFFSET (WINDOWPROP W (QUOTE DYOFFSET)))
(SETQ EBMXLIMIT (IPLUS EBMXOFFSET BITSWIDE))
(SETQ EBMYLIMIT (IPLUS EBMYOFFSET BITSHIGH))
(COND
(GRIDSPEC (SETQ GILEFT (fetch (REGION LEFT) of GRIDINTERIOR))
(SETQ GIBOTTOM (fetch (REGION BOTTOM) of GRIDINTERIOR))
(SETQ GIHEIGHT (fetch (REGION HEIGHT) of GRIDINTERIOR))
(SETQ GWIDTH (fetch (REGION WIDTH) of GRIDSPEC))
(SETQ GHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC))
(SETQ EXTENT (WINDOWPROP W (QUOTE EXTENT)))
(SETQ EXTENTWIDTH (fetch (REGION WIDTH) of EXTENT))
(SETQ EXTENTHEIGHT (fetch (REGION HEIGHT) of EXTENT))
(* Make a horizontal adjustment)
(COND
((FLOATP DX) (* Horizontal thumbing)
(WINDOWPROP W (QUOTE XOFFSET)
(SETQ EBMXOFFSET (FIX (TIMES (IDIFFERENCE
BITMAPWIDTH
BITSWIDE)
DX))))
(replace (REGION LEFT) of EXTENT
with (IMINUS (QUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH)
BITMAPWIDTH)))
(BITBLT NIL 0 0 W GILEFT GIBOTTOM \CURSORDESTWIDTH \CURSORDESTHEIGHT
(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 \CURSORDESTWIDTH \CURSORDESTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR) (* clear the newly exposed area.)
(BITBLT NIL 0 0 W (IPLUS GILEFT (TIMES (IDIFFERENCE BITSWIDE
DXGRID)
GWIDTH))
GIBOTTOM \CURSORDESTWIDTH \CURSORDESTHEIGHT (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 \CURSORDESTWIDTH \CURSORDESTHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR) (* clear the newly exposed area.)
(BITBLT NIL 0 0 W GILEFT GIBOTTOM (TIMES DXGRID GWIDTH)
GIHEIGHT
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(RESETGRID BM GRIDSPEC DXGRID BITSHIGH 0 0 W)))
(* Make a vertical adjustment)
(COND
((FLOATP DY) (* Vertical Thumbing)
(WINDOWPROP W (QUOTE YOFFSET)
(SETQ EBMYOFFSET (FIX (TIMES (IDIFFERENCE
BITMAPHEIGHT
BITSHIGH)
(FDIFFERENCE 1.0 DY))))
) (* set EXTENT bar)
(replace (REGION BOTTOM) of EXTENT
with (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT)
BITMAPHEIGHT)))
(* Clear Window)
(BITBLT NIL 0 0 W GILEFT GIBOTTOM \CURSORDESTWIDTH \CURSORDESTHEIGHT
(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 \CURSORDESTWIDTH \CURSORDESTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR)
(BITBLT NIL 0 0 W GILEFT (IPLUS GIBOTTOM (ITIMES (IDIFFERENCE
BITSHIGH DYGRID)
GHEIGHT))
\CURSORDESTWIDTH \CURSORDESTHEIGHT (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))
\CURSORDESTWIDTH \CURSORDESTHEIGHT (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) (* kbr: "26-Jan-86 12:17")
(* 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)
(MAXIMUMCOLOR (BITSPERPIXEL (DSPDESTINATION NIL DS)))))))))
)
(* 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) (* kbr: " 6-Jul-85 17:37")
(* Get position with cursor.
*)
(fetch (SCREENPOSITION POSITION) of (GETSCREENPOSITION WINDOW CURSOR))))
(GETBOXPOSITION
(LAMBDA (BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) (* kbr: " 6-Jul-85 18:15")
(* 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.)
(fetch (SCREENPOSITION POSITION) of (GETBOXSCREENPOSITION BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW
PROMPTMSG))))
(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 INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS)
(* kbr:
" 5-Feb-86 16:50")
(* accepts region from
the user.)
(fetch (SCREENREGION REGION) of (GETSCREENREGION MINWIDTH MINHEIGHT INITREGION NEWREGIONFN
NEWREGIONFNARG INITCORNERS))))
(\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 (* kbr:
" 3-Feb-86 12:43")
(DECLARE (GLOBALVARS \CURSORDESTINATION 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 HEIGHT
DESTINATION MAXX MAXY)
(SETQ WIDTH (IDIFFERENCE BASEX OPPX))
(SETQ HEIGHT (IDIFFERENCE BASEY OPPY))
(SETQ DESTINATION \CURSORDESTINATION)
(SETQ MAXX (SUB1 (BITMAPWIDTH DESTINATION)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT DESTINATION)))
(DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION 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))))
(\CURSORPOSITION OPPX OPPY))
((OR (NOT (EQ LASTMOUSEX OLDMOUSEX))
(NOT (EQ LASTMOUSEY OLDMOUSEY)))
(* the cursor has moved,
check user constraints.)
(SETQ OLDMOUSEX LASTMOUSEX)
(SETQ OLDMOUSEY LASTMOUSEY) (* make sure the base
corner {which is
opposite the one tracked
with the mouse} is on
the screen.)
(replace (POSITION XCOORD) of BASEPT
with (IMAX 0 (IMIN MAXX (IPLUS OLDMOUSEX WIDTH))))
(replace (POSITION YCOORD) of BASEPT
with (IMAX 0 (IMIN MAXY (IPLUS OLDMOUSEY HEIGHT))))
(\GETREGION.CHECKBASEPT NEWREGFNS BASEPT)
(SETQ XTEMP (fetch (POSITION XCOORD) of BASEPT))
(SETQ YTEMP (fetch (POSITION YCOORD) of BASEPT))
(COND
((NOT (AND (IEQP BASEX XTEMP)
(IEQP BASEY YTEMP)
(EQ \CURSORDESTINATION DESTINATION)))
(* move the box)
(SETQ XTEMP (IDIFFERENCE XTEMP BASEX))
(SETQ YTEMP (IDIFFERENCE YTEMP BASEY))
(DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION
DASHEDSHADE)
(SETQ DESTINATION \CURSORDESTINATION)
(SETQ MAXX (SUB1 (BITMAPWIDTH DESTINATION)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT DESTINATION)))
(SETQ OPPX (IPLUS OPPX XTEMP))
(SETQ OPPY (IPLUS OPPY YTEMP))
(SETQ BASEX (IPLUS BASEX XTEMP))
(SETQ BASEY (IPLUS BASEY YTEMP))
(COND
(BACKGROUNDCURSOREXITFN (APPLY*
BACKGROUNDCURSOREXITFN
)))
(DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION
DASHEDSHADE))))))))
(DRAWGRAYBOX OPPX OPPY BASEX BASEY DESTINATION DASHEDSHADE)
(COND
((NULL NOERROR) (* pass back ↑E)
(ERROR!))))))
(\UPDATEXYANDBOX
(LAMBDA (BASEPTCHANGE? DESTINATION SHADE) (* kbr:
" 3-Feb-86 12:44")
(* 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
((EQ DESTINATION \CURSORDESTINATION) (* Cursor destination
hasn't changed.
Add to old image.
*)
(COND
(BASEPTCHANGE? (* the base point might
have changed, check it
too.)
(SETQ TEMPX (fetch (POSITION XCOORD) of BASEPT))
(SETQ TEMPY (fetch (POSITION YCOORD) of BASEPT))
(COND
((NOT (AND (IEQP BASEX TEMPX)
(IEQP BASEY TEMPY))) (* move the box)
(MOVEBOX OPPX OPPY BASEX BASEY (SETQ BASEX TEMPX)
(SETQ BASEY TEMPY)
DESTINATION SHADE)))))
(SETQ TEMPX (fetch (POSITION XCOORD) of OPPT))
(SETQ TEMPY (fetch (POSITION YCOORD) of OPPT))
(COND
((NOT (AND (IEQP OPPX TEMPX)
(IEQP OPPY TEMPY))) (* move the box)
(MOVEBOX BASEX BASEY OPPX OPPY (SETQ OPPX TEMPX)
(SETQ OPPY TEMPY)
DESTINATION SHADE)
(SETCORNER BASEX BASEY OPPX OPPY))))
(T (* Cursor moved to new
screen. Can't get new
image by adding to old
image. *)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE)
(SETQ BASEX (fetch (POSITION XCOORD) of BASEPT))
(SETQ BASEY (fetch (POSITION YCOORD) of BASEPT))
(SETQ OPPX (fetch (POSITION XCOORD) of OPPT))
(SETQ OPPY (fetch (POSITION YCOORD) of OPPT))
(DRAWGRAYBOX BASEX BASEY OPPX OPPY \CURSORDESTINATION SHADE)
(SETCORNER BASEX BASEY OPPX OPPY))))))
(GETBOXREGION
(LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) (* kbr: " 6-Jul-85 19:58")
(* returns a region width by height positioned where
user says.)
(fetch (SCREENREGION REGION) of (GETBOXSCREENREGION WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG))))
(\TRACKWITHBOX
(LAMBDA (SHADE) (* kbr:
" 3-Feb-86 12:45")
(* 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 DESTINATION)
(SETQ MLMASK (CONSTANT (LOGOR (MOUSESTATE-NAME (QUOTE LEFT))
(MOUSESTATE-NAME (QUOTE MIDDLE)))))
(SETQ DESTINATION \CURSORDESTINATION)
(SETQ ORGLEFTMIDDLE (LOGAND MLMASK LASTMOUSEBUTTONS))
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH)
(IPLUS ORGY BOXHEIGHT)
DESTINATION SHADE)
(SETQ NOERROR (ERSETQ (until (PROGN (GETMOUSESTATE)
(NOT (EQ (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))))
(\CURSORPOSITION ORGX ORGY))
(T (COND
((NOT (AND (IEQP ORGX LASTMOUSEX)
(IEQP ORGY LASTMOUSEY)))
(* the cursor has moved,
move the box by erasing
old box and drawing new
box. *)
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH)
(IPLUS ORGY BOXHEIGHT)
DESTINATION SHADE)
(SETQ ORGX LASTMOUSEX)
(SETQ ORGY LASTMOUSEY)
(SETQ DESTINATION \CURSORDESTINATION)
(COND
(BACKGROUNDCURSOREXITFN (APPLY*
BACKGROUNDCURSOREXITFN
)))
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH)
(IPLUS ORGY BOXHEIGHT)
DESTINATION SHADE))))))))
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX BOXWIDTH)
(IPLUS ORGY BOXHEIGHT)
DESTINATION SHADE)
(COND
((NULL NOERROR) (* pass back ↑E)
(ERROR!))))))
(MOVEBOX
(LAMBDA (X1 Y1 X2 Y2 X3 Y3 DESTINATION SHADE) (* kbr: "25-May-85 15:45")
(* moves the opposite corner of a box from {X2,Y2} to
{X3,Y3}.)
(.WHILE.CURSOR.DOWN. (BLTHLINE Y1 X2 X3 DESTINATION SHADE)
(BLTVLINE X1 Y2 Y3 DESTINATION SHADE)
(BLTHLINE Y2 X1 X2 DESTINATION SHADE)
(BLTHLINE Y3 X1 X3 DESTINATION SHADE)
(BLTVLINE X2 Y1 Y2 DESTINATION SHADE)
(BLTVLINE X3 Y1 Y3 DESTINATION SHADE))))
(DRAWGRAYBOX
(LAMBDA (X1 Y1 X2 Y2 DESTINATION SHADE) (* kbr:
" 3-Feb-86 12:47")
(* Put a gray box in
window or bitmap
DESTINATION)
(.WHILE.CURSOR.DOWN. (BLTHLINE Y1 X1 X2 DESTINATION SHADE)
(BLTVLINE X1 Y1 Y2 DESTINATION SHADE)
(BLTHLINE Y2 X1 X2 DESTINATION SHADE)
(BLTVLINE X2 Y1 Y2 DESTINATION SHADE))))
(BLTHLINE
(LAMBDA (Y XA XB DESTINATION SHADE) (* kbr: "30-Mar-85 15:23")
(BITBLT NIL NIL NIL DESTINATION (IMIN XA XB)
Y
(IABS (IDIFFERENCE XB XA))
2
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)))
(BLTVLINE
(LAMBDA (X YA YB DESTINATION SHADE) (* kbr: "30-Mar-85 15:23")
(BITBLT NIL NIL NIL DESTINATION X (IMIN YA YB)
2
(IABS (IDIFFERENCE YB YA))
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)))
(SETCORNER
(LAMBDA (X1 Y1 X2 Y2) (* edited: "26-Jan-86 13:15")
(* sets the cursor shape for the box from x1,y1 to x2,
y2)
(DECLARE (GLOBALVARS LowerLeftCursor LowerRightCursor UpperLeftCursor UpperRightCursor))
(PROG (NEWCURSOR OLDCURSOR)
(SETQ NEWCURSOR (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))))) (* only call cursor if it changes
(less flicker on software cursors))
(SETQ OLDCURSOR (CURSOR))
(COND
((NOT (EQ NEWCURSOR OLDCURSOR))
(CURSOR NEWCURSOR)
(\CURSORPOSITION X2 Y2))))))
(GETSCREENPOSITION
(LAMBDA (WINDOW CURSOR) (* kbr:
"27-Feb-86 15:04")
(* Get screenposition
with cursor. If WINDOW,
then screenposition
should be on same screen
as WINDOW and in
WINDOW's coordinate
system. *)
(OR (NULL WINDOW)
(SETQ WINDOW (WFROMDS WINDOW)))
(RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
(until (MOUSESTATE LEFT) do (COND
(BACKGROUNDCURSOREXITFN (APPLY*
BACKGROUNDCURSOREXITFN
))))
(* wait until the
cursor is down)
(COND
(WINDOW (until (AND (MOUSESTATE (NOT LEFT))
(EQ \CURSORSCREEN (fetch (WINDOW SCREEN) of WINDOW)))
do (COND
(BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN))))))
(* if a window was
specified, then wait
until the left button
comes up, or until the
cursor leaves the screen
of the window)
(COND
((NULL WINDOW)
(create SCREENPOSITION
SCREEN ← LASTSCREEN
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY))
(T (create SCREENPOSITION
SCREEN ← LASTSCREEN
XCOORD ←(LASTMOUSEX WINDOW)
YCOORD ←(LASTMOUSEY WINDOW)))))))
(GETBOXSCREENPOSITION
(LAMBDA (BOXWIDTH BOXHEIGHT ORGX ORGY WINDOW PROMPTMSG) (* edited: "26-Jan-86 12:33")
(* 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)))
SHADE)
(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))))
(\CURSORPOSITION ORGX ORGY))
(T (SETQ ORGX LASTMOUSEX)
(SETQ ORGY LASTMOUSEY)))
(AND PROMPTMSG (PROMPTPRINT PROMPTMSG))
(SETQ SHADE GRAYSHADE)
TRACKLP (* track the cursor with a box ghost until the left or
middle button changes.)
(\TRACKWITHBOX SHADE)
(COND
((AND (NULL MOUSEDOWNFLG)
(LASTMOUSESTATE (NOT UP)))
(SETQ MOUSEDOWNFLG T)
(CURSOR CROSSHAIRS))
((AND MOUSEDOWNFLG (LASTMOUSESTATE UP))
(AND PROMPTMSG (CLRPROMPT))
(RETURN (COND
(WINDOW (create SCREENPOSITION
SCREEN ← LASTSCREEN
XCOORD ← (DSPXSCREENTOWINDOW
(IMIN ORGX (IPLUS ORGX BOXWIDTH))
WINDOW)
YCOORD ← (DSPYSCREENTOWINDOW
(IMIN ORGY (IPLUS ORGY BOXHEIGHT))
WINDOW)))
(T (create SCREENPOSITION
SCREEN ← LASTSCREEN
XCOORD ← (IMIN ORGX (IPLUS ORGX BOXWIDTH))
YCOORD ← (IMIN ORGY (IPLUS ORGY BOXHEIGHT)))
)))))
(GO TRACKLP)))))
(GETSCREENREGION
(LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS)
(* kbr:
" 3-Feb-86 12:46")
(* accepts region from
the user.)
(* 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))
(* * Why is INITCORNERS not two positions? gbn)
(RESETFORM (CURSOR EXPANDINGBOX)
(PROG (DESTINATION SHADE BASEX BASEY OPPX OPPY OLDMOUSEX OLDMOUSEY INITLEFT INITRIGHT
INITBOTTOM INITTOP BASEPT OPPT NEWMOUSEX NEWMOUSEY DOWNFLG BEGCLOCK
NOTTIMEDOUT NEWREGFNS)
(SETQ BASEPT (create POSITION))
(SETQ OPPT (create POSITION))
(SETQ MINWIDTH (COND
((FIXP MINWIDTH))
(T 0)))
(SETQ MINHEIGHT (COND
((FIXP MINHEIGHT))
(T 0)))
(SETQ NEWREGFNS (MKLIST NEWREGIONFN))
(SETQ SHADE GRAYSHADE)
(SETQ NOTTIMEDOUT T)
(SETQ DESTINATION \CURSORDESTINATION)
(COND
(INITCORNERS (* setup box by
initcorners.)
(COND
((AND (EQ 4 (LENGTH INITCORNERS))
(for X in INITCORNERS always (FIXP X)))
(SETQ BASEX (CAR INITCORNERS))
(SETQ BASEY (CADR INITCORNERS))
(SETQ OPPX (CADDR INITCORNERS))
(SETQ OPPY (CADDDR INITCORNERS)))
(T (\ILLEGAL.ARG INITCORNERS))))
(T (* start with the cursor
in the lower right
corner of the ghost box.)
(GETMOUSESTATE)
(SETQ OPPX LASTMOUSEX)
(SETQ OPPY LASTMOUSEY)
(COND
((ILESSP (SETQ BASEX (IDIFFERENCE OPPX MINWIDTH))
0)
(* arrange things so that the whole box if possible is on the screen.
If this is not possible, the lower right corner is on the screen.)
(SETQ OPPX (SUB1 (IMIN MINWIDTH \CURSORDESTWIDTH)))
(SETQ BASEX (IDIFFERENCE OPPX MINWIDTH))))
(COND
((IGEQ (SETQ BASEY (IPLUS OPPY MINHEIGHT))
\CURSORDESTHEIGHT)
(* 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 \CURSORDESTHEIGHT MINHEIGHT)))
(SETQ BASEY (IPLUS OPPY MINHEIGHT))))))
(\CURSORPOSITION OPPX OPPY) (* wait for the user to
put down the first
corner.)
(\GETREGIONTRACKWITHBOX)
(COND
((AND INITREGION (LASTMOUSESTATE MIDDLE)) (* switch the nearest
corner of INITREGION 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 INITREGION))
(SETQ INITRIGHT
(IPLUS INITLEFT (fetch (REGION WIDTH)
of INITREGION))))
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 INITREGION))
(SETQ INITTOP
(IPLUS INITBOTTOM (fetch (REGION
HEIGHT)
of INITREGION))))
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)
(SETQ DESTINATION \CURSORDESTINATION)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE)
(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)))
(swap BASEX OPPX)))
(COND
((IGEQ (IABS (IDIFFERENCE LASTMOUSEY OPPY))
(IABS (IDIFFERENCE LASTMOUSEY BASEY)))
(swap BASEY OPPY)))
(\GETREGION.PACKPTS)
(\GETREGION.CHECKBASEPT NEWREGFNS BASEPT)
(\GETREGION.CHECKOPPT MINWIDTH MINHEIGHT NEWREGFNS BASEPT OPPT
)
(SETCORNER BASEX BASEY OPPX OPPY)
(\UPDATEXYANDBOX T DESTINATION SHADE)
(SETQ DESTINATION \CURSORDESTINATION)
(COND
(BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN))))
((OR (NOT (EQ LASTMOUSEX OLDMOUSEX))
(NOT (EQ 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 DESTINATION SHADE)
(SETQ DESTINATION \CURSORDESTINATION)
(COND
(BACKGROUNDCURSOREXITFN (APPLY* BACKGROUNDCURSOREXITFN)))))
)) (* erase box image.)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY DESTINATION SHADE)
(RETURN (create SCREENREGION
SCREEN ← \CURSORSCREEN
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 DESTINATION SHADE)
(ERROR!)))))))
(GETBOXSCREENREGION
(LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) (* kbr: " 6-Jul-85 19:56")
(* returns a screenregion width by height positioned
where user says.)
(PROG (SCREENPOS)
(SETQ SCREENPOS (GETBOXSCREENPOSITION WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG))
(RETURN (create SCREENREGION
SCREEN ← (fetch (SCREENPOSITION SCREEN) of SCREENPOS)
LEFT ← (fetch (SCREENPOSITION XCOORD) of SCREENPOS)
BOTTOM ← (fetch (SCREENPOSITION YCOORD) of SCREENPOS)
WIDTH ← WIDTH
HEIGHT ← HEIGHT)))))
)
(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) NIL 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) NIL 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) NIL 0 13))
(16 16
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"N@@@"
"O@@@"
"OHNG"
"OLLC"
"ONKM"
"O@BD"
"MHBD"
"IHKM"
"@LLC"
"@LNG"
"@F@@"
"@F@@")(RPAQ FORCEPS (CURSORCREATE (READBITMAP) NIL 7 15))
(16 16
"@NG@"
"@JE@"
"@NG@"
"@DB@"
"@FF@"
"@CL@"
"@AH@"
"@AH@"
"@CL@"
"@FF@"
"ALCH"
"BDBD"
"BDBD"
"BDBD"
"BDBD"
"AHAH")(RPAQ BOXCURSOR (CURSORCREATE (READBITMAP) NIL 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) NIL 7 7))
(16 16
"@@@@"
"@@@@"
"COOL"
"COOL"
"C@@L"
"C@@L"
"CCLL"
"CCLL"
"CCLL"
"CCLL"
"C@@L"
"C@@L"
"COOL"
"COOL"
"@@@@"
"@@@@")(RPAQ OLDEXPANDINGBOX (CURSORCREATE (READBITMAP) NIL 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) NIL 0 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"OOL@"
"OON@")(RPAQ UpperRightCursor (CURSORCREATE (READBITMAP) NIL 15 15))
(16 16
"@COO"
"@AOO"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@A"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ UpperLeftCursor (CURSORCREATE (READBITMAP) NIL 0 15))
(16 16
"OOL@"
"OOH@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"H@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ LowerRightCursor (CURSORCREATE (READBITMAP) NIL 15 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@A"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@COO"
"@GOO")(DEFINEQ
(\SW2BM
(LAMBDA (P PR Q QR) (* edited: "26-Jan-86 13:23")
(* 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 (REGION LEFT) of PR))
(SETQ PB (fetch (REGION BOTTOM) of PR))
(SETQ PH (fetch (REGION HEIGHT) of PR))
(SETQ PW (fetch (REGION WIDTH) of PR)))
(T (SETQ PL (SETQ PB 0))
(SETQ PW (fetch (BITMAP BITMAPWIDTH) of P))
(SETQ PH (fetch (BITMAP BITMAPHEIGHT) of P))))
(COND
(QR (SETQ QL (fetch (REGION LEFT) of QR))
(SETQ QB (fetch (REGION BOTTOM) of QR))
(SETQ QW (fetch (REGION WIDTH) of QR))
(SETQ QH (fetch (REGION HEIGHT) of QR)))
(T (SETQ QL (SETQ QB 0))
(SETQ QW (fetch (BITMAP BITMAPWIDTH) of Q))
(SETQ QH (fetch (BITMAP 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 (BITMAP BITMAPWIDTH)
of P)
(IPLUS PL PW))
XP)
(IDIFFERENCE (IMIN (fetch (BITMAP BITMAPWIDTH)
of Q)
(IPLUS QL QW))
XQ)))
(SETQ CH (IMIN (IDIFFERENCE (IMIN (fetch (BITMAP BITMAPHEIGHT)
of P)
(IPLUS PB PH))
YP)
(IDIFFERENCE (IMIN (fetch (BITMAP 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) (* edited: "26-Jan-86 13:33")
(* 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 BPP ORIGBPP
ORIGWIDTH) (* 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 \CURSORDESTINATION)))
(* note that bm has initial bits in it.)
(SETQ ORIGBM BMSPEC)
(BITBLT \CURSORDESTINATION (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))
(BITSPERPIXEL BMSPEC)))
(* open the window and bring it to the top.)
(TOTOPW BMSPEC)
(SETQ CR (DSPCLIPPINGREGION NIL BMSPEC))
(BITBLT BMSPEC (fetch (REGION LEFT) of CR)
(fetch (REGION BOTTOM) of CR)
BM 0 0 (fetch (REGION WIDTH) of CR)
(fetch (REGION HEIGHT) of CR)))
(T (* otherwise create a bitmap)
(SETQ BM (\READBMDIMENSIONS))))
(SETQ BPP (BITSPERPIXEL \CURSORDESTINATION))
(SETQ ORIGBPP (fetch (BITMAP BITMAPBITSPERPIXEL) of BM))
(COND
((NOT (EQ BPP ORIGBPP))
(* save the actual number of bits per pixel and set it to BPP in the bitmap being editted so that it can be BITBLT
ed on the screen.)
(SETQ ORIGWIDTH (fetch (BITMAP BITMAPWIDTH) of BM))
(replace (BITMAP BITMAPBITSPERPIXEL) of BM with BPP)
(SETQ WIDTH (IQUOTIENT (ITIMES ORIGBPP ORIGWIDTH)
BPP))
(replace (BITMAP BITMAPWIDTH) of BM with WIDTH))
(T (SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BM))))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) 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
\CURSORDESTWIDTH 2)
3)
GRIDTHICKNESS)
WIDTH)
(IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES
\CURSORDESTHEIGHT 2)
3)
(ITIMES GRIDTHICKNESS 2))
(ADD1 HEIGHT))
NORMALGRIDSQUARE)
MINGRIDSQUARE))
(SETQ BMWWIDTH (IMIN (IPLUS (ITIMES GRIDSQUARE WIDTH)
GRIDTHICKNESS)
(IQUOTIENT (ITIMES \CURSORDESTWIDTH 2)
3)))
(SETQ BMWHEIGHT (IMIN (IPLUS (ITIMES HEIGHT (ADD1 GRIDSQUARE))
(ITIMES GRIDTHICKNESS 2)
1)
(IQUOTIENT (ITIMES \CURSORDESTHEIGHT 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 COLOR)
(MAXIMUMCOLOR BPP))
(WINDOWPROP BMW (QUOTE GRIDON)
T) (* 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)
(COND
((NOT (EQ ORIGBPP BPP))
(replace (BITMAP BITMAPBITSPERPIXEL) of BM with ORIGBPP)
(replace (BITMAP BITMAPWIDTH) of BM with ORIGWIDTH)))
(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 \CURSORDESTINATION (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) (* edited: "26-Jan-86 14:57")
(* lays tiles out in an area of a window.)
(PROG ((X LFT)
(Y BTM)
(RGHT (IPLUS LFT WDTH))
(TOP (IPLUS BTM HGHT))
(W (fetch (BITMAP BITMAPWIDTH) of SRCBM))
(H (fetch (BITMAP 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) (* kbr:
"19-Feb-86 16:20")
(* inner function of
bitmap editor.)
(PROG (GRIDX0 GRIDY0 BITMAPWIDTH BITMAPHEIGHT NEWGRIDSIZE PAINTW ORIGBM GRIDSPEC GRIDINTERIOR BM
BITSWIDE BITSHIGH WREGION XOFFSET YOFFSET DXOFFSET DYOFFSET DISPLAYREGION EXTENT
BITSPERPIXEL CURSORBM)
(SETQ GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
(SETQ GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
(SETQ BM (WINDOWPROP W (QUOTE BM)))
(SETQ BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
(SETQ BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
(SETQ WREGION (WINDOWPROP W (QUOTE REGION)))
(SETQ XOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
(SETQ YOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
(SETQ DXOFFSET (WINDOWPROP W (QUOTE DXOFFSET)))
(SETQ DYOFFSET (WINDOWPROP W (QUOTE DYOFFSET)))
(SETQ DISPLAYREGION (WINDOWPROP W (QUOTE DISPLAYREGION)))
(SETQ 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))
(SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of BM))
(SETQ COLOR (WINDOWPROP W (QUOTE COLOR))) (* 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 COLOR))
((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)
(SETQ POS (GETBOXPOSITION BITSWIDE BITSHIGH
(IPLUS 4 (fetch (REGION LEFT) of WREGION)
(IDIFFERENCE XOFFSET (WINDOWPROP W (QUOTE
DXOFFSET)))
)
(IPLUS (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
(IDIFFERENCE YOFFSET (WINDOWPROP W (QUOTE
DYOFFSET)))
4
(fetch (REGION BOTTOM) of WREGION))))
(WINDOWPROP W (QUOTE XOFFSET)
(SETQ XOFFSET
(IMIN (IDIFFERENCE BITMAPWIDTH BITSWIDE)
(IMAX (IPLUS (WINDOWPROP W (QUOTE DXOFFSET))
(IDIFFERENCE (fetch (POSITION XCOORD)
of POS)
(IPLUS 4 (fetch (REGION LEFT)
of WREGION))))
0))))
(WINDOWPROP
W
(QUOTE YOFFSET)
(SETQ YOFFSET
(IMAX 0 (IMIN (IDIFFERENCE BITMAPHEIGHT BITSHIGH)
(IDIFFERENCE (IPLUS (WINDOWPROP W (QUOTE DYOFFSET))
(IDIFFERENCE
(fetch (POSITION YCOORD)
of POS)
(IPLUS (fetch (REGION BOTTOM)
of WREGION)
4)))
(WINDOWPROP W (QUOTE BMDISPLAYBOTTOM)))))))
(replace (REGION LEFT) of EXTENT
with (IMINUS (QUOTIENT (TIMES XOFFSET (fetch (REGION WIDTH)
of EXTENT))
BITMAPWIDTH)))
(replace (REGION BOTTOM) of EXTENT
with (IMINUS (QUOTIENT (TIMES YOFFSET (fetch (REGION HEIGHT)
of EXTENT))
BITMAPHEIGHT)))
(COND
((OR (ILESSP XOFFSET DXOFFSET)
(ILESSP YOFFSET DYOFFSET)
(IGREATERP (IPLUS XOFFSET BITSWIDE)
(IPLUS DXOFFSET (WINDOWPROP W (QUOTE BMDISPLAYWIDTH))))
(IGREATERP (IPLUS YOFFSET BITSHIGH)
(IPLUS DYOFFSET (WINDOWPROP W (QUOTE BMDISPLAYHEIGHT))))
) (* Adjust the display
region left lower corner
so the selected region
is near the center.)
(WINDOWPROP W (QUOTE DXOFFSET)
(SETQ DXOFFSET
(IMAX 0 (IMIN (IDIFFERENCE (fetch (BITMAP BITMAPWIDTH)
of BM)
(WINDOWPROP W (QUOTE BMDISPLAYWIDTH)))
(IDIFFERENCE (IPLUS XOFFSET (LRSH BITSWIDE 1)
)
(LRSH (WINDOWPROP W (QUOTE
BMDISPLAYWIDTH
))
1))))))
(WINDOWPROP W (QUOTE DYOFFSET)
(SETQ DYOFFSET
(IMAX 0 (IMIN (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT)
of BM)
(WINDOWPROP W (QUOTE BMDISPLAYHEIGHT))
)
(IDIFFERENCE (IPLUS YOFFSET (LRSH BITSHIGH 1)
)
(LRSH (WINDOWPROP W (QUOTE
BMDISPLAYHEIGHT
))
1))))))))
(DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
W)
(UPDATE/BM/DISPLAY BM W)
(COND
((WINDOWPROP W (QUOTE GRIDON))
(GRID GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
W)))
(RESETGRID BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W)))
NIL))
((LASTMOUSESTATE LEFT)
(UPDATE/BM/DISPLAY/SELECTED/REGION W)
(SETQ CURSORBM (BITMAPCREATE 16 16 (BITSPERPIXEL BM)))
(BITBLT BM NIL NIL CURSORBM)
(RESETFORM (CURSOR (CURSORCREATE CURSORBM NIL (fetch (CURSOR CUHOTSPOTX)
of \CURRENTCURSOR)
(fetch (CURSOR CUHOTSPOTY) of \CURRENTCURSOR)))
(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 ←(APPEND
(COND
((COLORDISPLAYP)
(QUOTE ((Color (QUOTE Color)
"Choose color to set bits with"
))))
(T NIL))
(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 \CURSORDESTINATION
(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 \CURSORDESTINATION (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 (REGION HEIGHT)
GRIDINTERIOR))
HEIGHT ←(ADD1 (fetch (REGION 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
\CURSORDESTWIDTH
BITMAPWIDTH)
2)
BOTTOM ←(IQUOTIENT (IDIFFERENCE
\CURSORDESTHEIGHT
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))
(Color (WINDOWPROP W (QUOTE COLOR)
(OR (MENU (COLORMENU BITSPERPIXEL))
COLOR)))
(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) (* kbr: " 2-Sep-85 19:44")
(* 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) (* gbn: "26-Jan-86 15:52")
(* allows the bitmap edit window to be reshaped to enlarge the editting area. This is also called to set up the
image during initialization.)
(PROG (BMWINTERIORWIDTH BMWINTERIORHEIGHT EDITAREABITWIDTH EDITAREABITHEIGHT GRIDSQUARE
GRIDINTERIOR BITMAPWIDTH BMDISPLAYWIDTH BMDISPLAYBOTTOM BMDISPLAYHEIGHT
BITMAPHEIGHT (BM (WINDOWPROP BMEDITWINDOW (QUOTE BM)))
MINCOMMANDAREAWIDTH)
(SETQ MINCOMMANDAREAWIDTH 30)
(SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of BM))
(SETQ BITMAPHEIGHT (fetch (BITMAP 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 ZEROBMFLG))))
(EDITBMREPAINTFN
(LAMBDA (WIN REGION ZEROBM) (* gbn: "26-Jan-86 15:53")
(* 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) (* kbr: " 2-Sep-85 19:45")
(* 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) (* gbn: "26-Jan-86 15:56")
(* copies the contents of a bitmap into the edit
display grid.)
(PROG (XOFFSET YOFFSET MAXX MAXY SHADE)
(COND
((NULL ORGX)
(SETQ ORGX 0)))
(COND
((NULL ORGY)
(SETQ ORGY 0)))
(SETQ XOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
(SETQ YOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
(SETQ MAXX (IPLUS ORGX WIDTH -1))
(SETQ MAXY (IPLUS ORGY HEIGHT -1))
(for Y from ORGY to MAXY do (for X from ORGX to MAXX
do (SETQ SHADE (EDITBMTEXTURE BM
(IPLUS
X XOFFSET)
(IPLUS
Y YOFFSET)))
(SHADEGRIDBOX
X Y SHADE (QUOTE REPLACE)
GRIDSPEC
(COND
((NULL (WINDOWPROP W (QUOTE GRIDON))
)
0)
(T (QUOTE POINT)))
W))))))
(\READBMDIMENSIONS
(LAMBDA NIL (* gbn: "26-Jan-86 15:57")
(* 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 (BITSPERPIXEL \CURSORDESTINATION))))))
(EDITSHADE
(LAMBDA (SHADE) (* kbr:
" 2-Feb-86 15:36")
(* allows the editing of
a shade.)
(PROG (SHADEBM QUITREGION SHADEREGION BMWIDTH BMHEIGHT GRIDINTERIOR GRIDSPEC X Y SEDW DS BOXSIZE)
(SETQ 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))))
(SETQ QUITREGION (CREATEREGION 125 150 50 20))
(SETQ SHADEREGION (CREATEREGION 10 185 272 100))
(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) (* kbr:
" 2-Feb-86 15:38")
(* redisplays an edit
shade window.)
(PROG (GRIDSPEC SHADE BMWIDTH BMHEIGHT)
(SETQ GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
(SETQ SHADE (WINDOWPROP WIN (QUOTE SHADEBM)))
(SETQ BMWIDTH (BITMAPWIDTH SHADE))
(SETQ BMHEIGHT (BITMAPHEIGHT SHADE))
(SHOWBUTTON (create BUTTON
REGION ←(WINDOWPROP WIN (QUOTE QUITREGION))
LABEL ←(QUOTE QUIT)
HELP ←"Quits")
WIN)
(GRAYBOXAREA (fetch (REGION LEFT) of GRIDSPEC)
(fetch (REGION BOTTOM) of GRIDSPEC)
(ITIMES (fetch (REGION WIDTH) of GRIDSPEC)
BMWIDTH)
(ITIMES (fetch (REGION 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 COLOR)
(* gbn: "26-Jan-86 15:59")
(* cursor is inside the edit grid, so change the bit
in the bitmap, change the edit grid and redisplay the
bitmap.)
(PROG (BITSPERPIXEL XPIXEL YPIXEL OTHERCOLOR SHADE OTHERSHADE USECOLOR USESHADE X Y)
(SETQ BITSPERPIXEL (BITSPERPIXEL BM))
(SETQ OTHERCOLOR (OPPOSITECOLOR COLOR BITSPERPIXEL))
(COND
((EQ BITSPERPIXEL 1)
(COND
((EQ COLOR 1)
(SETQ SHADE DARKBITSHADE)
(SETQ OTHERSHADE WHITESHADE))
(T (SETQ SHADE WHITESHADE)
(SETQ OTHERSHADE DARKBITSHADE))))
(T (SETQ SHADE COLOR)
(SETQ OTHERSHADE OTHERCOLOR)))
(until (MOUSESTATE UP)
when (AND (NOT (EQ (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 (COND
((LASTMOUSESTATE LEFT)
(SETQ USECOLOR COLOR)
(SETQ USESHADE SHADE))
(T (SETQ USECOLOR OTHERCOLOR)
(SETQ USESHADE OTHERSHADE)))
(BITMAPBIT BM (IPLUS XPIXEL (WINDOWPROP W (QUOTE XOFFSET)))
(IPLUS YPIXEL (WINDOWPROP W (QUOTE YOFFSET)))
USECOLOR)
(UPDATE/BM/DISPLAY BM W)
(SHADEGRIDBOX XPIXEL YPIXEL USESHADE (QUOTE REPLACE)
GRIDSPEC
(COND
((NULL (WINDOWPROP W (QUOTE GRIDON)))
0)
(T (QUOTE POINT)))
W)))))
(READHOTSPOT
(LAMBDA (BM GRIDSPEC GRIDINTERIOR DS) (* kbr:
"13-Feb-86 15:21")
(* reads the hotspot
from the cursor and sets
cursor)
(UNTILMOUSESTATE UP)
(PROG (NOWCURSOR XPIXEL YPIXEL DOWNYET? CURSORBM)
(SETQ NOWCURSOR (CURSOR))
(CURSORPOSITION (create POSITION
XCOORD ←(IPLUS (LEFTOFGRIDCOORD (SETQ XPIXEL (fetch
(CURSOR CUHOTSPOTX
)
of NOWCURSOR
))
GRIDSPEC)
(IQUOTIENT (fetch (REGION WIDTH) of GRIDSPEC)
2))
YCOORD ←(IPLUS (BOTTOMOFGRIDCOORD (SETQ YPIXEL
(fetch (CURSOR CUHOTSPOTY
)
of NOWCURSOR))
GRIDSPEC)
(IQUOTIENT (fetch (REGION HEIGHT) of GRIDSPEC
)
2)))
DS)
(SHADEGRIDBOX XPIXEL YPIXEL NOTINUSEGRAY (QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)
(until (PROGN (GETMOUSESTATE)
(AND DOWNYET? (MOUSESTATE UP))) when (INSIDE? GRIDINTERIOR
(LASTMOUSEX DS)
(LASTMOUSEY DS))
do (OR DOWNYET? (SETQ DOWNYET? (NOT (EQ LASTMOUSEBUTTONS 0))))
(COND
(XPIXEL (SHADEGRIDBOX XPIXEL YPIXEL (EDITBMTEXTURE BM XPIXEL YPIXEL)
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)))
(SHADEGRIDBOX (SETQ XPIXEL (GRIDXCOORD (LASTMOUSEX DS)
GRIDSPEC))
(SETQ YPIXEL (GRIDYCOORD (LASTMOUSEY DS)
GRIDSPEC))
NOTINUSEGRAY
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS) finally (SETQ CURSORBM (BITMAPCREATE 16 16 (BITSPERPIXEL BM)))
(BITBLT BM NIL NIL CURSORBM)
(CURSOR (CURSORCREATE CURSORBM NIL 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)))
(EDITBMTEXTURE
(LAMBDA (BM X Y) (* kbr: " 9-Jan-86 21:51")
(* Texture EDITBM should use to represent pixel
(X . Y) of BM. *)
(PROG (COLOR SHADE)
(SETQ COLOR (BITMAPBIT BM X Y))
(SETQ SHADE (COND
((EQ (BITSPERPIXEL BM)
1)
(COND
((EQ COLOR 1)
DARKBITSHADE)
(T WHITESHADE)))
(T COLOR)))
(RETURN SHADE))))
)
(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) (* kbr: " 2-Sep-85 19:52")
(PROG (WIDTH HEIGHT BITSPERPIXEL NEWWIDTH NEWHEIGHT NEWX NEWY NEWBITMAP)
(OR WIDTHFACTOR (SETQ WIDTHFACTOR 1))
(OR HEIGHTFACTOR (SETQ HEIGHTFACTOR 1))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP))
(SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP))
(SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP))
(SETQ NEWWIDTH (ITIMES WIDTHFACTOR WIDTH))
(SETQ NEWHEIGHT (ITIMES HEIGHTFACTOR HEIGHT))
(SETQ NEWBITMAP (BITMAPCREATE NEWWIDTH NEWHEIGHT BITSPERPIXEL))
(* Expand in x-direction. *)
(SETQ NEWX 0)
(for X from 0 to (SUB1 WIDTH) do (for I from 1 to WIDTHFACTOR
do (BITBLT BITMAP X 0 NEWBITMAP NEWX 0 1 HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(add NEWX 1)))
(* Expand in y-direction. *)
(SETQ NEWY (SUB1 NEWHEIGHT))
(for Y from (SUB1 HEIGHT) to 0 by -1
do (for I from 1 to HEIGHTFACTOR
do (BITBLT NEWBITMAP 0 Y NEWBITMAP 0 NEWY NEWWIDTH 1 (QUOTE INPUT)
(QUOTE REPLACE))
(add NEWY -1)))
(RETURN NEWBITMAP))))
(SHRINKBITMAP
(LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR DESTINATIONBITMAP) (* hdj
"18-Feb-86 14:23")
(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))))
(if (AND (EQP WFACTOR 1)
(EQP HFACTOR 1))
then (BITBLT BITMAP NIL NIL DESTINATION)
else (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) (* kbr: "16-May-85 17:14")
(* 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 (NIBBLE N1) of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (ELT MAP (fetch (NIBBLE N2) of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (ELT MAP (fetch (NIBBLE N3) of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (ELT MAP (fetch (NIBBLE 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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3641 20424 (GRID 3651 . 6652) (GRIDXCOORD 6654 . 7194) (GRIDYCOORD 7196 . 7740) (
LEFTOFGRIDCOORD 7742 . 8105) (BOTTOMOFGRIDCOORD 8107 . 8360) (EDITBMSCROLLFN 8362 . 19409) (
SHADEGRIDBOX 19411 . 20422)) (20476 20846 (INSIDE? 20486 . 20844)) (20880 24750 (MOUSESTATE-EXPR 20890
. 24079) (MOUSESTATE-NAME 24081 . 24748)) (28832 29983 (DECODEBUTTONS 28842 . 29981)) (29984 30958 (
PTDIFFERENCE 29994 . 30482) (PTPLUS 30484 . 30956)) (31005 73531 (GETPOSITION 31015 . 31325) (
GETBOXPOSITION 31327 . 31856) (DSPYSCREENTOWINDOW 31858 . 32210) (DSPXSCREENTOWINDOW 32212 . 32564) (
GETREGION 32566 . 33186) (\GETREGION.PACKPTS 33188 . 33719) (\GETREGION.CHECKBASEPT 33721 . 34870) (
\GETREGION.CHECKOPPT 34872 . 36922) (\GETREGIONTRACKWITHBOX 36924 . 44283) (\UPDATEXYANDBOX 44285 .
47180) (GETBOXREGION 47182 . 47550) (\TRACKWITHBOX 47552 . 52902) (MOVEBOX 52904 . 53454) (DRAWGRAYBOX
53456 . 54132) (BLTHLINE 54134 . 54409) (BLTVLINE 54411 . 54681) (SETCORNER 54683 . 55753) (
GETSCREENPOSITION 55755 . 58549) (GETBOXSCREENPOSITION 58551 . 60841) (GETSCREENREGION 60843 . 72844)
(GETBOXSCREENREGION 72846 . 73529)) (73532 75085 (MOUSECONFIRM 73542 . 75083)) (75267 76527 (
NEAREST/PT/ON/GRID 75277 . 75750) (PTON10GRID 75752 . 76078) (NEAREST/MULTIPLE 76080 . 76525)) (78716
82278 (\SW2BM 78726 . 81049) (COMPOSEREGS 81051 . 81628) (TRANSLATEREG 81630 . 82276)) (82316 149370 (
EDITBM 82326 . 90638) (EDITBMCLOSEFN 90640 . 90991) (TILEAREA 90993 . 91652) (EDITBMBUTTONFN 91654 .
119362) (\EDITBM/PUTUP/DISPLAY 119364 . 119965) (\EDITBMHOWMUCH 119967 . 120851) (EDITBMRESHAPEFN
120853 . 126471) (EDITBMREPAINTFN 126473 . 128044) (UPDATE/SHADE/DISPLAY 128046 . 128500) (
UPDATE/BM/DISPLAY/SELECTED/REGION 128502 . 129638) (SHOWBUTTON 129640 . 130118) (RESETGRID 130120 .
131250) (\READBMDIMENSIONS 131252 . 132267) (EDITSHADE 132269 . 139233) (\BITMAPFROMTEXTURE 139235 .
139885) (EDITSHADEREPAINTFN 139887 . 141354) (GRAYBOXAREA 141356 . 142136) (\SHADEBITS 142138 . 144140
) (READHOTSPOT 144142 . 147728) (WBOX 147730 . 148576) (\CLEARBM 148578 . 148822) (EDITBMTEXTURE
148824 . 149368)) (150725 154810 (EXPANDBITMAP 150735 . 152299) (SHRINKBITMAP 152301 . 153875) (
\FAST4BIT 153877 . 154808)))))
STOP