hopkins@sun.com (Don Hopkins) (05/23/91)
Here's an implementation of pie menus and tab windows the the NeWS
toolkit, version TNT2.0fcs or TNT3.0beta. (TNT2.0 runs under OpenWindows
2.0 and is a separately distributed product.) This distribution includes
the files "pie.ps", "tab.ps", and "winit.ps". Put them in a directory
somewhere, adjust the file names in "winit.ps", and put something like:
(tnt/win/winit.ps) LoadFile pop
into your ".user.ps" file. This will take effect next time you start
another window server. If you want to try them out right now, you can
simply "psh" the files "pie.ps" and "win.ps" in that order.
For a demo, just type the following (if you're running V3, you'll also
have to do the beginpackage stuff):
psh
/demo ClassTabBaseWindow send
When you get some tab windows on the screen, try pressing the menu (right)
button over them and play around with the various functions. You can press
the point (left) or adjust (middle) buttons over the tab, and move the tab
or the window around in various ways. Try dragging the window by the
header, and stretching the resize corners of course. Don't forget to see
what happens while you're moving or resizing, when you press down the meta
key, the alt key, and even the shift key (if you have cycles to burn)!
When you get sick of the spiffy animation of pie menus spinning and
flipping and flying out of the screen, there is an easy way to supress it.
When your muscles can remember the direction of the item you want, you can
mouse ahead into the menu, and the display will be supressed -- you won't
even see the menu at all! To mouse ahead, press and hold the menu button,
drag in the direction you want, then release, in a smooth quick gesture.
You don't have to drag very far, but the further out you move, the better
your control of the direction! You can even quickly select from nested
submenus this way. You will know you're doing the right thing when you see
just the outline of the wedge that you're mousing ahead into.
The spiffy special effects you see when you don't mouse ahead are actually
negative reinforcement designed to make you *want* to mouse ahead to avoid
seeing the menu display, which is the whole point of using pie menus!
Pretty soon you will be totally sick of the spiffy animation but it will
not matter because you will mouse ahead all the time and never see it! But
if you really want to turn it off, so the menus pop up fast, you can set
the /Spiffy? flag to false. Or if you want them to animate even longer,
there's a variable you can frob for that, too.
TNT programmers can use ClassTabBaseWindow and ClassTabPopupWindow just
like ClassBaseWindow and ClassPopupWindow to manage any TNT application.
ClassPieMenuCanvas is a canvas subclass that allows you to pop up a
pie menu with the right button. You can mix it in with other canvas
subclasses you want to be "piemenuable". ClassPieMenu is pretty much like
ClassMenu in its application programmer interface, but not its user
interface!
Please send any comments and suggestions to "hopkins@sun.com".
Take a look and feel free!
-Don
==== winit.ps: cut here ================================================
% Autoloads for pie menus and tab windows.
% Load this from ".user.ps".
% Make sure the file names are correct, relative to the directory
% you started the server in!
%
systemdict begin
openwinversion 0 get 51 eq
dup { % V3?
/TNT 3 0 findpackage begin
currentdict beginautoload
} if
[ /ClassPieMenu (tnt/win/pie.ps)
/ClassPieMenuService (tnt/win/pie.ps)
/ClassPieMenuCanvas (tnt/win/pie.ps)
/ClassTabWindow (tnt/win/tab.ps)
/ClassTabBaseWindow (tnt/win/tab.ps)
/ClassTabPopupWindow (tnt/win/tab.ps)
/ClassPieMenuWindowManager (tnt/win/tab.ps)
] DefineAutoLoads
{ % V3?
currentdict endautoload end
} if
end % systemdict
==== pie.ps: cut here ==================================================
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Pie Menus for the NeWS toolkit
% Version 3.0.1
%
% Copyright (C) 1991, by Don Hopkins. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This file implements pie menus for the NeWS toolkit.
% It should work with TNT2.0fcs on OW2.0fcs and TNT3.0beta on OW3.0beta.
% This code and the ideas behind it were developed over time by Don Hopkins
% at the University of Maryland, UniPress Software, and Sun Microsystems.
% Pie menus and tab windows and NOT patented or restricted, and the
% interface and algorithms may be freely copied and improved upon.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
openwinversion 0 get 51 eq { % XXX: V3
/NeWS 3 0 findpackage beginpackage
/TNTCore 3 0 findpackage beginpackage
/TNT 3 0 findpackage dup beginpackage
dup beginautoload begin
/CVSEC { aload pop 1000000 div add } def
/SUBTIMEVAL { timeval subtimeval } def
} { % XXX: V2
systemdict begin
/CVSEC { 60 mul } def
/SUBTIMEVAL { sub } def
} ifelse
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassPieMenu
%
/ClassPieMenu [ClassCanvas ClassControl] [
/Direction /Distance
/SliceWidth /Radius
/CurrentValue /PaintedValue
] classbegin
% Canvas defaults:
/SaveBehind true def
/Transparent false def
/Mapped false def
/Retained false def
% Class variables:
/BaseMenu? false def
/SkipNextDamage? false def
/Label null def
/ItemList nullarray def
/ItemListValid? false def
/Invoker null def % Object that invoked the menu
/Border 3 def
/Gap 6 def
/Pad 1 def
/InactiveRadius 4 def
/RadiusMin 15 def
/RadiusExtra 2 def
/RadiusStep 2 def
/Clockwise? true def
/InitialAngle 90 def % up
/Sliced? true def
/Spiffy? true def
/ThrowSec .25 def
/TextFont /LucidaSans-Bold findfont 12 scalefont
false printermatchfont
/ISOLatin1Encoding encodefont def
% Existential stuff:
/NewInit { % parent => instance
/NewInit super send
/Radius 0 def
GlobalEventMgr /activate self send
} def
/destroy { % - => -
null /setinvoker self send
/destroy super send
} def
% Label stuff:
/label { % - => (label)
Label
} def
/setlabel { % (label) => -
/Label exch promote
} def
% Item stuff:
/List { % - => ItemList
ItemList
} def
/Move { % x y item => -
begin
/ItemY exch def
/ItemX exch def
end
} def
/Size { % item | self => width height
dup self eq {
/size exch send
}{
begin ItemWidth ItemHeight end
} ifelse
} def
/Location { % item | self => x y
dup self eq {
pop 0 0
}{
begin ItemX ItemY end
} ifelse
} def
/ResolveReference { % self | item-index => self | item
dup type /integertype eq {
ItemList exch get
} if
} def
/setitemlist { % [item0 ...] => -
/invalidate self send
/ItemListValid? unpromote
dup length dup array /ItemList exch promote
1 sub 0 1 3 2 roll {
2 copy get
/NewItem self send
ItemList 3 1 roll put
pause
} for
pop
} def
/insertitem { % item-index item
/invalidate self send
/ItemListValid? unpromote
/NewItem self send
ItemList 3 1 roll arrayinsert
/ItemList exch promote
} def
/deleteitem { % item-index => -
/invalidate self send
/ItemListValid? unpromote
ItemList exch arraydelete
/ItemList exch promote
} def
/replaceitem { % item-index item => -
/invalidate self send
/ItemListValid? unpromote
/NewItem self send
ItemList 3 1 roll % il i# i
put
} def
/appenditem { % item => -
/invalidate self send
/ItemListValid? unpromote
/NewItem self send
ItemList exch arrayappend
/ItemList exch promote
} def
% Translate an external item representation to an internal item dict.
% di can be a display item, or a dictionary (isobject? = false).
% The dictionary must contain the keys /DisplayItem and /SubMenu
% or /Notifier.
%
/NewItem { % string | [displayitem] | [di notify] | [di submenu] => item
dictbegin
dup type /stringtype eq { % string
/DisplayItem exch def % -
}{ % [ di stuff(opt.) ]
dup 0 get /DisplayItem exch def
dup length 1 eq {pop}{
1 get dup isobject? {
/SubMenu exch def
}{
/Notifier exch def
} ifelse
} ifelse
} ifelse
dictend % item
} def
/itemsize { % item-index => width height
/?validate self send
ItemList exch get begin
ItemWidth ItemHeight
end
} def
/itembbox { % item-index => x y width height
/?validate self send
ItemList exch get begin
ItemX ItemY ItemWidth ItemHeight
end
} def
/itemlocation { % item-index => x y
/?validate self send
ItemList exch get begin
ItemX ItemY
end
} def
/itemlist { % - => [ item0 ... ]
/itemcount self send dup array
0 1 4 -1 roll 1 sub {
2 copy /item self send
exch 4 1 roll put
pause
} for
} def
/itemcount { % - => n
ItemList length
} def
/item { % index => string | [displayitem] | [di notify] | [di submenu]
/Item self send % dict
dup /DisplayItem get /stringtype ne % dict bool1
1 index /Notifier known % dict bool1 bool2
2 index /SubMenu known % dict bool1 bool2 bool3
2 copy 5 2 roll or or { % dict bool2 bool3
2 copy or { % dict bool2 bool3
pop exch dup 3 -1 roll % dict dict bool2
{ /Notifier } { /SubMenu } ifelse get % dict notify|submenu
exch /DisplayItem get % notify|submenu di
exch 2 array astore % [di notify|submenu]
}{ % dict false false
pop pop /DisplayItem get 1 array astore % [di]
} ifelse
}{ % dict bool2 bool3
pop pop
/DisplayItem get % string
} ifelse
} def
/Item { % item-index => item
ItemList exch get
} def
/pointtoitem { % x y => item-index true | false
/?validate self send
Radius dup xysub
/SetCurrentValue self send
CurrentValue dup null eq { pop false } { true } ifelse
} def
/pointinitem? { % x y <item index> => boolean
/?validate self send
/PointInItem? self send
} def
/PointInItem? { % x y <item index> => boolean
3 1 roll /pointtoitem self send eq
} def
% Layout:
/clockwise? { % - => clockwise
Clockwise?
} def
/setclockwise { % clockwise => -
/Clockwise? exch promote
/invalidate self send
} def
/initialangle { % - => initialangle
InitialAngle
} def
/setinitialangle { % initialangle => -
/InitialAngle exch promote
/invalidate self send
} def
/radiusmin { % - => radiusmin
RadiusMin
} def
/setradiusmin { % radiusmin => -
/RadiusMin exch promote
/invalidate self send
} def
/inactiveradius { % - => inactiveradius
InactiveRadius
} def
/setinactiveradius { % inactiveradius => -
/InactiveRadius exch promote
/invalidate self send
} def
/sliced? { % - => bool
Sliced?
} def
/setsliced { % bool => -
/Sliced? exch promote
} def
/minsize { % - => w h
/?validate self send
Radius dup add dup
} def
/validate { % - => -
/Layout self send
/validate super send
gsave
Parent setcanvas
/minsize self send
2 copy /size self send
3 -1 roll ne 3 1 roll ne or {
/location self send 4 2 roll /reshape self send
} { pop pop } ifelse
/Valid? true def % XXX
grestore
} def
/Layout { % - => -
PieGSave self setcanvas
% Deflate the menu.
/Radius 0 def
% Figure the slice width.
/SliceWidth 360 /itemcount self send 1 max div def
% Point the initial slice in the initial angle.
/ThisAngle InitialAngle store
% Loop through the items, validating each one.
ItemList {
begin % item
% Measure the label.
/DisplayItem load DisplayItemSize
/ItemHeight exch def
/ItemWidth exch def
% Remember the angle and the direction.
/Angle ThisAngle def
/DX Angle cos def
/DY Angle sin def
% Figure the offset from the tip of the inner radius
% spoke to the lower left label corner, according to
% the direction of the item.
%
% Labels at the very top (bottom) are centered on their
% bottom (top) edge. Labels to the left (right) are
% centered on their right (left) edge.
%
DX abs .05 lt { % tippy top or bippy bottom
% Offset to the North or South edge of the label.
/XOffset ItemWidth -.5 mul def
/YOffset
DY 0 lt {ItemHeight neg} {0} ifelse
def
} { % left or right
% Offset to the East or West edge of the label.
/XOffset
DX 0 lt {ItemWidth neg} {0} ifelse
def
/YOffset ItemHeight -.5 mul def
} ifelse
% Twist around to the next item.
/ThisAngle
ThisAngle SliceWidth
Clockwise? {sub} {add} ifelse
NormalAngle
store
end % item
} forall
% Figure the inner label radius, at least enough to prevent
% the labels from overlapping.
/LabelRadius RadiusMin def
/itemcount self send 3 gt { % No sweat if 3 or less.
% Check each item label against its following neighbor.
0 1 /itemcount self send 1 sub {
/I exch def
/NextI I 1 add /itemcount self send mod def
% See if these two labels overlap.
% If they do, keep pushing the label radius out
% by RadiusStep until they don't.
{ I /CalcRect self send
NextI /CalcRect self send
rectsoverlap not {exit} if % They don't overlap!
% They overlap. Push them out a notch and try again.
/LabelRadius LabelRadius RadiusStep add def
} loop
} for
% Now that we've gone around once checking each pair,
% none of them overlap any more!
} if
% Add in some more space to be nice.
/LabelRadius LabelRadius RadiusExtra add def
% Now we need to calculate the outer radius, based on the radius
% of the farthest label corner. During the loop, Radius actually
% holds the square of the radius, since we're comparing it against
% squared label corner radii anyway.
/Radius LabelRadius dup mul def
ItemList {
begin % item
% Remember the location to center the label edge.
/x DX LabelRadius mul def
/y DY LabelRadius mul def
% Remember the location of the label's SouthWest corner.
/ItemX x XOffset add round def
/ItemY y YOffset add round def
% Figure the distance of the label's farthest corner.
% This is easy 'cause we can fold all the labels into
% the NorthEast quadrant and get the same result.
DX abs .05 lt { % tippy top or bippy bottom
% (|x|,|y|) is South edge: radius^2 of NorthEast corner
x abs ItemWidth .5 mul add dup mul
y abs ItemHeight add dup mul add
} { % left or right
% (|x|,|y|) is West edge: radius^2 of NorthEast corner
x abs ItemWidth add dup mul
y abs ItemHeight .5 mul add dup mul add
} ifelse
% Remember the maximum corner radius seen so far.
Radius max /Radius exch store
end % item
} forall
% Take the square root and add some extra space.
/Radius
Radius sqrt Gap add Border add ceiling cvi
store
grestore % Whew, we're done! Time to party!
} def
/CalcRect { % item-number => x y w h
/Item self send begin
LabelRadius DX mul XOffset add Pad sub
LabelRadius DY mul YOffset add Pad sub
ItemWidth Pad dup add add ItemHeight Pad dup add add
end
} def
/NormalAngle { % angle => angle
dup 0 lt {
dup 360 sub 360 div cvi 360 mul sub
} if
dup 360 ge {
dup 360 div cvi 360 mul sub
} if
} def
/PieGSave { % - => -
gsave
self setcanvas
Radius dup translate
TextFont setfont
} def
% Painting:
/FixAll { % - => -
SkipNextDamage? {
/SkipNextDamage? unpromote
damagepath newpath
} {
/FixAll super send
} ifelse
} def
/Paint { % - => -
gsave
TextFont setfont
Radius dup translate
/PaintFrame self send
/PaintItems self send
true CurrentValue PaintSlice
grestore
} def
/PaintFrame { % - => -
0 0 Radius 1 add 45 225 arc closepath
0 0 Radius Border sub 45 225 arc closepath
3D? { BG0 } { 2DFG } ifelse setcolor eofill
0 0 Radius 1 add 225 45 arc closepath
0 0 Radius Border sub 225 45 arc closepath
3D? { BG3 } { 2DFG } ifelse setcolor eofill
0 0 Radius Border sub .9 add 0 360 arc closepath
BackgroundColor setcolor fill
} def
/PaintItems { % - => -
ForegroundColor setcolor
ItemList {
begin
ItemX ItemY moveto
/DisplayItem load DisplayItemPaint
Sliced? {
newpath
Angle SliceWidth .5 mul sub
matrix currentmatrix
exch rotate
InactiveRadius 0 moveto
LabelRadius Gap sub 0 lineto
ForegroundColor setcolor
stroke
setmatrix
} if
end
} forall
} def
/PaintCurrentValue { % - => -
false PaintedValue PaintSlice
true CurrentValue PaintSlice
/PaintedValue CurrentValue store
} def
% Paint highlighting on a menu slice. If it's null, then do nothing.
%
/PaintSlice { % draw key => -
dup null eq {pop pop} {
PieGSave
10 dict begin % localdict
exch /Hilite? exch def
/Item self send begin
% Highlight the key
Hilite? {
-2 ItemX ItemY ItemWidth ItemHeight insetrect
3D? { true Paint3DBox } { false Paint2DBox } ifelse
ForegroundColor setcolor
} {
BackgroundColor setcolor
-3 ItemX ItemY ItemWidth ItemHeight insetrect
rectpath fill
ForegroundColor setcolor
} ifelse
ItemX ItemY moveto /DisplayItem load
end % keydict
end % localdict
DisplayItemPaint
grestore
} ifelse
} def
/path { % x y w h => -
ovalpath
} def
% Tracking:
/showat { % posname event => -
/BaseMenu? true def
Parent setcanvas
dup 3 1 roll begin % event posname
XLocation YLocation % event posname x y
end
/popup self send % event
/PieStart self send %
} def
/popup { % posname x y => -
/?validate self send
/PaintedValue null def
/CurrentValue null def
Parent setcanvas
Radius dup xysub
/move self send
/totop self send
pop
} def
/?Reveal {
Mapped not { /Reveal self send } if
} def
/Reveal { % - => -
/SkipNextDamage? true promote
/ClearOverlay self send
gsave Parent setcanvas
10 dict begin % localdict
% Force menu on screen
/bbox self send rect2points % x0 y0 x1 y1
/y1 exch def /x1 exch def % x0 y0
/y0 exch def /x0 exch def %
/size Parent send % w h
/h exch def /w exch def %
x0 0 lt {
x0 neg % dx=-x0
} {
x1 w gt {
w x1 sub % dx=w-x1
} { 0 } ifelse % dx=0
} ifelse % dx
y0 0 lt {
y0 neg % dx dy=-y0
} {
y1 h gt {
h y1 sub % dx dy=h-y1
} { 0 } ifelse % dx dy=0
} ifelse % dx dy
end % localdict
2 copy 0 eq exch 0 eq and {
pop pop %
} { % dx dy
2 copy /location self send xyadd % dx dy dx+x dy+y
/move self send % dx dy
/CurrentMenu PieMenuService send
self ne { pop pop } {
currentcursorlocation xyadd % dx+cx dy+cy
setcursorlocation %
} ifelse
} ifelse
Spiffy? {
/ThrowPie self send
} {
/map self send
/paint self send
} ifelse
grestore
} def
/ThrowPie { % - => -
{ 100 dict begin gsave
/c self newcanvas def
c /Mapped false put
c /Transparent false put
c /Retained true put
self setcanvas
clippath
c reshapecanvas
c setcanvas
/PaintedValue null store
Radius dup translate
TextFont setfont
/PaintFrame self send
/PaintItems self send
/map self send
self setcanvas
Radius dup translate
/top? /CurrentMenu PieMenuService send self eq def
/t0 currenttime def
/spin 0 def
top? {
currentcursorlocation
1 index dup mul 1 index dup mul add sqrt
InactiveRadius le {
/spin 360 def
pop pop 90
} { exch atan } ifelse
} {
Direction
} ifelse
/a exch def
{ /i
currenttime t0 SUBTIMEVAL CVSEC ThrowSec div
.9 mul .1 add
def
i 1 ge { exit } if
gsave
a rotate
i i mul .02 max
i .02 max
scale
1 i sub spin mul a sub rotate
Radius neg dup translate
newpath Radius dup dup 0 360 arc closepath
clip newpath
c imagecanvas
grestore
} loop
Radius neg dup translate
c imagecanvas c /Retained false put
self setcanvas Radius dup translate
top? {
currentcursorlocation /SetCurrentValue self send
} if
/PaintCurrentValue self send
} fork pop
} def
/popdown { % event notify? => -
/unmap self send
{ /PieStop self send } { /PieCancel self send } ifelse
BaseMenu? {
currentcanvas
/CurrentClient PieMenuService send dup setcanvas
self /PieMenuStop 3 -1 roll send
/BaseMenu? unpromote
setcanvas
} if
/PaintedValue null store
} def
/UnPaintValue { % - => -
PaintedValue null ne {
false PaintedValue PaintSlice
/PaintedValue null store
} if
} def
/PieStart { % event => -
/PieMotion self send
} def
/PieMotion { % event => -
PieGSave
begin XLocation YLocation end
/SetCurrentValue self send
Mapped {
PaintedValue CurrentValue ne {
/PaintCurrentValue self send
} if
} {
Overlay setcanvas erasepage
CurrentValue null ne {
/location self send Radius dup xyadd translate
0 0 moveto
0 0 Radius
ItemList CurrentValue get /Angle get
SliceWidth .5 mul sub
dup SliceWidth add
arc
closepath
stroke
} if
} ifelse
grestore
} def
/PieStop { % event => -
/PieMotion self send
/ClearOverlay self send
CurrentValue null ne {
CurrentValue /NotifyItem self send
} if
} def
/PieCancel { % event => -
pop /ClearOverlay self send
} def
/Overlay { % - => can
Parent createoverlay
/Overlay 1 index promote
} def
/ClearOverlay { % - => -
/Overlay promoted? {
Overlay setcanvas erasepage
/Overlay unpromote
} if
} def
/Notifier {pop pop} def
/NotifyItem { % index => -
dup /Item self send % index child
begin /Notifier load end % index proc
/ExecuteNotifier self send % -
} def
/SetCurrentValue { % dx dy => -
/Distance
2 index cvr dup mul 2 index cvr dup mul add sqrt def
Distance 0 eq { pop pop 0 } { neg exch atan } ifelse
/Direction exch def
/CurrentValue
Distance InactiveRadius le { null } {
SliceWidth .5 mul InitialAngle
Clockwise? { add } { sub } ifelse
Direction add NormalAngle
SliceWidth div cvi
} ifelse
def
} def
/submenu { % event => false | menu true
gsave
self setcanvas
begin XLocation YLocation end
/pointtoitem self send { % index
[1 index] /setvalue self send
/Item self send
dup /SubMenu known {
/SubMenu get true
} {
pop false
} ifelse
} {
false
} ifelse
grestore
} def
/invoker { % - => object
Invoker
} def
/setinvoker { % object|null => -
dup Invoker ne {
Invoker null ne {
Invoker self /removeclient ObsoleteService send
} if
/Invoker exch soften def
Invoker null ne {
Invoker self /addclient ObsoleteService send
} if
} {
pop
} ifelse
} def
/HandleObsoleteTarget { % object => -
dup Invoker eq {
null /setinvoker self send
} if
/HandleObsoleteTarget super send
} def
/eventmgr { % - => process
/eventmgr Invoker send
} def
/target { % - => object
/target super send dup null eq {
pop /DefaultTarget self send
} if
} def
/DefaultTarget { % - => object
Invoker null eq {null} {
/target /understands? Invoker send {
/target Invoker send
}{
Invoker
} ifelse
} ifelse
} def
% Demo:
/demo {
userdict begin
/pie0 framebuffer /new ClassPieMenu send def
[ (a)(b)(c)(d)(e)(f)(g)[(h) {{beep}fork pop pop pop}]
] /setitemlist pie0 send
/pie framebuffer /new ClassPieMenu send def
[ [(foo...) pie0] (bar) (baz) [(yow) {{beep}fork pop pop pop}]
] /setitemlist pie send
/can framebuffer /new ClassPieMenuCanvas send def
/minsize { 200 200 } /promote can send
pie /setpiemenu can send
/win can framebuffer /new ClassBaseWindow send def
(Pie Menu Demo) /setlabel win send
/mgr /new ClassEventMgr send def
mgr /activate win send
/place win send /map win send
end % userdict
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassPieMenuService
%
/ClassPieMenuService [
ClassNotifyInterest ClassFullScreenInterest
] [
/CurrentMenu % which canvas we're currently tracking in
/MenuList % array of active menus not including CurrentMenu
/ButtonDict % which up/downs to watch for during tracking
/PressedDownAt % [x y] of cursor at button down
% The state machine:
/MouseDragged
/UpTransition
/DownTransition
]
classbegin
% Class variables:
/PointName PointButton def
/AdjustName AdjustButton def
/MenuName MenuButton def
% Methods:
% intialize the menu interest; create and install its dependents
%
/NewInit { % - => -
/Exclusivity true def
/Priority MenuButtonPriority .9 add def
% ensures that dependent interest in mouse-down is higher
growabledict /DownTransition TriggerName
/NewInit super send
/CurrentMenu null def
/MenuList nullarray def
/ButtonDict 10 dict def
/RevealEvent createevent def
RevealEvent /Name /PieMenuReveal put
CreateDependents
self /addclient GlobalEventMgr send
} def
/destroy { % - => -
Active? { /CancelNotify self send } if
} def
% the Default NotifyInterest name
%
/TriggerName 2 dict dup begin
MenuName {
/trigger /SendInContext 2 index /Interest get send
} def
AdjustName MenuName load def
end def
% Override: Popdown all menus, remove any references to them.
%
/CancelNotify { % - => -
CurrentMenu null ne {
createevent false /popdown CurrentMenu send
/CurrentMenu null def
} if
MenuList {
createevent false /popdown 4 -1 roll send
} forall
/MenuList nullarray def
/CancelNotify super send
} def
/NullActionUnblock { % event => -
pop unblockinputqueue
} def
% Include the stopped/Unwind stuff in the executable matches rather
% than having to include it in every procedure that might get stored
% as one of the DownTransition/UpTransition/MouseDragged methods.
%
/MenuAction 2 dict dup begin
/DownTransition {
{{gsave DownTransition grestore} stopped {grestore Unwind} if}
1 index /Interest get /NotifyInterest get send
} def
/UpTransition {
{{gsave UpTransition grestore} stopped {grestore Unwind} if}
1 index /Interest get /NotifyInterest get send
} def
end def
/MotionName 1 dict dup begin
/MouseDragged {
{{gsave MouseDragged grestore} stopped {grestore Unwind} if}
1 index /Interest get /NotifyInterest get send
} def
end def
/RevealName 1 dict dup begin
/PieMenuReveal {
{{gsave Reveal grestore} stopped {grestore Unwind} if}
1 index /Interest get /NotifyInterest get send
} def
end def
% Create a set of dependent interests that can manage a menu
%
/CreateDependents { % - => -
/MenuClick
null MenuAction ButtonDict DepCreate
dup /Priority MenuButtonPriority 1 add put
dup /Synchronous true put
dup /Exclusivity true put
pop
/MenuMotion
null null MotionName DepCreate
dup /Priority MenuButtonPriority 1 add put
dup /Synchronous true put
dup /Exclusivity true put
pop
/MenuReveal
CurrentClient null RevealName DepCreate
dup /Priority MenuButtonPriority 1 add put
dup /Synchronous true put
dup /Exclusivity true put
pop
} def
% Utility that ensures ButtonDict contains only the given name.
%
/ButtonDictDef { % name => -
ButtonDict MenuName undef
ButtonDict PointName undef
ButtonDict AdjustName undef
ButtonDict exch dup put
} def
/ActivateDependents { % event => -
CurrentClient /Center 3 -1 roll % invoker posname event
/PieMenuStart CurrentClient send { % invoker posname event pie
% REMIND: Placeholder for null menu. For now, just swallow the
% event. Later, want to change it to start a tracker with no
% menu showing, and add an interface to allow belated installation
% of the menu associated with this mouse-down event.
dup null ne {
/activatefullscreen self send
1 index 5 1 roll % ev invoker posname ev pie
/StartMenuTracking self send % event
/ActivateDependents super send % -
}{ % invoke posname event null
pop pop pop pop
/CancelNotify self send
} ifelse
}{ % invoker posname event
/CancelNotify self send
dup /Canvas null put
% Let event continue up the canvas tree; the Canvas field got
% set to this particular canvas when it was distributed to it.
% REMIND: Do we need to be hairy like the ReceptionService and
% avoid having modified the Canvas field in the first place (to
% avoid marking the event as /Synthetic)?
redistributeevent
pop pop
} ifelse
} def
/DeactivateDependents { % - => -
/deactivatefullscreen self send
RevealEvent recallevent
/DeactivateDependents super send
} def
/Reveal { % event => -
pop unblockinputqueue
/RevealNow self send
} def
/RevealNow { % - => -
RevealEvent recallevent
null blockinputqueue
null MenuList aload pop CurrentMenu
{ dup null eq { pop exit } if
/?Reveal exch send
} loop
unblockinputqueue
} def
openwinversion 0 get 51 eq { % XXX: V3
/RevealDelay [0 750000] def
/RevealLater { % - => -
RevealEvent dup recallevent
dup /TimeStamp
currenttime RevealDelay [0 0] addtimeval
put
sendevent
} def
} { % XXX: V2
/RevealDelay .5 60 div def
/RevealLater { % - => -
RevealEvent dup recallevent
dup /TimeStamp
currenttime RevealDelay add
put
sendevent
} def
} ifelse
/StartMenuTracking { % invoker posname event pie => -
/CurrentMenu exch def
/MenuList 0 array def % invoker posname event
gsave
dup /Name get ButtonDictDef
/showat CurrentMenu send % invoker
/RevealLater self send
/setinvoker CurrentMenu send %
/framebufferof CurrentMenu send setcanvas
dup /Coordinates get /PressedDownAt exch promote
/MouseDragged /PieTrack load def
/UpTransition /CheckClick load def
/DownTransition /NullActionUnblock load def
grestore
} def
/PieTrack { % event => -
CurrentMenu dup null eq { pop pop } {
dup setcanvas
/PieMotion exch send
} ifelse
unblockinputqueue
} def
/ClickDown { % event => -
CurrentMenu null eq { pop } {
dup /Name get MenuName ne {
CurrentMenu setcanvas
/Radius CurrentMenu send dup setcursorlocation
% the cursor dissappears in V2 lego, so we force it to appear:
CurrentMenu /Cursor 2 copy get put
} if
/MouseDragged /PieTrack load def
/UpTransition /CheckClick load def
/DownTransition /NullActionUnblock load def
% Watch for uptransitions only on the button that just went down
dup /Name get ButtonDictDef
/framebufferof CurrentMenu send setcanvas
dup /Coordinates get /PressedDownAt exch promote
CurrentMenu % event menu
dup setcanvas
/PieStart exch send %
} ifelse
unblockinputqueue
} def
/CheckClick { % event => -
/MouseDragged /PieTrack load def
/UpTransition /NullActionUnblock load def
/DownTransition /ClickDown load def
% If we keep tracking we want to watch for either button going down
ButtonDict PointName dup put
ButtonDict AdjustName dup put
ButtonDict MenuName dup put
CurrentMenu setcanvas
dup /PieTrack self send
dup /Name get MenuName ne
CurrentMenu /CurrentValue get null eq and {
MenuList length 0 eq {
/CancelNotify self send
unblockinputqueue
pop
} {
dup false /popdown CurrentMenu send
/CurrentMenu MenuList dup length 1 sub get def
/MenuList MenuList 0 1 index length 1 sub getinterval def
/PieTrack self send
} ifelse
} {
dup /submenu CurrentMenu send {
CurrentMenu /setinvoker 2 index send % event submenu
/MenuList MenuList CurrentMenu arrayappend def
/CurrentMenu exch def % event
/framebufferof CurrentMenu send setcanvas
begin XLocation YLocation end %
2 copy
/Default 3 1 roll /popup CurrentMenu send
% Was this the result of a click? If so, map now.
% Otherwise we were moving with the button down, so map later.
PressedDownAt aload pop xysub abs exch abs max
4 le {
/RevealNow self send
} {
/RevealLater self send
} ifelse
} {
MenuList length 0 eq {
{ CurrentValue null eq Mapped not and
} CurrentMenu send {
/RevealNow self send
pop
} {
/ExecDone self send
} ifelse
} {
/ExecDone self send
} ifelse
} ifelse
unblockinputqueue
} ifelse
} def
/ExecDone { % event => -
CurrentMenu setcanvas
dup true /popdown CurrentMenu send
dup MenuList arrayreverse { % ev ev menu
false /popdown 3 -1 roll send % ev
dup
} forall % ev ev
pop % ev
/MenuList nullarray def
/CurrentMenu null def
/untrigger self send
} def
classend def
systemdict /PieMenuService 2 copy known { % dict name
2 copy get type /eventtype ne % dict name buildIt?
} { true } ifelse % dict name buildIt?
{ /new ClassPieMenuService send put %
} { pop pop } ifelse %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassPieMenuCanvas
%
/ClassPieMenuCanvas ClassCanvas []
classbegin
/PieMenuable? true def
/PieMenu null def
/activate {
/activate super send
EventMgr null ne {
PieMenuable? {self /addclient PieMenuService send} if
} if
} def
/deactivate {
EventMgr null ne {
PieMenuable? {self /removeclient PieMenuService send} if
} if
/deactivate super send
} def
/piemenuable? { % - => bool
PieMenuable?
} def
/setpiemenuable { % bool => -
EventMgr null ne {
self 1 index {/addclient} {/removeclient} ifelse
PieMenuService send
} if
/PieMenuable? exch def
} def
/PieMenuStart { % invoker pos event => invoker' pos' event' pie true |
% invoker pos event => invoker pos event false
PieMenu dup null eq { pop false } {
/InitPieMenu self send
true
} ifelse
} def
/PieMenuStop { % pie => -
pop
} def
/InitPieMenu % invoker pos event pie => invoker' pos' event' pie' =>
nullproc
def
/piemenu { % - => pie
PieMenu
} def
/setpiemenu { % pie => -
/PieMenu exch promote
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
openwinversion 0 get 51 eq { % XXX: V3
currentdict endautoload end % TNT
endpackage endpackage endpackage
} { % XXX: V2
end % systemdict
} ifelse
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
==== tab.ps: cut here ==================================================
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Tab Windows for the NeWS toolkit
% Version 3.0.1
%
% Copyright (C) 1991, by Don Hopkins. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This file implements a pie menu tab window manager for the NeWS toolkit.
% It should work with TNT2.0fcs on OW2.0fcs and TNT3.0beta on OW3.0beta.
% This code and the ideas behind it were developed over time by Don Hopkins
% at the University of Maryland, UniPress Software, and Sun Microsystems.
% Pie menus and tab windows and NOT patented or restricted, and the
% interface and algorithms may be freely copied and improved upon.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
openwinversion 0 get 51 eq { % XXX: V3
/NeWS 3 0 findpackage beginpackage
/TNTCore 3 0 findpackage beginpackage
/TNT 3 0 findpackage dup beginpackage
dup beginautoload begin
} { % XXX: V2
systemdict begin
} ifelse
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassTabWindow
%
/ClassTabWindow [ClassWindow ClassPieMenuCanvas]
dictbegin
/TabEdge /West def
/TabPosition 1 def
dictend
classbegin
/Hands? true def
/tabedge { % - => /West|/East|/North|/South
TabEdge
} def
/settabedge { % /West|/East|/North|/South => -
/TabEdge exch store
/invalidate self send
} def
/changetabedge { % edge => -
gsave
Parent setcanvas
/bbox self send /unfittab self send
5 -1 roll /settabedge self send
/fittab self send
/reshape self send
grestore
} def
/tabposition { % - => 0..1
TabPosition
} def
/settabposition { % 0..1 => -
/TabPosition exch store
/invalidate self send
} def
/changetabposition { % 0..1 => -
gsave
Parent setcanvas
/bbox self send
5 -1 roll /settabposition self send
/reshape self send
grestore
} def
/NInset { % - => n
/NInset super send
TabEdge /North eq { TabSize exch pop add } if
self /NInset 2 index put
} def
/SInset { % - => n
/SInset super send
TabEdge /South eq { TabSize exch pop add } if
self /SInset 2 index put
} def
/EInset { % - => n
/EInset super send
TabEdge /East eq { TabSize pop add } if
self /EInset 2 index put
} def
/WInset { % - => n
/WInset super send
TabEdge /West eq { TabSize pop add } if
self /WInset 2 index put
} def
/TabSize { 100 25 } def
/EdgeTabXYDict 4 dict def
EdgeTabXYDict begin
/North { % width height => x y
TabSize xysub
exch TabPosition mul round exch % x y
} def
/South { % width height => x y
pop TabSize pop sub TabPosition mul round % x
0 % x 0
} def
/East { % width height => x y
TabSize xysub TabPosition mul round % x y
} def
/West { % width height => x y
exch pop 0 exch % 0 height
TabSize exch pop sub TabPosition mul round % 0 y
} def
end % EdgeTabXYDict
/TabXY { % - => x y
gsave
/opened? self send {
/size self send
//EdgeTabXYDict TabEdge get exec
} { 0 0 } ifelse
2 copy 2 packedarray cvx
self exch /TabXY exch put
grestore
} def
/TabPathDict 4 dict def
TabPathDict begin
/West { % - => -
tw 0 moveto
0 h th sub TabPosition mul round rlineto
tw neg 0 rlineto
0 th rlineto
tw 0 rlineto
tw h lineto
w h lineto
w 0 lineto
closepath
} def
/East { % - => -
h th sub TabPosition mul round
0 0 moveto
0 h rlineto
w tw sub 0 rlineto
0 1 index th add h sub
rlineto
tw 0 rlineto
0 th neg rlineto
tw neg 0 rlineto
0 exch neg rlineto
closepath
} def
/North { % - => -
0 0 moveto
0 h th sub rlineto
w tw sub TabPosition mul round 0 rlineto
0 th rlineto
tw 0 rlineto
0 th neg rlineto
w h th sub lineto
w 0 lineto
closepath
} def
/South { % - => -
0 th moveto
0 h th sub rlineto
w 0 rlineto
0 h th sub neg rlineto
w tw sub TabPosition mul round tw add
th lineto
0 th neg rlineto
tw neg 0 rlineto
0 th rlineto
closepath
} def
end % TabPathDict
/TabPath { % x y w h => -
10 dict begin % tempdict
/mat matrix currentmatrix def
/minsize self send xymax
/h exch def /w exch def
TabSize /th exch def /tw exch def
translate
//TabPathDict TabEdge get exec
mat setmatrix
end % tempdict
} def
/path { % x y w h => -
/TabPath self send
} def
/EdgeUnfitDict 4 dict def
EdgeUnfitDict begin
/West { % x y w h => x' y' w' h'
4 -1 roll TabSize pop add 4 1 roll
exch TabSize pop sub exch
} def
/East { % x y w h => x' y' w' h'
exch TabSize pop sub exch
} def
/North { % x y w h => x' y' w' h'
TabSize exch pop sub
} def
/South { % x y w h => x' y' w' h'
3 -1 roll TabSize exch pop add 3 1 roll
TabSize exch pop sub
} def
end % EdgeUnfitDict
% given tabbed frame bbox, returns bbox of frame w/out tab
%
/unfittab { % x y w h => x' y' w' h'
//EdgeUnfitDict TabEdge get exec
} def
/EdgeFitDict 4 dict def
EdgeFitDict begin
/West { % x y w h => x' y' w' h'
4 -1 roll TabSize pop sub 4 1 roll
exch TabSize pop add exch
} def
/East { % x y w h => x' y' w' h'
exch TabSize pop add exch
} def
/North { % x y w h => x' y' w' h'
TabSize exch pop add
} def
/South { % x y w h => x' y' w' h'
3 -1 roll TabSize exch pop sub 3 1 roll
TabSize exch pop add
} def
end
% given untabbed frame bbox, returns bbox of frame with tab
%
/fittab { % x' y' w' h' => x y w h
//EdgeFitDict TabEdge get exec
} def
/invalidate { % - => -
/NInset unpromote
/SInset unpromote
/EInset unpromote
/WInset unpromote
/TabSize unpromote
/TabXY unpromote
/invalidate super send
} def
/InReshapeArea? { % event => bool
matrix currentmatrix
/bbox self send /unfittab self send
4 2 roll translate
4 -1 roll begin XLocation YLocation end % w h X Y
4 2 roll
ReshapeSize dup xysub % X Y w h
4 copy ReshapeSize dup pointinrect? % X Y w h bool
4 index 4 index 0 0 ReshapeSize dup pointinrect? or
4 index 4 index 0 4 index ReshapeSize dup pointinrect? or
4 index 4 index 4 index 0 ReshapeSize dup pointinrect? or
5 1 roll pop pop pop pop
exch setmatrix
} def
/PaintReshape { % - => -
GraphicFont setfont
matrix currentmatrix
/bbox self send /unfittab self send
4 2 roll translate
exch ReshapeSize sub exch % w-reshape h
0 1 index
3D? {
BG0 setcolor 2 copy moveto (\130) show
BG setcolor 2 copy moveto (\132) show
BG3 setcolor moveto (\131) show
2 copy
BG0 setcolor 2 copy moveto (\133) show
BG setcolor 2 copy moveto (\135) show
BG3 setcolor moveto (\134) show
1 index ReshapeSize
BG0 setcolor 2 copy moveto (\136) show
BG setcolor 2 copy moveto (\140) show
BG3 setcolor moveto (\137) show
0 ReshapeSize
BG0 setcolor 2 copy moveto (\141) show
BG setcolor 2 copy moveto (\143) show
BG3 setcolor moveto (\142) show
} {
2DFG setcolor
moveto (\242) show
2 copy moveto (\243) show
1 index ReshapeSize
moveto (\244) show
0 ReshapeSize
moveto (\245) show
} ifelse
pop pop
setmatrix
} def
/PaintLabelBackground { % - => -
WInset SInset
/size self send
EInset NInset xysub 3 index 3 index xysub % x y w h
3 -1 roll add exch HeaderHeight HeaderGap add
/opened? self send { 1 add } if
BackgroundColor setcolor
rectpath fill
} def
/reshape { % x y w h => -
/reshape super send
/?validate self send
} def
/minsize { % - => w h
/minsize super send
/TabSize self send xymax
} def
/PaintFocus { % - => -
WInset SInset
/size self send % w h
EInset NInset xysub 3 index 3 index xysub % x y w h
3 -1 roll add exch HeaderHeight
-1 2 xyadd
/ClickToType? self send {
4 2 roll 1 add 4 2 roll
3D? {true Paint3DBox} {2DFG setcolor rectpath fill} ifelse
} { % x y w h
3 index ReshapeSize BorderEdge sub add
3 index 2 index add 1 add
3 index ReshapeSize BorderEdge sub dup add sub
3D? {Paint3DLine} {2 rectpath 2DFG setcolor fill} ifelse
pop
3D? {Paint3DLine} {2 rectpath fill} ifelse
} ifelse
} def
/PaintTab { % - => -
gsave
TabXY translate
newpath 0 0 TabSize rectpath clip newpath
BackgroundColor FillCanvas
ForegroundColor BorderStroke StrokeCanvas
/Label load dup null eq {pop} {
ForegroundColor setcolor FooterFont setfont
TabSize pop % dspitm w
1 index DisplayItemSize pop sub 2 div 4 max % dspitm x
4 moveto DisplayItemPaint
} ifelse
grestore
} def
/Paint { % - => -
/PaintBackground self send
/PaintTab self send
/PaintBorder self send
Reshape? {/PaintReshape self send} if
Label? {false /PaintHeader self send} if
Footer? {false /PaintFooter self send} if
} def
/PaintLabel { % erase? => -
/Label load
WInset NInset /size self send % ? di x y w h
EInset NInset xysub 3 index 3 index xysub % ? di x y w h
3 -1 roll add HeaderGap add exch HeaderHeight
VisualState /Busy eq {
ForegroundColor setcolor
Gray12Stipple 5 copy pop //rectpath StipplePath
} if
Close? Pin? or {
Close? {CloseSize ClosePad add} {PinSize PinPad add} ifelse
5 2 roll 3 index sub
5 2 roll exch add
4 1 roll
} if
gsave % for clip
TextFont setfont % ? di x y w h
4 copy rectpath clip % ? di x y w h
6 -1 roll {
ClickToType? Focus? and {
3D? {BG2} {2DFG} ifelse
} {BackgroundColor} ifelse
setcolor clippath fill
} if % di x y w h
4 2 roll % di w h x y
HeaderPad add moveto % di w h
pop 1 index DisplayItemSize pop % di w swidth
2 copy lt {pop pop} {
sub 2.2 div 0 rmoveto % note: 2++ to round toward left
} ifelse % di
3D? not ClickToType? Focus? and and
{BackgroundColor} {ForegroundColor} ifelse
setcolor DisplayItemPaint
grestore
} def
/PaintPin { % pinned? => -
% REMIND: simplify!
GraphicFont setfont
{103} {100} ifelse
% WInset PinX BorderEdge sub add
WInset PinPad add
/size self send exch pop NInset sub
HeaderHeight add HeaderPad add
2 copy PinSize HeaderHeight HeaderPad 2 mul sub neg % i x y x y w h
rectpath
3D? {
BG setcolor fill % i x y
BG0 setcolor 2 copy moveto 2 index cvis show
BG2 setcolor 2 copy moveto 2 index 2 add cvis show
BG3 setcolor moveto 1 add cvis show
} {
2DBG setcolor fill % i x y
2DFG setcolor moveto
100 eq { (\23) } { (\24) } ifelse show
} ifelse
} def
/InCloseArea? { % event => bool
begin XLocation YLocation end % X Y
/size self send exch pop NInset sub
HeaderGap add % X Y y
Close? {
CloseX exch CloseSize % X Y x y w
} {
PinX exch PinSize % X Y x y w
} ifelse
HeaderHeight
pointinrect? % bool
} def
/CloseX { % - => closex
WInset /CloseX super send BorderEdge sub add
} def
/PinX { % - => pinx
WInset /PinX super send BorderEdge sub add
} def
/HeaderDeltaY { % - => headerdeltay
NInset HeaderGap sub
} def
/PaintClose { % down? => -
GraphicFont setfont
CloseX
/size self send exch pop NInset sub
HeaderHeight add HeaderGap add
3D? {
3 copy moveto {BG3} {BG0} ifelse setcolor (\63) show
3 copy moveto {BG0} {BG3} ifelse setcolor (\64) show
3 copy moveto {BG2} {BG} ifelse setcolor (\65) show
4 -4 xyadd
2 copy moveto BG3 setcolor (\55) show
2 copy moveto BG0 setcolor (\56) show
2 copy moveto BG2 setcolor (\57) show
pop pop pop
} {
2DBG setcolor 1 index 1 add 1 index moveto (\164) show
2DFG setcolor moveto { (\27) } { (\26) } ifelse show
} ifelse
} def
/PaintFooter { % erase? => -
/LeftFooter load /RightFooter load % ? l r
WInset FooterGap add % ? l r x
/size self send pop % ? l r x w
1 index sub EInset FooterGap add sub % ? l r x w
exch % ? l r w x
SInset FooterPad sub FooterHeight sub % ? l r w x y
6 -1 roll {
2 copy 4 index FooterHeight
BackgroundColor setcolor rectpath
fill
} if
FooterFont setfont
ForegroundColor setcolor
2 copy moveto 5 -1 roll DisplayItemPaint % r w x y
3 1 roll % r y w x
add 2 index DisplayItemSize pop sub exch % r x y
moveto DisplayItemPaint
} def
/InTabArea? { % event => bool
/opened? self send {
begin XLocation YLocation end % X Y
TabXY TabSize
pointinrect? % bool
} {
pop true
} ifelse
} def
/TrackStart { % event => /Default true
dup /Name get AdjustButton ne {
/TrackStart super send
} {
gsave
self setcanvas
dup InTabArea? not { /TrackStart super send } {
/WindowTracking? true store
/opened? self send
TrackDict begin
{ /Start /TabStart load def
/Motion /TabMotion load def
/Stop /TabStop load def
} {
/Start /ShowWhereStart load def
/Motion NullNotify def
/Stop /ShowWhereStop load def
} ifelse
end
[exch TrackDict /Start get self]
/sendmanager EventMgr send
/Default true
} ifelse
grestore
} ifelse
} def
% Window sliding stuff:
/MoveStart { % event => -
true /inhibitfocus ClassFocus send
gsave
TrackDict begin
self setcanvas
/edge
1 index InTabArea?
opened? self send not or {
TabEdge {
/North /South { /Horizontal }
/East /West { /Vertical }
} case
} { /All } ifelse
def
/Can Parent createoverlay def
Can setcanvas
InitTracking
/TrackHasMoved? false store
dup begin
/TrackStartXY [ XLocation YLocation ] cvx store
end
TrackEvent %
/downx x def /downy y def
/downname name def
end % TrackDict
grestore
} def
/MoveMotion { % event => -
gsave
TrackDict begin
TrackHasMoved? {
Can setcanvas
TrackEvent %
AdjustEdge
e /Shift /modifierdown? ClassKeyboard send {
FinishAdjustEdge
} if
pop
PreviewAdjustEdge
} {
Can setcanvas
begin XLocation YLocation end %
TrackStartXY xysub
abs MoveThresh ge exch abs MoveThresh ge or {
/TrackHasMoved? true store
} if
} ifelse
end % TrackDict
grestore
} def
/MoveStop { % event => -
dup /MoveMotion self send % event
TrackHasMoved? {
pop %
gsave
TrackDict begin
Can setcanvas erasepage
FinishAdjustEdge
end % TrackDict
grestore
openwinversion 0 get 51 eq { % XXX: V3
timeval
} { % XXX: V2
0
} ifelse
} { % event
dup /HandleSingleClick self send % event
openwinversion 0 get 51 eq { % XXX: V3
/TimeStamp get % time
} { % XXX: V2
/TimeStampMS get % time
} ifelse
} ifelse % time
/TrackStopTime exch store %
TrackDict cleanoutdict
false /inhibitfocus ClassFocus send
} def
% BBox dragging stuff:
/BBoxStart { % event => -
true /inhibitfocus ClassFocus send
gsave
TrackDict begin
/Can Parent createoverlay def
Can setcanvas
InitTracking
x x0 sub abs x x1 sub abs lt
y y0 sub abs y y1 sub abs lt { % South
{ /SouthWest } { /SouthEast } ifelse
} { % North
{ /NorthWest } { /NorthEast } ifelse
} ifelse
/edge exch def
TrackEvent
/downx x def /downy y def
/downname name def
end % TrackDict
grestore
} def
/BBoxMotion { % event => -
gsave
TrackDict begin
Can setcanvas
TrackEvent
AdjustEdge
e /Shift /modifierdown? ClassKeyboard send {
FinishAdjustEdge
} if
pop
PreviewAdjustEdge
end % TrackDict
grestore
} def
/BBoxStop { % event => -
dup /BBoxMotion self send
gsave
TrackDict begin
Can setcanvas erasepage
FinishAdjustEdge
end % TrackDict
grestore
TrackDict cleanoutdict
false /inhibitfocus ClassFocus send
} def
% Tab dragging stuff:
/TabStart { % event => -
true /inhibitfocus ClassFocus send
gsave
/TrackStartXY [
2 index begin XLocation YLocation end
] cvx store
/TrackHasMoved? false store
Parent createoverlay dup setcanvas % event can
/bbox self send /unfittab self send rect2points % e c w s e n
TrackDict begin
/north exch def /east exch def % e c w s
/south exch def /west exch def % e c
/Can exch def % e
end % TrackDict
grestore
/TabMotion self send %
} def
/TabMotion { % event => -
gsave
TrackDict begin
Can setcanvas
begin /x XLocation /y YLocation end def def
TrackHasMoved? not {
x y TrackStartXY xysub
abs MoveThresh ge exch abs MoveThresh ge or {
/TrackHasMoved? true store
} if
} if
TrackHasMoved? {
TabEdge {
/West {
x west gt {
y north gt { /North /settabedge self send } {
y south lt { /South /settabedge self send } {
x east gt { /East /settabedge self send } if
} ifelse
} ifelse
} if
}
/East {
x east lt {
y north gt { /North /settabedge self send } {
y south lt { /South /settabedge self send } {
x west lt { /West /settabedge self send } if
} ifelse
} ifelse
} if
}
/North {
y north lt {
x west lt { /West /settabedge self send } {
x east gt { /East /settabedge self send } {
y south lt { /South /settabedge self send } if
} ifelse
} ifelse
} if
}
/South {
y south gt {
x west lt { /West /settabedge self send } {
x east gt { /East /settabedge self send } {
y north gt { /North /settabedge self send } if
} ifelse
} ifelse
} if
}
} case
% XXX: clean this up
TabEdge {
/West /East {
y south sub
TabSize exch pop .5 mul sub
north south sub TabSize exch pop sub 1 max div
0 max 1 min
}
/North /South {
x west sub
TabSize pop .5 mul sub
east west sub TabSize pop sub 1 max div
0 max 1 min
}
} case
/settabposition self send
} if
west south east 2 index sub north 2 index sub % x y w h
end % TrackDict
/fittab self send
4 copy /TabPath self send
4 2 roll -1 1 xyadd 4 2 roll /TabPath self send
erasepage
stroke
grestore
} def
/TabStop { % event => -
/TabMotion self send %
gsave
TrackHasMoved? {
TrackDict begin
Can setcanvas erasepage
west south % x y
east 2 index sub % x y w
north 2 index sub % x y w h
end % TrackDict
/fittab self send
/minsize self send % x y w h mw mh
3 -1 roll max % x y w mw H
3 1 roll max % x y H W
exch % x y W H
/reshape self send %
} {
TrackDict /Can get setcanvas erasepage
} ifelse
grestore
TrackDict cleanoutdict
false /inhibitfocus ClassFocus send
} def
/UpdateTab {
/PaintTab self send
/PaintBorder self send
} def
/ShowWhereStart { % event => -
pop
} def
/ShowWhereStop { % event => -
pop
} def
% Window Placement:
/PlaceDelta { % - => dx dy
0 TabSize neg exch pop
} def
% XXX: V2
/place { % - => -
gsave Parent dup setcanvas
/TNTPlaceXY known not {
Parent /TNTPlaceXY [
0 /size Parent send exch pop
] cvx put
} if
/reshaped? self send % bool
Parent /TNTPlaceXY get exec % bool x y
2 index {
/size self send % bool x y w h
} {
/preferredsize self send % bool x y w h
} ifelse % bool x y-h w h
3 -1 roll 1 index sub 3 1 roll
4 copy rect2points % bool x y-h w h x y-h x1 y1
4 -1 roll 0 lt 4 -1 roll 0 lt or { % bool x y-h w h x1 y1
pop pop true % bool x y-h w h true
} { % bool x y-h w h x1 y1
/size Parent send % bool x y-h w h x1 y1 W h
3 -1 roll lt % bool x y-h w h x1 W H<y1
3 1 roll gt or % bool x y-h w h H<y1|x1>W
} ifelse % bool x y-h w h init?
{ Parent /TNTPlaceXY [
0 /size Parent send exch pop
PlaceDelta xyadd
] cvx put % bool x y-h w h
4 2 roll % bool w h x y-h
pop pop % bool w h
0 /size Parent send exch pop
2 index sub % bool w h x y-h
4 2 roll % bool x y-h w h
} { % bool x y-h w h
3 index 3 index % bool x y-h w h x y-h
2 index add % bool x y-h w h x y
PlaceDelta xyadd % bool x y-h w h x' y'
2 array astore cvx % bool x y-h w h {x' y'}
Parent /TNTPlaceXY 3 -1 roll put% bool x y-h w h
} ifelse
5 -1 roll { % x y-h w h
pop pop /move self send
} { % x y-h w h
/reshape self send
} ifelse
grestore
} def
% Random utilities:
/?Open { % - => -
/opened? self send not {
/ToggleOpened self send
} if
} def
openwinversion 0 get 51 eq { % XXX: V3
/flashwindow { % - => -
{ /Selected? Selected? not def /Focus? Focus? not def
/paintwindow self send
[0 500000] sleep
/Selected? Selected? not def /Focus? Focus? not def
/paintwindow self send
} fork pop
} def
} { % XXX: V2
/flashwindow { % - => -
{ /Selected? Selected? not def /Focus? Focus? not def
/paintwindow self send
.5 60 div sleep
/Selected? Selected? not def /Focus? Focus? not def
/paintwindow self send
} fork pop
} def
} ifelse
% ClassPieMenuWindowManager mixin hooks:
/TrackBBox { % x y w h => x' y' w' h'
/unfittab self send
} def
/UnTrackBBox { % x y w h => x' y' w' h'
/fittab self send
} def
/demo {
ClassName /ClassTabWindow eq {
/demo ClassTabBaseWindow send
/demo ClassTabPopupWindow send
} {
/demo super send
} ifelse
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassPieMenuWindowManager
%
/ClassPieMenuWindowManager ClassCanvas []
classbegin
% ClassPieMenuWindowManager mixin hooks:
% /TrackBBox % x y w h => x' y' w' h'
% /UnTrackBBox % x y w h => x' y' w' h'
% Pie Menu Definitions:
/FBFindMenu where { pop } { % XXX: V2
% Utility for managing shared menus with multiple framebuffers.
% The proc should create and return a menu whose parent is
% "/framebufferof self send". The dict is the cache of menus
% keyed by framebuffer. The menu for the object's framebuffer is
% looked up in the cache, created and stashed away if needed,
% and returned.
%
/FBFindMenu { % proc dict => menu
/framebufferof self send % proc dict fb
2 copy known {
get exch pop % menu
} { % proc dict fb
3 -1 roll cvx exec % dict fb menu
dup 4 1 roll put % menu
} ifelse
} def
} ifelse
/Parent { framebuffer } /installmethod ClassCanvas send
/PieMenu { % - => menu
/MakeWindowPieMenu WindowPieMenus /FBFindMenu self send
} def
/EdgeItemList [
/Icon findfont 1 scalefont begin
[ [ { /size eq {11 7}
{ [(\243) -2 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\237) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq { 7 11}
{ [(\244) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\241) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {11 7}
{ [(\243) -2 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\242) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq { 7 11}
{ [(\244) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\240) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
end
] def
/SlideItemList [
/ZapfDingbats findfont 35 scalefont begin
[ [ (\327) currentdict ]
{ null blockinputqueue
exch pop /VMoveFromUser /sendtarget 2 index send } ]
[ [ (\326) currentdict ]
{ null blockinputqueue
exch pop /HMoveFromUser /sendtarget 2 index send } ]
[ [ (\327) currentdict ]
{ null blockinputqueue
exch pop /VMoveFromUser /sendtarget 2 index send } ]
[ [ (\326) currentdict ]
{ null blockinputqueue
exch pop /HMoveFromUser /sendtarget 2 index send } ]
end
] def
/WindowPieMenus growabledict def
/MakeWindowPieMenu { % - => menu
/framebufferof self send /new ClassPieMenu send
[ [ (Front!)
{ exch pop /FrontFromUser /sendtarget 2 index send } ]
[ (Zoom!)
{ exch pop /ZoomFromUser /sendtarget 2 index send } ]
[ ((Grab))
/framebufferof self send /new ClassPieMenu send
[ /Icon findfont 1 scalefont begin
[ [ { /size eq {11 7}
{ [(\243) -2 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\237) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq { 7 11}
{ [(\244) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\241) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {11 7}
{ [(\243) -2 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\242) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq { 7 11}
{ [(\244) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
[ [ { /size eq {15 15}
{ [(\240) 0 -1] DisplayItemPaint }
ifelse } currentdict ] ]
end ] /setitemlist 2 index send
/Icon findfont 1 scalefont /settextfont 2 index send
{ null blockinputqueue
exch pop /AdjustEdgeFromUser /sendtarget 2 index send
} /setnotifier 2 index send
20 /setradiusmin 2 index send ]
[ ((Frame))
/framebufferof self send /new ClassPieMenu send
[ [ (Quit!)
{ exch pop /QuitFromUser /sendtarget 2 index send } ]
[ (Props...)
{ exch pop /PropsFromUser /sendtarget 2 index send } ]
] /setitemlist 2 index send ]
[ (Back!)
{ exch pop /BackFromUser /sendtarget 2 index send } ]
[ (Paint!)
{ exch pop /RefreshFromUser /sendtarget 2 index send } ]
[ ((Push))
/framebufferof self send /new ClassPieMenu send
[ [ [ { /size eq {64 35} { (\271) DisplayItemPaint } ifelse
} /Icon findfont ]
{ exch pop /PlaceFromUser /sendtarget 2 index send } ]
[ [ (\054) /ZapfDingbats findfont 50 scalefont ]
{ null blockinputqueue
exch pop /MoveFromUser /sendtarget 2 index send } ]
[ [ (\327) /ZapfDingbats findfont 40 scalefont ]
{ null blockinputqueue
exch pop /VMoveFromUser /sendtarget 2 index send } ]
[ [ (\326) /ZapfDingbats findfont 40 scalefont ]
{ null blockinputqueue
exch pop /HMoveFromUser /sendtarget 2 index send } ]
] /setitemlist 2 index send
5 /setradiusmin 2 index send ]
[ (Icon!)
{ exch pop /CloseFromUser /sendtarget 2 index send } ]
] /setitemlist 2 index send
} def
% Pie Menu Handlers:
/PieMenuStart { % piename event => piename event <pie true> | false
/PieMenuStart super send dup {
% Let the right button pop up the regular frame menu if the
% event is in the close button, by refusing pie tracking.
Close? {
gsave
self setcanvas
2 index InCloseArea? {
pop pop false
} if
grestore
} if
} if
} def
/PlaceFromUser { % ctl => -
/place self send
} def
/FrontFromUser { % ctl => -
pop /totop self send
} def
/VMoveFromUser { % ctl => -
pop /Vertical /ClickAdjustEdge self send
} def
/HMoveFromUser { % ctl => -
pop /Horizontal /ClickAdjustEdge self send
} def
/MoveFromUser { % ctl => -
pop /All /ClickAdjustEdge self send
} def
/AdjustEdgeFromUser { % ctl => -
/value exch send 0 get
{ /North /NorthEast /East /SouthEast
/South /SouthWest /West /NorthWest
} exch get
/?Open self send
/ClickAdjustEdge self send
} def
/AdjustEdgeDict 20 dict def
AdjustEdgeDict begin
/North {
/y1 y1 dy add store
} def
/South {
/y0 y0 dy add store
} def
/East {
/x1 x1 dx add store
} def
/West {
/x0 x0 dx add store
} def
/NorthEast { North East } def
/NorthWest { North West } def
/SouthEast { South East } def
/SouthWest { South West } def
/Vertical { North South } def
/Horizontal { East West } def
/All { North South East West } def
end % AdjustEdgeDict
/AdjustEdge { % - => -
AdjustEdgeDict begin
edge cvx exec
end
} def
/GrabInterest { % - => interest
createevent
dup /Name [ PointButton AdjustButton MenuButton /MouseDragged ] put
dup /Priority 1000 put
dup /IsPreChild true put
dup /Exclusivity true put
/GrabInterest 1 index store
} def
/ClickAdjustEdge { % edge => -
{ gsave TrackDict begin
/edge exch def
/Can Parent createoverlay def
Can setcanvas
GrabInterest expressinterest
unblockinputqueue
InitTracking
PreviewAdjustEdge
{ awaitevent TrackEvent
action /DownTransition eq { exit } if
PreviewAdjustEdge
} loop
/downx x def /downy y def
/downname name def
{ AdjustEdge
e /Shift /modifierdown? ClassKeyboard send {
FinishAdjustEdge
} if
pop
PreviewAdjustEdge
awaitevent TrackEvent
name downname eq
action /UpTransition eq and {
exit
} if
} loop
Can setcanvas erasepage
FinishAdjustEdge
TrackDict cleanoutdict
clear
} fork /ProcessName (ClickAdjustEdge tracker) put
pop
} def
/InitTracking { % - => -
/startx lasteventx def
/starty lasteventy def
/bbox self send
/TrackBBox self send
rect2points
/y1 exch def /x1 exch def /y0 exch def /x0 exch def
/x startx def /y starty def
/x' startx def /y' starty def
/xe 0 def /ye 0 def
% /Arrow Quiver dup length random mul floor cvi get cvis store
} def
/SlowTrackSpeed .1 def
/FastTrackSpeed 4 def
/TrackEvent { % event => -
/e 1 index def
Can setcanvas
{ /Meta /modifierdown? self send % event slow?
exch /FunctionAlt /modifierdown? self send% s? ev fast?
3 -1 roll % ev s? f?
} ClassKeyboard send % ev s? f?
{ { 0 } { SlowTrackSpeed } ifelse }
{ { FastTrackSpeed } { 1 } ifelse }
ifelse % ev speed
/x' x /y' y % ev sp /x' x' /y' y'
6 -1 roll begin % sp /x' x' /y' y'
XLocation YLocation Name Action % sp /x' x' /y' y' x y n a
end
/action exch def /name exch def % sp /x' x' /y' y' x y
/y exch def /x exch def % sp /x' x' /y' y'
def def % speed
dup x x' sub mul % speed dx
/dx exch def % speed
y y' sub mul % dy
/dy exch def %
} def
/EdgeOffsetDict growabledict def
EdgeOffsetDict begin
/North {.5 1} def
/South {.5 0} def
/East { 1 .5} def
/West { 0 .5} def
/NorthEast { 1 1} def
/NorthWest { 0 1} def
/SouthEast { 1 0} def
/SouthWest { 0 0} def
/Vertical {.5 .5} def
/Horizontal //Vertical def
/All //Vertical def
end % EdgeOffsetDict
/EdgeLen 50 def
/EdgeGap 10 def
/Quiver [
42 43 49 50 165 167 212 213 217 219 220 221 222 223 224 225
226 227 228 229 230 231 232 233 234 235 236 237 238 239 241
242 243 245 248 250 251 253 254
] def
/Arrow [ 43 ] cvas def
/ding /ZapfDingbats findfont def
/s 50 def
/EastArrowFont
ding [ 1 0 0 1 0 0 ] makefont s scalefont def
/WestArrowFont
ding [ -1 0 0 1 0 0 ] makefont s scalefont def
/NorthArrowFont
ding [ 0 1 -1 0 0 0 ] makefont s scalefont def
/SouthArrowFont
ding [ 0 -1 -1 0 0 0 ] makefont s scalefont def
/hfr .35 def
/vfr .35 def
/NorthHand { % x y => -
NorthArrowFont setfont
s hfr mul -1 xyadd moveto Arrow show
} def
/SouthHand { % x y => -
SouthArrowFont setfont
s hfr mul 1 xyadd moveto Arrow show
} def
/EastHand { % x y => -
EastArrowFont setfont
-1 s vfr neg mul xyadd moveto Arrow show
} def
/WestHand { % x y => -
WestArrowFont setfont
1 s vfr neg mul xyadd moveto Arrow show
} def
/PreviewAdjustEdge { % - => -
% /Arrow Quiver dup length random mul floor cvi get cvis store
x0 y0 x1 y1 points2rect % x0 y0 x1 y1
/UnTrackBBox self send
4 copy /path self send
4 2 roll -1 1 xyadd 4 2 roll % x0-1 y0+1 x1 y1
/path self send %
erasepage
edge {
/All {
Hands? {
x0 x1 add .5 mul
y0 y1 add .5 mul
1 index y0 SouthHand
1 index y1 NorthHand
x0 1 index WestHand
x1 1 index EastHand
pop pop
} if
}
/Horizontal {
x0 EdgeGap sub y0 moveto EdgeLen neg 0 rlineto
x1 EdgeGap add y0 moveto EdgeLen 0 rlineto
x0 EdgeGap sub y1 1 add moveto EdgeLen neg 0 rlineto
x1 EdgeGap add y1 1 add moveto EdgeLen 0 rlineto
Hands? {
y0 y1 add .5 mul
x0 1 index WestHand
x1 exch EastHand
} if
}
/Vertical {
x0 1 sub y0 EdgeGap sub moveto 0 EdgeLen neg rlineto
x1 y0 EdgeGap sub moveto 0 EdgeLen neg rlineto
x0 1 sub y1 EdgeGap add moveto 0 EdgeLen rlineto
x1 y1 EdgeGap add moveto 0 EdgeLen rlineto
Hands? {
x0 x1 add .5 mul
dup y0 SouthHand
y1 NorthHand
} if
}
/North {
x0 1 sub y1 EdgeGap add moveto 0 EdgeLen rlineto
x1 y1 EdgeGap add moveto 0 EdgeLen rlineto
Hands? {
x0 x1 add .5 mul y1 2 copy NorthHand SouthHand
} if
}
/South {
x0 1 sub y0 EdgeGap sub moveto 0 EdgeLen neg rlineto
x1 y0 EdgeGap sub moveto 0 EdgeLen neg rlineto
Hands? {
x0 x1 add .5 mul y0 2 copy NorthHand SouthHand
} if
}
/East {
x1 EdgeGap add y0 moveto EdgeLen 0 rlineto
x1 EdgeGap add y1 1 add moveto EdgeLen 0 rlineto
Hands? {
x1 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
/West {
x0 EdgeGap sub y0 moveto EdgeLen neg 0 rlineto
x0 EdgeGap sub y1 1 add moveto EdgeLen neg 0 rlineto
Hands? {
x0 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
/NorthEast {
x1 EdgeGap add y1 EdgeGap add
2 copy moveto EdgeLen neg 0 rlineto
moveto 0 EdgeLen neg rlineto
x1 EdgeGap sub y1 EdgeGap sub
2 copy moveto EdgeLen neg 0 rlineto
moveto 0 EdgeLen neg rlineto
Hands? {
x0 x1 add .5 mul y1 2 copy NorthHand SouthHand
x1 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
/NorthWest {
x0 EdgeGap sub y1 EdgeGap add
2 copy moveto EdgeLen 0 rlineto
moveto 0 EdgeLen neg rlineto
x0 EdgeGap add y1 EdgeGap sub
2 copy moveto EdgeLen 0 rlineto
moveto 0 EdgeLen neg rlineto
Hands? {
x0 x1 add .5 mul y1 2 copy NorthHand SouthHand
x0 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
/SouthEast {
x1 EdgeGap add y0 EdgeGap sub
2 copy moveto EdgeLen neg 0 rlineto
moveto 0 EdgeLen rlineto
x1 EdgeGap sub y0 EdgeGap add
2 copy moveto EdgeLen neg 0 rlineto
moveto 0 EdgeLen rlineto
Hands? {
x0 x1 add .5 mul y0 2 copy NorthHand SouthHand
x1 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
/SouthWest {
x0 EdgeGap sub y0 EdgeGap sub
2 copy moveto EdgeLen 0 rlineto
moveto 0 EdgeLen rlineto
x0 EdgeGap add y0 EdgeGap add
2 copy moveto EdgeLen 0 rlineto
moveto 0 EdgeLen rlineto
Hands? {
x0 x1 add .5 mul y0 2 copy NorthHand SouthHand
x0 y0 y1 add .5 mul 2 copy EastHand WestHand
} if
}
} case
stroke
pause
} def
/FinishAdjustEdge { % - => -
gsave
x0 y0 x1 y1 points2rect
/UnTrackBBox self send
Parent setcanvas
edge dup /Vertical eq 1 index /Horizontal eq or exch /All eq or {
pop pop /move self send
} {
/reshape self send
% currentprocess /eventmgr self send eq {
% /invalidate self send /damage self send
% } if
} ifelse
grestore
} def
% Demo:
/ClassBaseWindow { ClassTabBaseWindow } def
/ClassPopupWindow { ClassTabPopupWindow } def
/demo {
userdict begin
framebuffer setcanvas
1 1 4 { /i exch def
/demo super send pop
/win exch def
i (Tab Demo #%) sprintf /setlabel win send
userdict win dup put
/QuitFromUser {
userdict self undef /QuitFromUser super send
} /installmethod win send
} for
currentdict /win undef
end
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassTabBaseWindow
%
/ClassTabBaseWindow [
ClassPieMenuWindowManager ClassTabWindow ClassBaseWindow
] []
classbegin
/IconFont /LucidaSans findfont 10 scalefont
false printermatchfont
/ISOLatin1Encoding encodefont def
/setlabel { % - => -
/IconLabel promoted? not {
dup /seticonlabel self send
} if
/setlabel super send
} def
/seticonlabel { % - => -
/seticonlabel super send
/opened? self send /valid? self send and {
/UpdateTab self send
} if
} def
/IconSize { % - => w h
/TabSize super send
} def
/IconImage null def
/DefaultIconSize { % - => w h
/TabSize super send
} def
/IconXY { % - => x y
/location self send
/TabXY self send xyadd
} def
/PaintIcon { % - => -
/PaintTab self send
} def
/path { % x y w h => -
Opened? {
/TabPath self send
} {
rectpath
} ifelse
} def
/ToggleOpened { % - => -
/Opened? Opened? not def
gsave
Parent setcanvas
Opened? {
/location self send % x y
/TabSize unpromote
/TabXY unpromote
BaseWindowBBox % x y wx wy ww wh
4 2 roll pop pop % x y ww wh
2 copy 6 2 roll % ww wh x y ww wh
//EdgeTabXYDict TabEdge get exec % ww wh x y tx ty
xysub 4 2 roll % wx wy ww wh
/reshape self send
/clientlist self send {/map exch send} forall
/Valid? true def
} {
/BaseWindowBBox [ /bbox self send ] cvx def
IconXY IconSize /reshape self send
/clientlist self send {/unmap exch send} forall
} ifelse
grestore
} def
/ShowWhereStart { % event => -
gsave
TrackDict /Can Parent createoverlay dup setcanvas put
/location self send % x y
BaseWindowBBox % x y wx wy ww wh
4 2 roll pop pop % x y ww wh
2 copy 6 2 roll % ww wh x y ww wh
//EdgeTabXYDict TabEdge get exec % ww wh x y tx ty
xysub 4 2 roll % wx wy ww wh
4 copy /TabPath self send
4 2 roll -1 1 xyadd 4 2 roll /TabPath self send
stroke
grestore
} def
/ShowWhereStop { % event => -
gsave
TrackDict /Can get setcanvas
erasepage
TrackDict cleanoutdict
grestore
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ClassTabPopupWindow
%
/ClassTabPopupWindow [
ClassPieMenuWindowManager ClassTabWindow ClassPopupWindow
] []
classbegin
/ToggleOpened { % - => -
/ToggleOpened super send
/TabXY unpromote
/opened? self send { /damage self send } if
} def
classend def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
openwinversion 0 get 51 eq { % XXX: V3
currentdict endautoload end % TNT
endpackage endpackage endpackage
} { % XXX: V2
end % systemdict
} ifelse
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
==== End of file: cut here =============================================