mh@wlbr.EATON.COM (Mike Hoegeman) (05/06/88)
Here's a little doo-dad that subclasses LiteWindow and provides
a simple pop-up message (for lack of a better name) capability.
This is useful for things like "please wait" or "you blew it"
feedback information.
You can try it out by just cutting at the mark below and
running the whole thing through psh
%============= Snip here ========================================
/MWindow LiteWindow
dictbegin
/MsgBuf null def %% holds message text
/MsgDisplayed? false def %% is CloseControl in msg mode?
/MsgTimeOut 5 def
/LastMsgEvent null def %% last msg timer event sent out
dictend
classbegin
%+
% message: (fmt_string) [args...] seconds => -
%
% seconds demotes the amount of time the message will stay up.
%
% If seconds is 0, the default value defined in MsgTimeOut will be applied.
%
% If seconds is less then zero , the message stays on the screen till
% the user clicks on it. The negative value -1 is special in that it will
% append the advisory message "Click on Message to Erase" automatically to
% the end of the supplied message data.
%
% No seconds parameter makes /message use the default timeout value.
%-
/message {
4 dict begin
gsave
%% stop any outstanding killmessage timer event we may have
%% so that a new message is not killed by an old one.
LastMsgEvent null ne {
LastMsgEvent recallevent
/LastMsgEvent null store
} if
dup /tmp exch def
tmp type /integertype ne tmp type /realtype ne and {
/seconds MsgTimeOut def
} {
/seconds exch dup 0 eq { pop MsgTimeOut } if def
} ifelse
FrameFont setfont
sprintf seconds -1 eq { (\n*Click On Message to Erase*) append } if
/MsgBuf exch store
/MsgDisplayed? true store
/mh 0 def
/mw 0 def
%% figure the w & h for the message
MsgBuf
{
(\n) search {
stringwidth pop mw max /mw exch def
pop
/mh mh 1 add def
} {
stringwidth pop mw max /mw exch def
/mh mh 1 add def
exit
} ifelse
} loop
/mh mh currentfont fontheight mul def
%CloseControl /Mapped false put
%% blow the canvas up to hold the message
FrameCanvas setcanvas
0 0 mw 5 add mh 4 add rectpath CloseControl reshapecanvas
MoveMsgControl
seconds 0 gt {
%% set the killmessage timer
createevent dup begin
/Name /KillMessage def
/Action null def
/Canvas FrameCanvas def
/TimeStamp currenttime seconds 60 div add def
end
dup /LastMsgEvent exch store
sendevent
} if
%CloseControl /Mapped true put
grestore
end
} def
%+
% killmessage: - => -
% zoom the message back to the normal close control
%
%-
/killmessage {
%% kill message
MsgDisplayed? {
/MsgDisplayed? false store
/MsgBuf null store
%% shrink the canvas back down to a Close Control
gsave
CloseControl setcanvas
FrameFillColor fillcanvas
FrameCanvas setcanvas
0 0 BorderTop 1.5 sub dup rectpath CloseControl reshapecanvas
CloseControl setcanvas
MoveCloseControl
grestore
paintframe
} if
} def
/MoveCloseControl {
gsave
CloseControl setcanvas
BorderLeft BorderTop eq {1} {BorderLeft 1 sub} ifelse
FrameHeight BorderTop sub movecanvas
grestore
} def
/MoveMsgControl {
gsave
CloseControl setcanvas
clippath pathbbox /mh exch def
pop pop pop
0 FrameHeight mh sub movecanvas
grestore
} def
/MoveFrameControls { % - => - ([Re]set frame control shapes)
1 dict begin
gsave
MsgDisplayed? { MoveMsgControl } { MoveCloseControl } ifelse
StretchControl setcanvas
FrameWidth BorderRight sub 0 movecanvas
grestore
end
} def
%+
% MsgPaint: - => -
% Function: Repaint the message/close control when we are in message mode
%-
/MsgPaint {
5 dict begin
gsave
CloseControl setcanvas
clippath pathbbox
/mh exch def /mw exch def /my exch def /mx exch def
/fh FrameFont fontheight neg def
FrameFont setfont
FrameTextColor fillcanvas
FrameFillColor setcolor
1.5 mx my mw mh insetrect rectpath stroke
3 mh fh add moveto
MsgBuf
{
currentpoint 3 -1 roll
(\n) search {
show pop
3 1 roll
moveto
currentpoint fh add moveto
} {
show pop pop exit
} ifelse
} loop
grestore
end
} def
%%
%% ==== overrides of our superclass needed for the pop-up message stuff ====
%%
/PaintFrameControls {
MsgDisplayed? not {
gsave CloseControl setcanvas FrameFillColor fillcanvas grestore
} if
/PaintFrameControls super send
MsgDisplayed? { MsgPaint } if
} def
/CreateFrameControls {
/CreateFrameControls super send
gsave
FrameCanvas setcanvas
CloseControl /Transparent false put
0 0 BorderTop 1.5 sub dup rectpath CloseControl reshapecanvas
grestore
} def
/CreateFrameInterests {
%% do our superclass stuff
/CreateFrameInterests super send
%% Then add our message stuff...
%% We have the CloseControl do double-duty, close control & message
%% display canvas
FrameInterests begin
/FrameCloseEvent
PointButton
{ MsgDisplayed? { killmessage } { flipiconic } ifelse }
DownTransition
CloseControl
eventmgrinterest
def
/KillMessageEvent
/KillMessage
{ MsgDisplayed? { killmessage } if }
null
FrameCanvas
eventmgrinterest
def
end
} def
classend def
%================= some test code ==================
/mypaint {
1 1 1 hsbcolor fillcanvas
} def
/mm framebuffer /new MWindow send def
{
/PaintClient { mypaint } def
} mm send
/reshapefromuser mm send
/map mm send
%% display a pop-up message
(%%%%%%%%%)
[
(0th\n)
(this is the message string\nthis is the second line)
(third line\n)
(fourth line\n)
(fifth line\n)
(sixth line\n)
(7th line\n)
(8th line\n)
(9th line\n)
]
8 /message mm send
%% wait a little bit...
2000 { pause pause } repeat
%% write a new one over the top of it
(%%%)
[
(this is the second message...\n)
(will it get killed from the first's timeout?...\n)
(let's hope not!)
]
-1 /message mm send