don@BRILLIG.UMD.EDU (Don Hopkins) (03/31/88)
Here's the latest piemenu.ps, for NeWS 1.1! You can psh it into your
NeWS server, or load it from your user.ps. Note that because of a
problem with /flipstyle, you should load piemenu.ps after customizing
the NeWS rootmenu and its submenus. This is because flipstyle changes
the submenu objects under rootmenu, but not the variables in
systemdict that refer to them. The function /setdefaultmenu, defined
and invoked in piemenu.ps, sends a /flipstyle to roomenu and redefines
the rootmenu in systemdict. If you want to change the menus after
running piemenu.ps, one fix for this problem is to use /searchkey in
your user.ps, after running piemenu.ps, to redefine the variables in
systemdict to refer to the new submenus. Then you can send /insertitem
and /deleteitem messages to terminalmenu, etc. (Otherwise you'd be
changing the old submenus, and see no effect on the pie submenus.)
% redefine menus in systemdict after flipstyle!
(Applications =>) /searchkey rootmenu send {
/getmenuaction rootmenu send
/applicationsmenu exch def
} if
(Terminals =>) /searchkey applicationsmenu send {
/getmenuaction applicationsmenu send
/terminalmenu exch def
} if
(Fixed Startup =>) /searchkey terminalmenu send {
/getmenuaction terminalmenu send
/fixedterminalmenu exch def
} if
% etc...
The above is a bit of a kludge. The way I think it should work is that
menu actions that invoke submenus should be (executable?) keywords
that refer to menus defined in systemdict, instead of the actual menu
objects themselves. (see /getmenuaction) Then flipstyle would be able
to redefine the keywords in systemdict, instead of just sticking new
submenus into the new menus it creates. And you'd be able to just
redefine keywords in systemdict to be new menus, and the any menus
using those as submenus would reflect the changes.
I'm also including class LayeredPieMenu. Its /new method takes an
extra argument: an array of MenuArgs. The cursor distance from the menu
center determines the argument from MenuArgs returned by the
/getmenuarg method. One problem I had was that /flipstyle was
flipping the style of instances of class LayeredPieMenu, whose actions
use LayeredPieMenu's /getmenuarg method, not defined in class
LitePullRightMenu. I defined a /flipstyle method in LayeredPieMenu
that makes it immune to having its style flipped. Here is an example
of how to use class LayeredPieMenu:
/rloginmenu
[ 24 32 48 ]
[ (brillig) (gyre) (ballast) (tumtum) (amanda) (bensun) (haigha) (mimsy) ]
[ { (rsh % -n setenv NEWSSERVER % ; psterm -t h19 -bg -fl % -il % -li %)
[ currentkey % host
% get rid of hostname after ; in NEWSSERVER!
(NEWSSERVER) getenv (;) search {exch pop exch pop} if
currentkey dup % host NEWSSERVER host host
getmenuarg % host NEWSSERVER host host #lines
] sprintf
forkunix } ]
/new LayeredPieMenu send
dup /LabelMinRadius 30 put
def
% add rlogin menu
2 (Rlogin =>) rloginmenu /insertitem rootmenu send
You will get an menu of hosts, which will show "24", "32", or "48" in
the menu center when the cursor is in an active region, depending on
how far out the cursor is. You will get a psterm that menu lines tall
when you choose a host.
Try out you own ideas, by making subclasses of PieMenu and LayeredPieMenu
that do what you YOU want them to, and tell me about them! Have fun!
-Don
----Cut here: 8X--------------------------------------------------------
%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% @(#)piemenu.ps
%
% Pie menu class implementation.
% Copyright (C) 1987.
% By Don Hopkins.
% All rights reserved.
%
% Simple Simon popped a Pie Men-
% u upon the screen;
% With directional selection,
% all is peachy keen!
%
% Pie Menus are provided for UNRESTRICTED use provided that this
% copyright message is preserved on all copies and derivative works.
% This is provided without any warranty. No author or distributor
% accepts any responsibility whatsoever to any person or any entity
% with respect to any loss or damage caused or alleged to be caused
% directly or indirectly by this program. This includes, but is not
% limited to, any interruption of service, loss of business, loss of
% information, loss of anticipated profits, core dumps, abuses of the
% virtual memory system, or any consequential or incidental damages
% resulting from the use of this program.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% May 28 1987 Don Hopkins
% First cut, based on LitePullRightMenu.
%
% May 30 1987 Don Hopkins
% Uses "Thing"s from liteitem.ps for key labels. A thing can be a
% string, or a keyword. The string is shown in MenuFont. The
% keyword can be either the name of an icon in icondict, or bound
% on the dict stack to an executable function. The function takes
% a boolean as input; if true, it draws itsself; if false, it
% returns its width and height.
% NOTE: in NeWS 1.1, a Thing is either: a string, a keyword (icon
% name only), an executable array (taking /draw or /size as
% input), or an Object dict (sent a /draw and /size messages).
% See the colornames demo!
% Better label positioning scheme: top or bottom justify labels at
% at the very bottom or top of the menu, and left or right justify
% labels on the right or left sides of the menu. The points
% relative to which the labels are justified are positioned at
% evenly spaced angles in a circle around the menu center. The
% instance variable PieInitialAngle is the angle of the first
% point. LabelRadius is the distance from the menu center to each
% point, calculated as:
% LabelMinRadius + LabelRadiusPerKey * <the number of menu keys>
% NOTE: LabelRadiusPerKey is obsolete now. LabelRadius is automatically
% pushed out until no labels overlap.
% If the menu can't be centered on the location of the button
% event that invoked it, then warp the cursor to the menu center
% plus how much it has moved since the button down event, so that
% pop up menus near the screen edge and static menus work
% correctly. But ARRRGH FOO: setcursorlocation is broken!!! It
% moves the cursor, but next time you move the mouse, the cursor
% pops back to where it used to be! The Sun X server used to have
% the same problem with XWarpMouse. Makes you wonder. Well,
% anyway, I commented it out, because it's more confusing with
% setcursorlocation broken than it is not warping at all.
% NOTE: It's fixed now, so it works right!
%
% July 13 1987 Don Hopkins
% Fixed up handling of retained canvases. Changed SliceLines to
% SliceWedges, and made it draw wedges inside of LabelRadius.
% Put in MoveMenu, which moves the menu, making sure that it's
% completely on the screen, and the mouse is in the menu center.
% (The latter part should be uncommented when setcursorlocation
% is fixed.) Changed slice highlighting.
% Implemented an oops function. Pressing the adjust button moves
% the top menu so the cursor's back in its center. (Well,
% setcursorlocation is still broken ...) If the mouse is already
% in the menu center, then the menu is popped down and the
% one below it is moved so its center is at the cursor.
% NOTE: Oops works much better now that setcursorlocation is fixed!
% On AdjustButton Down (Ker), the cursor moves to the menu center.
% On AdjustButtonUp (Chunk), if the cursor is still in the menu
% center, the menu is popped down, leaving you in the previous
% menu (if any), at the location you invoked this menu from.
%
% July 24 1987 Don Hopkins
% Changed to work with NeWS 1.1 litemenu.ps ... (just in time for SIGGRAPH!)
%
% August 20, 1987 Don Hopkins
% Uncommented out and fixed the mouse warping code. Added display
% interruption, so that if the events that would make the menu
% selection are already in the event queue, then the menu is not
% displayed. I'm not sure if the way I'm doing it is the best way,
% but it seems to work. I'm still not sure that the way mouse warping
% near the screen edge and display interruption are interacting is
% really correct. It should not warp the mouse if the events are
% already in the queue, so maybe warping should be defered, as well.
% There was also a problem with /Damaged events generated when the
% canvas is reshaped, being put into the queue before the /MapMenu
% event is. This was causing the menu to be painted before the
% defered mapping took place, which is not the way I think it should
% work. So I kludged around it. There's got to be a safer way to
% make it work right.
% NOTE: This kludge has been flushed in favor of drawing the menu
% before it's mapped.
% A delay has been added to the map event, to facilitate mouse-ahead
% display suppression. If you click down and up, without moving out
% of the menu center, you will get the menu as soon you let up, but
% if you click down and move, without letting up, there will be a
% delay before it is mapped, during which time if you let up in an
% active slice region, the mapping of the menu will be suppressed
% (unless there is a submenu), and the selection you have chosen
% acted upon immediatly. The submenu delay is shorter than the delay
% of a menu with no parent, so that when you mouse-ahead quickly
% into a submenu, you will see the submenu mapped first. (Because
% the parent menu is less important than the active submenu, now
% that you've already made the selection.) This may sound quite
% bizarre, but it seems to work pretty nicely for me.
%
% March 29, 1988 Don Hopkins
% Lots of changes have been made, too many to go into excruciating
% detail, but I've put notes in the above comments to bring them
% somewhat up to date. Please destroy any evil old copies of
% piemenu.ps and replace them with this!!!
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Things to do:
%
% Teach it to use items as menu keys. Create PieItems like buttons,
% cycles, sliders and pull-out menus based on the distance,
% etc... (Use Things that are Objects!)
%
% Figure out some sort of light-weight feedback to use with mouse-ahead
% display suppression, short of mapping the menu.
%
% Make each slice a canvas, and map just the choosen slices. Leave
% a trail of wedges to the current active submenu.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
systemdict begin
systemdict /Item known not {
(NeWS/liteitem.ps) run
} if
systemdict /LiteMenu known not {
(NeWS/litemenu.ps) run
} if
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Utilities
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Replace the go! function with one that starts a root event manager
% that listens for (and ignores) menu button up events. This is so they
% don't get dropped on the floor before a pie menu can express interest
% in them. (Crucial for effective mouse-ahead!)
/go! {
verbose? { (Starting root eventmgr\n) print } if
systemdict /rooteventmgr known {
rooteventmgr type /processtype eq {
rooteventmgr killprocess
} if
} if
systemdict begin
/rooteventmgr [
/rootmenu where { pop
MenuButton
{ {newprocessgroup /showat rootmenu send} fork pop }
/DownTransition framebuffer eventmgrinterest
MenuButton
{ } /UpTransition framebuffer eventmgrinterest
} if
/Damaged
{newprocessgroup damagepath clipcanvas PaintRoot newpath clipcanvas}
null framebuffer eventmgrinterest
] forkeventmgr def
end % systemdict
} def
systemdict /rooteventmgr known {
rooteventmgr type /processtype eq {
go!
} if
} if
% Coerce an angle to be >=0 and <360.
% Note: mod returns integers, so's no good.
/NormalAngle { % angle => angle
dup 0 lt {
dup 360 sub 360 idiv 360 mul sub
} if
dup 360 ge {
dup 360 idiv 360 mul sub
} if
} def
% From demomenu.ps
% Fake method to send to a menu that returns a copy of the menu in the
% new menu style. Recursivly changes all sub-menus. One thing to look
% out for is that it does not change variables bound to the sub-menus
% that were changed, so setting /rootmenu to the result of sending
% /flipstyle to rootmenu will give you a new root menu, with a new
% terminal sub-menu, but /terminalmenu will still be bound to the old
% one, so sending messages to terminalmenu will not change the
% terminal menu you get under the new rootmenu. But sending /flipstyle
% to terminalwindow would not update the terminal menu under rootmenu.
% So get your changes in before you flip styles! Or use /searchkey to
% find the new menu, and re-def it in systemdict.
/flipstyle { % - => newmenu
0 1 MenuActions length 1 sub {
getmenuaction % fixed to use getmenuaction!
dup type /dicttype eq {
/flipstyle exch send % i menu'
MenuActions 3 1 roll put % -
} {pop pop} ifelse
} for
MenuKeys MenuActions /new DefaultMenu send
} def
% Override flipdefaultmenustyle, a function invoked from the user
% interface menu.
/flipdefaultmenustyle { % - => - (Flips default menu style)
/DefaultMenu
DefaultMenu SunViewMenu eq {PieMenu} {SunViewMenu} ifelse
store
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% PieMenu class
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/PieMenu LiteMenu
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Instance variables
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
dictbegin
% The slice currently painted.
/PaintedValue null def
% Inner radius around which labels are positioned. Based LabelMinRadius,
% LabelRadiusPerKey, and the length of MenuKeys.
/LabelRadius null def
% Minimum radius for label positioning.
/LabelMinRadius 25 def
% Radius to step by when sizing menu
/LabelRadiusStep 5 def
% Extra radius to add when sizing menu
/LabelRadiusExtra 10 def
% Direction in which the keys are laid out around the circle.
/Clockwise true def
% Pie menu outer radius. Based on LabelRadius and the bounding boxes of
% the Key Things.
/PieRadius null def
% The angle at which the first key is placed.
/PieInitialAngle 90 def % up
% The number of degrees a slice takes up. Based on length of MenuKeys.
/PieSliceWidth null def
% The current direction in degrees from the menu center to the cursor.
/PieDirection null def
% The current distance from the menu center to the cursor.
/PieDistance null def
% Angle used in loops.
/ThisAngle null def
% Amount to move the menu so that it fits entirely on the screen.
/DeltaX null def
/DeltaY null def
% Flag to remember if we've gotten a menu button down event before.
/GotDown false def
% Don't ask.
/SplatFactor 0 def
% Interruptable display event
/MapMenuEvent null def
% Delays to use before mapping, if a button up has not happened yet.
/MapLongDelay 1 60 div def % root menu popup delay
/MapShortDelay .25 60 div def % submenu popup delay
dictend
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Class variables
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
classbegin
% Highlight: true strokes, false fills.
/StrokeSelection false def
% Width of border just inside PieRadius perimiter.
/Border 3 def
% Gap between outermost label edge and border.
/Gap 9 def
% Radius of numb hole in menu center that makes no menu selection.
/NumbRadius 14 def
% Fudge factors for menu positioning.
/MouseXDelta 0 def
/MouseYDelta -3 def
% Draw lines delimiting slices.
/SliceWedges true def
% Draw arrows in the directions of slices.
/SliceArrows false def
% Drill a hole through the menu center, as big as NumbRadius.
/NumbHole false def
% Save the bits so pop-up is fast.
/RetainCanvas? true def
% Nice menu font...
/MenuFont /Helvetica-Bold findfont 12 scalefont def
% Draw arrow pointing to current selection?
/HiLiteWithArrow? true def
% Menu line attributes
/MenuLineWidth 1 def
/MenuLineCap 1 def
/MenuArrowWidth 1 def
/MenuArrowCap 1 def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Class methods
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Calculate and set the menu
% LabelRadius, PieRadius, MenuWidth, and MenuHeight. Shape the canvas
% and set the cursor.
/layout {
gsave MenuFont setfont initmatrix
/PieSliceWidth 360 MenuKeys length 1 max div store
% Get the size of all the keys, and point them in the right direction
/ThisAngle PieInitialAngle store
MenuItems {
begin
w null eq
{/Key load ThingSize /h exch def /w exch def} if
/ang ThisAngle def
/dx ang cos def
/dy ang sin def
dx abs .05 lt { % top or bottom
/xoffset w -.5 mul def
/yoffset ang 180 gt {h neg} {0} ifelse def
} { % left or right
/xoffset ang 90 gt ang 270 lt and {w neg} {0} ifelse def
/yoffset h -.5 mul def
} ifelse
/ThisAngle ThisAngle PieSliceWidth
Clockwise {sub} {add} ifelse
NormalAngle store
end
} forall
% Push the keys out so none of them overlap
/LabelRadius LabelMinRadius def
MenuItems length 1 gt {
0 1 MenuItems length 1 sub {
/i exch def
/nexti i 1 add MenuItems length mod def
{
i calcrect
nexti calcrect
rectsoverlap not {exit} if
/LabelRadius LabelRadius LabelRadiusStep add def
} loop
} for
} if
/LabelRadius LabelRadius LabelRadiusExtra add def
/PieRadius LabelRadius dup mul def
MenuItems {
begin
/x dx LabelRadius cvr mul def % XXX: cvr is for NeWS math bug
/y dy LabelRadius cvr mul def
/X x xoffset add def
/Y y yoffset add def
dx abs .05 lt { % top or bottom
x abs w 2 div add dup mul y abs h add dup mul add
} { % left or right
x abs w add dup mul y abs h 2 div add dup mul add
} ifelse
PieRadius max /PieRadius exch store
end
} forall
/PieRadius PieRadius sqrt Gap add Border add round store
/MenuWidth
PieRadius dup add store
/MenuHeight
MenuWidth store
grestore
} def
/calcrect { % item_number => x y w h
MenuItems exch get begin
LabelRadius dx mul xoffset add
LabelRadius dy mul yoffset add
w h
end
} def
/reshape {
MenuGSave
framebuffer setcanvas
newpath
PieRadius dup dup 0 360 arc
closepath
NumbHole {
PieRadius dup NumbRadius 1 sub 360 0 arcn closepath } if
SplatFactor { 6 { PieRadius dup add random mul } repeat
curveto } repeat
MenuCanvas eoreshapecanvas
/beye /beye_m MenuCanvas setstandardcursor
% So retained canvases don't have their old image upon popup:
RetainCanvas? {
MenuCanvas setcanvas
MenuFillColor fillcanvas
} if
grestore
} def
% Make sure nothing's highlighted if there's a retained canvas.
% Layout the menu, make the canvas, and reshape it, as needed. Try to
% center the menu on (XLocation, YLocation) (the location of the event
% or the (X, Y) arguments), but if needed, move it so that it's
% completely on the screen, remembering the distance moved in (DeltaX,
% DeltaY), for repositioning the mouse later. Set up the canvas. Send
% out a MapMenuEvent with a delay, so that we can supress the mapping
% if we receive the events that complete the selection right away.
% (This is mouse-ahead display suppression.) (Submenus have a shorter
% delay than parentless menus, because if you mouse quickly into a
% submenu, then wait, you're more immediatly interested in seeing the
% submenu than the parent.) Finally, reset the menu value, and
% activate the menu event manager.
/showat { % event => -
PaintedValue null ne MenuCanvas null ne and MenuWidth null ne and {
MenuGSave
PaintedValue PaintSlice
grestore
} if
/PaintedValue null store
MenuEventMgr null ne {MenuEventMgr waitprocess pop} if
MenuWidth null eq {
/layout self send
MenuCanvas null ne {/reshape self send} if
} if
MenuCanvas null eq {
/MenuCanvas ParentCanvas newcanvas def
MenuCanvas /Retained RetainCanvas? put
/reshape self send
} if
gsave
framebuffer setcanvas
dup type /eventtype eq {
begin XLocation YLocation end
} if
PieRadius sub MouseYDelta add /MenuY exch def
PieRadius sub MouseXDelta add /MenuX exch def
clippath pathbbox /DeltaY exch def /DeltaX exch def pop pop
/DeltaY
MenuY MenuHeight add
dup DeltaY ge {
DeltaY exch sub
} {
dup MenuHeight lt {
MenuHeight exch sub
} { pop 0 } ifelse
} ifelse
def
/DeltaX
MenuX MenuWidth add
dup DeltaX ge {
DeltaX exch sub
} {
dup MenuWidth lt {
MenuWidth exch sub
} { pop 0 } ifelse
} ifelse
def
/MenuX MenuX DeltaX add store
/MenuY MenuY DeltaY add store
MenuCanvas savebehindcanvas
MenuCanvas setcanvas MenuX MenuY movecanvas
MenuCanvas canvastotop
grestore
% Defer the mapping till events already in the input queue
% have been processed.
MapMenuEvent null ne {
MapMenuEvent recallevent
} if
/MapMenuEvent
createevent begin
/Name /MapMenu def
% So active submenu pops up before already choosen parent!
/TimeStamp currenttime
ParentMenu null eq {MapLongDelay} {MapShortDelay} ifelse
add def
/Canvas MenuCanvas def
currentdict
end def
MapMenuEvent sendevent
/MenuValue null def
/GotDown false def
/activate self send
} def
/paint {
MenuGSave
PaintMenuFrame
PaintMenuItems
grestore
} def
/PaintMenuFrame {
MenuGSave
MenuFillColor fillcanvas
PieRadius dup translate
newpath
0 0 PieRadius 0 360 arc closepath
0 0 PieRadius Border sub 0 360 arc closepath
% 0 0 NumbRadius 0 360 arc closepath
MenuBorderColor setcolor eofill
grestore
} def
/PaintMenuItems {
MenuGSave
false setprintermatch
PieRadius dup translate
MenuItems { % item
begin
MenuTextColor setcolor
/Key load X Y ShowThing
% There seems to be a NeWS line clipping bug with lines with one
% endpoint the right of the hole in the center of the menu ...
2 setlinequality % Solves SOME of the line glitches ...
MenuLineWidth setlinewidth
MenuLineCap setlinecap
SliceWedges {
gsave
newpath
ang PieSliceWidth 2 div sub rotate
NumbRadius 0 moveto
LabelRadius Gap sub 0 lineto
MenuBorderColor setcolor
stroke
grestore
} if
SliceArrows {
gsave
MenuArrowWidth setlinewidth
MenuArrowCap setlinecap
newpath
ang rotate
NumbRadius 0 moveto
LabelRadius .5 mul 0 lineto
currentpoint
LabelRadius .4 mul LabelRadius .04 mul lineto
moveto
LabelRadius .4 mul LabelRadius -.04 mul lineto
MenuBorderColor setcolor
stroke
grestore
} if
end
} forall
grestore
} def
% Handle drag events. If there's not a child menu up, then track the
% mouse movement, updating the menu value according the the event
% location; if it has changed, then update the highlighting.
/DragProc {
ChildMenu null eq {
MenuGSave
PieRadius dup translate
CurrentEvent begin
XLocation DeltaX add
YLocation DeltaY add
end
SetMenuValue
MenuValue PaintedValue ne {
PaintMenuValue
} if
grestore
} if
} def
% Handle enter canvas events. Just call DragProc to keep the menu
% value updated.
/EnterProc {
DragProc
} def
% Handle exit canvas events. Same as above. Here we keep tracking even
% when you're off the menu edge (due to expressing interest in events
% on the null canvas). But if it really turns you on, going off the
% edge could mean no selection (like when you're within the numb
% radius - look at SetMenuValue), or select the slice, or pop up a
% submenu, or drag the menu around, or give more info about the slice,
% or whatever.
/ExitProc {
DragProc
} def
% Pop back to the center of the menu.
/KerProc {
MenuGSave
DragProc
framebuffer setcanvas
MenuX PieRadius add MouseXDelta sub
MenuY PieRadius add MouseYDelta sub
setcursorlocation
grestore
} def
% Pop back to the previous menu, if we're in this menu's center.
/ChunkProc {
MenuGSave
DragProc
MenuValue null eq {
popdown
} if
grestore
} def
% Map the menu on the screen. This is invoked when we get a /MapMenu
% event, so that we can interrupt the display of the menu (by
% recalling the event) if the events that would complete the selection
% are already in the input queue.
/MapMenu {
gsave
DeltaX 0 ne DeltaY 0 ne or {
framebuffer setcanvas
currentcursorlocation
exch DeltaX add
exch DeltaY add
setcursorlocation
/DeltaX 0 def /DeltaY 0 def
} if
MenuCanvas mapcanvas
/MapMenuEvent null def
grestore
} def
/popdown {
MapMenuEvent null ne {
MapMenuEvent recallevent
/MapMenuEvent null def
} if
MenuCanvas null ne {MenuCanvas unmapcanvas} if % spin needs this??
RetainCanvas? not {
/MenuCanvas null store
/MenuInterests null store
% /MenuWidth null store
} if % framebuffer setcanvas?
ChildMenu null ne {
/popdown ChildMenu send
} if
ParentMenu null ne {
ParentMenu /ChildMenu null put
/ParentMenu null store
} if
MenuEventMgr null ne {
MenuEventMgr /MenuEventMgr null store killprocess
} if
} def
% Calculate and set the menu value from the cursor x y location.
% Updates /PieDistance and /PieDirection instance variables.
/SetMenuValue { % x y => - (Sets /MenuValue)
/PieDistance
2 index cvr dup mul 2 index cvr dup mul add sqrt def
exch atan /PieDirection exch def
/MenuValue
PieDistance NumbRadius le
% It could be that when the cursor is out past the menu radius,
% nothing is selected. But I don't do it that way, because it wins
% to be able to get arbitrarily more precision by moving out further.
% PieDistance PieRadius gt or
{ null }
{ PieSliceWidth 2 div PieInitialAngle
Clockwise { add PieDirection sub } { sub PieDirection add } ifelse
NormalAngle
PieSliceWidth idiv } ifelse
def
} def
% Update the highlighted slice to show the current menu value.
/PaintMenuValue { % - => - (Hilite current item, un-hilite prev one.)
PaintedValue PaintSlice
MenuValue PaintSlice
/PaintedValue MenuValue store
} def
% Paint highlighting on a menu slice. If it's null, then do nothing.
% Draw an arrow, and a box around the key.
/PaintSlice { % key => -
dup null ne { % key
MenuGSave
PieRadius dup translate
% Draw an arrow pointing out in the direction of the slice.
MenuItems exch get begin
% overlayerase
MenuBorderColor setcolor
5 setrasteropcode
HiLiteWithArrow? {
gsave
ang rotate
newpath
NumbRadius 0 moveto
LabelRadius Gap sub % r
dup .6 mul dup PieSliceWidth 3 div sin mul lineto
dup .9 mul 0 lineto
.6 mul dup PieSliceWidth -3 div sin mul lineto %
closepath
StrokeSelection {stroke} {fill} ifelse
grestore
} if
% Highlight the key Thing.
-4 2 X Y w h insetrrect rrectpath
StrokeSelection {stroke} {fill} ifelse
end
grestore
} {pop} ifelse %
} def
% Handle button up events. If we have children, then let the leaf
% child menu handle the button up event. Otherwise, we handle it: If
% it's a menu dictionary, then make it the child menu and show it.
% Otherwise, execute the associated menu action, and send a /popdown
% message to the root parent menu.
/UpProc {
DragProc
MenuValue getmenuaction dup type /dicttype eq {
/DeltaX 0 def /DeltaY 0 def % selection already made -- don't warp!
/ChildMenu exch def
ChildMenu /ParentMenu self put
CurrentEvent /showat ChildMenu send
} {
pop
% Ignore first mouse up if we're still in center of first menu
ParentMenu null ne MenuValue null ne GotDown or or {
/DeltaX 0 def /DeltaY 0 def % don't warp!
{
% Find the parent menu
self {
dup /ParentMenu get dup null eq
{ pop exit }
{ exch pop } ifelse
} loop
% ^?^? (toodles [tm]!)
/popdown exch send
domenu
} fork waitprocess % doesn't return
} {
% If we are still in menu center then map immediatly!
MapMenuEvent null ne {
MapMenuEvent recallevent
/MapMenuEvent null def
MapMenu
} if
} ifelse
} ifelse
} def
% Handle menu button down events.
/DownProc {
/GotDown true store
DragProc
} def
% Handle damage events. Gotta make sure the highlighted slice is
% re-highlighted.
/DamageProc {
MenuGSave
damagepath clipcanvas
/paint self send
PaintedValue PaintSlice
newpath clipcanvas
grestore
} def
% Construct menu event interests. Use exclusivity so only the
% top-most menu sees the events.
/makeinterests {
/MenuInterests [
MenuButton /UpProc UpTransition null eventmgrinterest
dup /Exclusivity true put
dup /Priority 5 put
MenuButton /DownProc DownTransition null eventmgrinterest
dup /Exclusivity true put
MouseDragged /DragProc null null eventmgrinterest
dup /Exclusivity true put
/EnterEvent /EnterProc null MenuCanvas eventmgrinterest
dup /Exclusivity true put
/ExitEvent /ExitProc null MenuCanvas eventmgrinterest
dup /Exclusivity true put
/Damaged /DamageProc null MenuCanvas eventmgrinterest
dup /Exclusivity true put
dup /Priority -5 put
AdjustButton /KerProc DownTransition null eventmgrinterest
dup /Exclusivity true put
AdjustButton /ChunkProc UpTransition null eventmgrinterest
dup /Exclusivity true put
% Kludge to refresh messed up retained menu canvases. Ssssh! Don't tell anyone.
PointButton {} DownTransition null eventmgrinterest
PointButton /DamageProc UpTransition MenuCanvas eventmgrinterest
/MapMenu /MapMenu null MenuCanvas eventmgrinterest
dup /Priority -5 put
] def
} def
/getmenuaction { % index => action
dup null ne {
MenuActions 1 index MenuActions length 1 sub min get
% Execute actions that are names! (This is so we can have references
% to submenus (executable names) as actions, as opposed to having the
% submenu object dict itsself!)
dup type /nametype eq { exec } if
} {nullproc} ifelse
exch pop
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/LayeredPieMenu PieMenu
dictbegin
/MenuArgs [] def
/MenuArg null def
/PaintedArg null def
dictend
classbegin
% Need to make flipstype a no-op because /new takes a different number
% of args, and actions might depend on MenuArg!
/flipstyle {currentdict} def
/new { % args keys actions => menu
% -or- args keys/actions (one array) => menu
/new super send begin
/MenuArgs exch def
currentdict end
} def
/showat {
/showat super send
/MenuArg null def
} def
/DragProc {
ChildMenu null eq {
MenuGSave
PieRadius dup translate
CurrentEvent begin
XLocation DeltaX add
YLocation DeltaY add
end
SetMenuValue
MenuValue PaintedValue ne {
PaintMenuValue
} if
MenuArg PaintedArg ne {
PaintMenuArg
} if
grestore
} if
} def
/PaintMenuArg {
PaintedArg PaintArg
MenuArg PaintArg
/PaintedArg MenuArg store
} def
/PaintArg {
dup null ne {
MenuGSave
PieRadius dup translate
MenuBorderColor setcolor
5 setrasteropcode
100 string cvs
dup stringbbox points2rect
-.5 mul exch -.5 mul exch moveto
pop pop
show
grestore
} if
} def
/SetMenuValue { % x y => -
/SetMenuValue super send
/MenuArg
MenuValue null eq
MenuArgs length 0 eq or {
null
} {
PieDistance PieRadius 1 sub min NumbRadius sub
PieRadius NumbRadius sub div MenuArgs length mul floor
MenuArgs exch get
} ifelse
def
} def
/getmenuarg {
MenuArg
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/setdefaultmenu { % class => -
/DefaultMenu exch store
/rootmenu /flipstyle rootmenu send store
} def
% Death to pulldown menus!
PieMenu setdefaultmenu
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%