(FILECREATED " 4-Aug-85 20:31:14" {ERIS}<LISPCORE>SOURCES>MENU.;22 68886
changes to: (FNS \POSITION.MENU.IMAGE)
previous date: "21-Jul-85 01:16:49" {ERIS}<LISPCORE>SOURCES>MENU.;21)
(* Copyright (c) 1982, 1983, 1984, 1985 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 \POSITION.MENU.IMAGE
\SMASHMENUIMAGEONRESET CLOSE.PROCESS.MENU DEFAULTSUBITEMFN GETMENUPROP PUTMENUPROP
WAKE.MY.PROCESS \INVERTITEM \MENU.ITEM.SELECT \MENU.ITEM.DESELECT \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 " 2-May-85 13:58")
(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 SELVAL DSP) (* make sure the image is a window)
[SETQ IMAGE (COND
((NEQ POSITION (QUOTE INPLACE))
(\POSITION.MENU.IMAGE MENU POSITION))
(T (fetch (MENU IMAGE) of MENU]
(SETQ DSP (WINDOWPROP IMAGE (QUOTE DSP)))
[SETQ SELVAL (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 SELVAL)
(SELVAL (DOSELECTEDITEM MENU (CAR SELVAL)
(CDR SELVAL])
(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) (* hdj "12-Apr-85 14:07")
(* 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)
(SHOWSHADEDITEMS ADDEDMENU W)
(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) (* hdj "12-Apr-85 14:05")
(* 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 (PROG1 (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)))
(SHOWSHADEDITEMS MENU DSTWIN]
(T (PROG1 (BITBLT SRC NIL NIL DSTWIN (fetch (MENU MENUREGIONLEFT) of MENU)
(fetch (MENU MENUREGIONBOTTOM) of MENU))
(SHOWSHADEDITEMS MENU DSTWIN])
(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 "21-May-85 15:12")
(DECLARE (SPECVARS SUBMENU MOVEDLEFT)) (* 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))
SUBMENUWINDOW SUBMENU)
(* SUBMENUWINDOW is used to hold the window of the submenu and to indicate if a submenu is up.
SUBMENU is to hold onto the submenu so it can be passed to MENU if it is entered.)
[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.)
(SETQ SUBMENUWINDOW (\MENU.ITEM.SELECT (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)
(SETQ SUBMENUWINDOW
(\MENU.ITEM.SELECT OLDBOXX
OLDBOXY
MENU DSP]
NIL))
do [COND
[(OR (AND SUBMENUWINDOW (INSIDE?
(fetch (WINDOW REG) of SUBMENUWINDOW)
LASTMOUSEX LASTMOUSEY))
(AND SUBMENU (EQ (GRIDYCOORD (LASTMOUSEY
DSP)
MGRIDSPEC)
OLDBOXY)
(IGEQ (GRIDXCOORD (LASTMOUSEX DSP)
MGRIDSPEC)
NCOLUMNS)))
(* either the cursor moved into or already was inside of the submenu, or it rolled out the right side of an item
that has non-popup submenu items. It could already be inside if the submenu came up over the menu.
This can lead to funny interactions of submenus popping up and automatically being selected when near the right edge
of the screen but I can't think of anything better and this is at least consistent.)
(* call submenu and process result.)
(COND
((EQ (SETQ SUBMENURESULT
(MENU SUBMENU
(COND
(SUBMENUWINDOW (QUOTE INPLACE))
(T (NESTED.SUBMENU.POS
MENU
(GETMENUITEM MENU OLDBOXX
OLDBOXY)
DSP)))
NIL T))
MOVEDLEFT)
(* user moved back to left without selecting anything.)
(* reopen the submenu which was closed by MENU on its way out. This would be cleaner to have MENU not close it but
this is hard to error set protect correctly.)
(AND SUBMENUWINDOW (OPENW SUBMENUWINDOW))
(SETQ SUBMENURESULT NIL))
(T (* selected something from submenu)
(COND
(MOUSEDOWN (\MENU.ITEM.DESELECT OLDBOXX
OLDBOXY
MENU DSP))
(T (\BOXITEM OLDBOXX OLDBOXY MENU DSP)))
(MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
(SETQ OLDBOXX)
(GO OUT]
[(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.)
(* deselect old item if there was one.)
[COND
(OLDBOXX (COND
(MOUSEDOWN (\MENU.ITEM.DESELECT
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 (SETQ SUBMENUWINDOW
(\MENU.ITEM.SELECT 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 out of the menu, deselect any selected
items)
(COND
(OLDBOXX (COND
(MOUSEDOWN (\MENU.ITEM.DESELECT
OLDBOXX OLDBOXY MENU
DSP))
(T (\BOXITEM OLDBOXX OLDBOXY MENU
DSP)))
(MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
(SETQ OLDBOXX)))
(COND
((AND NESTEDFLG BOXX (IGREATERP 0 BOXX)
(ILESSP (LASTMOUSEX DSP)
0))
(* make sure the mouse has moved all the way past the left including its border and outline size.
We know it has to be a popup menu that will have 0 as its left edge.)
(* if this is a nested call and the user moved to the
left, return indicator of this.)
(RETURN MOVEDLEFT))
((NOT KEEPCONTROLIFOUTFLG)
(RETURN]
(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 (\MENU.ITEM.DESELECT
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. ↑d is handled by RESETLST.)
[COND
(OLDBOXX (COND
(MOUSEDOWN (\MENU.ITEM.DESELECT 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 "12-Apr-85 13:58")
(* returns the region for ITEM in IMENU.
NIL if ITEM isn't in IMENU.)
(CHECK/MENU/IMAGE IMENU) (* COMPUTE MENUCOLUMNS ETC)
(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])
(\POSITION.MENU.IMAGE
[LAMBDA (MENU POSITION) (* mpl " 4-Aug-85 20:30")
(* puts a menu image window in the right place on the
screen. Subfunction to MENU)
(PROG (IMAGE MX MY) (* make sure the image is a window)
(CHECK/MENU/IMAGE MENU T)
(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 IMAGE (FETCH (MENU IMAGE) OF MENU))
(MOVEW IMAGE (create POSITION
XCOORD ← MX
YCOORD ← MY))
(SHOWSHADEDITEMS MENU IMAGE)
(RETURN IMAGE])
(\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])
(\MENU.ITEM.SELECT
[LAMBDA (COLUMN ROW MENU DSP) (* rrb "21-May-85 13:57")
(DECLARE (USEDFREE SUBMENU))
(* selects an item in a menu displayed in DSP. Looks for submenus and brings those up as well.
Returns the image window of the submenu if it was brought up.)
(PROG (ITEM SUBITEMS)
(\INVERTITEM COLUMN ROW MENU DSP)
(RETURN (AND (SETQ ITEM (GETMENUITEM MENU COLUMN ROW))
(SETQ SUBITEMS (\MENUSUBITEMS MENU ITEM))
(COND
[(EQ (CAR SUBITEMS)
(QUOTE POPUP)) (* if the first item is POPUP then bring up the menu.)
(SETQ SUBMENU (NESTED.SUBMENU MENU (CDR SUBITEMS)))
(OPENW (\POSITION.MENU.IMAGE SUBMENU (NESTED.SUBMENU.POS MENU ITEM DSP]
(T (* otherwise just create it but don't bring it up.)
(SETQ SUBMENU (NESTED.SUBMENU MENU SUBITEMS))
NIL])
(\MENU.ITEM.DESELECT
[LAMBDA (COLUMN ROW MENU DSP) (* rrb "21-May-85 15:11")
(DECLARE (USEDFREE SUBMENU SUBMENUWINDOW))
(* deselects an item in a menu displayed in DSP. Also takes care of closing the submenu and resetting the variables
that indicate that there is a submenu.)
(\INVERTITEM COLUMN ROW MENU DSP)
(AND SUBMENUWINDOW (CLOSEW SUBMENUWINDOW))
(SETQ SUBMENUWINDOW (SETQ SUBMENU NIL])
(\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 "11-Apr-85 12:11")
(* 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])
)
(* 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 "12-Apr-85 14:01")
(* shades a menu item with a background shade.
DS/W if provided is the displaystream to use.)
(PROG ((NEWSHADE (OR SHADE WHITESHADE))
DSP ITEMREGION)
(SETQ ITEMREGION (MENUITEMREGION ITEM MENU)) (* if the item isn't in MENU don't do anything.)
(OR ITEMREGION (RETURN))
(\AddShade ITEM NEWSHADE MENU) (* if the menu is not in a window mark it as shaded but
don't try to display)
(if [SETQ DSP (COND
[(NULL DS/W)
(COND
((SETQ DSP (WFROMMENU MENU))
(WINDOWPROP DSP (QUOTE DSP]
((DISPLAYSTREAMP (\OUTSTREAMARG DS/W T]
then (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))
(QUOTE ((MENU 0 POINTER)
(MENU 2 POINTER)
(MENU 4 POINTER)
(MENU 6 POINTER)
(MENU 8 POINTER)
(MENU 10 POINTER)
(MENU 12 POINTER)
(MENU 14 POINTER)
(MENU 16 POINTER)
(MENU 18 POINTER)
(MENU 20 POINTER)
(MENU 22 POINTER)
(MENU 24 POINTER)
(MENU 26 POINTER)
(MENU 28 POINTER)
(MENU 30 POINTER)
(MENU 32 POINTER)
(MENU 34 POINTER)
(MENU 36 POINTER)
(MENU 38 POINTER)
(MENU 40 POINTER)
(MENU 42 POINTER)))
(QUOTE 44))
(PUTPROPS MENU COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1821 57658 (MAXMENUITEMHEIGHT 1831 . 2496) (MAXMENUITEMWIDTH 2498 . 3368) (MENU 3370 .
5548) (MENUTITLEFONT 5550 . 6386) (ADDMENU 6388 . 10774) (DELETEMENU 10776 . 12350) (MENUREGION 12352
. 13013) (BLTMENUIMAGE 13015 . 14418) (ERASEMENUIMAGE 14420 . 15227) (DEFAULTMENUHELDFN 15229 . 15530
) (DEFAULTWHENSELECTEDFN 15532 . 15946) (BACKGROUNDWHENSELECTEDFN 15948 . 16439) (GETMENUITEM 16441 .
16934) (MENUBUTTONFN 16936 . 17534) (MENU.HANDLER 17536 . 27339) (DOSELECTEDITEM 27341 . 27582) (
SHOWSHADEDITEMS 27584 . 29029) (\AddShade 29031 . 29713) (\FDECODE/BUTTON 29715 . 30067) (
MENUITEMREGION 30069 . 31818) (\MENUITEMLABEL 31820 . 32105) (\MENUSUBITEMS 32107 . 32341) (
CHECK/MENU/IMAGE 32343 . 33639) (PPROMPT2 33641 . 33991) (UPDATE/MENU/IMAGE 33993 . 44003) (
\SHOWMENULABEL 44005 . 46796) (\POSITION.MENU.IMAGE 46798 . 48924) (\SMASHMENUIMAGEONRESET 48926 .
49348) (CLOSE.PROCESS.MENU 49350 . 49543) (DEFAULTSUBITEMFN 49545 . 50167) (GETMENUPROP 50169 . 50363)
(PUTMENUPROP 50365 . 50745) (WAKE.MY.PROCESS 50747 . 50941) (\INVERTITEM 50943 . 51339) (
\MENU.ITEM.SELECT 51341 . 52379) (\MENU.ITEM.DESELECT 52381 . 52881) (\ItemNumber 52883 . 53173) (
\BOXITEM 53175 . 54238) (NESTED.SUBMENU 54240 . 55656) (NESTED.SUBMENU.POS 55658 . 57258) (WFROMMENU
57260 . 57656)) (58253 58704 (MENUREPAINTFN 58263 . 58702)) (58735 61407 (MAXSTRINGWIDTH 58745 . 59000
) (CENTEREDPRIN1 59002 . 59369) (CENTERPRINTINREGION 59371 . 59937) (CENTERPRINTINAREA 59939 . 61082)
(STRICTLY/BETWEEN 61084 . 61405)) (61437 65596 (UNREADITEM 61447 . 61698) (TYPEINMENU 61700 . 61892) (
SHADEITEM 61894 . 63407) (MOST/VISIBLE/OPERATION 63409 . 63725) (#BITSON 63727 . 64397) (BUTTONPANEL
64399 . 64951) (BUTTONPANEL/SELECTION/FN 64953 . 65370) (GETSELECTEDITEMS 65372 . 65594)) (65895 66436
(MENUDESELECT 65905 . 66122) (MENUSELECT 66124 . 66434)))))
STOP