(FILECREATED "11-AUG-83 12:35:38" {PHYLUM}<LISPCORE>SOURCES>HLDISPLAY.;70 81763
changes to: (FNS EDITBM)
previous date: "20-JUL-83 14:28:41" {PHYLUM}<LISPCORE>SOURCES>HLDISPLAY.;69)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT HLDISPLAYCOMS)
(RPAQQ HLDISPLAYCOMS ((* GRID functions)
(FNS GRID GRIDXCOORD GRIDYCOORD LEFTOFGRIDCOORD BOTTOMOFGRIDCOORD EDITBMSCROLLFN SHADEGRIDBOX)
(* Low level compatibility and extensions)
(FNS CLEAR INSIDE?)
(EXPORT (* Mouse selection code)
(FNS MOUSESTATE-EXPR MOUSESTATE-NAME)
(PROP ARGNAMES MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE LASTKEYSETSTATE)
(DECLARE: DOCOPY (MACROS MOUSESTATE LASTMOUSESTATE UNTILMOUSESTATE KEYSETSTATE
LASTKEYSETSTATE))
(DECLARE: DONTCOPY (MACROS WITHIN))
(ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)))
(* High Level Display utilities)
(FNS DECODEBUTTONS)
(FNS GETPOSITION GETBOXPOSITION DSPYSCREENTOWINDOW DSPXSCREENTOWINDOW GETREGION GETBOXREGION
MOVEBOX DRAWGRAYBOX BLTHLINE BLTVLINE SETCORNER)
(FNS NEAREST/PT/ON/GRID PTON10GRID NEAREST/MULTIPLE)
(EXPORT (MACROS IABS))
(CURSORS CROSSHAIRS EXPANDINGBOX BOXCURSOR LOCKEDSPOT OLDEXPANDINGBOX LowerLeftCursor
UpperRightCursor UpperLeftCursor LowerRightCursor)
(FNS \SW2BM COMPOSEREGS TRANSLATEREG)
(COMS (* Bitmap and shade editors)
(FNS EDITBM EDITBMCLOSEFN TILEAREA EDITBMBUTTONFN \EDITBM/PUTUP/DISPLAY \EDITBMHOWMUCH
EDITBMRESHAPEFN EDITBMREPAINTFN UPDATE/SHADE/DISPLAY
UPDATE/BM/DISPLAY/SELECTED/REGION SHOWBUTTON RESETGRID \READBMDIMENSIONS EDITSHADE
EDITSHADEREPAINTFN GRAYBOXAREA \SHADEBITS READHOTSPOT WBOX)
(DECLARE: DONTCOPY (RECORDS BUTTON)
(MACROS BITMASK UPDATE/BM/DISPLAY))
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (DARKBITSHADE 23130)
(NORMALGRIDSQUARE 16)
(NOTINUSEGRAY 42405)
(EDITBMMENU)
(EDITBMWINDOWMENU)
(GRIDSIZEMENU)))
(DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE
NOTINUSEGRAY EDITBMMENU))
(CONSTANTS (GRIDTHICKNESS 2)
(MINGRIDSQUARE 8)
(MAXGRIDWIDTH 199)
(MAXGRIDHEIGHT 175)
(BMWINDOWSHADE 33410)))
(FNS EXPANDBITMAP)
(UGLYVARS \4BITEXPANSIONTABLE)))
(* GRID functions)
(DEFINEQ
(GRID
[LAMBDA (GRIDSPEC WIDTH HEIGHT BORDER DS GRIDSHADE) (* rrb "21-MAR-83 18:27")
(* draws a grid)
(PROG ((X0 (fetch (REGION LEFT) of GRIDSPEC))
(Y0 (fetch (REGION BOTTOM) of GRIDSPEC))
(SQWIDTH (fetch (REGION WIDTH) of GRIDSPEC))
(SQHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC))
(GRIDSHADE (COND
((TEXTUREP GRIDSHADE))
(T BLACKSHADE)))
LINELENGTH TWICEBORDER)
(COND
((OR (ZEROP BORDER)
(NULL BORDER)) (* don't draw anything.)
(RETURN))
((NUMBERP BORDER)
(SETQ TWICEBORDER (ITIMES BORDER 2))
(PROGN
(* draw vertical lines use BITBLT so that we don't have to correct for the width of the line since line drawing
will put the coordinate in the middle.)
(BITBLT NIL NIL NIL DS X0 Y0 BORDER (SETQ LINELENGTH (ITIMES HEIGHT SQHEIGHT))
(QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE)
(for X from (IDIFFERENCE (IPLUS X0 SQWIDTH)
BORDER)
to (IDIFFERENCE (IPLUS X0 (ITIMES (SUB1 WIDTH)
SQWIDTH))
BORDER)
by SQWIDTH do (BITBLT NIL NIL NIL DS X Y0 TWICEBORDER LINELENGTH
(QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE))
(BITBLT NIL NIL NIL DS (IDIFFERENCE (IPLUS X0 (ITIMES WIDTH SQWIDTH))
BORDER)
Y0 BORDER LINELENGTH (QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE))
(PROGN (* draw horizontal lines)
(BITBLT NIL NIL NIL DS X0 Y0 (SETQ LINELENGTH (ITIMES WIDTH SQWIDTH))
BORDER
(QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE)
(for Y from (IDIFFERENCE (IPLUS Y0 SQHEIGHT)
BORDER)
to (IDIFFERENCE (IPLUS Y0 (ITIMES (SUB1 HEIGHT)
SQHEIGHT))
BORDER)
by SQHEIGHT do (BITBLT NIL NIL NIL DS X0 Y LINELENGTH TWICEBORDER
(QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE))
(BITBLT NIL NIL NIL DS X0 (IDIFFERENCE (IPLUS Y0 (ITIMES HEIGHT SQHEIGHT))
BORDER)
LINELENGTH BORDER (QUOTE TEXTURE)
(QUOTE REPLACE)
GRIDSHADE)))
[(EQ BORDER (QUOTE POINT)) (* put a point in the lower left corner of each box)
(for X from X0 to (IPLUS X0 (ITIMES WIDTH SQWIDTH)) by SQWIDTH
do (for Y from Y0 to (IPLUS Y0 (ITIMES HEIGHT SQHEIGHT)) by SQHEIGHT
do (BITMAPBIT DS X Y 1]
(T (\ILLEGAL.ARG BORDER])
(GRIDXCOORD
[LAMBDA (XPOS GRIDSPEC) (* rrb "21-MAR-83 13:04")
(PROG [(GX (IDIFFERENCE XPOS (fetch (REGION LEFT) of GRIDSPEC]
(* because (IQUOTIENT -1 2) is 0 instead of -1 like we
would like)
(RETURN (COND
((IGEQ GX 0)
(IQUOTIENT GX (fetch (REGION WIDTH) of GRIDSPEC)))
(T (SUB1 (IQUOTIENT GX (fetch (REGION WIDTH) of GRIDSPEC])
(GRIDYCOORD
[LAMBDA (YPOS GRIDSPEC) (* rrb "21-MAR-83 13:07")
(PROG [(GY (IDIFFERENCE YPOS (fetch (REGION BOTTOM) of GRIDSPEC]
(* because (IQUOTIENT -1 2) is 0 instead of -1 like we
would like)
(RETURN (COND
((IGEQ GY 0)
(IQUOTIENT GY (fetch (REGION HEIGHT) of GRIDSPEC)))
(T (SUB1 (IQUOTIENT GY (fetch (REGION HEIGHT) of GRIDSPEC])
(LEFTOFGRIDCOORD
[LAMBDA (GRIDX GRIDSPEC) (* rrb "19-MAR-82 09:20")
(* returns the Left position of a grid location.)
(IPLUS (fetch (REGION LEFT) of GRIDSPEC)
(ITIMES (fetch (REGION WIDTH) of GRIDSPEC)
GRIDX])
(BOTTOMOFGRIDCOORD
[LAMBDA (GRIDY GRIDSPEC) (* rrb "19-MAR-82 09:38")
(IPLUS (fetch (REGION BOTTOM) of GRIDSPEC)
(ITIMES (fetch (REGION HEIGHT) of GRIDSPEC)
GRIDY])
(EDITBMSCROLLFN
[LAMBDA (W DX DY) (* rrb "20-JUN-82 16:56")
(* Do scrolling for the bitmap editor.)
(PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0)
(DYGRID 0)
GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT GRIDINTERIOR EBMXLIMIT EBMYLIMIT
EBMXOFFSET EBMYOFFSET BM BITSWIDE BITSHIGH DXOFFSET DYOFFSET)
(SETQ GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
(SETQ REG (WINDOWPROP W (QUOTE REGION)))
(SETQ WHEIGHT (WINDOWPROP W (QUOTE HEIGHT)))
(SETQ WWIDTH (WINDOWPROP W (QUOTE WIDTH)))
(SETQ GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
(SETQ EBMXOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
(SETQ EBMYOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
(SETQ BM (WINDOWPROP W (QUOTE BM)))
(SETQ BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
(SETQ BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
(SETQ DXOFFSET (WINDOWPROP W (QUOTE DXOFFSET)))
(SETQ DYOFFSET (WINDOWPROP W (QUOTE DYOFFSET)))
(SETQ EBMXLIMIT (IPLUS EBMXOFFSET BITSWIDE))
(SETQ EBMYLIMIT (IPLUS EBMYOFFSET BITSHIGH))
(COND
(GRIDSPEC (SETQ GILEFT (fetch (REGION LEFT) of GRIDINTERIOR))
(SETQ GIBOTTOM (fetch (REGION BOTTOM) of GRIDINTERIOR))
(SETQ GIHEIGHT (fetch (REGION HEIGHT) of GRIDINTERIOR))
(SETQ GWIDTH (fetch (REGION WIDTH) of GRIDSPEC))
(SETQ GHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC))
(* Make a horizontal adjustment)
(COND
((FLOATP DX)
(printout PROMPTWINDOW "Thumbing isn't implemented yet." T))
((ILESSP DX 0) (* moving to the left.)
(* determine how many grid points to move.)
(SETQ DXGRID (IMIN (GRIDXCOORD (IMINUS DX)
GRIDSPEC)
(IDIFFERENCE (fetch (BITMAP BITMAPWIDTH) of BM)
EBMXLIMIT)))
(COND
((NOT (IGREATERP DXGRID 0)) (* right edge is at the right margin)
(RETURN)))
(WINDOWPROP W (QUOTE XOFFSET)
(SETQ EBMXOFFSET (IPLUS EBMXOFFSET DXGRID)))
(* move image to the left.)
(BITBLT W (IPLUS GILEFT (ITIMES DXGRID GWIDTH))
GIBOTTOM W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR) (* clear the newly exposed area.)
(BITBLT NIL 0 0 W (IPLUS GILEFT (ITIMES (IDIFFERENCE BITSWIDE DXGRID)
GWIDTH))
GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE GRIDINTERIOR)
(RESETGRID BM GRIDSPEC DXGRID BITSHIGH (IDIFFERENCE BITSWIDE DXGRID)
0 W))
((ILESSP 0 DX) (* determine how many grid point to the left to move.)
(SETQ DXGRID (IMIN EBMXOFFSET (GRIDXCOORD DX GRIDSPEC)))
(COND
((NOT (IGREATERP DXGRID 0)) (* left edge is at the left margin)
(RETURN)))
(WINDOWPROP W (QUOTE XOFFSET)
(SETQ EBMXOFFSET (IDIFFERENCE EBMXOFFSET DXGRID)))
(* move image to the right.)
(BITBLT W GILEFT GIBOTTOM W (IPLUS GILEFT (ITIMES DXGRID GWIDTH))
GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR) (* clear the newly exposed area.)
(BITBLT NIL 0 0 W GILEFT GIBOTTOM (ITIMES DXGRID GWIDTH)
GIHEIGHT
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(RESETGRID BM GRIDSPEC DXGRID BITSHIGH 0 0 W)))
(* Make a vertical adjustment)
(COND
((FLOATP DY)
(printout PROMPTWINDOW "Thumbing isn't implemented yet." T))
((ILESSP DY 0) (* determine how many squares to move down.)
(SETQ DYGRID (IMIN (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of BM)
EBMYLIMIT)
(GRIDYCOORD (IMIN GIHEIGHT (IPLUS WHEIGHT DY))
GRIDSPEC)))
(COND
((NOT (IGREATERP DYGRID 0)) (* top edge is at the top margin)
(RETURN)))
(WINDOWPROP W (QUOTE YOFFSET)
(SETQ EBMYOFFSET (IPLUS EBMYOFFSET DYGRID)))
(BITBLT W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT))
W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR)
(BITBLT NIL 0 0 W GILEFT (IPLUS GIBOTTOM (ITIMES (IDIFFERENCE BITSHIGH
DYGRID)
GHEIGHT))
SCREENWIDTH SCREENHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE GRIDINTERIOR)
(RESETGRID BM GRIDSPEC BITSWIDE DYGRID 0 (IDIFFERENCE BITSHIGH DYGRID)
W))
((ILESSP 0 DY) (* moving up; determine how may grid squares to move.)
(SETQ DYGRID (IMIN EBMYOFFSET (GRIDYCOORD (IMIN GIHEIGHT (IDIFFERENCE
WHEIGHT DY))
GRIDSPEC)))
(COND
((NOT (IGREATERP DYGRID 0)) (* bottom edge is at the bottom margin)
(RETURN)))
(WINDOWPROP W (QUOTE YOFFSET)
(SETQ EBMYOFFSET (IDIFFERENCE EBMYOFFSET DYGRID)))
(BITBLT W GILEFT GIBOTTOM W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT))
SCREENWIDTH SCREENHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)
NIL GRIDINTERIOR)
(BITBLT NIL 0 0 W GILEFT GIBOTTOM (fetch (REGION WIDTH) of GRIDINTERIOR)
(ITIMES DYGRID GHEIGHT)
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(RESETGRID BM GRIDSPEC BITSWIDE DYGRID 0 0 W)))
(GRID GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
W)
[COND
([OR (ILESSP EBMXOFFSET DXOFFSET)
(ILESSP EBMYOFFSET DYOFFSET)
[IGREATERP (IPLUS EBMXOFFSET BITSWIDE)
(IPLUS DXOFFSET (WINDOWPROP W (QUOTE BMDISPLAYWIDTH]
(IGREATERP (IPLUS EBMYOFFSET BITSHIGH)
(IPLUS DYOFFSET (WINDOWPROP W (QUOTE BMDISPLAYHEIGHT]
(* Adjust the display region left lower corner so the
selected region is near the center.)
[WINDOWPROP W (QUOTE DXOFFSET)
(SETQ DXOFFSET (IMAX 0
(IMIN (IDIFFERENCE (fetch (BITMAP
BITMAPWIDTH)
of BM)
(WINDOWPROP
W
(QUOTE BMDISPLAYWIDTH)
))
(IDIFFERENCE
(IPLUS EBMXOFFSET
(LRSH BITSWIDE 1))
(LRSH (WINDOWPROP W (QUOTE
BMDISPLAYWIDTH))
1]
(WINDOWPROP W (QUOTE DYOFFSET)
(SETQ DYOFFSET (IMAX 0
(IMIN (IDIFFERENCE (fetch (BITMAP
BITMAPHEIGHT)
of BM)
(WINDOWPROP
W
(QUOTE
BMDISPLAYHEIGHT)))
(IDIFFERENCE
(IPLUS EBMYOFFSET
(LRSH BITSHIGH 1))
(LRSH (WINDOWPROP W (QUOTE
BMDISPLAYHEIGHT))
1]
(UPDATE/BM/DISPLAY BM W])
(SHADEGRIDBOX
[LAMBDA (X Y SHADE OPERATION GRIDSPEC GRIDBORDER DS) (* rrb "13-JUN-82 16:48")
(* shades the interior of a grid box.)
(PROG ((BORDER (OR (FIXP GRIDBORDER)
0)))
(BITBLT NIL NIL NIL DS (IPLUS (LEFTOFGRIDCOORD X GRIDSPEC)
BORDER)
(IPLUS (BOTTOMOFGRIDCOORD Y GRIDSPEC)
BORDER)
(IDIFFERENCE (fetch (REGION WIDTH) of GRIDSPEC)
(ITIMES BORDER 2))
(IDIFFERENCE (fetch (REGION HEIGHT) of GRIDSPEC)
(ITIMES BORDER 2))
(QUOTE TEXTURE)
OPERATION SHADE) (* if this is POINT grid, set lower left corner.)
(COND
((EQ GRIDBORDER (QUOTE POINT))
(BITMAPBIT DS (LEFTOFGRIDCOORD X GRIDSPEC)
(BOTTOMOFGRIDCOORD Y GRIDSPEC)
1])
)
(* Low level compatibility and extensions)
(DEFINEQ
(CLEAR
[LAMBDA (BM TXT REG) (* bas: "21-APR-81 15:39")
(BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
(OR TXT WHITESHADE)
REG])
(INSIDE?
[LAMBDA (BOX X Y) (* rrb "19-MAR-82 09:32")
(AND (WITHIN (OR X LASTMOUSEX)
(fetch (REGION LEFT) of BOX)
(fetch (REGION WIDTH) of BOX))
(WITHIN (OR Y LASTMOUSEY)
(fetch (REGION BOTTOM) of BOX)
(fetch (REGION HEIGHT) of BOX])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(* Mouse selection code)
(DEFINEQ
(MOUSESTATE-EXPR
[LAMBDA (EXPR MOUSEONLYFLG) (* rrb "13-JUN-82 11:53")
(* if MOUSEONLYFLG is non-NIL, the testing should be done only on the mouse buttons. MOUSEONLYFLG will be passed
in as T by MOUSESTATE but will get reset if any of the names are not mouse button names.)
(PROG (NAMEMASK (MOUSEBUTTONMASK 7))
(RETURN (COND
[(NLISTP EXPR)
(COND
[(EQ EXPR (QUOTE UP))
(LIST (QUOTE ZEROP)
(COND
(MOUSEONLYFLG (LIST (QUOTE LOGAND)
MOUSEBUTTONMASK
(QUOTE LASTMOUSEBUTTONS)))
(T (QUOTE LASTMOUSEBUTTONS]
(T
(* MOUSEONLYFLG can be ignored on this branch because it is generating code for the case where the user is listing
the button names and if he includes keyset names you want to include them anyway.)
(LIST (QUOTE NEQ)
(LIST (QUOTE LOGAND)
(QUOTE LASTMOUSEBUTTONS)
(MOUSESTATE-NAME EXPR))
0]
((EQ (CAR EXPR)
(QUOTE ONLY))
(COND
((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR)
MOUSEONLYFLG)))
((SETQ NAMEMASK (MOUSESTATE-NAME (CADR EXPR)
NIL))
(* non-mouse buttons were named, use all keys.)
(SETQ MOUSEONLYFLG NIL)))
(LIST (QUOTE EQ)
(COND
(MOUSEONLYFLG (LIST (QUOTE LOGAND)
MOUSEBUTTONMASK
(QUOTE LASTMOUSEBUTTONS)))
(T (QUOTE LASTMOUSEBUTTONS)))
NAMEMASK))
([for I in EXPR always (AND (ATOM I)
(NEQ I (QUOTE UP]
(* Cant use LOGx trick for UP as it is a disjunct not a
key selector)
(SELECTQ (CAR EXPR)
[OR (LIST (QUOTE NEQ)
0
(LIST (QUOTE LOGAND)
(QUOTE LASTMOUSEBUTTONS)
(CONS (QUOTE LOGOR)
(for X in (CDR EXPR) collect (MOUSESTATE-NAME
X]
[AND (LIST (QUOTE EQ)
(CONS (QUOTE LOGOR)
(for X in (CDR EXPR) collect (MOUSESTATE-NAME X)))
(LIST (QUOTE LOGAND)
(QUOTE LASTMOUSEBUTTONS)
(CONS (QUOTE LOGOR)
(for X in (CDR EXPR) collect (MOUSESTATE-NAME
X]
[NOT (COND
((CDDR EXPR)
(SHOULDNT)))
(LIST (QUOTE ZEROP)
(LIST (QUOTE LOGAND)
(QUOTE LASTMOUSEBUTTONS)
(MOUSESTATE-NAME (CADR EXPR]
(HELP (CAR EXPR)
" unrecognized mouse key operator")))
(T (CONS (CAR EXPR)
(for OPT in (CDR EXPR) collect (MOUSESTATE-EXPR OPT MOUSEONLYFLG])
(MOUSESTATE-NAME
[LAMBDA (KEYNAME MOUSEONLYFLG) (* rrb "13-JUN-82 11:17")
(* return the numeric code for a mouse or keyset key.)
(SELECTQ KEYNAME
((LEFT RED)
4)
((RIGHT BLUE)
2)
((YELLOW MIDDLE)
1)
(COND
((NOT MOUSEONLYFLG) (* if wants mouse only, return NIL)
(SELECTQ KEYNAME
(LEFTKEY 128)
(LEFTMIDDLEKEY 64)
(MIDDLEKEY 32)
(RIGHTMIDDLEKEY 16)
(RIGHTKEY 8)
(HELP KEYNAME " is not a recognized key name."])
)
(PUTPROPS MOUSESTATE ARGNAMES (BUTTONFORM))
(PUTPROPS LASTMOUSESTATE ARGNAMES (BUTTONFORM))
(PUTPROPS UNTILMOUSESTATE ARGNAMES (BUTTONFORM INTERVAL))
(PUTPROPS KEYSETSTATE ARGNAMES (BUTTONFORM))
(PUTPROPS LASTKEYSETSTATE ARGNAMES (BUTTONFORM))
(DECLARE: DOCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN)
(QUOTE (GETMOUSESTATE))
(MOUSESTATE-EXPR (CAR ARGS)
T))))
(PUTPROPS LASTMOUSESTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS)
T)))
(PUTPROPS UNTILMOUSESTATE MACRO [ARGS (COND
[(AND (CDR ARGS)
(CADR ARGS)
(NEQ (CADR ARGS)
T)) (* time argument is given and is not T or NIL;
compile in time keeping loop.)
(LIST (QUOTE PROG)
[LIST (LIST (QUOTE TIMEOUT)
(LIST (QUOTE IPLUS)
(QUOTE (CLOCK 0))
(LIST (QUOTE OR)
(LIST (QUOTE NUMBERP)
(CADR ARGS))
100)))
(QUOTE (NOWTIME (CLOCK 0]
(QUOTE LP)
[LIST (QUOTE COND)
(LIST (CONS (QUOTE MOUSESTATE)
(LIST (CAR ARGS)
T))
(QUOTE (RETURN T]
[QUOTE (COND ((IGREATERP (CLOCK0 NOWTIME)
TIMEOUT)
(RETURN NIL))
(T (\BACKGROUND]
(QUOTE (GO LP]
(T (LIST (QUOTE PROG)
NIL
(QUOTE LP)
[LIST (QUOTE COND)
(LIST (CONS (QUOTE MOUSESTATE)
(LIST (CAR ARGS)
T))
(QUOTE (RETURN T]
(QUOTE (\BACKGROUND))
(QUOTE (GO LP])
(PUTPROPS KEYSETSTATE MACRO [ARGS (LIST (QUOTE PROGN)
(QUOTE (GETMOUSESTATE))
(MOUSESTATE-EXPR (CAR ARGS])
(PUTPROPS LASTKEYSETSTATE MACRO (ARGS (MOUSESTATE-EXPR (CAR ARGS))))
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS WITHIN MACRO [(A B C)
(AND (IGEQ A B)
(ILESSP A (IPLUS B C])
)
)
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)
(* END EXPORTED DEFINITIONS)
(* High Level Display utilities)
(DEFINEQ
(DECODEBUTTONS
[LAMBDA (BUTTONSTATE)
(DECLARE (GLOBALVARS LASTMOUSEBUTTONS)) (* rrb " 9-JAN-82 14:20")
(* return a list of the buttons and keys that are down
from a button state.)
(OR (SMALLP BUTTONSTATE)
(SETQ BUTTONSTATE LASTMOUSEBUTTONS))
(NCONC (AND (NEQ 0 (LOGAND BUTTONSTATE 4))
(CONS (QUOTE LEFT)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 2))
(CONS (QUOTE RIGHT)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 1))
(CONS (QUOTE MIDDLE)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 128))
(CONS (QUOTE LEFTKEY)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 64))
(CONS (QUOTE LEFTMIDDLEKEY)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 32))
(CONS (QUOTE MIDDLEKEY)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 16))
(CONS (QUOTE RIGHTMIDDLEKEY)))
(AND (NEQ 0 (LOGAND BUTTONSTATE 8))
(CONS (QUOTE RIGHTKEY])
)
(DEFINEQ
(GETPOSITION
[LAMBDA (WINDOW CURSOR) (* rmk: "18-JUL-83 13:13")
(* reads a point from a WINDOW if non-NIL or the screen.
Will change to cursor if given.)
(RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
(until (MOUSESTATE LEFT))
(until (MOUSESTATE (NOT LEFT)))
(COND
((NULL WINDOW)
(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY))
((OR (type? WINDOW WINDOW)
(\DISPLAYSTREAMP WINDOW))
(create POSITION
XCOORD ←(LASTMOUSEX WINDOW)
YCOORD ←(LASTMOUSEY WINDOW)))
[(EQ WINDOW T)
(create POSITION
XCOORD ←(LASTMOUSEX (TTYDISPLAYSTREAM))
YCOORD ←(LASTMOUSEY (TTYDISPLAYSTREAM]
(T (\ILLEGAL.ARG WINDOW])
(GETBOXPOSITION
[LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) (* rrb "14-MAY-82 11:59")
(* gets a box position, returning the lower left corner. During the moving the outline of the box is displayed.
If ORGX is given, the box is originally drawn at that location and the nearest corner to the cursor is snapped to
the cursor position.)
(RESETFORM (CURSOR BOXCURSOR)
(AND PROMPTMSG (PROMPTPRINT PROMPTMSG))
[COND
((AND (FIXP ORGX)
(FIXP ORGY)) (* origin given, snap cursor to nearest corner.)
(GETMOUSESTATE)
(\SETCURSORPOSITION (COND
((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT WIDTH 2)))
(IPLUS ORGX WIDTH))
(T ORGX))
(COND
((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT HEIGHT 2)))
(IPLUS ORGY HEIGHT))
(T ORGY]
(until (MOUSESTATE (NOT UP)))
[COND
((AND (FIXP ORGX)
(FIXP ORGY)) (* origin given, snap cursor to nearest corner.)
(GETMOUSESTATE)
[COND
((IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT WIDTH 2)))
(SETQ ORGX (IPLUS ORGX WIDTH))
(SETQ WIDTH (IMINUS WIDTH]
(COND
((IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT HEIGHT 2)))
(SETQ ORGY (IPLUS ORGY HEIGHT))
(SETQ HEIGHT (IMINUS HEIGHT]
(CURSOR CROSSHAIRS)
(SETQ ORGX LASTMOUSEX)
(SETQ ORGY LASTMOUSEY)
(COND
[[ERSETQ (first (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX WIDTH)
(IPLUS ORGY HEIGHT))
until (MOUSESTATE UP) unless (AND (IEQP ORGX LASTMOUSEX)
(IEQP ORGY LASTMOUSEY))
do (COND
((LASTMOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
(until (MOUSESTATE (NOT RIGHT)))
(* switch to drag nearest corner)
[COND
((COND
[(IGREATERP WIDTH 0)
(IGREATERP LASTMOUSEX (IPLUS ORGX (IQUOTIENT WIDTH 2]
(T (IGREATERP (IPLUS ORGX (IQUOTIENT WIDTH 2))
LASTMOUSEX)))
(* switch X)
(SETQ ORGX (IPLUS ORGX WIDTH))
(SETQ WIDTH (IMINUS WIDTH]
[COND
((COND
[(IGREATERP HEIGHT 0)
(IGREATERP LASTMOUSEY (IPLUS ORGY (IQUOTIENT HEIGHT 2]
(T (IGREATERP (IPLUS ORGY (IQUOTIENT HEIGHT 2))
LASTMOUSEY)))
(* switch Y)
(SETQ ORGY (IPLUS ORGY HEIGHT))
(SETQ HEIGHT (IMINUS HEIGHT]
(\SETCURSORPOSITION ORGX ORGY))
(T (DRAWGRAYBOX ORGX ORGY (IPLUS ORGX WIDTH)
(IPLUS ORGY HEIGHT))
(* Erase old box, make new one)
(DRAWGRAYBOX (SETQ ORGX LASTMOUSEX)
(SETQ ORGY LASTMOUSEY)
(IPLUS ORGX WIDTH)
(IPLUS ORGY HEIGHT]
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX WIDTH)
(IPLUS ORGY HEIGHT))
(AND PROMPTMSG (CLRPROMPT))
(COND
(WINDOW (create POSITION
XCOORD ←(DSPXSCREENTOWINDOW (IMIN ORGX (IPLUS ORGX WIDTH))
WINDOW)
YCOORD ←(DSPYSCREENTOWINDOW (IMIN ORGY (IPLUS ORGY HEIGHT))
WINDOW)))
(T (create POSITION
XCOORD ←(IMIN ORGX (IPLUS ORGX WIDTH))
YCOORD ←(IMIN ORGY (IPLUS ORGY HEIGHT]
(T (* ↑E take down box)
(DRAWGRAYBOX ORGX ORGY (IPLUS ORGX WIDTH)
(IPLUS ORGY HEIGHT))
(ERROR!])
(DSPYSCREENTOWINDOW
[LAMBDA (Y DS) (* rrb "14-MAY-82 11:34")
(* transforms an y coordinate from screen coordinates
into window coordinates)
(IDIFFERENCE Y (fetch \SFYOFFSET of (\SFInsureDisplayStream DS])
(DSPXSCREENTOWINDOW
[LAMBDA (X DS) (* rrb "14-MAY-82 11:35")
(* transforms an x coordinate from screen coordinates
into window coordinates)
(IDIFFERENCE X (fetch \SFXOFFSET of (\SFInsureDisplayStream DS])
(GETREGION
[LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG)
(* rrb "29-APR-83 09:09")
(* accepts region from the user.)
(RESETFORM (CURSOR EXPANDINGBOX)
(PROG [BASEX BASEY OPPX OPPY BASEPT OPPT NEWMOUSEX NEWMOUSEY
(NEWREGFNS (COND
((LISTP NEWREGIONFN)
NEWREGIONFN)
(NEWREGIONFN (LIST NEWREGIONFN))
(T NIL]
(COND
((AND INITREGION (PROGN (* A region to use if user bugs yellow)
(until (MOUSESTATE (NOT UP)))
(LASTMOUSESTATE MIDDLE)))
(* Pull from closest corner, ie.
set BASEX,Y to be opposite corner)
(SETQ BASEX (fetch (REGION LEFT) of INITREGION))
(SETQ OPPX (IPLUS BASEX (fetch (REGION WIDTH) of INITREGION)))
(COND
((ILESSP LASTMOUSEX (IPLUS BASEX (IQUOTIENT (fetch (REGION WIDTH)
of INITREGION)
2)))
(* pointing at left half of box, so make origin be in
right)
(swap BASEX OPPX)))
(SETQ BASEY (fetch (REGION BOTTOM) of INITREGION))
(SETQ OPPY (IPLUS BASEY (fetch (REGION HEIGHT) of INITREGION)))
(COND
((ILESSP LASTMOUSEY (IPLUS BASEY (IQUOTIENT (fetch (REGION HEIGHT)
of INITREGION)
2)))
(swap BASEY OPPY))) (* Now draw the initial box)
)
(T (until (MOUSESTATE (NOT UP)))
(SETQ BASEX LASTMOUSEX)
(SETQ BASEY LASTMOUSEY)
(SETQ OPPX BASEX)
(SETQ OPPY BASEY))) (* if the new region fns is a list, apply them in
order.)
(for FN in NEWREGFNS
do (* call user fn on base pt)
(SETQ BASEPT (APPLY* FN (create POSITION
XCOORD ← BASEX
YCOORD ← BASEY)
NIL NEWREGIONFNARG))
(SETQ BASEX (fetch XCOORD of BASEPT))
(SETQ BASEY (fetch YCOORD of BASEPT))
(SETQ OPPT (APPLY* FN BASEPT (create POSITION
XCOORD ← OPPX
YCOORD ← OPPY)
NEWREGIONFNARG))
(SETQ OPPX (fetch XCOORD of OPPT))
(SETQ OPPY (fetch YCOORD of OPPT)))
(DRAWGRAYBOX BASEX BASEY OPPX OPPY)
(COND
[[ERSETQ (until (MOUSESTATE UP) unless (AND (IEQP OPPX LASTMOUSEX)
(IEQP OPPY LASTMOUSEY))
do (COND
((MOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
(until (MOUSESTATE (NOT RIGHT)))
(* Switch to nearest corner)
[COND
((IGEQ (IABS (IDIFFERENCE LASTMOUSEX OPPX))
(IABS (IDIFFERENCE LASTMOUSEX BASEX)))
(SETQ BASEX (PROG1 OPPX (SETQ OPPX BASEX]
[COND
((IGEQ (IABS (IDIFFERENCE LASTMOUSEY OPPY))
(IABS (IDIFFERENCE LASTMOUSEY BASEY)))
(SETQ BASEY (PROG1 OPPY (SETQ OPPY BASEY]
(\SETCURSORPOSITION OPPX OPPY)
(COND
(NEWREGFNS (* takedown box because user functions may change any of
its coordinates.)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY)
(for FN in NEWREGFNS
do
(* call user fn on new base pt)
(SETQ BASEPT
(APPLY* FN
(create POSITION
XCOORD ← BASEX
YCOORD ← BASEY)
NIL NEWREGIONFNARG))
(SETQ BASEX (fetch XCOORD of BASEPT))
(SETQ BASEY (fetch YCOORD of BASEPT))
(SETQ OPPT
(APPLY* FN BASEPT
(create POSITION
XCOORD ← OPPX
YCOORD ← OPPY)
NEWREGIONFNARG))
(SETQ OPPX (fetch XCOORD of OPPT))
(SETQ OPPY (fetch YCOORD of OPPT)))
(* draw box back)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY)))
(SETCORNER BASEX BASEY OPPX OPPY))
(T (COND
[NEWREGIONFN (SETQ OPPT
(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY smashing
OPPT))
(for FN in NEWREGFNS
do (SETQ OPPT
(APPLY* FN BASEPT OPPT
NEWREGIONFNARG))
(COND
((NOT (POSITIONP OPPT))
(ERROR
"non-POSITION returned by NEWREGIONFN"
OPPT))
(T (SETQ NEWMOUSEX
(fetch XCOORD of OPPT))
(SETQ NEWMOUSEY
(fetch YCOORD of OPPT]
(T (SETQ NEWMOUSEX LASTMOUSEX)
(SETQ NEWMOUSEY LASTMOUSEY)))
(COND
((OR (NEQ NEWMOUSEX OPPX)
(NEQ NEWMOUSEY OPPY))
(* refresh if position changes.)
(MOVEBOX BASEX BASEY OPPX OPPY NEWMOUSEX NEWMOUSEY)
(SETQ OPPX NEWMOUSEX)
(* save for next pass)
(SETQ OPPY NEWMOUSEY)
(SETCORNER BASEX BASEY OPPX OPPY]
(* erase box image.)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY)
(RETURN (create REGION
LEFT ←(IMIN BASEX OPPX)
BOTTOM ←(IMIN BASEY OPPY)
WIDTH ←[COND
[MINWIDTH (IMAX MINWIDTH (IABS (IDIFFERENCE OPPX BASEX]
(T (IABS (IDIFFERENCE OPPX BASEX]
HEIGHT ←(COND
[MINHEIGHT (IMAX MINHEIGHT (IABS (IDIFFERENCE BASEY OPPY]
(T (IABS (IDIFFERENCE BASEY OPPY]
(T (* ↑E take down box.)
(DRAWGRAYBOX BASEX BASEY OPPX OPPY)
(ERROR!])
(GETBOXREGION
[LAMBDA (WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG) (* edited: "17-SEP-82 09:36")
(* returns a region width by height positioned where
user says.)
(PROG ((POS (GETBOXPOSITION WIDTH HEIGHT ORGX ORGY WINDOW PROMPTMSG)))
(RETURN (create REGION
LEFT ←(fetch (POSITION XCOORD) of POS)
BOTTOM ←(fetch (POSITION YCOORD) of POS)
WIDTH ← WIDTH
HEIGHT ← HEIGHT])
(MOVEBOX
[LAMBDA (X1 Y1 X2 Y2 X3 Y3) (* rrb " 6-AUG-81 09:09")
(* moves the opposite corner of a box from {X2,Y2} to
{X3,Y3}.)
(BLTHLINE Y1 X2 X3)
(BLTVLINE X1 Y2 Y3)
(BLTHLINE Y2 X1 X2)
(BLTHLINE Y3 X1 X3)
(BLTVLINE X2 Y1 Y2)
(BLTVLINE X3 Y1 Y3])
(DRAWGRAYBOX
[LAMBDA (X1 Y1 X2 Y2 W) (* jds "28-APR-82 09:25")
(* Put a gray box in window W
(or on screen, if W←NIL))
(BLTHLINE Y1 X1 X2 W)
(BLTVLINE X1 Y1 Y2 W)
(BLTHLINE Y2 X1 X2 W)
(BLTVLINE X2 Y1 Y2 W])
(BLTHLINE
[LAMBDA (Y XA XB W) (* bvm: "31-MAY-82 14:00")
(BITBLT NIL NIL NIL (OR W (SCREENBITMAP))
(IMIN XA XB)
Y
(IABS (IDIFFERENCE XB XA))
2
(QUOTE TEXTURE)
(QUOTE INVERT)
GRAYSHADE])
(BLTVLINE
[LAMBDA (X YA YB W) (* bvm: "31-MAY-82 14:06")
(BITBLT NIL NIL NIL (OR W (SCREENBITMAP))
X
(IMIN YA YB)
2
(IABS (IDIFFERENCE YB YA))
(QUOTE TEXTURE)
(QUOTE INVERT)
GRAYSHADE])
(SETCORNER
[LAMBDA (X1 Y1 X2 Y2) (* rrb " 4-NOV-81 15:32")
(* sets the cursor shape for the box from x1,y1 to x2,
y2)
(DECLARE (GLOBALVARS LowerLeftCursor LowerRightCursor UpperLeftCursor UpperRightCursor))
(SETCURSOR (COND
((IGREATERP X2 X1) (* moving to left)
(COND
((IGREATERP Y2 Y1) (* moving up)
UpperRightCursor)
(T LowerRightCursor)))
(T (* moving to right)
(COND
((IGREATERP Y2 Y1)
UpperLeftCursor)
(T LowerLeftCursor])
)
(DEFINEQ
(NEAREST/PT/ON/GRID
[LAMBDA (PT GRIDN) (* rrb " 6-AUG-81 08:45")
(* finds the point on a grid of multiple GRIDN closest
to PT.)
(create POSITION
XCOORD ←(NEAREST/MULTIPLE (fetch XCOORD of PT)
GRIDN)
YCOORD ←(NEAREST/MULTIPLE (fetch YCOORD of PT)
GRIDN)
smashing PT])
(PTON10GRID
[LAMBDA (FIXEDPT MOVINGPT) (* rrb " 6-AUG-81 08:45")
(* insists that a pt be on a 10 grid)
(COND
(MOVINGPT (NEAREST/PT/ON/GRID MOVINGPT 10))
(T (NEAREST/PT/ON/GRID FIXEDPT 10])
(NEAREST/MULTIPLE
[LAMBDA (X N) (* rrb " 6-AUG-81 08:42")
(* finds the multiple of N that is nearest to X)
(COND
((IGREATERP X 0)
(ITIMES (IQUOTIENT (IPLUS X (IQUOTIENT N 2))
N)
N))
(T (ITIMES (IQUOTIENT (IDIFFERENCE X (IQUOTIENT N 2))
N)
N])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS IABS MACRO [OPENLAMBDA (A)
(COND
((IGEQ A 0)
A)
(T (IMINUS A])
)
(* END EXPORTED DEFINITIONS)
(RPAQ CROSSHAIRS (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@GL@"
"AMG@"
"CAAH"
"FA@L"
"DA@D"
"LA@F"
"HA@B"
"OOON"
"HA@B"
"LA@F"
"DA@D"
"FA@L"
"CAAH"
"AMG@"
"@GL@")(RPAQ EXPANDINGBOX (CURSORCREATE (READBITMAP) 0 13))
(16 16
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"N@@@"
"O@@@"
"OHNG"
"OLLC"
"ONKM"
"O@BD"
"MHBD"
"IHKM"
"@LLC"
"@LNG"
"@F@@"
"@F@@")(RPAQ BOXCURSOR (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@@@@"
"COOL"
"COOL"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"C@@L"
"COOL"
"COOL"
"@@@@"
"@@@@")(RPAQ LOCKEDSPOT (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@@@@"
"COOL"
"COOL"
"C@@L"
"C@@L"
"CCLL"
"CCLL"
"CCLL"
"CCLL"
"C@@L"
"C@@L"
"COOL"
"COOL"
"@@@@"
"@@@@")(RPAQ OLDEXPANDINGBOX (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"OHCN"
"N@@N"
"O@AN"
"KHCJ"
"IMGB"
"@ON@"
"@DD@"
"@LF@"
"@DD@"
"@ON@"
"IMGB"
"KHCJ"
"O@AN"
"N@@N"
"OHCN")(RPAQ LowerLeftCursor (CURSORCREATE (READBITMAP) 0 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"OOL@"
"OON@")(RPAQ UpperRightCursor (CURSORCREATE (READBITMAP) 15 15))
(16 16
"@COO"
"@AOO"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@A"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ UpperLeftCursor (CURSORCREATE (READBITMAP) 0 15))
(16 16
"OOL@"
"OOH@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"L@@@"
"H@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ LowerRightCursor (CURSORCREATE (READBITMAP) 15 0))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@A"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@@@C"
"@COO"
"@GOO")(DEFINEQ
(\SW2BM
[LAMBDA (P PR Q QR) (* bas: "21-OCT-82 16:53")
(* Switches the areas of P and Q defined by the regions
PR and QR respectively)
(PROG (PL PH PW PB QL QH QW QB)
(if PR
then (SETQ PL (fetch LEFT of PR))
(SETQ PB (fetch BOTTOM of PR))
(SETQ PH (fetch HEIGHT of PR))
(SETQ PW (fetch WIDTH of PR))
else (SETQ PL (SETQ PB 0))
(SETQ PW (fetch BITMAPWIDTH of P))
(SETQ PH (fetch BITMAPHEIGHT of P)))
(if QR
then (SETQ QL (fetch LEFT of QR))
(SETQ QB (fetch BOTTOM of QR))
(SETQ QW (fetch WIDTH of QR))
(SETQ QH (fetch HEIGHT of QR))
else (SETQ QL (SETQ QB 0))
(SETQ QW (fetch BITMAPWIDTH of Q))
(SETQ QH (fetch BITMAPHEIGHT of Q)))
(PROG ((CL (IMAX (IMINUS PL)
(IMINUS QL)
0))
(CB (IMAX (IMINUS PB)
(IMINUS QB)
0)))
(PROG ((XP (IPLUS CL PL))
(YP (IPLUS CB PB))
(XQ (IPLUS CL QL))
(YQ (IPLUS CB QB))
CW CH)
(SETQ CW (IMIN (IDIFFERENCE (IMIN (fetch BITMAPWIDTH of P)
(IPLUS PL PW))
XP)
(IDIFFERENCE (IMIN (fetch BITMAPWIDTH of Q)
(IPLUS QL QW))
XQ)))
(SETQ CH (IMIN (IDIFFERENCE (IMIN (fetch BITMAPHEIGHT of P)
(IPLUS PB PH))
YP)
(IDIFFERENCE (IMIN (fetch BITMAPHEIGHT of Q)
(IPLUS QB QH))
YQ)))
(UNINTERRUPTABLY
(BITBLT P XP YP Q XQ YQ CW CH (QUOTE INPUT)
(QUOTE INVERT))
(BITBLT Q XQ YQ P XP YP CW CH (QUOTE INPUT)
(QUOTE INVERT))
(BITBLT P XP YP Q XQ YQ CW CH (QUOTE INPUT)
(QUOTE INVERT)))])
(COMPOSEREGS
[LAMBDA (INNER OUTER) (* rrb "19-MAR-82 09:35")
(* Converts INNER from OUTER relative coords to same
units as OUTER -
inverse of TRANSLATEREGS)
(create REGION
LEFT ←(IPLUS (fetch (REGION LEFT) of OUTER)
(fetch (REGION LEFT) of INNER))
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of OUTER)
(fetch (REGION BOTTOM) of INNER))
using INNER])
(TRANSLATEREG
[LAMBDA (INNER OUTER) (* rrb "19-MAR-82 09:35")
(* Translates a nested INNER region to OUTER region
relative coordinates)
(create REGION
LEFT ←(IDIFFERENCE (fetch (REGION LEFT) of INNER)
(fetch (REGION LEFT) of OUTER))
BOTTOM ←(IDIFFERENCE (fetch (REGION BOTTOM) of INNER)
(fetch (REGION BOTTOM) of OUTER))
WIDTH ←(fetch (REGION WIDTH) of INNER)
HEIGHT ←(fetch (REGION HEIGHT) of INNER])
)
(* Bitmap and shade editors)
(DEFINEQ
(EDITBM
[LAMBDA (BMSPEC) (* rrb "11-AUG-83 12:34")
(* edits a bitmap)
(* the edit part of the display is from 0 to MAXGRIDWIDTH in width and from 0 to MAXGRIDHEIGHT in height.
The commands and display area for the bitmap being edited are above the edit region.)
(PROG (BMW BMWINTERIOR BMWWIDTH BMWHEIGHT WIDTH HEIGHT BM CR ORIGBM GRIDSQUARE ORIGBPP)
(* set ORIGBM to the input bitmap if any and BM to a
copy of it for editting.)
[COND
((OR (EQ BMSPEC CursorBitMap)
(AND (EQ BMSPEC (QUOTE CursorBitMap))
(SETQ BMSPEC CursorBitMap))) (* editting cursor, save old value and make changes to
the original.)
(SETQ ORIGBM (BITMAPCOPY CursorBitMap))
(SETQ BM CursorBitMap))
[(BITMAPP BMSPEC)
(SETQ BM (BITMAPCOPY (SETQ ORIGBM BMSPEC]
[(LITATOM BMSPEC)
(COND
([BITMAPP (SETQ ORIGBM (EVALV BMSPEC (QUOTE EDITBM]
(* use value.)
(SETQ BM (BITMAPCOPY ORIGBM)))
(T (SETQ ORIGBM NIL)
(SETQ BM (\READBMDIMENSIONS]
((REGIONP BMSPEC) (* if BMSPEC is a region, treat it as a region of the
screen.)
[SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of BMSPEC)
(fetch (REGION HEIGHT) of BMSPEC)
(BITSPERPIXEL (SCREENBITMAP]
(* note that bm has initial bits in it.)
(SETQ ORIGBM BMSPEC)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of BMSPEC)
(fetch (REGION BOTTOM) of BMSPEC)
BM 0 0 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)))
((WINDOWP BMSPEC)
(SETQ ORIGBM BMSPEC)
[SETQ BM (BITMAPCREATE (WINDOWPROP BMSPEC (QUOTE WIDTH))
(WINDOWPROP BMSPEC (QUOTE HEIGHT]
(* open the window and bring it to the top.)
(TOTOPW BMSPEC)
(SETQ CR (DSPCLIPPINGREGION NIL BMSPEC))
(BITBLT BMSPEC (fetch LEFT of CR)
(fetch BOTTOM of CR)
BM 0 0 (fetch WIDTH of CR)
(fetch HEIGHT of CR)))
(T (* otherwise create a bitmap)
(SETQ BM (\READBMDIMENSIONS]
(SETQ HEIGHT (fetch BITMAPHEIGHT of BM)) (* get and use width in bits not pixels.)
(SETQ WIDTH (fetch BITMAPWIDTH of BM)) (* calculate a default window size.)
(* start by calculating the grid size from the bitmap
size.)
(SETQ GRIDSQUARE (IMAX (IMIN (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES SCREENWIDTH 2)
3)
GRIDTHICKNESS)
WIDTH)
(IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES SCREENHEIGHT 2)
3)
(ITIMES GRIDTHICKNESS 2))
(ADD1 HEIGHT))
NORMALGRIDSQUARE)
MINGRIDSQUARE))
(SETQ BMWWIDTH (IMIN (IPLUS (ITIMES GRIDSQUARE WIDTH)
GRIDTHICKNESS)
(IQUOTIENT (ITIMES SCREENWIDTH 2)
3)))
(SETQ BMWHEIGHT (IMIN (IPLUS (ITIMES HEIGHT (ADD1 GRIDSQUARE))
(ITIMES GRIDTHICKNESS 2)
1)
(IQUOTIENT (ITIMES SCREENHEIGHT 2)
3)))
(SETQ BMW (CREATEW (GETBOXREGION (WIDTHIFWINDOW BMWWIDTH)
(HEIGHTIFWINDOW BMWHEIGHT T)
(IQUOTIENT (IDIFFERENCE SCREENWIDTH BMWWIDTH)
2)
(IQUOTIENT (IDIFFERENCE SCREENHEIGHT BMWHEIGHT)
2)
NIL "Indicate the position for the Bitmap Edit window.")
"Bitmap Editor"))
(WINDOWPROP BMW (QUOTE BM)
BM)
(WINDOWPROP BMW (QUOTE SCROLLFN)
(FUNCTION EDITBMSCROLLFN))
(WINDOWPROP BMW (QUOTE RESHAPEFN)
(FUNCTION EDITBMRESHAPEFN))
(WINDOWPROP BMW (QUOTE REPAINTFN)
(FUNCTION EDITBMREPAINTFN))
(WINDOWPROP BMW (QUOTE BUTTONEVENTFN)
(FUNCTION EDITBMBUTTONFN))
(WINDOWPROP BMW (QUOTE CLOSEFN)
(FUNCTION EDITBMCLOSEFN))
(WINDOWPROP BMW (QUOTE XOFFSET)
0)
(WINDOWPROP BMW (QUOTE YOFFSET)
0)
(WINDOWPROP BMW (QUOTE DXOFFSET)
0)
(WINDOWPROP BMW (QUOTE DYOFFSET)
0)
(WINDOWPROP BMW (QUOTE ORIGINALBITMAP)
ORIGBM)
(WINDOWPROP BMW (QUOTE FINISHEDFLG)
NIL)
(SETQ ORIGBPP (fetch (BITMAP BITMAPBITSPERPIXEL) of BM))
(* save the actual number of bits per pixel and set it to 1 in the bitmap being editted so that it can be BITBLT
ed on the screen.)
(replace (BITMAP BITMAPBITSPERPIXEL) of BM with 1)
(* call reshapefn to initialize the display and values)
(EDITBMRESHAPEFN BMW NIL NIL (NOT ORIGBM)) (* start a mouse process in case this process is the
mouse process.)
(SPAWN.MOUSE)
(while (NOT (WINDOWPROP BMW (QUOTE FINISHEDFLG))) do (DISMISS 500))
(* remove the closefn before closing the window.)
(WINDOWPROP BMW (QUOTE CLOSEFN)
NIL)
(CLOSEW BMW)
(replace (BITMAP BITMAPBITSPERPIXEL) of BM with ORIGBPP)
(RETURN (COND
((EQ T (WINDOWPROP BMW (QUOTE FINISHEDFLG)))
(* editor exited via ok, stuff contents into original
bitmap.)
(COND
((EQ BMSPEC CursorBitMap) (* editting happened in original, leave it alone.)
CursorBitMap)
((REGIONP ORIGBM) (* put it back into the screen.)
(BITBLT BM 0 0 (SCREENBITMAP)
(fetch (REGION LEFT) of ORIGBM)
(fetch (REGION BOTTOM) of ORIGBM)
(fetch (REGION WIDTH) of ORIGBM)
(fetch (REGION HEIGHT) of ORIGBM)
(QUOTE INPUT)
(QUOTE REPLACE))
BM)
((WINDOWP ORIGBM) (* put it back into the window)
(BITBLT BM 0 0 ORIGBM (fetch (REGION LEFT) of CR)
(fetch (REGION BOTTOM) of CR)
(fetch (REGION WIDTH) of CR)
(fetch (REGION HEIGHT) of CR)
(QUOTE INPUT)
(QUOTE REPLACE))
BM)
(ORIGBM (BITBLT BM 0 0 ORIGBM 0 0 WIDTH HEIGHT)
[COND
((AND BMSPEC (LITATOM BMSPEC))
(* if spec was an atom without a bm value, set it.
in the environment above EDITBM.)
(MARKASCHANGED BMSPEC (QUOTE VARS))
(STKEVAL (QUOTE EDITBM)
(LIST (QUOTE SETQQ)
BMSPEC BM]
ORIGBM)
(T BM)))
(T (* error exit, if cursor return it to original value.)
(COND
((EQ BMSPEC CursorBitMap)
(BITBLT ORIGBM NIL NIL CursorBitMap)))
(ERROR!])
(EDITBMCLOSEFN
[LAMBDA (BMW) (* rrb "21-MAR-83 18:58")
(* the close function for a bitmap edit window.
For now do what a STOP would have done.)
(WINDOWPROP BMW (QUOTE FINISHEDFLG)
(QUOTE KILL])
(TILEAREA
[LAMBDA (LFT BTM WDTH HGHT SRCBM WIN) (* rrb "20-JUN-82 17:01")
(* lays tiles out in an area of a window.)
(PROG ((X LFT)
(Y BTM)
(RGHT (IPLUS LFT WDTH))
(TOP (IPLUS BTM HGHT))
(W (fetch BITMAPWIDTH of SRCBM))
(H (fetch BITMAPHEIGHT of SRCBM)))
(while (ILESSP X RGHT) do (SETQ Y BTM)
(while (ILESSP Y TOP)
do (BITBLT SRCBM 0 0 WIN X Y W H NIL (QUOTE REPLACE))
(add Y H))
(add X W])
(EDITBMBUTTONFN
[LAMBDA (W) (* rrb "31-MAR-83 17:34")
(* inner function of bitmap editor.)
(PROG [GRIDX0 GRIDY0 BITMAPWIDTH BITMAPHEIGHT NEWGRIDSIZE PAINTW ORIGBM
(GRIDSPEC (WINDOWPROP W (QUOTE GRIDSPEC)))
(GRIDINTERIOR (WINDOWPROP W (QUOTE GRIDINTERIOR)))
(BM (WINDOWPROP W (QUOTE BM)))
(BITSWIDE (WINDOWPROP W (QUOTE BITSWIDE)))
(BITSHIGH (WINDOWPROP W (QUOTE BITSHIGH)))
(WREGION (WINDOWPROP W (QUOTE REGION)))
(XOFFSET (WINDOWPROP W (QUOTE XOFFSET)))
(YOFFSET (WINDOWPROP W (QUOTE YOFFSET)))
(DISPLAYREGION (WINDOWPROP W (QUOTE DISPLAYREGION]
(SETQ GRIDX0 (fetch (REGION LEFT) of GRIDSPEC))
(SETQ GRIDY0 (fetch (REGION BOTTOM) of GRIDSPEC))
(SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of BM))
(SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of BM))
(* mark the region of the bitmap that is being editted.)
(COND
((INSIDE? GRIDINTERIOR (LASTMOUSEX W)
(LASTMOUSEY W)) (* if cursor is inside, shade it.)
(\SHADEBITS BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH))
((INSIDE? DISPLAYREGION (LASTMOUSEX W)
(LASTMOUSEY W)) (* Run the menu foe re-windowing into the whole bitmap)
(SELECTQ [MENU (COND
((type? MENU EDITBMWINDOWMENU)
EDITBMWINDOWMENU)
((SETQ EDITBMWINDOWMENU (create MENU
ITEMS ←(QUOTE ((Move (QUOTE Move)
"Selects a different part of the bitmap to be editting.")))
CENTERFLG ← T]
(Move (* move the editing window's location on the bitmap.)
(PROG [(POS (GETBOXPOSITION BITSWIDE BITSHIGH
[IPLUS 4 (fetch LEFT of WREGION)
(IDIFFERENCE XOFFSET
(WINDOWPROP
W
(QUOTE DXOFFSET]
(IPLUS (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
(IDIFFERENCE YOFFSET
(WINDOWPROP
W
(QUOTE DYOFFSET)))
4
(fetch BOTTOM of WREGION]
(WINDOWPROP W (QUOTE XOFFSET)
(IMIN (IDIFFERENCE BITMAPWIDTH BITSWIDE)
(IMAX [IPLUS (WINDOWPROP W (QUOTE DXOFFSET))
(IDIFFERENCE (fetch XCOORD
of POS)
(IPLUS 4
(fetch LEFT
of WREGION]
0)))
[WINDOWPROP
W
(QUOTE YOFFSET)
(IMAX 0
(IMIN (IDIFFERENCE BITMAPHEIGHT BITSHIGH)
(IDIFFERENCE (IPLUS (WINDOWPROP W (QUOTE DYOFFSET))
(IDIFFERENCE
(fetch YCOORD of POS)
(IPLUS (fetch BOTTOM
of WREGION)
4)))
(WINDOWPROP W (QUOTE BMDISPLAYBOTTOM]
(DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
W)
(UPDATE/BM/DISPLAY BM W)
(GRID GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
W)
(RESETGRID BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W)))
NIL))
((LASTMOUSESTATE LEFT)
(UPDATE/BM/DISPLAY/SELECTED/REGION W)
[RESETFORM (CURSOR (CURSORCREATE BM (CURSORHOTSPOT)))
(until (MOUSESTATE (NOT LEFT]
(UPDATE/BM/DISPLAY/SELECTED/REGION W))
(T (* the region being editted is inverted while the menu
is active. Each command must make sure that it is
recomplemented.)
(UPDATE/BM/DISPLAY/SELECTED/REGION W)
(SELECTQ [MENU (COND
((type? MENU EDITBMMENU)
EDITBMMENU)
(T (SETQ EDITBMMENU (create MENU
ITEMS ←(QUOTE ((Paint (QUOTE Paint)
"Calls the window PAINT command on the bitmap.")
(ShowAsTile (QUOTE
ShowAsTile)
"tiles the upper part of the edit window with the bitmap.")
(GridSize←(QUOTE
GridSize←)
"Allows setting of the size of a bit in the edit area.")
(Reset (QUOTE Reset)
"Sets the bitmap back to the state at the start of this edit session.")
(Clear (QUOTE Clear)
"Sets the entire bitmap to 0")
(Cursor←(QUOTE Cursor←)
"Puts the bitmap into the cursor and exits the editor.")
(OK (QUOTE OK)
"Leaves the edit session.")
(Stop (QUOTE Stop)
"Restores the bitmap to its original values and leaves the editor.")))
CENTERFLG ← T]
(OK (WINDOWPROP W (QUOTE FINISHEDFLG)
T))
(Stop (WINDOWPROP W (QUOTE FINISHEDFLG)
(QUOTE KILL)))
[Reset (* allow the user to choose between everything or just
visible part. This also give the user a chance to change
their mind.)
(COND
((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "RESET how much?")
(VISIBLE (COND
[(SETQ ORIGBM (WINDOWPROP W (QUOTE
ORIGINALBITMAP)))
(COND
((REGIONP ORIGBM)
(BITBLT (SCREENBITMAP)
(IPLUS XOFFSET
(fetch (REGION LEFT)
of ORIGBM))
(IPLUS YOFFSET
(fetch (REGION BOTTOM)
of ORIGBM))
BM XOFFSET YOFFSET BITSWIDE
BITSHIGH (QUOTE INPUT)
(QUOTE REPLACE)))
(T (BITBLT ORIGBM XOFFSET YOFFSET BM
XOFFSET YOFFSET BITSWIDE
BITSHIGH]
(T (BITBLT NIL NIL NIL BM XOFFSET YOFFSET
BITSWIDE BITSHIGH (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)))
T)
(WHOLE (COND
[(SETQ ORIGBM (WINDOWPROP W (QUOTE ORIGINALBITMAP)
))
(COND
((REGIONP ORIGBM)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of ORIGBM)
(fetch (REGION BOTTOM)
of ORIGBM)
BM))
(T (BITBLT ORIGBM NIL NIL BM]
(T (CLEAR BM)))
T)
(PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W)
NIL))
(\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE
BITSHIGH]
[Clear (* allow the user to choose between everything or just
visible part. This also give the user a chance to change
their mind.)
(COND
((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "CLEAR how much?")
(VISIBLE (BITBLT NIL NIL NIL BM XOFFSET YOFFSET BITSWIDE
BITSHIGH (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
T)
(WHOLE (CLEAR BM)
T)
(PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W)
NIL))
(DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
W)
(GRID GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
W)
(UPDATE/BM/DISPLAY BM W]
[GridSize← (* sets the grid square size and calls the reshapefn.)
(COND
([SETQ NEWGRIDSIZE
(NUMBERP (MENU (COND
((TYPENAMEP GRIDSIZEMENU (QUOTE MENU))
GRIDSIZEMENU)
(T (SETQ GRIDSIZEMENU
(create MENU
ITEMS ←(QUOTE (3 4 5 6 7 8 12
16 20 24 28
32))
MENUROWS ← 4]
(WINDOWPROP W (QUOTE GRIDSQUARE)
NEWGRIDSIZE)
(EDITBMRESHAPEFN W]
(ShowAsTile (* tiles the upper part of the window with the bitmap so
the user can see what it would be as a shade.)
(UPDATE/SHADE/DISPLAY BM W))
[Paint (* call the window paint command on the contents of the
bitmap.)
[SETQ PAINTW (CREATEW (create REGION
LEFT ←(IQUOTIENT (IDIFFERENCE
SCREENWIDTH
BITMAPWIDTH)
2)
BOTTOM ←(IQUOTIENT (IDIFFERENCE
SCREENHEIGHT
BITMAPHEIGHT)
2)
WIDTH ←(WIDTHIFWINDOW BITMAPWIDTH)
HEIGHT ←(HEIGHTIFWINDOW BITMAPHEIGHT NIL]
(OPENW PAINTW)
(BITBLT BM 0 0 PAINTW)
(PAINTW PAINTW)
(COND
((MENU (create MENU
ITEMS ←(QUOTE ((YES T
"Will put the newly painted bits back in the bitmap being editted.")
(NO NIL
"Will discard the painted bits, not changing the bitmap being editted.")))
TITLE ← "Put change into bitmap?"
CENTERFLG ← T))
(BITBLT PAINTW 0 0 BM)
(CLOSEW PAINTW) (* set PAINTW so that space can be reclaimed)
(SETQ PAINTW)
(\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE
BITSHIGH]
(Cursor← (* Stuffs lower left part of image into the cursor and
sets the hotspot.)
(READHOTSPOT BM GRIDSPEC GRIDINTERIOR W)
(WINDOWPROP W (QUOTE FINISHEDFLG)
T))
(UPDATE/BM/DISPLAY/SELECTED/REGION W])
(\EDITBM/PUTUP/DISPLAY
[LAMBDA (WINDOW BM GRIDSPEC GRIDINTERIOR BITSWIDE BITSHIGH)
(* rrb " 2-AUG-82 10:59")
(* initializes the display for the bitmap editor.)
(DSPFILL GRIDINTERIOR WHITESHADE (QUOTE REPLACE)
WINDOW)
(GRID GRIDSPEC BITSWIDE BITSHIGH (QUOTE POINT)
WINDOW)
(RESETGRID BM GRIDSPEC BITSWIDE BITSHIGH 0 0 WINDOW)
(UPDATE/BM/DISPLAY BM WINDOW])
(\EDITBMHOWMUCH
[LAMBDA (BM EDITWIDTH EDITHEIGHT TITLEQ) (* rrb "21-JUN-82 10:30")
(* asks the user how much to clear)
(MENU (COND
((OR (IGREATERP (fetch (BITMAP BITMAPWIDTH) of BM)
EDITWIDTH)
(IGREATERP (fetch (BITMAP BITMAPHEIGHT) of BM)
EDITHEIGHT))
(create MENU
TITLE ← TITLEQ
ITEMS ←(QUOTE ((VisiblePart (QUOTE VISIBLE)
"Operates on just the part visible in the edit region")
(WholeBitmap (QUOTE WHOLE)
"Operates on the entire bitmap")))
CENTERFLG ← T))
(T (create MENU
TITLE ← TITLEQ
ITEMS ←(QUOTE ((WholeBitmap (QUOTE WHOLE)
"Operates on the entire bitmap")))
CENTERFLG ← T])
(EDITBMRESHAPEFN
[LAMBDA (BMEDITWINDOW OLDIMAGE OLDREGION ZEROBMFLG) (* rrb "17-JUN-82 12:45")
(* allows the bitmap edit window to be reshaped to enlarge the editting area. This is also called to set up the
image during initialization.)
(PROG (BMWINTERIORWIDTH BMWINTERIORHEIGHT EDITAREABITWIDTH EDITAREABITHEIGHT GRIDSQUARE
GRIDINTERIOR BITMAPWIDTH BMDISPLAYWIDTH BMDISPLAYBOTTOM BMDISPLAYHEIGHT
BITMAPHEIGHT (BM (WINDOWPROP BMEDITWINDOW (QUOTE BM)))
(MINCOMMANDAREAWIDTH 30))
(SETQ BITMAPWIDTH (fetch BITMAPWIDTH of BM))
(SETQ BITMAPHEIGHT (fetch BITMAPHEIGHT of BM))
(SETQ BMWINTERIORWIDTH (WINDOWPROP BMEDITWINDOW (QUOTE WIDTH)))
(* leave room at the top for the full size display area.
But not more than half of the window.)
(SETQ BMWINTERIORHEIGHT (IMAX (IDIFFERENCE (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
(IPLUS BITMAPHEIGHT GRIDTHICKNESS))
(IQUOTIENT (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
2)))
(* if the user hasn't set it, determine the grid size as the largest size which fits the interior but not larger
than NORMALGRIDSQUARE nor smaller than MINGRIDSQUARE. If GRIDSQUARE was specified, reset it to NIL so that if
reshaped it will be recalculated.)
(SETQ GRIDSQUARE (OR (WINDOWPROP BMEDITWINDOW (QUOTE GRIDSQUARE)
NIL)
(IMAX (IMIN (IQUOTIENT BMWINTERIORWIDTH BITMAPWIDTH)
(IQUOTIENT BMWINTERIORHEIGHT BITMAPHEIGHT)
NORMALGRIDSQUARE)
MINGRIDSQUARE))) (* calculate how many bits will be displayed at once.)
(SETQ EDITAREABITWIDTH (IMIN (IQUOTIENT BMWINTERIORWIDTH GRIDSQUARE)
BITMAPWIDTH))
(WINDOWPROP BMEDITWINDOW (QUOTE BITSWIDE)
EDITAREABITWIDTH)
(SETQ EDITAREABITHEIGHT (IMIN (IQUOTIENT BMWINTERIORHEIGHT GRIDSQUARE)
BITMAPHEIGHT)) (* calculate offset of display and command regions at
the top of the window.)
(WINDOWPROP BMEDITWINDOW (QUOTE BITSHIGH)
EDITAREABITHEIGHT)
(SETQ BMDISPLAYBOTTOM (IPLUS (ITIMES GRIDSQUARE EDITAREABITHEIGHT)
GRIDTHICKNESS))
(SETQ BMDISPLAYWIDTH (IMIN BITMAPWIDTH (IDIFFERENCE BMWINTERIORWIDTH MINCOMMANDAREAWIDTH)))
(* put the offset -
the lower left coordinate -
in the same place unless the new shape allows more to be shown past the upper right corner.)
(WINDOWPROP BMEDITWINDOW (QUOTE XOFFSET)
(IMIN (WINDOWPROP BMEDITWINDOW (QUOTE XOFFSET))
(IDIFFERENCE BITMAPWIDTH EDITAREABITWIDTH)))
(WINDOWPROP BMEDITWINDOW (QUOTE YOFFSET)
(IMIN (WINDOWPROP BMEDITWINDOW (QUOTE YOFFSET))
(IDIFFERENCE BITMAPHEIGHT EDITAREABITHEIGHT)))
(* Center edit square)
(SETQ GRIDINTERIOR (create REGION
LEFT ←(IQUOTIENT (IDIFFERENCE BMWINTERIORWIDTH (ITIMES
EDITAREABITWIDTH
GRIDSQUARE))
2)
BOTTOM ←(IQUOTIENT (IDIFFERENCE BMDISPLAYBOTTOM
(ITIMES EDITAREABITHEIGHT
GRIDSQUARE))
2)
WIDTH ←(ITIMES EDITAREABITWIDTH GRIDSQUARE)
HEIGHT ←(ITIMES EDITAREABITHEIGHT GRIDSQUARE)))
(WINDOWPROP BMEDITWINDOW (QUOTE GRIDINTERIOR)
GRIDINTERIOR)
(WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYBOTTOM)
BMDISPLAYBOTTOM)
(WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYWIDTH)
BMDISPLAYWIDTH)
(WINDOWPROP BMEDITWINDOW (QUOTE BMDISPLAYHEIGHT)
(SETQ BMDISPLAYHEIGHT (IDIFFERENCE (WINDOWPROP BMEDITWINDOW (QUOTE HEIGHT))
BMDISPLAYBOTTOM)))
(WINDOWPROP BMEDITWINDOW (QUOTE DISPLAYREGION)
(create REGION
LEFT ← 0
BOTTOM ← BMDISPLAYBOTTOM
WIDTH ← BMDISPLAYWIDTH
HEIGHT ← BMDISPLAYHEIGHT))
(WINDOWPROP BMEDITWINDOW (QUOTE GRIDSPEC)
(create REGION
LEFT ←(fetch (REGION LEFT) of GRIDINTERIOR)
BOTTOM ←(fetch (REGION BOTTOM) of GRIDINTERIOR)
WIDTH ← GRIDSQUARE
HEIGHT ← GRIDSQUARE))
(EDITBMREPAINTFN BMEDITWINDOW NIL ZEROBMFLG])
(EDITBMREPAINTFN
[LAMBDA (WIN REGION ZEROBM) (* edited: "17-SEP-82 09:34")
(* redisplays a bitmap editting window If ZEROBM is
non-NIL, it doesn't bother to display the bits.)
(PROG [(GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
(EDITAREABITWIDTH (WINDOWPROP WIN (QUOTE BITSWIDE)))
(EDITAREABITHEIGHT (WINDOWPROP WIN (QUOTE BITSHIGH)))
(BM (WINDOWPROP WIN (QUOTE BM]
(CLEARW WIN) (* gray the area above the edit grid that is not bitmap
display area.)
(BITBLT NIL NIL NIL WIN (IPLUS (WINDOWPROP WIN (QUOTE BMDISPLAYWIDTH))
GRIDTHICKNESS)
(WINDOWPROP WIN (QUOTE BMDISPLAYBOTTOM))
NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
NOTINUSEGRAY) (* put in the display of the full sized bitmap.)
(UPDATE/BM/DISPLAY BM WIN) (* put in grid markings.)
(GRID GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT (QUOTE POINT)
WIN)
(* shade in the bits that are on. If the expectation is that most bits were on it would be faster to change
RESETGRID to show both off and on bits and remove the previous call to GRID.)
(OR ZEROBM (RESETGRID BM GRIDSPEC EDITAREABITWIDTH EDITAREABITHEIGHT 0 0 WIN])
(UPDATE/SHADE/DISPLAY
[LAMBDA (BM WIN) (* rrb "20-JUN-82 16:53")
(* displays BM as if it were a shade.)
(PROG [(BOTTOM (WINDOWPROP WIN (QUOTE BMDISPLAYBOTTOM]
(TILEAREA 0 BOTTOM (WINDOWPROP WIN (QUOTE WIDTH))
(IDIFFERENCE (WINDOWPROP WIN (QUOTE HEIGHT))
BOTTOM)
BM WIN])
(UPDATE/BM/DISPLAY/SELECTED/REGION
[LAMBDA (W) (* rrb "17-JUN-82 11:19")
(* Shade the selected region of the bitmap display
area.)
(COND
([OR (IGREATERP (FETCH (BITMAP BITMAPWIDTH) OF (WINDOWPROP W (QUOTE BM)))
(WINDOWPROP W (QUOTE BITSWIDE)))
(IGREATERP (FETCH (BITMAP BITMAPHEIGHT) OF (WINDOWPROP W (QUOTE BM)))
(WINDOWPROP W (QUOTE BITSHIGH] (* only invert the region being editted if it is less
than the entire bitmap.)
(BITBLT NIL 0 0 W (IDIFFERENCE (WINDOWPROP W (QUOTE XOFFSET))
(WINDOWPROP W (QUOTE DXOFFSET)))
(IDIFFERENCE (IPLUS (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
(WINDOWPROP W (QUOTE YOFFSET)))
(WINDOWPROP W (QUOTE DYOFFSET)))
(WINDOWPROP W (QUOTE BITSWIDE))
(WINDOWPROP W (QUOTE BITSHIGH))
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(SHOWBUTTON
[LAMBDA (BUTTON DS) (* rrb "27-JUL-81 10:59")
(* displays a menu box and its title.)
(PROG ((BLOCK (fetch (BUTTON REGION) of BUTTON)))
(WBOX BLOCK NIL NIL DS) (* Display the title in the middle of the box)
(CENTERPRINTINREGION (fetch (BUTTON LABEL) of BUTTON)
BLOCK DS])
(RESETGRID
[LAMBDA (BM GRIDSPEC WIDTH HEIGHT ORGX ORGY W) (* rrb "17-JUN-82 11:48")
(* copies the contents of a bitmap into the edit display
grid.)
(bind [(XOFFSET ←(WINDOWPROP W (QUOTE XOFFSET)))
(YOFFSET ←(WINDOWPROP W (QUOTE YOFFSET]
for Y from (OR ORGY 0) to (SUB1 (COND
(ORGY (IPLUS ORGY HEIGHT))
(T HEIGHT)))
do (for X from (OR ORGX 0) to (SUB1 (COND
(ORGX (IPLUS ORGX WIDTH))
(T WIDTH)))
when (EQ (BITMAPBIT BM (IPLUS X XOFFSET)
(IPLUS Y YOFFSET))
1)
do (SHADEGRIDBOX X Y DARKBITSHADE (QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
W])
(\READBMDIMENSIONS
[LAMBDA NIL (* rrb "24-AUG-82 10:42")
(* asks the user for dimensions of a bitmap and creates
it.)
(PROG (WIDTH HEIGHT)
WIDTHLP
(PRIN1 "How wide would you like the bitmap to be? " T)
(COND
([NOT (NUMBERP (SETQ WIDTH (READ T]
(PRIN1 "?" T)
(TERPRI T)
(GO WIDTHLP))
((ILESSP WIDTH 1)
(PRIN1 "WIDTH must be positive." T)
(TERPRI T)
(GO WIDTHLP)))
HEIGHTLP
(PRIN1 "How high would you like the bitmap to be? " T)
(COND
([NOT (NUMBERP (SETQ HEIGHT (READ T]
(PRIN1 "?" T)
(TERPRI T)
(GO HEIGHTLP))
((ILESSP HEIGHT 1)
(PRIN1 "HEIGHT must be positive." T)
(TERPRI T)
(GO HEIGHTLP)))
(RETURN (BITMAPCREATE WIDTH HEIGHT])
(EDITSHADE
[LAMBDA (SHADE) (* rrb "17-JUN-83 10:05")
(* allows the editing of a shade.)
(OR (FIXP SHADE)
(SETQ SHADE WHITESHADE))
[PROG ((GRIDSPEC (CREATEREGION 90 15 30 30))
(GRIDINTERIOR (CREATEREGION 90 15 120 120))
(QUITREGION (CREATEREGION 125 150 50 20))
(SHADEREGION (CREATEREGION 10 185 272 100))
X Y SEDW DS)
(SETQ DS (WINDOWPROP (SETQ SEDW (CREATEW (GETBOXREGION 300 300 NIL NIL NIL
"Indicate position of Shade edit window.")))
(QUOTE DSP)))
(WINDOWPROP SEDW (QUOTE CLOSEFN)
(QUOTE DON'T))
(WINDOWPROP SEDW (QUOTE REPAINTFN)
(QUOTE EDITSHADEREPAINTFN))
(WINDOWPROP SEDW (QUOTE QUITREGION)
QUITREGION)
(WINDOWPROP SEDW (QUOTE GRIDSPEC)
GRIDSPEC)
(WINDOWPROP SEDW (QUOTE GRIDINTERIOR)
GRIDINTERIOR)
(WINDOWPROP SEDW (QUOTE SHADE)
SHADE)
(WINDOWPROP SEDW (QUOTE SHADEREGION)
SHADEREGION)
(EDITSHADEREPAINTFN SEDW)
(do (DSPFILL SHADEREGION SHADE (QUOTE TEXTURE)
DS)
(until (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do (BLOCK))
(COND
((LASTMOUSESTATE RIGHT)
(DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY)))
((EQ (QUOTE STOP)
(until (MOUSESTATE UP) bind (XPIXEL YPIXEL)
do [COND
[(INSIDE? GRIDINTERIOR (SETQ X (LASTMOUSEX DS))
(SETQ Y (LASTMOUSEY DS)))
(COND
((AND (STRICTLY/BETWEEN (SETQ XPIXEL (GRIDXCOORD X GRIDSPEC))
-1 4)
(STRICTLY/BETWEEN (SETQ YPIXEL (GRIDYCOORD Y GRIDSPEC))
-1 4))
(SHADEGRIDBOX XPIXEL YPIXEL (COND
((LASTMOUSESTATE LEFT)
DARKBITSHADE)
(T WHITESHADE))
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)
[SETQ SHADE
(COND
[(LASTMOUSESTATE LEFT)
(LOGOR SHADE (BITMASK (IPLUS (ITIMES 4 (IDIFFERENCE 3 YPIXEL)
)
XPIXEL]
(T (LOGAND SHADE (LOGXOR 65535
(BITMASK (IPLUS (ITIMES 4
(IDIFFERENCE
3 YPIXEL))
XPIXEL]
(WINDOWPROP SEDW (QUOTE SHADE)
SHADE]
((INSIDE? QUITREGION X Y)
(DSPFILL QUITREGION BLACKSHADE (QUOTE INVERT)
DS)
(RETURN (until (MOUSESTATE UP) do (COND
((NOT (INSIDE? QUITREGION
(LASTMOUSEX DS)
(LASTMOUSEY DS)))
(DSPFILL QUITREGION BLACKSHADE
(QUOTE INVERT)
DS)
(RETURN)))
finally (DSPFILL QUITREGION BLACKSHADE (QUOTE INVERT)
DS)
(* close window.)
(WINDOWPROP SEDW (QUOTE CLOSEFN)
NIL)
(CLOSEW SEDW)
(RETURN (QUOTE STOP]
(BLOCK)))
(RETURN]
SHADE])
(EDITSHADEREPAINTFN
[LAMBDA (WIN) (* rrb "17-JUN-83 10:06")
(PROG [(GRIDSPEC (WINDOWPROP WIN (QUOTE GRIDSPEC)))
(SHADE (WINDOWPROP WIN (QUOTE SHADE]
(SHOWBUTTON (create BUTTON
REGION ←(WINDOWPROP WIN (QUOTE QUITREGION))
LABEL ←(QUOTE QUIT)
HELP ← "Quits")
WIN)
(GRAYBOXAREA (fetch LEFT of GRIDSPEC)
(fetch BOTTOM of GRIDSPEC)
(ITIMES (fetch WIDTH of GRIDSPEC)
4)
(ITIMES (fetch HEIGHT of GRIDSPEC)
4)
2 BLACKSHADE WIN)
(GRID GRIDSPEC 4 4 (QUOTE POINT)
WIN)
(for I from 0 to 15 unless (ZEROP (LOGAND SHADE (BITMASK I)))
do (SHADEGRIDBOX (IREMAINDER I 4)
(IDIFFERENCE 3 (IQUOTIENT I 4))
DARKBITSHADE
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
WIN))
(DSPFILL (WINDOWPROP WIN (QUOTE SHADEREGION))
SHADE
(QUOTE TEXTURE)
WIN])
(GRAYBOXAREA
[LAMBDA (X Y WIDTH HEIGHT OUTLINESIZE TEXTURE DS) (* rrb "13-JUN-82 17:41")
(* outlines an area with a gray box.)
(COND
((FIXP OUTLINESIZE))
((NULL OUTLINESIZE)
(SETQ OUTLINESIZE 1))
(T (\ILLEGAL.ARG OUTLINESIZE)))
(BITBLT NIL NIL NIL DS (IDIFFERENCE X OUTLINESIZE)
(IDIFFERENCE Y OUTLINESIZE)
(IPLUS WIDTH (ITIMES 2 OUTLINESIZE))
(IPLUS HEIGHT (ITIMES 2 OUTLINESIZE))
(QUOTE TEXTURE)
(QUOTE REPLACE)
(OR TEXTURE BLACKSHADE))
(BITBLT NIL NIL NIL DS X Y WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL DS])
(\SHADEBITS
[LAMBDA (BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH) (* rrb "16-JUN-82 16:14")
(* cursor is inside the edit grid, so change the bit in
the bitmap, change the edit grid and redisplay the
bitmap.)
(bind (XPIXEL YPIXEL INTENSITY X Y) until (MOUSESTATE UP)
when (AND [NEQ (AND [EQ XPIXEL (SETQ XPIXEL (IMAX 0 (IMIN BITSWIDE (GRIDXCOORD (SETQ X
(LASTMOUSEX
W))
GRIDSPEC]
YPIXEL)
(SETQ YPIXEL (IMAX 0 (IMIN BITSHIGH (GRIDYCOORD (SETQ Y (LASTMOUSEY W))
GRIDSPEC]
(INSIDE? GRIDINTERIOR X Y))
do [BITMAPBIT BM (IPLUS XPIXEL (WINDOWPROP W (QUOTE XOFFSET)))
(IPLUS YPIXEL (WINDOWPROP W (QUOTE YOFFSET)))
(SETQ INTENSITY (COND
((LASTMOUSESTATE LEFT)
DARKBITSHADE)
(T WHITESHADE]
(UPDATE/BM/DISPLAY BM W)
(SHADEGRIDBOX XPIXEL YPIXEL INTENSITY (QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
W])
(READHOTSPOT
[LAMBDA (BM GRIDSPEC GRIDINTERIOR DS) (* rrb "16-JUN-82 11:26")
(DECLARE (GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY)) (* reads the hotspot from the cursor and sets cursor)
(UNTILMOUSESTATE UP)
(PROG ((NOWCURSOR (CURSOR))
XPIXEL YPIXEL DOWNYET?)
(CURSORPOSITION (create POSITION
XCOORD ←(IPLUS (LEFTOFGRIDCOORD (SETQ XPIXEL (fetch CURSORHOTSPOTX
of NOWCURSOR))
GRIDSPEC)
(IQUOTIENT (fetch (REGION WIDTH) of GRIDSPEC)
2))
YCOORD ←(IPLUS (BOTTOMOFGRIDCOORD (SETQ YPIXEL
(fetch CURSORHOTSPOTY
of NOWCURSOR))
GRIDSPEC)
(IQUOTIENT (fetch (REGION HEIGHT) of GRIDSPEC)
2)))
DS)
(SHADEGRIDBOX XPIXEL YPIXEL NOTINUSEGRAY (QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)
(until (PROGN (GETMOUSESTATE)
(AND DOWNYET? (MOUSESTATE UP)))
when (INSIDE? GRIDINTERIOR (LASTMOUSEX DS)
(LASTMOUSEY DS))
do (OR DOWNYET? (SETQ DOWNYET? (NEQ LASTMOUSEBUTTONS 0)))
(COND
(XPIXEL (SHADEGRIDBOX XPIXEL YPIXEL (SELECTQ (BITMAPBIT BM XPIXEL YPIXEL)
(0 WHITESHADE)
(1 DARKBITSHADE)
(SHOULDNT))
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)))
(SHADEGRIDBOX (SETQ XPIXEL (GRIDXCOORD (LASTMOUSEX DS)
GRIDSPEC))
(SETQ YPIXEL (GRIDYCOORD (LASTMOUSEY DS)
GRIDSPEC))
NOTINUSEGRAY
(QUOTE REPLACE)
GRIDSPEC
(QUOTE POINT)
DS)
finally (CURSOR (CURSORCREATE BM XPIXEL YPIXEL])
(WBOX
[LAMBDA (REG THCK TEXT DS) (* rrb "19-MAR-82 09:38")
(* Draws a box around REG with bounding lines of
THCKness)
(OR THCK (SETQ THCK 2))
(BITBLT NIL NIL NIL DS NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE REG)
(BITBLT NIL NIL NIL DS (IPLUS (fetch (REGION LEFT) of REG)
THCK)
(IPLUS (fetch (REGION BOTTOM) of REG)
THCK)
(IDIFFERENCE (fetch (REGION WIDTH) of REG)
(ITIMES 2 THCK))
(IDIFFERENCE (fetch (REGION HEIGHT) of REG)
(ITIMES 2 THCK))
(QUOTE TEXTURE)
(QUOTE REPLACE)
(OR TEXT (DSPTEXTURE NIL DS])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD BUTTON (REGION LABEL HELP))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS BITMASK MACRO ((X)
(LLSH 1 (IDIFFERENCE 15 X))))
(PUTPROPS UPDATE/BM/DISPLAY MACRO ((BM W)
(BITBLT BM (WINDOWPROP W (QUOTE DXOFFSET))
(WINDOWPROP W (QUOTE DYOFFSET))
W 0 (WINDOWPROP W (QUOTE BMDISPLAYBOTTOM))
(WINDOWPROP W (QUOTE BMDISPLAYWIDTH))
1000 NIL (QUOTE REPLACE))))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQQ DARKBITSHADE 23130)
(RPAQQ NORMALGRIDSQUARE 16)
(RPAQQ NOTINUSEGRAY 42405)
(RPAQQ EDITBMMENU NIL)
(RPAQQ EDITBMWINDOWMENU NIL)
(RPAQQ GRIDSIZEMENU NIL)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS DARKBITSHADE NORMALGRIDSQUARE NOTINUSEGRAY EDITBMMENU)
)
)
(DECLARE: EVAL@COMPILE
(RPAQQ GRIDTHICKNESS 2)
(RPAQQ MINGRIDSQUARE 8)
(RPAQQ MAXGRIDWIDTH 199)
(RPAQQ MAXGRIDHEIGHT 175)
(RPAQQ BMWINDOWSHADE 33410)
(CONSTANTS (GRIDTHICKNESS 2)
(MINGRIDSQUARE 8)
(MAXGRIDWIDTH 199)
(MAXGRIDHEIGHT 175)
(BMWINDOWSHADE 33410))
)
(DEFINEQ
(EXPANDBITMAP
[LAMBDA (BITMAP WIDTHFACTOR HEIGHTFACTOR) (* rrb " 7-DEC-82 11:53")
(* (* bas: " 5-JUN-82 01:12") expands a bitmap
WIDTHFACTOR time in the width direction and HEIGHTFACTOR
times in the height direction.)
(DECLARE (GLOBALVARS \4BITEXPANSIONTABLE))
(OR WIDTHFACTOR (SETQ WIDTHFACTOR 4))
(OR HEIGHTFACTOR (SETQ HEIGHTFACTOR 1))
(PROG (NU SCR NUH NUW (BMH (fetch BITMAPHEIGHT of BITMAP))
(BMW (fetch BITMAPWIDTH of BITMAP)))
[SETQ NU (BITMAPCREATE (SETQ NUW (ITIMES WIDTHFACTOR BMW))
(SETQ NUH (ITIMES HEIGHTFACTOR BMH]
[COND
[(EQ WIDTHFACTOR 4)
(for I from 0 to (SUB1 BMH) as C from 0 by HEIGHTFACTOR
do (\FAST4BIT (\ADDBASE (fetch BITMAPBASE of BITMAP)
(ITIMES (IDIFFERENCE BMH (ADD1 I))
(fetch BITMAPRASTERWIDTH of BITMAP)))
(\ADDBASE (fetch BITMAPBASE of NU)
(ITIMES (IDIFFERENCE (fetch BITMAPHEIGHT of NU)
(ADD1 C))
(fetch BITMAPRASTERWIDTH of NU)))
(fetch BITMAPRASTERWIDTH of NU)
\4BITEXPANSIONTABLE)
(for I to (SUB1 HEIGHTFACTOR) do (BITBLT NU 0 C NU 0 (IPLUS C I)
NUW 1 (QUOTE INPUT)
(QUOTE REPLACE]
(T (SETQ SCR 0)
(for X from 0 to (SUB1 BMW)
do (for I to WIDTHFACTOR
do (BITBLT BITMAP X 0 NU SCR 0 1 BMH (QUOTE INPUT)
(QUOTE REPLACE))
(add SCR 1)))
(SETQ SCR NUH)
(for Y from (SUB1 BMH) to 0 by -1 do (for I from 0 to (SUB1 HEIGHTFACTOR)
do (BITBLT NU 0 Y NU 0 (SETQ SCR (SUB1 SCR))
NUW 1 (QUOTE INPUT)
(QUOTE REPLACE]
(RETURN NU])
)
(READVARS \4BITEXPANSIONTABLE)
({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 })
(PUTPROPS HLDISPLAY COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2292 14671 (GRID 2302 . 4963) (GRIDXCOORD 4965 . 5478) (GRIDYCOORD 5480 . 5997) (
LEFTOFGRIDCOORD 5999 . 6346) (BOTTOMOFGRIDCOORD 6348 . 6585) (EDITBMSCROLLFN 6587 . 13803) (
SHADEGRIDBOX 13805 . 14669)) (14723 15288 (CLEAR 14733 . 14951) (INSIDE? 14953 . 15286)) (15359 18735
(MOUSESTATE-EXPR 15369 . 18099) (MOUSESTATE-NAME 18101 . 18733)) (20800 21724 (DECODEBUTTONS 20810 .
21722)) (21725 35556 (GETPOSITION 21735 . 22583) (GETBOXPOSITION 22585 . 26182) (DSPYSCREENTOWINDOW
26184 . 26536) (DSPXSCREENTOWINDOW 26538 . 26890) (GETREGION 26892 . 32969) (GETBOXREGION 32971 .
33494) (MOVEBOX 33496 . 33914) (DRAWGRAYBOX 33916 . 34282) (BLTHLINE 34284 . 34557) (BLTVLINE 34559 .
34832) (SETCORNER 34834 . 35554)) (35557 36760 (NEAREST/PT/ON/GRID 35567 . 36038) (PTON10GRID 36040 .
36359) (NEAREST/MULTIPLE 36361 . 36758)) (38516 41612 (\SW2BM 38526 . 40426) (COMPOSEREGS 40428 .
40987) (TRANSLATEREG 40989 . 41610)) (41650 78494 (EDITBM 41660 . 48999) (EDITBMCLOSEFN 49001 . 49336)
(TILEAREA 49338 . 49933) (EDITBMBUTTONFN 49935 . 59385) (\EDITBM/PUTUP/DISPLAY 59387 . 59911) (
\EDITBMHOWMUCH 59913 . 60746) (EDITBMRESHAPEFN 60748 . 65122) (EDITBMREPAINTFN 65124 . 66556) (
UPDATE/SHADE/DISPLAY 66558 . 66980) (UPDATE/BM/DISPLAY/SELECTED/REGION 66982 . 67986) (SHOWBUTTON
67988 . 68466) (RESETGRID 68468 . 69255) (\READBMDIMENSIONS 69257 . 70195) (EDITSHADE 70197 . 73210) (
EDITSHADEREPAINTFN 73212 . 74281) (GRAYBOXAREA 74283 . 74969) (\SHADEBITS 74971 . 76034) (READHOTSPOT
76036 . 77743) (WBOX 77745 . 78492)) (79626 81545 (EXPANDBITMAP 79636 . 81543)))))
STOP