(FILECREATED "22-Oct-84 16:28:22" {ERIS}<LISPCORE>SOURCES>MENU.;11 61831
changes to: (FNS UPDATE/MENU/IMAGE)
previous date: "28-Sep-84 16:01:38" {ERIS}<LISPCORE>SOURCES>MENU.;10)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MENUCOMS)
(RPAQQ MENUCOMS ((* window functions)
(FNS MAXMENUITEMHEIGHT MAXMENUITEMWIDTH MENU MENUTITLEFONT ADDMENU DELETEMENU MENUREGION
BLTMENUIMAGE ERASEMENUIMAGE DEFAULTMENUHELDFN DEFAULTWHENSELECTEDFN
BACKGROUNDWHENSELECTEDFN GETMENUITEM MENUBUTTONFN MENU.HANDLER DOSELECTEDITEM
SHOWSHADEDITEMS \AddShade \FDECODE/BUTTON MENUITEMREGION \MENUITEMLABEL \MENUSUBITEMS
CHECK/MENU/IMAGE PPROMPT2 UPDATE/MENU/IMAGE \SHOWMENULABEL \SMASHMENUIMAGEONRESET
CLOSE.PROCESS.MENU DEFAULTSUBITEMFN GETMENUPROP PUTMENUPROP WAKE.MY.PROCESS \INVERTITEM
\ItemNumber \BOXITEM NESTED.SUBMENU NESTED.SUBMENU.POS WFROMMENU)
(BITMAPS MENUSUBITEMMARK)
(DECLARE: DONTCOPY (MACROS MENU.HELDSTATE.RESET))
(* scrolling menu functions and utilities)
(INITVARS (MENUFONT (FONTCREATE (QUOTE HELVETICA)
10)))
(FNS MENUREPAINTFN)
(* misc utility fns.)
(FNS MAXSTRINGWIDTH CENTEREDPRIN1 CENTERPRINTINREGION CENTERPRINTINAREA STRICTLY/BETWEEN)
(COMS (* examples of use.)
(FNS UNREADITEM TYPEINMENU SHADEITEM MOST/VISIBLE/OPERATION #BITSON BUTTONPANEL
BUTTONPANEL/SELECTION/FN GETSELECTEDITEMS)
(VARS EDITCMDS MENUHELDWAIT)
(CONSTANTS (BITSPERSHADE 16))
(GLOBALVARS MENUSELECTSHADE)
(VARS MENUSELECTSHADE)
(FNS MENUDESELECT MENUSELECT))
(DECLARE: DOCOPY DONTEVAL@LOAD (VARS (MENUFONT)))
(GLOBALVARS MENUFONT MENUHELDWAIT)
(RECORDS MENU)))
(* window functions)
(DEFINEQ
(MAXMENUITEMHEIGHT
[LAMBDA (MENU) (* rrb "22-NOV-83 13:59")
(* returns the height of the largest menu item label in
the menu MENU.)
(IMAX (for I in (fetch (MENU ITEMS) of MENU) bind LABEL (M ← 0)
do (SETQ LABEL (\MENUITEMLABEL I))
[SETQ M (IMAX M (COND
((BITMAPP LABEL)
(fetch (BITMAP BITMAPHEIGHT) of LABEL))
(T 0]
finally (RETURN M))
(FONTPROP (fetch (MENU MENUFONT) of MENU)
(QUOTE HEIGHT])
(MAXMENUITEMWIDTH
[LAMBDA (MENU) (* rrb "29-Dec-83 10:03")
(* returns the width of the largest menu item label in
the menu MENU.)
(DECLARE (GLOBALVARS MENUSUBITEMMARK))
(bind LABEL SUBITEMS (M ← 0)
(FONT ←(fetch (MENU MENUFONT) of MENU)) for I in (fetch (MENU ITEMS) of MENU)
do (SETQ LABEL (\MENUITEMLABEL I))
(SETQ SUBITEMS (\MENUSUBITEMS MENU I))
[SETQ M (IMAX M (IPLUS (COND
((BITMAPP LABEL)
(fetch (BITMAP BITMAPWIDTH) of LABEL))
(T (STRINGWIDTH LABEL FONT NIL NIL)))
(COND
(SUBITEMS (BITMAPWIDTH MENUSUBITEMMARK))
(T 0]
finally (RETURN M])
(MENU
[LAMBDA (MENU POSITION RELEASECONTROLFLG NESTEDFLG) (* rrb "20-Mar-84 14:30")
(DECLARE (LOCALVARS . T)) (* puts a menu on the screen and waits for the user to
select one of the items)
(OR (TYPENAMEP MENU (QUOTE MENU))
(\ILLEGAL.ARG MENU))
(PROG (IMAGE MX MY DSP) (* make sure the image is a window)
(CHECK/MENU/IMAGE MENU T)
(SETQ IMAGE (fetch (MENU IMAGE) of MENU))
(COND
((AND (OR POSITION (SETQ POSITION (fetch (MENU MENUPOSITION) of MENU)))
(FIXP (fetch XCOORD of POSITION))
(FIXP (fetch YCOORD of POSITION)))
(SETQ MX (fetch XCOORD of POSITION))
(SETQ MY (fetch YCOORD of POSITION)))
(T (GETMOUSESTATE)
(SETQ MX LASTMOUSEX)
(SETQ MY LASTMOUSEY)))
[SETQ MX (IDIFFERENCE MX (fetch XCOORD of (fetch MENUOFFSET of MENU]
[SETQ MY (IDIFFERENCE MY (fetch YCOORD of (fetch MENUOFFSET of MENU]
(* Adjust the position so that the menu will be entirely
on the screen.)
(PROGN (* do left margin first so that if the menu is wider
than the screen, the left most part of it will be shown)
(SETQ MX (IMAX (IMIN MX (IDIFFERENCE SCREENWIDTH (fetch (MENU IMAGEWIDTH)
of MENU)))
0)))
[PROGN (* do the bottom margin first so that the top of the
menu will show if the menu is higher than the a screen)
(SETQ MY (IMIN (IMAX MY 0)
(IDIFFERENCE SCREENHEIGHT (fetch (MENU IMAGEHEIGHT) of MENU]
(SETQ DSP (WINDOWPROP IMAGE (QUOTE DSP)))
(MOVEW IMAGE (create POSITION
XCOORD ← MX
YCOORD ← MY))
[SETQ MX (RESETLST (RESETSAVE (OPENW IMAGE)
(LIST (QUOTE CLOSEW)
IMAGE))
(COND
(RELEASECONTROLFLG (PROG (MVAL)
(WINDOWPROP IMAGE (QUOTE MENUPROCESS)
(THIS.PROCESS))
(WINDOWPROP IMAGE (QUOTE CLOSEFN)
(QUOTE CLOSE.PROCESS.MENU))
(WINDOWPROP IMAGE (QUOTE BUTTONEVENTFN)
(QUOTE WAKE.MY.PROCESS))
LP (TOTOPW IMAGE)
(OR (NEQ T (SETQ MVAL (BLOCK 200)))
(RETURN NIL))
(GETMOUSESTATE)
(* if mouse state is up, then someone came into the
window with the mouse down. Ignore it.)
(OR (MOUSESTATE (OR LEFT RIGHT MIDDLE))
(GO LP))
(* MVAL will be NIL only if the user clicked up outside
the window)
(OR (SETQ MVAL
(MENU.HANDLER MENU DSP NIL T NESTEDFLG))
(GO LP))
(RETURN MVAL)))
(T (MENU.HANDLER MENU DSP T T NESTEDFLG]
(* evaluate menu form after image has been taken down.)
(RETURN (COND
(NESTEDFLG MX)
(MX (DOSELECTEDITEM MENU (CAR MX)
(CDR MX])
(MENUTITLEFONT
[LAMBDA (MENU) (* rrb "30-Dec-83 14:08")
(* returns the title font for a menu.)
(DECLARE (GLOBALVARS WindowTitleDisplayStream))
(PROG (TITLEFONT)
(RETURN (COND
((NULL (SETQ TITLEFONT (fetch (MENU MENUTITLEFONT) of MENU)))
(* use the window title font)
(DSPFONT NIL WindowTitleDisplayStream))
((EQ TITLEFONT T) (* use the menu item font)
(fetch (MENU MENUFONT) of MENU))
((FONTP (\GETFONTDESC TITLEFONT (QUOTE DISPLAY)
T)))
(T (DSPFONT NIL WindowTitleDisplayStream])
(ADDMENU
[LAMBDA (ADDEDMENU W POSITION DONTOPENFLG) (* rrb "23-Apr-84 14:23")
(* adds a menu to a window. If W is not given, it is
created; sized a necessary.)
(OR (TYPENAMEP ADDEDMENU (QUOTE MENU))
(\ILLEGAL.ARG ADDEDMENU))
(PROG ((IMAGEWIDTH (fetch (MENU IMAGEWIDTH) of ADDEDMENU))
(IMAGEHEIGHT (fetch (MENU IMAGEHEIGHT) of ADDEDMENU)))
(* put menu at POSITION if argument, otherwise its
stored position, otherwise at cursorposition)
[COND
((POSITIONP POSITION))
((SETQ POSITION (fetch (MENU MENUPOSITION) of ADDEDMENU)))
(W (* if a window is given, put it in the lower left
corner.)
(SETQ POSITION (create POSITION
XCOORD ← 0
YCOORD ← 0)))
(T (SETQ POSITION (create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY]
[COND
((WINDOWP W)
(* adding to an existing window. To avoid partial images when window is partly off the screen, this case could
close window then blt to save region then reopen window.)
(* locate menu grid in MENU.)
(replace (REGION LEFT) of (fetch (MENU MENUGRID) of ADDEDMENU)
with (IPLUS (fetch (POSITION XCOORD) of POSITION)
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
(replace (REGION BOTTOM) of (fetch (MENU MENUGRID) of ADDEDMENU)
with (IPLUS (fetch (POSITION YCOORD) of POSITION)
(fetch (MENU MENUOUTLINESIZE) of ADDEDMENU)))
(* Blt image into Window.)
(BLTMENUIMAGE ADDEDMENU (WINDOWPROP W (QUOTE DSP))
DONTOPENFLG))
(T (* have to create new window.
Put position at Origin.)
[SETQ W (CREATEWFROMIMAGE (BITMAPCOPY (CHECK/MENU/IMAGE ADDEDMENU]
(MOVEW W POSITION)
(SETQ POSITION (create POSITION
XCOORD ← 0
YCOORD ← 0)) (* locate menu grid in MENU.)
(replace (REGION LEFT) of (fetch (MENU MENUGRID) of ADDEDMENU)
with (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))
(replace (REGION BOTTOM) of (fetch (MENU MENUGRID) of ADDEDMENU)
with (fetch (MENU MENUOUTLINESIZE) of ADDEDMENU))
(OR DONTOPENFLG (OPENW W] (* put MENUBUTTONFN in CURSORINFN so it will get called
if button is down and moves into W.)
(WINDOWPROP W (QUOTE CURSORINFN)
(FUNCTION MENUBUTTONFN)) (* Set ButtonEventFn to activate menu selection.)
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION MENUBUTTONFN))
(WINDOWPROP W (QUOTE CURSORMOVEDFN)
(FUNCTION MENUBUTTONFN)) (* put ADDEDMENU on USERDATA so MENUBUTTONFN can get at
it.)
(WINDOWADDPROP W (QUOTE MENU)
ADDEDMENU)
(WINDOWADDPROP W (QUOTE REPAINTFN)
(FUNCTION MENUREPAINTFN))
[COND
((NULL (fetch (MENU WHENSELECTEDFN) of ADDEDMENU))
(* make the default selection function call
EVAL.AS.PROCESS instead of EVAL so it won't tie up
background.)
(replace (MENU WHENSELECTEDFN) of ADDEDMENU with (FUNCTION BACKGROUNDWHENSELECTEDFN]
[COND
((NOT (SUBREGIONP (DSPCLIPPINGREGION NIL W)
(MENUREGION ADDEDMENU))) (* if the menu didn't fit, make it scrollable.)
(WINDOWPROP W (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(EXTENDEXTENT W (MENUREGION ADDEDMENU]
(RETURN W])
(DELETEMENU
[LAMBDA (MENU CLOSEFLG FROMWINDOW) (* rrb " 6-Apr-84 11:55")
(* deletes a menu from its window.
If it is the only menu in the window and CLOSEFLG is
non-NIL, it closes the window.)
(OR (TYPENAMEP MENU (QUOTE MENU))
(\ILLEGAL.ARG MENU))
(PROG ([W (COND
((type? WINDOW FROMWINDOW)
FROMWINDOW)
(T (WFROMMENU MENU]
OTHERMENUS) (* see if menu is in a window.)
(OR W (RETURN)) (* Blt image out of Window.)
(ERASEMENUIMAGE MENU W)
[COND
[[NULL (CDR (SETQ OTHERMENUS (WINDOWPROP W (QUOTE MENU]
(* last menu)
(OR (EQ MENU (CAR OTHERMENUS))
(ERROR "MENU not correctly in W"))
(WINDOWPROP W (QUOTE MENU)
NIL)
(COND
(CLOSEFLG (CLOSEW W]
(T (WINDOWPROP W (QUOTE MENU)
(DREMOVE MENU OTHERMENUS]
(COND
((EQ (fetch (MENU WHENSELECTEDFN) of MENU)
(FUNCTION BACKGROUNDWHENSELECTEDFN)) (* return the default selection function call EVAL
instead of EVAL.AS.PROCESS so it will return the correct
value.)
(replace (MENU WHENSELECTEDFN) of MENU with NIL)))
(RETURN W])
(MENUREGION
[LAMBDA (MENU) (* rrb " 9-FEB-82 09:37")
(* returns the region covered by the image of a MENU)
(* calls IMAGEWIDTH first so that it will calculate an
image if none exists yet.)
(create REGION
WIDTH ←(fetch (MENU IMAGEWIDTH) of MENU)
HEIGHT ←(fetch (MENU IMAGEHEIGHT) of MENU)
LEFT ←(fetch (MENU MENUREGIONLEFT) of MENU)
BOTTOM ←(fetch (MENU MENUREGIONBOTTOM) of MENU])
(BLTMENUIMAGE
[LAMBDA (MENU WIN DONTOPEN) (* rrb "30-NOV-83 18:12")
(* Displays a menu image at its position on DS.)
(PROG ([SRC (COND
((WINDOWP (fetch IMAGE of MENU))
(fetch (WINDOW SAVE) of (fetch (MENU IMAGE) of MENU)))
(T (fetch IMAGE of MENU]
(DSTWIN (\INSUREWINDOW WIN)))
(RETURN (COND
[(AND DONTOPEN (NOT (OPENWP DSTWIN))) (* leave the window closed)
(PROG ((BORDER (WINDOWPROP DSTWIN (QUOTE BORDER)))
(CR (DSPCLIPPINGREGION NIL DSTWIN)))
(RETURN (BITBLT SRC 0 0 (fetch (WINDOW SAVE) of DSTWIN)
(IPLUS BORDER (fetch (MENU MENUREGIONLEFT) of MENU))
(IPLUS BORDER (fetch (MENU MENUREGIONBOTTOM)
of MENU))
(IMIN (BITMAPWIDTH SRC)
(fetch (REGION WIDTH) of CR))
(IMIN (BITMAPHEIGHT SRC)
(fetch (REGION HEIGHT) of CR]
(T (BITBLT SRC NIL NIL DSTWIN (fetch (MENU MENUREGIONLEFT) of MENU)
(fetch (MENU MENUREGIONBOTTOM) of MENU])
(ERASEMENUIMAGE
[LAMBDA (MENU W) (* rrb "19-MAR-82 10:26")
(* removes the menu image from a window by clearing the place it used to occupy. Image may be different from
stored image because user may have shaded an item.)
(BITBLT NIL NIL NIL (WINDOWPROP W (QUOTE DSP))
(IDIFFERENCE (fetch (REGION LEFT) of (fetch (MENU MENUGRID) of MENU))
(fetch MENUOUTLINESIZE of MENU))
(IDIFFERENCE (fetch (REGION BOTTOM) of (fetch (MENU MENUGRID) of MENU))
(fetch MENUOUTLINESIZE of MENU))
(fetch (MENU IMAGEWIDTH) of MENU)
(fetch (MENU IMAGEHEIGHT) of MENU)
(QUOTE TEXTURE)
(QUOTE REPLACE])
(DEFAULTMENUHELDFN
[LAMBDA (ITEM) (* rrb "23-NOV-81 12:41")
(COND
((AND (LISTP ITEM)
(CADDR ITEM))
(PROMPTPRINT (CADDR ITEM)))
(T (PROMPTPRINT "Will select this item when you release the button."])
(DEFAULTWHENSELECTEDFN
[LAMBDA (ITEM FROMMENU BUTTON) (* rrb "24-Feb-84 15:01")
(* default Menu handler)
(COND
((AND (LISTP ITEM)
(LISTP (CDR ITEM)))
(STKEVAL (OR (STKPOS (QUOTE MENU))
(QUOTE MENUBUTTONFN))
(CADR ITEM)
T))
(T ITEM])
(BACKGROUNDWHENSELECTEDFN
[LAMBDA (ITEM FROMMENU BUTTON) (* rrb "27-AUG-82 10:17")
(* default Menu handler for fixed menus.
It differs from DEFAULTWHENSELECTEDFN by calling
EVAL.AS.PROCESS instead of EVAL.)
(COND
[(LISTP ITEM)
(COND
((CDR ITEM)
(EVAL.AS.PROCESS (CADR ITEM)))
(T (CAR ITEM]
(T ITEM])
(GETMENUITEM
[LAMBDA (MENU XGRID YGRID) (* rrb "31-JUL-81 07:31")
(* returns the menu item that is in grid location
{XGRID,YGRID}.)
(CAR (FNTH (fetch (MENU ITEMS) of MENU)
(IPLUS (ITIMES (SUB1 (IDIFFERENCE (fetch MENUROWS of MENU)
YGRID))
(fetch MENUCOLUMNS of MENU))
XGRID 1])
(MENUBUTTONFN
[LAMBDA (W) (* rrb "18-APR-83 17:19")
(COND
[(LASTMOUSESTATE (OR LEFT MIDDLE RIGHT))
(TOTOPW W)
(bind SELECTION for MENU in (WINDOWPROP W (QUOTE MENU)) when [SETQ SELECTION
(MENU.HANDLER
MENU
(WINDOWPROP W (QUOTE DSP]
do (DOSELECTEDITEM MENU (CAR SELECTION)
(CDR SELECTION]
(T (* must have been button up or a cursor move event.)
NIL])
(MENU.HANDLER
[LAMBDA (MENU DSP KEEPCONTROLIFOUTFLG CHANGEOFFSETFLG NESTEDFLG)
(* rrb "29-Aug-84 16:00")
(* handles details of watching mouse for menus.)
(RESETLST (RESETSAVE NIL (LIST (QUOTE \SMASHMENUIMAGEONRESET)
MENU))
(PROG (ITEM SUBITEMS SUBMENURESULT OLDBOXX OLDBOXY BOXX BOXY HELDSTATE
(MOUSEDOWN (LASTMOUSESTATE (NOT UP)))
(MOVEDLEFT "NESTED")
(LASTBUTTONSTATE LASTMOUSEBUTTONS)
(MGRIDSPEC (fetch (MENU MENUGRID) of MENU))
(HOLDTIMER (SETUPTIMER MENUHELDWAIT))
(HELDFN (fetch (MENU WHENHELDFN) of MENU))
(NROWS (fetch (MENU MENUROWS) of MENU))
(NCOLUMNS (fetch (MENU MENUCOLUMNS) of MENU)))
(COND
((AND MOUSEDOWN (STRICTLY/BETWEEN (SETQ BOXY (GRIDYCOORD (LASTMOUSEY DSP)
MGRIDSPEC))
-1 NROWS)
(STRICTLY/BETWEEN (SETQ BOXX (GRIDXCOORD (LASTMOUSEX DSP)
MGRIDSPEC))
-1 NCOLUMNS))
(* make a special check for when the last state was down
and save the information about which item that was
over.)
(\INVERTITEM (SETQ OLDBOXX BOXX)
(SETQ OLDBOXY BOXY)
MENU DSP)))
(RETURN (COND
([SETQ ITEM
(ERSETQ (until (COND
(MOUSEDOWN
(* if mouse has been down, process it)
(MOUSESTATE UP))
((MOUSESTATE (NOT UP))
(* mouse hasn't been down but just went down.)
[COND
((AND (NULL KEEPCONTROLIFOUTFLG)
(LASTMOUSESTATE RIGHT))
(DOWINDOWCOM (WHICHW LASTMOUSEX LASTMOUSEY)))
(T (SETQ MOUSEDOWN T)
(COND
(OLDBOXX
(* switch between boxing to flipping items.)
(\BOXITEM OLDBOXX OLDBOXY MENU
DSP)
(\INVERTITEM OLDBOXX OLDBOXY
MENU DSP]
NIL))
do (COND
[(AND (STRICTLY/BETWEEN (SETQ BOXY
(GRIDYCOORD (LASTMOUSEY
DSP)
MGRIDSPEC))
-1 NROWS)
(STRICTLY/BETWEEN (SETQ BOXX
(GRIDXCOORD (LASTMOUSEX
DSP)
MGRIDSPEC))
-1 NCOLUMNS))
(* BOXX and BOXY hold the number of the box pointed at.)
(COND
((OR (NEQ BOXX OLDBOXX)
(NEQ BOXY OLDBOXY))
(* selected item has changed.)
(* uninvert old item if there was one.)
[COND
(OLDBOXX (COND
(MOUSEDOWN (\INVERTITEM OLDBOXX
OLDBOXY
MENU DSP)
)
(T (\BOXITEM OLDBOXX OLDBOXY
MENU DSP)))
(MENU.HELDSTATE.RESET OLDBOXX
OLDBOXY))
(T (SETQ HOLDTIMER (SETUPTIMER MENUHELDWAIT
HOLDTIMER]
(* invert new item)
(COND
(MOUSEDOWN (\INVERTITEM BOXX BOXY MENU DSP))
(T (\BOXITEM BOXX BOXY MENU DSP)))
(SETQ OLDBOXX BOXX)
(SETQ OLDBOXY BOXY))
((AND HELDFN (NULL HELDSTATE)
(TIMEREXPIRED? HOLDTIMER))
(* same button in same region for MENUHELDWAIT
milliseconds.)
(APPLY* HELDFN (GETMENUITEM MENU OLDBOXX
OLDBOXY)
MENU
(\FDECODE/BUTTON LASTBUTTONSTATE))
(SETQ HELDSTATE T]
(T (* cursor moved outside of the menu.)
(COND
(OLDBOXX (COND
((AND (IGREATERP BOXX 0)
(SETQ ITEM
(GETMENUITEM MENU OLDBOXX
OLDBOXY))
(SETQ SUBITEMS
(\MENUSUBITEMS MENU ITEM)))
(* There are subitems to be displayed)
(SETQ SUBMENURESULT
(MENU (NESTED.SUBMENU MENU
SUBITEMS)
(NESTED.SUBMENU.POS
MENU ITEM DSP)
NIL T))
(COND
((NEQ SUBMENURESULT MOVEDLEFT)
(* selected something from submenu)
(COND
(MOUSEDOWN (\INVERTITEM
OLDBOXX
OLDBOXY MENU
DSP))
(T (\BOXITEM OLDBOXX
OLDBOXY MENU
DSP)))
(MENU.HELDSTATE.RESET OLDBOXX
OLDBOXY)
(SETQ OLDBOXX)
(GO OUT)))
(SETQ SUBMENURESULT NIL)))
(COND
(MOUSEDOWN (\INVERTITEM OLDBOXX
OLDBOXY
MENU DSP))
(T (\BOXITEM OLDBOXX OLDBOXY MENU
DSP)))
(MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
(SETQ OLDBOXX)))
(* OLDBOXX denotes item inverted.)
(COND
((AND NESTEDFLG BOXX (IGREATERP 0 BOXX))
(* if this is a nested call and the user moved to the
left, return indication of this.)
(RETURN MOVEDLEFT))
((NOT KEEPCONTROLIFOUTFLG)
(RETURN)))
(SETQ OLDBOXX)))
(COND
((NEQ LASTBUTTONSTATE (SETQ LASTBUTTONSTATE
LASTMOUSEBUTTONS))
(* reset held timer)
(MENU.HELDSTATE.RESET OLDBOXX OLDBOXX)))
finally (* turn off inverse image. and call whenunheldfn is
necessary.)
OUT
(COND
(OLDBOXX (COND
(MOUSEDOWN (\INVERTITEM OLDBOXX
OLDBOXY
MENU DSP))
(T (\BOXITEM OLDBOXX OLDBOXY MENU
DSP)))
(MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
))
(* if called for, change the menu offset so the menu
will come up in the same place relative to the cursor
next time.)
[COND
((AND CHANGEOFFSETFLG OLDBOXX)
(SELECTQ (fetch (MENU CHANGEOFFSETFLG)
of MENU)
((Y NIL))
(replace (POSITION XCOORD)
of (fetch (MENU MENUOFFSET)
of MENU)
with (LASTMOUSEX DSP)))
(SELECTQ (fetch (MENU CHANGEOFFSETFLG)
of MENU)
((X NIL))
(replace (POSITION YCOORD)
of (fetch (MENU MENUOFFSET)
of MENU)
with (LASTMOUSEY DSP]
(RETURN (COND
(SUBMENURESULT)
(OLDBOXX (CONS (GETMENUITEM MENU
OLDBOXX
OLDBOXY)
(\FDECODE/BUTTON
LASTBUTTONSTATE]
(* no error)
(RETURN (CAR ITEM)))
(T (* user ↑E -
reset the menu selection.)
(* note -
this doesn't protect against ↑D. I would suggest that something be put on the reset list to clear the menu image
in the case of a ↑D.)
[COND
(OLDBOXX (COND
(MOUSEDOWN (\INVERTITEM OLDBOXX OLDBOXY MENU DSP))
(T (\BOXITEM OLDBOXX OLDBOXY MENU DSP]
(ERROR!])
(DOSELECTEDITEM
[LAMBDA (MENU ITEM BUTTON) (* rrb "28-JAN-82 16:33")
(APPLY* (OR (fetch WHENSELECTEDFN of MENU)
(FUNCTION DEFAULTWHENSELECTEDFN))
ITEM MENU BUTTON])
(SHOWSHADEDITEMS
[LAMBDA (MENU DSP) (* hdj "31-Aug-84 14:25")
(* shades a menu item with a background shade.
DS/W if provided is the displaystream to use.)
(PROG ((ALLITEMS (fetch (MENU ITEMS) of MENU))
SHADE ITEM ITEMREGION) (* if the item isn't in MENU don't do anything.)
(for ITEMDESCR in (fetch (MENU SHADEDITEMS) of MENU)
do [SETQ ITEM (CAR (NTH ALLITEMS (CAR ITEMDESCR]
(SETQ SHADE (CDR ITEMDESCR))
(SETQ ITEMREGION (MENUITEMREGION ITEM MENU))
(OR ITEMREGION (RETURN)) (* if the menu is not in a window don't do anything.)
(DSPFILL ITEMREGION SHADE (QUOTE REPLACE)
DSP)
(RESETLST (RESETSAVE NIL (LIST (QUOTE DSPOPERATION)
(DSPOPERATION (MOST/VISIBLE/OPERATION SHADE)
DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPRIGHTMARGIN)
(DSPRIGHTMARGIN 64000 DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT (fetch (MENU MENUFONT) of MENU)
DSP)
DSP))
(\SHOWMENULABEL ITEM ITEMREGION MENU DSP (fetch (MENU CENTERFLG)
of MENU])
(\AddShade
[LAMBDA (ITEM SHADE MENU) (* hdj "28-Sep-84 14:53")
(PROG ((INDEX (\ItemNumber ITEM (fetch (MENU ITEMS) of MENU)))
(SHADEDITEMS (fetch (MENU SHADEDITEMS) of MENU)))
(if (NULL INDEX)
then (RETURN))
(for SHADEDITEM in SHADEDITEMS do (if (EQ (CAR SHADEDITEM)
INDEX)
then (RPLACD SHADEDITEM SHADE)
(RETURN))
finally (SETQ SHADEDITEMS (CONS (CONS INDEX SHADE)
SHADEDITEMS)))
(replace (MENU SHADEDITEMS) of MENU with SHADEDITEMS])
(\FDECODE/BUTTON
[LAMBDA (BUTTONSTATE) (* rrb " 9-JAN-82 13:59")
(* return RED BLUE or YELLOW from a button state.)
(SELECTQ BUTTONSTATE
(4 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(1 (QUOTE MIDDLE))
NIL])
(MENUITEMREGION
[LAMBDA (ITEM IMENU) (* hdj "28-Sep-84 15:49")
(* returns the region for ITEM in IMENU.
NIL if ITEM isn't in IMENU.)
(PROG (ITEMNUMBER (ITEMS (fetch (MENU ITEMS) of IMENU))
(GRIDSPEC (fetch (MENU MENUGRID) of IMENU))
(BORDER (fetch (MENU MENUBORDERSIZE) of IMENU)))
[SETQ ITEMNUMBER (IDIFFERENCE (LENGTH ITEMS)
(LENGTH (OR (FMEMB ITEM ITEMS)
(for ITEMTAIL on ITEMS
when (EQ (CAR (LISTP (CAR ITEMTAIL)))
ITEMS)
do (RETURN ITEMTAIL))
(RETURN]
(RETURN (create REGION
LEFT ←(IPLUS (fetch (REGION LEFT) of GRIDSPEC)
(ITIMES (IREMAINDER ITEMNUMBER (fetch (MENU MENUCOLUMNS)
of IMENU))
(fetch (REGION WIDTH) of GRIDSPEC))
BORDER)
BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of GRIDSPEC)
(ITIMES [SUB1 (IDIFFERENCE (fetch (MENU MENUROWS)
of IMENU)
(IQUOTIENT ITEMNUMBER
(fetch (MENU
MENUCOLUMNS)
of IMENU]
(fetch (REGION HEIGHT) of GRIDSPEC))
BORDER)
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of GRIDSPEC)
(ITIMES 2 BORDER))
HEIGHT ←(IDIFFERENCE (fetch (REGION HEIGHT) of GRIDSPEC)
(ITIMES 2 BORDER])
(\MENUITEMLABEL
[LAMBDA (ITEM) (* rrb "21-AUG-81 08:13")
(* returns the item label of an item.)
(COND
((LISTP ITEM)
(CAR ITEM))
(T ITEM])
(\MENUSUBITEMS
[LAMBDA (MENU ITEM) (* rrb "29-Dec-83 09:54")
(APPLY* (OR (fetch (MENU SUBITEMFN) of MENU)
(FUNCTION DEFAULTSUBITEMFN))
MENU ITEM])
(CHECK/MENU/IMAGE
[LAMBDA (MENU MAKEWINDOWFLG) (* rrb " 4-Apr-84 15:40")
(* returns menus image, creating one if necessary.
The image field will be a WINDOW for popup menus.)
(PROG (IMAGE)
(OR (type? MENU MENU)
(\ILLEGAL.ARG MENU))
(SETQ IMAGE (OR (fetch (MENU IMAGE) of MENU)
(UPDATE/MENU/IMAGE MENU)))
[COND
(MAKEWINDOWFLG (PROG (DSP)
[COND
((type? WINDOW IMAGE)
(UPDATEWFROMIMAGE IMAGE)
(SETQ DSP (fetch (WINDOW DSP) of IMAGE))
(SETQ IMAGE (fetch (WINDOW SAVE) of IMAGE)))
(T (SETQ DSP (fetch (WINDOW DSP) of (replace (MENU IMAGE)
of MENU
with (CREATEWFROMIMAGE
IMAGE]
(* set the offset in the display stream to agree with
the region.)
(DSPXOFFSET 0 DSP)
(DSPYOFFSET 0 DSP]
(RETURN (COND
((type? BITMAP IMAGE)
IMAGE)
(T (fetch (WINDOW SAVE) of IMAGE])
(PPROMPT2
[LAMBDA (ITEM) (* rrb "17-NOV-81 14:09")
(* prints the second element of ITEM in the prompt
window.)
(COND
((AND (LISTP ITEM)
(CADR ITEM))
(PROMPTPRINT (CADR ITEM])
(UPDATE/MENU/IMAGE
[LAMBDA (MNU) (* rrb "22-Oct-84 16:26")
(DECLARE (GLOBALVARS WindowTitleDisplayStream)) (* recomputes the menu image from its labels.)
(PROG (NUMCOLS NUMROWS WIDTH HEIGHT (DSP (DSPCREATE))
BLK COLWIDTH ROWHEIGHT (MENUITEMS (fetch (MENU ITEMS) of MNU))
NITEMS BORDER OUTLINE FONT TITLEFONT TITLEHEIGHT TITLEWIDTH WINDOW TITLE
(CENTER? (fetch (MENU CENTERFLG) of MNU)))
(* check the font.)
(COND
[(FONTP (SETQ FONT (AND (fetch (MENU MENUFONT) of MNU)
(\GETFONTDESC (fetch (MENU MENUFONT) of MNU)
(QUOTE DISPLAY)
T]
(T [SETQ FONT (COND
((FONTP MENUFONT))
(T (SETQ MENUFONT (FONTCREATE (QUOTE HELVETICA)
10] (* keep font in the menu)
(replace (MENU MENUFONT) of MNU with FONT)))
(COND
((SETQ TITLE (fetch (MENU TITLE) of MNU)) (* set the title font)
(SETQ TITLEFONT (MENUTITLEFONT MNU))
(SETQ TITLEHEIGHT (FONTPROP TITLEFONT (QUOTE HEIGHT)))
(SETQ TITLEWIDTH (STRINGWIDTH TITLE TITLEFONT)))
(T (SETQ TITLEHEIGHT 0)
(SETQ TITLEWIDTH 0))) (* calculate the number of columns and rows)
(SETQ NITEMS (LENGTH MENUITEMS))
(COND
[(SETQ NUMCOLS (NUMBERP (fetch (MENU MENUCOLUMNS) of MNU)))
(SETQ NUMROWS (COND
((NUMBERP (fetch (MENU MENUROWS) of MNU)))
(T (ADD1 (IQUOTIENT (SUB1 NITEMS)
NUMCOLS]
[(SETQ NUMROWS (NUMBERP (fetch (MENU MENUROWS) of MNU)))
(SETQ NUMCOLS (ADD1 (IQUOTIENT (SUB1 NITEMS)
NUMROWS]
(T (SETQ NUMCOLS 1)
(SETQ NUMROWS NITEMS)))
(* set BORDER to the size of the outline around each menu item and OUTLINE to the size of the outline around the
whole menu.)
(SETQ BORDER (OR (FIXP (fetch (MENU MENUBORDERSIZE) of MNU))
(replace (MENU MENUBORDERSIZE) of MNU with 0)))
[SETQ OUTLINE (OR (FIXP (fetch (MENU MENUOUTLINESIZE) of MNU))
(replace (MENU MENUOUTLINESIZE) of MNU with (IMAX BORDER 1]
(COND
((IGREATERP (SETQ COLWIDTH (fetch (MENU ITEMWIDTH) of MNU))
5000)
(* If ITEMWIDTH is greater than 5000, it was probably default clipping region. if no columnwidth is given {common
case}, calculate it from the items widths.)
(SETQ COLWIDTH (IPLUS (MAXMENUITEMWIDTH MNU CENTER?)
(ITIMES (ADD1 BORDER)
2)))
[COND
((IGREATERP (IPLUS TITLEWIDTH 2)
(ITIMES COLWIDTH NUMCOLS)) (* adjust column width to cover title.)
(SETQ COLWIDTH (IQUOTIENT (PLUS TITLEWIDTH (SUB1 NUMCOLS))
NUMCOLS]
(replace (MENU ITEMWIDTH) of MNU with COLWIDTH)))
[SETQ ROWHEIGHT (COND
((ILESSP (SETQ HEIGHT (fetch (MENU ITEMHEIGHT) of MNU))
5000)
HEIGHT)
(T (replace (MENU ITEMHEIGHT) of MNU with (IPLUS (MAXMENUITEMHEIGHT MNU)
(ITIMES BORDER 2]
[COND
[(IGREATERP (ITIMES NUMROWS ROWHEIGHT)
SCREENHEIGHT) (* it is too large to fit on the screen)
(PROG (NITEMSTOFIT)
(COND
((NULL (fetch (MENU MENUCOLUMNS) of MNU))
(* menu is defaulting the number of columns)
(SETQ NITEMSTOFIT (IQUOTIENT SCREENHEIGHT ROWHEIGHT))
(SETQ NUMCOLS (ADD1 (IQUOTIENT (SUB1 NITEMS)
NITEMSTOFIT)))
(SETQ NUMROWS (ADD1 (IQUOTIENT (SUB1 NITEMS)
NUMCOLS]
((IGREATERP (ITIMES NUMCOLS COLWIDTH)
SCREENWIDTH) (* it is too wide to fit on screen)
(PROG (NITEMSTOFIT)
(COND
((NULL (fetch (MENU MENUROWS) of MNU))
(* menu is defaulting the number of rows)
(SETQ NITEMSTOFIT (IQUOTIENT SCREENWIDTH COLWIDTH))
(SETQ NUMROWS (ADD1 (IQUOTIENT (SUB1 NITEMS)
NITEMSTOFIT)))
(SETQ NUMCOLS (ADD1 (IQUOTIENT (SUB1 NITEMS)
NUMROWS]
(PROGN (* put actual values of #row and #cols into the menu
object.)
(replace (MENU MENUCOLUMNS) of MNU with NUMCOLS)
(replace (MENU MENUROWS) of MNU with NUMROWS))
(SETQ WIDTH (IPLUS (ITIMES COLWIDTH NUMCOLS)
(ITIMES OUTLINE 2)))
(SETQ HEIGHT (IPLUS (ITIMES NUMROWS ROWHEIGHT)
(ITIMES OUTLINE 2)
TITLEHEIGHT))
[SETQ BLK (COND
((AND [SETQ BLK (COND
((type? BITMAP (SETQ BLK (fetch (MENU IMAGE) of MNU)))
BLK)
((type? WINDOW BLK) (* if it is a window, make sure it is not active, then)
(CLOSEW BLK)
(fetch (WINDOW SAVE) of BLK]
(EQ (BITMAPWIDTH BLK)
WIDTH)
(EQ (fetch (BITMAP BITMAPHEIGHT) of BLK)
HEIGHT)) (* reuse current image bitmap)
BLK)
(T (* create a new one)
(BITMAPCREATE WIDTH HEIGHT]
(BITBLT NIL NIL NIL BLK 0 0 WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE) (* Draw box by nested BitBlts)
(* leave outline)
(BITBLT NIL NIL NIL BLK OUTLINE OUTLINE (IDIFFERENCE WIDTH (ITIMES OUTLINE 2))
(IDIFFERENCE HEIGHT (IPLUS TITLEHEIGHT (ITIMES OUTLINE 2)))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(DSPDESTINATION BLK DSP)
(replace (REGION LEFT) of (fetch (MENU MENUGRID) of MNU) with OUTLINE)
(replace (REGION BOTTOM) of (fetch MENUGRID of MNU) with OUTLINE)
(GRID (fetch MENUGRID of MNU)
NUMCOLS NUMROWS BORDER DSP)
(DSPOPERATION (QUOTE INVERT)
DSP) (* calculate the offset from the top of the item box to
the base line of the printed item.)
[COND
(TITLE (* if there is a title, display it)
(DSPFONT TITLEFONT DSP)
(\SHOWMENULABEL TITLE (create REGION
LEFT ←(IPLUS OUTLINE BORDER)
BOTTOM ←(IDIFFERENCE (IPLUS HEIGHT BORDER)
(IPLUS TITLEHEIGHT OUTLINE))
WIDTH ← WIDTH
HEIGHT ← TITLEHEIGHT)
MNU DSP CENTER?)
(SETQ HEIGHT (IDIFFERENCE HEIGHT TITLEHEIGHT]
[PROG ([ITEMREGION (create REGION
LEFT ←(IPLUS OUTLINE BORDER)
BOTTOM ←(IDIFFERENCE (IPLUS HEIGHT BORDER)
(IPLUS ROWHEIGHT OUTLINE))
WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH)
of (fetch (MENU MENUGRID) of MNU))
(ITIMES BORDER 2))
HEIGHT ←(IDIFFERENCE ROWHEIGHT (ITIMES BORDER 2]
(MAJOR# 1))
(DSPFONT FONT DSP)
LP (COND
(MENUITEMS (\SHOWMENULABEL (CAR MENUITEMS)
ITEMREGION MNU DSP CENTER?)
(SETQ MENUITEMS (CDR MENUITEMS))
[COND
((EQ MAJOR# NUMCOLS) (* advance to the next row)
(SETQ MAJOR# 1)
(replace (REGION BOTTOM) of ITEMREGION
with (IDIFFERENCE (fetch (REGION BOTTOM) of ITEMREGION)
ROWHEIGHT))
(replace (REGION LEFT) of ITEMREGION with (IPLUS OUTLINE BORDER)))
(T (SETQ MAJOR# (ADD1 MAJOR#))
(replace (REGION LEFT) of ITEMREGION
with (IPLUS (fetch (REGION LEFT) of ITEMREGION)
COLWIDTH]
(GO LP]
[COND
((NULL (fetch (MENU MENUOFFSET) of MNU))
(* set offset so cursor will be be in middle of the menu on first display if it is to move with the cursor.
If it is fixed offset, initialize it to 0)
(replace (MENU MENUOFFSET) of MNU
with (COND
((fetch (MENU CHANGEOFFSETFLG) of MNU)
(create POSITION
XCOORD ←(IQUOTIENT WIDTH 2)
YCOORD ←(IQUOTIENT HEIGHT 2)))
(T (create POSITION
XCOORD ← 0
YCOORD ← 0]
[COND
((type? WINDOW (SETQ WINDOW (fetch (MENU IMAGE) of MNU)))
(* menu has a window, replace its save image.)
(replace (WINDOW SAVE) of WINDOW with BLK))
(T (replace (MENU IMAGE) of MNU with (SETQ WINDOW (CREATEWFROMIMAGE BLK]
(* tell the window about its border)
(replace (WINDOW WBORDER) of WINDOW with OUTLINE)
(ADVISEWDS WINDOW) (* snap circular link between the display stream
created for printing and its stream.)
(RETURN (fetch (WINDOW SAVE) of (fetch (MENU IMAGE) of MNU])
(\SHOWMENULABEL
[LAMBDA (ITEM ITEMREGION MENU DSP CENTER?) (* rrb "29-Dec-83 10:19")
(* displays the item label for ITEM in the region
ITEMREGION on the stream DSP according to the formatting
information from MENU.)
(DECLARE (GLOBALVARS MENUSUBITEMMARK))
(PROG ((LABEL (\MENUITEMLABEL ITEM)))
[COND
((\MENUSUBITEMS MENU ITEM) (* this item has subitems, put the mark in and change
the region that the item should print in.)
(BITBLT MENUSUBITEMMARK 0 0 DSP (IPLUS (fetch (REGION LEFT) of ITEMREGION)
(IDIFFERENCE (fetch (REGION WIDTH) of ITEMREGION)
(BITMAPWIDTH MENUSUBITEMMARK)))
(IPLUS (fetch (REGION BOTTOM) of ITEMREGION)
(FONTPROP (fetch (MENU MENUFONT) of MENU)
(QUOTE DESCENT)))
NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)
NIL ITEMREGION)
(SETQ ITEMREGION (CREATEREGION (fetch (REGION LEFT) of ITEMREGION)
(fetch (REGION BOTTOM) of ITEMREGION)
(IDIFFERENCE (fetch (REGION WIDTH) of ITEMREGION)
(BITMAPWIDTH MENUSUBITEMMARK))
(fetch (REGION HEIGHT) of ITEMREGION]
(RETURN (COND
[(BITMAPP LABEL) (* bitblt the label using the default operation of the
displaystream.)
(COND
(CENTER? (BITBLT LABEL 0 0 DSP (IPLUS (fetch (REGION LEFT) of ITEMREGION)
(IQUOTIENT (IDIFFERENCE
(fetch (REGION WIDTH)
of ITEMREGION)
(BITMAPWIDTH LABEL))
2))
(IPLUS (fetch (REGION BOTTOM) of ITEMREGION)
(IQUOTIENT (IDIFFERENCE (fetch (REGION HEIGHT)
of ITEMREGION)
(fetch (BITMAP BITMAPHEIGHT)
of LABEL))
2))
NIL NIL (QUOTE INPUT)
NIL NIL ITEMREGION))
(T (BITBLT LABEL 0 0 DSP (fetch (REGION LEFT) of ITEMREGION)
(fetch (REGION BOTTOM) of ITEMREGION)
(fetch (REGION WIDTH) of ITEMREGION)
(fetch (REGION HEIGHT) of ITEMREGION)
(QUOTE INPUT)
NIL NIL]
(CENTER? (CENTERPRINTINREGION LABEL ITEMREGION DSP))
(T (DSPXPOSITION (ADD1 (fetch (REGION LEFT) of ITEMREGION))
DSP)
(DSPYPOSITION (IPLUS (fetch (REGION BOTTOM) of ITEMREGION)
(FONTDESCENT (DSPFONT NIL DSP)))
DSP)
(PRIN3 LABEL DSP])
(\SMASHMENUIMAGEONRESET
[LAMBDA (MENU) (* rrb " 9-Jan-84 19:23")
(* sets the menu image field to NIL if RESETSTATE
indicates that a ↑D was typed.)
(COND
((FMEMB RESETSTATE (QUOTE (RESET HARDRESET)))
(replace (MENU IMAGE) of MENU with NIL])
(CLOSE.PROCESS.MENU
[LAMBDA (WINDOW) (* dgb: "15-DEC-83 19:18")
(WAKE.PROCESS (WINDOWPROP WINDOW (QUOTE MENUPROCESS))
T])
(DEFAULTSUBITEMFN
[LAMBDA (MENU ITEM) (* rrb "17-Aug-84 17:24")
(* default subitemfn for menus.
Checks the fourth element of the
(item for an expression of the form
(SUBITEMS a b c)))
(AND (LISTP ITEM)
(LISTP (SETQ ITEM (CDR ITEM)))
(LISTP (SETQ ITEM (CDR ITEM)))
(LISTP (SETQ ITEM (CDR ITEM)))
(EQ [CAR (SETQ ITEM (LISTP (CAR ITEM]
(QUOTE SUBITEMS))
(CDR ITEM])
(GETMENUPROP
[LAMBDA (MENU PROPERTY) (* dgb: "13-DEC-83 17:50")
(LISTGET (fetch (MENU MENUUSERDATA) of MENU)
PROPERTY])
(PUTMENUPROP
[LAMBDA (MENU PROPERTY VALUE) (* dgb: "13-DEC-83 17:52")
(PROG ((NOWDATA (fetch (MENU MENUUSERDATA) of MENU)))
[COND
(NOWDATA (LISTPUT NOWDATA PROPERTY VALUE))
(T (replace (MENU MENUUSERDATA) of MENU with (LIST PROPERTY VALUE]
(RETURN VALUE])
(WAKE.MY.PROCESS
[LAMBDA (WINDOW) (* dgb: "15-DEC-83 19:09")
(WAKE.PROCESS (WINDOWPROP WINDOW (QUOTE MENUPROCESS))
"ABC"])
(\INVERTITEM
[LAMBDA (COLUMN ROW MENU DSP) (* dgb: "13-DEC-83 18:06")
(* inverts an item in a menu displayed in DSP.)
(SHADEGRIDBOX COLUMN ROW BLACKSHADE (QUOTE INVERT)
(fetch (MENU MENUGRID) of MENU)
(fetch (MENU MENUBORDERSIZE) of MENU)
DSP])
(\ItemNumber
[LAMBDA (ITEM ALLITEMS) (* hdj "31-Aug-84 13:51")
(for SOMEITEM in ALLITEMS as ITEMNUM from 1 do (if (EQ SOMEITEM ITEM)
then (RETURN ITEMNUM))
finally (RETURN NIL])
(\BOXITEM
[LAMBDA (COLUMN ROW MENU DSP) (* rrb "28-Dec-83 17:34")
(* inverts an item in a menu displayed in DSP.)
(PROG ((BORDER (OR (FIXP (fetch (MENU MENUBORDERSIZE) of MENU))
0))
(GRID (fetch (MENU MENUGRID) of MENU))
LFT BTM WID HGHT)
(BITBLT NIL NIL NIL DSP (SETQ LFT (IPLUS (LEFTOFGRIDCOORD COLUMN GRID)
BORDER))
(SETQ BTM (IPLUS (BOTTOMOFGRIDCOORD ROW GRID)
BORDER))
(SETQ WID (IDIFFERENCE (fetch (REGION WIDTH) of GRID)
(ITIMES BORDER 2)))
(SETQ HGHT (IDIFFERENCE (fetch (REGION HEIGHT) of GRID)
(ITIMES BORDER 2)))
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(BITBLT NIL NIL NIL DSP (ADD1 LFT)
(ADD1 BTM)
(IDIFFERENCE WID 2)
(IDIFFERENCE HGHT 2)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(NESTED.SUBMENU
[LAMBDA (MENU SUBITEMS) (* rrb "20-Jun-84 19:26")
(* computes and returns the nested submenu for SUBITEMS.
It maintains a cache on the MENUUSERDATA)
(PROG [SUBMENU (SUBMENULST (GETMENUPROP MENU (QUOTE SUBMENUS]
[COND
([NULL (SETQ SUBMENU (CDR (FASSOC SUBITEMS SUBMENULST]
(* Cache submenu on user data)
(PUTMENUPROP MENU (QUOTE SUBMENUS)
(CONS [CONS SUBITEMS (SETQ SUBMENU
(create MENU
ITEMS ← SUBITEMS
MENUOFFSET ←(create POSITION
XCOORD ← 1
YCOORD ← 5)
CHANGEOFFSETFLG ←(QUOTE Y)
CENTERFLG ←(fetch (MENU CENTERFLG) of MENU)
MENUFONT ←(fetch (MENU MENUFONT) of MENU)
MENUBORDERSIZE ←(fetch (MENU MENUBORDERSIZE)
of MENU)
MENUOUTLINESIZE ←(IMAX (fetch (MENU MENUOUTLINESIZE)
of MENU)
1)
WHENHELDFN ←(fetch (MENU WHENHELDFN) of MENU)
WHENUNHELDFN ←(fetch (MENU WHENUNHELDFN)
of MENU)
SUBITEMFN ←(fetch (MENU SUBITEMFN) of MENU]
SUBMENULST]
(RETURN SUBMENU])
(NESTED.SUBMENU.POS
[LAMBDA (IMENU ITEM STREAM) (* rrb "28-Dec-83 19:24")
(* return the position of a nested submenu should have.)
(PROG (ITEMNUMBER (ITEMS (fetch (MENU ITEMS) of IMENU))
(GRIDSPEC (fetch (MENU MENUGRID) of IMENU))
(BORDER (fetch (MENU MENUBORDERSIZE) of IMENU))
(DD (\GETDISPLAYDATA STREAM)))
[SETQ ITEMNUMBER (IDIFFERENCE (LENGTH ITEMS)
(LENGTH (OR (FMEMB ITEM ITEMS)
(for ITEMTAIL on ITEMS
when (EQ (CAAR ITEMTAIL)
ITEM)
do (RETURN ITEMTAIL))
(RETURN]
(RETURN (create POSITION
XCOORD ←(\DSPTRANSFORMX (IPLUS (fetch (REGION LEFT) of GRIDSPEC)
(ITIMES (IREMAINDER ITEMNUMBER
(fetch (MENU MENUCOLUMNS)
of IMENU))
(fetch (REGION WIDTH) of GRIDSPEC))
(IDIFFERENCE (fetch (REGION WIDTH)
of GRIDSPEC)
(ITIMES 2 BORDER)))
DD)
YCOORD ←(\DSPTRANSFORMY
(IPLUS (ITIMES -2 BORDER)
(fetch (REGION BOTTOM) of GRIDSPEC)
(ITIMES [SUB1 (IDIFFERENCE (fetch (MENU MENUROWS) of IMENU)
(IQUOTIENT ITEMNUMBER
(fetch (MENU MENUCOLUMNS)
of IMENU]
(fetch (REGION HEIGHT) of GRIDSPEC)))
DD])
(WFROMMENU
[LAMBDA (MENU) (* rrb "20-AUG-81 12:31")
(* finds the window that menu is in if any.)
(for WINDOW←TOPW by (fetch NEXTW of WINDOW) while WINDOW thereis (MEMB MENU (WINDOWPROP
WINDOW
(QUOTE MENU])
)
(RPAQ MENUSUBITEMMARK (READBITMAP))
(6 9
"H@@@"
"D@@@"
"J@@@"
"E@@@"
"JH@@"
"E@@@"
"J@@@"
"D@@@"
"H@@@")
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS MENU.HELDSTATE.RESET MACRO ((BX BY)
[COND
(HELDSTATE (COND
((SETQ HELDSTATE (fetch (MENU WHENUNHELDFN)
of MENU))
(APPLY* HELDSTATE (GETMENUITEM MENU BX BY)
MENU
(\FDECODE/BUTTON LASTBUTTONSTATE))
(SETQ HELDSTATE NIL]
(SETQ HOLDTIMER (SETUPTIMER MENUHELDWAIT HOLDTIMER))))
)
)
(* scrolling menu functions and utilities)
(RPAQ? MENUFONT (FONTCREATE (QUOTE HELVETICA)
10))
(DEFINEQ
(MENUREPAINTFN
[LAMBDA (WINDOW REG) (* hdj "31-Aug-84 14:25")
(* repaints the menus in a window.)
(PROG [(DSP (WINDOWPROP WINDOW (QUOTE DSP] (* stuff new images over old)
(for MENU in (REVERSE (WINDOWPROP WINDOW (QUOTE MENU)))
do (BLTMENUIMAGE MENU DSP)
(SHOWSHADEDITEMS MENU DSP])
)
(* misc utility fns.)
(DEFINEQ
(MAXSTRINGWIDTH
[LAMBDA (L FONT PRIN2FLG RDTBL) (* rrb " 9-JAN-82 13:49")
(for I in L bind M←0 do (SETQ M (IMAX M (STRINGWIDTH I FONT PRIN2FLG RDTBL)))
finally (RETURN M])
(CENTEREDPRIN1
[LAMBDA (EXP DS LEFT WIDTH Y) (* rrb "17-DEC-82 15:53")
(* prints an expression in the middle of a width.)
(MOVETO (IPLUS LEFT (IQUOTIENT (IDIFFERENCE WIDTH (STRINGWIDTH EXP DS))
2))
Y DS)
(PRIN3 EXP DS])
(CENTERPRINTINREGION
[LAMBDA (EXP REGION STREAM) (* rmk: "26-AUG-83 15:04")
(* prints an expression in the middle of a region)
(OR (type? REGION REGION)
(SETQ REGION (DSPCLIPPINGREGION NIL STREAM)))
(CENTERPRINTINAREA EXP (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
STREAM])
(CENTERPRINTINAREA
[LAMBDA (EXP X Y WIDTH HEIGHT STREAM) (* rmk: "29-AUG-83 18:49")
(* prints an expression in a box.)
(SETQ STREAM (\OUTSTREAMARG STREAM))
(PROG (XPOS (STRWIDTH (STRINGWIDTH EXP STREAM)))
(MOVETO (SETQ XPOS (IPLUS X (IQUOTIENT (ADD1 (IDIFFERENCE WIDTH STRWIDTH))
2)))
(IPLUS Y (IQUOTIENT (IPLUS (IDIFFERENCE HEIGHT (FONTPROP STREAM (QUOTE ASCENT)))
(FONTPROP STREAM (QUOTE DESCENT)))
2))
STREAM)
(COND
((IGREATERP (IPLUS XPOS STRWIDTH)
(DSPRIGHTMARGIN NIL STREAM))
(* if string would cause a CR to be inserted, change the right margin to avoid it. When PRIN3 is fixed so that it
never inserts CR, this can be removed.)
(RESETLST (RESETSAVE NIL (LIST (QUOTE DSPRIGHTMARGIN)
(DSPRIGHTMARGIN (IPLUS XPOS STRWIDTH)
STREAM)
STREAM))
(PRIN3 EXP STREAM)))
(T (PRIN3 EXP STREAM])
(STRICTLY/BETWEEN
[LAMBDA (VAL LOWER HIGHER) (* rrb "30-JUL-81 14:53")
(* returns T if VAL is strictly between LOWER and
HIGHER)
(AND (IGREATERP VAL LOWER)
(IGREATERP HIGHER VAL])
)
(* examples of use.)
(DEFINEQ
(UNREADITEM
[LAMBDA (ITEM MENU BUTTON) (* rrb "31-JUL-81 17:37")
(BKSYSBUF (CONCAT (MKSTRING (COND
((LISTP ITEM)
(EVAL (CADR ITEM)))
(T ITEM)))
"
"])
(TYPEINMENU
[LAMBDA (LST) (* rrb "17-NOV-81 14:04")
(create MENU
ITEMS ← LST
WHENSELECTEDFN ← (FUNCTION UNREADITEM))])
(SHADEITEM
[LAMBDA (ITEM MENU SHADE DS/W) (* hdj "31-Aug-84 14:08")
(* shades a menu item with a background shade.
DS/W if provided is the displaystream to use.)
(PROG ((ITEMREGION (MENUITEMREGION ITEM MENU))
(NEWSHADE (OR SHADE WHITESHADE))
DSP) (* if the item isn't in MENU don't do anything.)
(OR ITEMREGION (RETURN)) (* if the menu is not in a window don't do anything.)
(OR [SETQ DSP (COND
[(NULL DS/W)
(COND
((SETQ DSP (WFROMMENU MENU))
(WINDOWPROP DSP (QUOTE DSP]
((DISPLAYSTREAMP (\OUTSTREAMARG DS/W T]
(RETURN))
(\AddShade ITEM NEWSHADE MENU)
(DSPFILL ITEMREGION NEWSHADE (QUOTE REPLACE)
DSP)
(RESETLST (RESETSAVE NIL (LIST (QUOTE DSPOPERATION)
(DSPOPERATION (MOST/VISIBLE/OPERATION NEWSHADE)
DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPRIGHTMARGIN)
(DSPRIGHTMARGIN 64000 DSP)
DSP))
(RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT (fetch (MENU MENUFONT) of MENU)
DSP)
DSP))
(\SHOWMENULABEL ITEM ITEMREGION MENU DSP (fetch (MENU CENTERFLG) of MENU])
(MOST/VISIBLE/OPERATION
[LAMBDA (SHADE) (* chooses the operation that is most visible way of
putting characters on a SHADE background.)
(COND
((IGREATERP (#BITSON SHADE)
8)
(QUOTE ERASE))
(T (QUOTE PAINT])
(#BITSON
[LAMBDA (N) (* rrb "16-AUG-81 18:35")
(* determines the number of bits that are on.)
(PROG ((MASK 1)
(I 1)
NBITS)
(COND
((NOT (ZEROP (LOGAND N 1)))
(SETQ NBITS 1))
(T (SETQ NBITS 0)))
LP (COND
((EQ I BITSPERSHADE)
(RETURN NBITS)))
(SETQ MASK (LLSH MASK 1))
(SETQ I (ADD1 I))
[COND
((NOT (ZEROP (LOGAND N MASK)))
(SETQ NBITS (ADD1 NBITS]
(GO LP])
(BUTTONPANEL
[LAMBDA (LABELLST) (* rrb "17-NOV-81 14:09")
(* make items which have second element that marks
whether or not they are selected.)
(create MENU
ITEMS ← (for LABEL in LABELLST collect (LIST LABEL "Release the button to select this item."
NIL))
CENTERFLG ← T
WHENSELECTEDFN ← (FUNCTION BUTTONPANEL/SELECTION/FN)
WHENHELDFN ← (FUNCTION PPROMPT2))])
(BUTTONPANEL/SELECTION/FN
[LAMBDA (ITEM MENU BUTTON WINDOW) (* rrb "10-NOV-81 09:25")
(* flips the selection and shades the background.)
(SHADEITEM ITEM MENU (COND
((CADDR ITEM)
WHITESHADE)
(T MENUSELECTSHADE))
WINDOW)
(RPLACA (CDDR ITEM)
(NOT (CADDR ITEM])
(GETSELECTEDITEMS
[LAMBDA (WMENU) (* rrb "10-NOV-81 09:26")
(for ITEM in (fetch ITEMS of WMENU) when (CADDR ITEM) collect (CAR ITEM])
)
(RPAQQ EDITCMDS ("P" "PP" ("LF" "%
")
0 1 -1 2 3 "BK" "EF" "EVAL"))
(RPAQQ MENUHELDWAIT 1200)
(DECLARE: EVAL@COMPILE
(RPAQQ BITSPERSHADE 16)
(CONSTANTS (BITSPERSHADE 16))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MENUSELECTSHADE)
)
(RPAQQ MENUSELECTSHADE 32800)
(DEFINEQ
(MENUDESELECT
[LAMBDA (ITEM MENU) (* deselects a menu item)
(SHADEITEM ITEM MENU WHITESHADE)
(replace (MENU MENUUSERDATA) of MENU with NIL])
(MENUSELECT
[LAMBDA (ITEM MENU) (* rrb "23-SEP-81 15:26")
(* selects a menu item)
(SHADEITEM ITEM MENU MENUSELECTSHADE)
(replace (MENU MENUUSERDATA) of MENU with ITEM])
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(RPAQQ MENUFONT NIL)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MENUFONT MENUHELDWAIT)
)
[DECLARE: EVAL@COMPILE
(DATATYPE MENU (IMAGE SAVEIMAGE ITEMS MENUROWS MENUCOLUMNS MENUGRID CENTERFLG CHANGEOFFSETFLG
MENUFONT TITLE MENUOFFSET WHENSELECTEDFN MENUBORDERSIZE MENUOUTLINESIZE
WHENHELDFN MENUPOSITION WHENUNHELDFN MENUUSERDATA MENUTITLEFONT SUBITEMFN
MENUFEEDBACKFLG SHADEDITEMS)
MENUGRID ←(create REGION
LEFT ← 0
BOTTOM ← 0)
WHENHELDFN ←(QUOTE DEFAULTMENUHELDFN)
WHENUNHELDFN ←(QUOTE CLRPROMPT)
[ACCESSFNS ((ITEMWIDTH (fetch (REGION WIDTH) of (fetch (MENU MENUGRID) of DATUM))
(replace (REGION WIDTH) of (fetch (MENU MENUGRID) of DATUM)
with NEWVALUE))
(ITEMHEIGHT (fetch (REGION HEIGHT) of (fetch (MENU MENUGRID) of DATUM))
(replace (REGION HEIGHT) of (fetch (MENU MENUGRID) of DATUM)
with NEWVALUE))
(IMAGEWIDTH (fetch (BITMAP BITMAPWIDTH) of (CHECK/MENU/IMAGE DATUM)))
(IMAGEHEIGHT (fetch (BITMAP BITMAPHEIGHT) of (CHECK/MENU/IMAGE DATUM)))
(MENUREGIONLEFT (IDIFFERENCE (fetch (REGION LEFT) of (fetch (MENU MENUGRID)
of DATUM))
(fetch MENUOUTLINESIZE of DATUM)))
(MENUREGIONBOTTOM (IDIFFERENCE (fetch (REGION BOTTOM)
of (fetch (MENU MENUGRID) of DATUM))
(fetch MENUOUTLINESIZE of DATUM])
]
(/DECLAREDATATYPE (QUOTE MENU)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)))
(PUTPROPS MENU COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1746 51504 (MAXMENUITEMHEIGHT 1756 . 2386) (MAXMENUITEMWIDTH 2388 . 3210) (MENU 3212 .
6595) (MENUTITLEFONT 6597 . 7385) (ADDMENU 7387 . 11530) (DELETEMENU 11532 . 12989) (MENUREGION 12991
. 13652) (BLTMENUIMAGE 13654 . 14847) (ERASEMENUIMAGE 14849 . 15628) (DEFAULTMENUHELDFN 15630 . 15903
) (DEFAULTWHENSELECTEDFN 15905 . 16275) (BACKGROUNDWHENSELECTEDFN 16277 . 16740) (GETMENUITEM 16742 .
17211) (MENUBUTTONFN 17213 . 17771) (MENU.HANDLER 17773 . 25791) (DOSELECTEDITEM 25793 . 26021) (
SHOWSHADEDITEMS 26023 . 27368) (\AddShade 27370 . 28052) (\FDECODE/BUTTON 28054 . 28390) (
MENUITEMREGION 28392 . 30044) (\MENUITEMLABEL 30046 . 30319) (\MENUSUBITEMS 30321 . 30543) (
CHECK/MENU/IMAGE 30545 . 31773) (PPROMPT2 31775 . 32098) (UPDATE/MENU/IMAGE 32100 . 42110) (
\SHOWMENULABEL 42112 . 44750) (\SMASHMENUIMAGEONRESET 44752 . 45158) (CLOSE.PROCESS.MENU 45160 . 45341
) (DEFAULTSUBITEMFN 45343 . 45893) (GETMENUPROP 45895 . 46085) (PUTMENUPROP 46087 . 46447) (
WAKE.MY.PROCESS 46449 . 46631) (\INVERTITEM 46633 . 47021) (\ItemNumber 47023 . 47301) (\BOXITEM 47303
. 48262) (NESTED.SUBMENU 48264 . 49623) (NESTED.SUBMENU.POS 49625 . 51116) (WFROMMENU 51118 . 51502))
(52208 52674 (MENUREPAINTFN 52218 . 52672)) (52705 55197 (MAXSTRINGWIDTH 52715 . 52954) (
CENTEREDPRIN1 52956 . 53299) (CENTERPRINTINREGION 53301 . 53855) (CENTERPRINTINAREA 53857 . 54884) (
STRICTLY/BETWEEN 54886 . 55195)) (55227 59074 (UNREADITEM 55237 . 55460) (TYPEINMENU 55462 . 55654) (
SHADEITEM 55656 . 57025) (MOST/VISIBLE/OPERATION 57027 . 57327) (#BITSON 57329 . 57915) (BUTTONPANEL
57917 . 58464) (BUTTONPANEL/SELECTION/FN 58466 . 58857) (GETSELECTEDITEMS 58859 . 59072)) (59373 59911
(MENUDESELECT 59383 . 59599) (MENUSELECT 59601 . 59909)))))
STOP