don@cs.UMD.EDU (Don Hopkins) (02/27/90)
Here is a goodie from Sun's NeWS archive server, that demonstrates
some neat stuff about the NeWS toolkit (in X11/NeWS). To get other
stuff from the server, you can send mail to news-archive@sun.com, with
the subject line "help", and it will send you instructions on using
it. If you also give it the line "send index" it will send you an
index.
-Don
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# SimpleTNT
# This archive created: Tue Nov 14 15:28:16 1989
export PATH; PATH=/bin:/usr/bin:$PATH
if test ! -d 'SimpleTNT'
then
mkdir 'SimpleTNT'
fi
cd 'SimpleTNT'
if test -f 'Frame'
then
echo shar: "will not over-write existing file 'Frame'"
else
cat << \SHAR_EOF > 'Frame'
%
% Simple Frame
%
null nullarray framebuffer /newdefault ClassBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Hello'
then
echo shar: "will not over-write existing file 'Hello'"
else
cat << \SHAR_EOF > 'Hello'
%
% Simple HelloWorld
%
/SimpleCanvas ClassCanvas
dictbegin
/Message (Howdy) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
200 200 /lockminsize self send
} def
/PaintCanvas {
1 fillcanvas
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray Message cshow
} def
classend
def
SimpleCanvas nullarray framebuffer /new OpenLookBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
/place 1 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'HelloMenu'
then
echo shar: "will not over-write existing file 'HelloMenu'"
else
cat << \SHAR_EOF > 'HelloMenu'
/SCanvas ClassCanvas
dictbegin
/Message (Your Momma) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
[
(Your Momma)
(Your Daddy)
(Your Sister)
]
null
{
/valuething 1 index send
/setmessage /sendtarget 4 -1 roll send
}
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/PaintCanvas {
1 fillcanvas
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray Message cshow
} def
/setmessage {
/Message exch def
/paint self send
} def
classend
def
SCanvas [] framebuffer /new OpenLookBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (Amazing) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/SimpleHello exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'HelloMenuPullRight'
then
echo shar: "will not over-write existing file 'HelloMenuPullRight'"
else
cat << \SHAR_EOF > 'HelloMenuPullRight'
%
% Menu with 2 pull-right menus on it
%
% Syntax is:
% [ (string) menu null (string2) menu2 null ... ]
%
/SimpleCanvas ClassCanvas
dictbegin
/Message (Your Momma) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
[
(New Message)
[ (Your Momma) (Your Daddy) (Your Sister) ]
null
{ /setmessage /sendtarget 2 index send }
framebuffer /new OpenLookMenu send
null % (string) submenu null
(New Font)
[ (Times-Roman) (Times-Italic) (Times-Bold) ]
null
{ /setfontname /sendtarget 2 index send }
framebuffer /new OpenLookMenu send
null
]
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/PaintCanvas {
1 fillcanvas
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray Message cshow
} def
/setmessage { % menu => -
/valuething exch send % menu => string
/Message exch def
/paint self send
} def
/setfontname { % menu => -
/valuething 1 index send cvn % menu => fontname
null null /settextparams self send
/paint self send
} def
classend
def
SimpleCanvas nullarray framebuffer /new OpenLookBaseFrame send
(HelloMenu with a PullRight) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 400 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Mousehits'
then
echo shar: "will not over-write existing file 'Mousehits'"
else
cat << \SHAR_EOF > 'Mousehits'
%
% Mouse Events Example
%
/EventCanvas ClassCanvas
dictbegin
/Message (Waiting for Mouse Hit) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
} def
/PaintCanvas {
1 fillcanvas
Width 2 div Height 2 div moveto
TextFont setfont
0 setgray Message cshow
} def
/setmessage { % event => -
/Name get 20 string cvs
/Message exch def
(Status:) Message
/parent self send /setfooter exch send
/paint self send
} def
/MakeInterests {
[/LeftMouseButton /MiddleMouseButton /RightMouseButton]
/setmessage /DownTransition Canvas
/MakeInterest self send
} def
classend
def
EventCanvas nullarray framebuffer /newdefault ClassBaseFrame send
(Mousehits!) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 400 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'SimpleDraw'
then
echo shar: "will not over-write existing file 'SimpleDraw'"
else
cat << \SHAR_EOF > 'SimpleDraw'
/DrawCanvas ClassCanvas
dictbegin
/DrawMode (Point) def
/StoreCanvas null def
dictend
classbegin
/newinit {
/newinit super send
/BuildStore self send
500 500 /lockminsize self send
[
(Point)
(Line)
(Box)
(Circle)
]
null
{
/valuething 1 index send
/setdrawmode /sendtarget 4 -1 roll send
}
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
/setmenu self send
} def
/destroy {
/StoreCanvas null def
/destroy super send
} def
/PaintCanvas {
StoreCanvas imagecanvas
} def
/BuildStore {
gsave
framebuffer setcanvas
/StoreCanvas framebuffer newcanvas def
StoreCanvas /Transparent false put
StoreCanvas /Retained true put
0 0 500 500 rectpath StoreCanvas reshapecanvas
StoreCanvas setcanvas 1 fillcanvas
grestore
} def
/UpDateFooter { % string => -
(Mode:) exch /setfooter /parent self send send
} def
/setdrawmode { % string => -
dup
/UpDateFooter self send
/DrawMode exch def
} def
/StartAction { % event => -
pop
{
DrawMode (Point) ne
{
/canvas self send InitOverlay
}{
/canvas self send setcanvas
} ifelse
}
{ % forked process handling drags
DrawMode (Point) ne {
erasepage
} if
x y x0 y0 /DrawThing self send
DrawMode (Point) eq {
gsave
StoreCanvas setcanvas
x y x0 y0 /DrawThing self send
grestore
x y SetX0Y0
} if
}
{
DrawMode (Point) ne {
/canvas self send setcanvas
} if
x y x0 y0 /DrawThing self send
gsave
StoreCanvas setcanvas
x y x0 y0 /DrawThing self send
grestore
}
/UpTransition getfromuser
} def
/DrawThing { % x y x0 y0 => -
DrawMode {
(Point) (Line) {
moveto lineto
}
(Box) {
points2rect rectpath
}
(Circle) {
points2rect ovalpath
}
} case
stroke
} def
/MakeInterests {
/MakeInterests super send
/LeftMouseButton
/StartAction /DownTransition Canvas
/MakeInterest self send
} def
classend
def
DrawCanvas [/Reshape false] framebuffer /newdefault ClassBaseFrame send
(Draw) /setlabel 2 index send
(Mode:) (Point) /setfooter 3 index send
100 100 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'README'
then
echo shar: "will not over-write existing file 'README'"
else
cat << \SHAR_EOF > 'README'
Last tested 6/27/89 beta2 + beta TNT
This directory holds a group of simple applications using
TNT. The purpose is to illustrate some basic usage for ISV's.
BagDoodles - Directory of simple bag examples for interactive use
Buttons - More subclasses of ClassBag, multiple clients
Circle - Drag out a circle
Frame - Just a frame
FrameQuit - Overrides quit on menu
FrameIcon - Overrides close/open
FunnyEZ - a canvas with a disjoint path
Hello - Simple ClassCanvas subclass
HelloMenu - Use of CanvasMenu, /sendtarget
HelloMenuPullRight - Pullrights with class OpenLookMenu
MatchExplorer - low level canvas used to look at event matching
KBez - Simple grabbing of keyboard keys
MatchExplorer - Low level event distribution exploration sample
Meta - Metakeys on the keyboard
Meter - Dave Gedye's memory meter
Mousehits - Catching mouse buttons, overriding MakeInterests
OneButton - Using a flexbag and a control
Panepain - Use of a OpenLookPane, getting the scrollbar values
Panepain2 - Use of a OpenLookPane, override scrollbar default notify behavior
PsAngles - "PostScript" in various angles
Resize - A twobag in a frame, some Layout fun
SimpleAppBag - using a bag for a panel/canvas application
SimpleDraw - Simple use of getfromuser in a draw program
flippers.ps - capturing shift keys
pswin - simple PS previewer
scoutclock - digital clock
scouticoneditor - simple bitmap editor
SHAR_EOF
fi
if test -f 'Buttons'
then
echo shar: "will not over-write existing file 'Buttons'"
else
cat << \SHAR_EOF > 'Buttons'
%
% Example of Bags and Buttons
%
/SimpleCanvas ClassCanvas
dictbegin
/Message (Hello Programmers) def
/Position (Middle) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 20 null /settextparams self send
null 1 1 1 rgbcolor null /setcolors self send
400 300 /lockminsize self send
[
(Your Momma)
(Your Daddy)
(Your Sister)
]
null
{
/valuething 1 index send
/setmessage /sendtarget 4 -1 roll send
}
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/setmessage {
/Message exch def
/paint self send
} def
/setposition {
/Position exch def
/paint self send
} def
/PaintCanvas {
/PaintCanvas super send
Position {
(Left) {
/size self send 2 div 10 exch moveto pop
}
(Middle) {
/size self send 2 div exch 2 div exch moveto
}
(Right) {
/size self send 2 div exch 40 sub exch moveto
}
(Sideways) {
/size self send 2 div exch 2 div exch moveto
90 rotate
}
} case
/textfont self send setfont
Message cshow
} def
classend
def
/SimpleFlexBag FlexBag
dictbegin
/ButtonLine 350 def
dictend
classbegin
/newinit {
/newinit super send
null 1 1 1 rgbcolor null /setcolors self send
400 400 /lockminsize self send
/can [/sw {
0 0
} SimpleCanvas] /addclient self send
/l [
/c {
self WIDTH .2 mul ButtonLine
}
(Left)
{
(Left) /setposition
/sendtarget 4 -1 roll send
} OpenLookButton
] /addclient self send
/can /getbyname self send pop
/settarget
/l /getbyname self send pop send
/m [
/c {
self WIDTH .4 mul ButtonLine
}
(Middle)
{
(Middle) /setposition
/sendtarget 4 -1 roll send
} OpenLookButton
] /addclient self send
/can /getbyname self send pop
/settarget
/m /getbyname self send pop send
/r [
/c {
self WIDTH .6 mul ButtonLine
}
(Right)
{
(Right) /setposition
/sendtarget 4 -1 roll send
} OpenLookButton
] /addclient self send
/can /getbyname self send pop
/settarget
/r /getbyname self send pop send
/s [
/c {
self WIDTH .8 mul ButtonLine
}
(Sideways)
{
(Sideways) /setposition
/sendtarget 4 -1 roll send
} OpenLookButton
] /addclient self send
/can /getbyname self send pop
/settarget
/s /getbyname self send pop send
} def
classend
def
SimpleFlexBag nullarray framebuffer /newdefault ClassBaseFrame send
(Bags and Buttons) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Panepain'
then
echo shar: "will not over-write existing file 'Panepain'"
else
cat << \SHAR_EOF > 'Panepain'
/InfoCanvas ClassCanvas
dictbegin
/HSValue 0 def
/VSValue 0 def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 20 null /settextparams self send
} def
/PaintCanvas {
1 fillcanvas 0 setgray TextFont setfont
50 100 moveto (HSValue - ) show
50 50 moveto (VSValue - ) show
/update self send
} def
/update {
gsave
self setcanvas
150 50 100 100 rectpath 1 setgray fill
0 setgray TextFont setfont
150 100 moveto (%) [HSValue] sprintf show
150 50 moveto (%) [VSValue] sprintf show
grestore
} def
/setHSvalue {
/HSValue exch def
/update self send
} def
/setVSvalue {
/VSValue exch def
/update self send
} def
classend
def
/SimplePane OpenLookPane []
classbegin
/CreateHSbarNotify { % - => proc
{
/value exch send
/setHSvalue
/parent self send
/client exch send
send
}
} def
/CreateVSbarNotify { % - => proc
{
/value exch send
/setVSvalue
/parent self send
/client exch send
send
}
} def
classend
def
[[InfoCanvas] SimplePane ] nullarray framebuffer
/newdefault ClassBaseFrame send
(Scroll Me) /setlabel 2 index send
100 100 300 300 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'KBez'
then
echo shar: "will not over-write existing file 'KBez'"
else
cat << \SHAR_EOF > 'KBez'
/KeyCanvas ClassCanvas
dictbegin
/CurrentKey (?) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
} def
/PaintCanvas {
/PaintCanvas super send
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray CurrentKey show
} def
/setcurrentkey {
/CurrentKey exch def
/paint self send
} def
/HandleKey { % event => -
/Name get cvis /setcurrentkey self send
} def
/MakeInterests {
/HandleKey Canvas soften buildsend
Canvas /defaultkeys ClassKeysInterest send
} def
classend
def
KeyCanvas nullarray framebuffer /newdefault ClassBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'MatchExplorer'
then
echo shar: "will not over-write existing file 'MatchExplorer'"
else
cat << \SHAR_EOF > 'MatchExplorer'
%
% For some experiments with event matching
% To use:
%
% % psh MatchExplorer (or load the file to an interactive session)
%
% RightMouseButton terminates
% utilities
/buildcanvas { % parent size => canvas
dup createcanvas dup
begin
/Transparent false def
/Retained false def
/EventsConsumed /MatchedEvents def
end
} def
/addinterest { % Exclusive? PreChild? cv action name => -
createevent
begin
/Name exch def
/Action exch def
/Canvas exch def
/IsPreChild exch def
/Exclusivity exch def
currentdict
end
expressinterest
} def
/leftdict
dictbegin
/LeftMouseButton
{
dup
begin
(n - % c - % pc - % ex - %\n)
[
Name
Interest /Canvas get
Interest /IsPreChild get
Interest /Exclusivity get
] printf
end
pop
% redistributeevent % if exclusive might want to turn this on
} def
dictend
def
/enddict
dictbegin
/RightMouseButton
{
pop currentprocess killprocess
} def
dictend
def
% build canvases
/c1 framebuffer 200 buildcanvas def
/c2 c1 100 buildcanvas def
c1 /Mapped true put
gsave c1 setcanvas 1 fillcanvas grestore
c2 /Mapped true put
gsave c2 setcanvas .8 fillcanvas grestore
% terminate interest
true true c1 null enddict addinterest
% pre and post child fun
%true true c1 /DownTransition leftdict addinterest
false false c1 /DownTransition leftdict addinterest
false true c1 /DownTransition leftdict addinterest
false false c2 /DownTransition leftdict addinterest
false true c2 /DownTransition leftdict addinterest
% handle events
{
awaitevent
} loop
SHAR_EOF
fi
if test -f 'OneButton'
then
echo shar: "will not over-write existing file 'OneButton'"
else
cat << \SHAR_EOF > 'OneButton'
%
% FlexBags for more complex layout needs
%
/ButtonBag FlexBag []
classbegin
/newinit {
/newinit super send
/b1 [/c {/c self POSITION} (Button1) nullnotify OpenLookButton]
/addclient self send
} def
classend
def
ButtonBag nullarray framebuffer /newdefault ClassBaseFrame send
(ONE Button) /setlabel 2 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Panepain2'
then
echo shar: "will not over-write existing file 'Panepain2'"
else
cat << \SHAR_EOF > 'Panepain2'
/InfoCanvas ClassCanvas
dictbegin
/HSValue 0 def
/VSValue 0 def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 20 null /settextparams self send
} def
/PaintCanvas {
1 fillcanvas 0 setgray TextFont setfont
50 100 moveto (HSValue - ) show
50 50 moveto (VSValue - ) show
/update self send
} def
/update {
gsave
self setcanvas
150 50 100 100 rectpath 1 setgray fill
0 setgray TextFont setfont
150 100 moveto (%) [HSValue] sprintf show
150 50 moveto (%) [VSValue] sprintf show
grestore
} def
/setHSvalue {
/HSValue exch def
/update self send
} def
/setVSvalue {
/VSValue exch def
/update self send
} def
classend
def
/SimplePane OpenLookPane []
classbegin
/newinit { % - => -
/newinit super send
/HSbar /getbyname self send {
/CallNotify?
{ % event => bool
/Name get /MouseDragged eq {
false
}{
true
} ifelse
}
/installmethod 4 -1 roll send
} if
/VSbar /getbyname self send {
/CallNotify?
{ % event => bool
/Name get /MouseDragged eq {
false
}{
true
} ifelse
}
/installmethod 4 -1 roll send
} if
} def
/CreateHSbarNotify { % - => proc
{
/value exch send
/setHSvalue
/parent self send
/client exch send
send
}
} def
/CreateVSbarNotify { % - => proc
{
/value exch send
/setVSvalue
/parent self send
/client exch send
send
}
} def
classend
def
[[InfoCanvas] SimplePane ] nullarray framebuffer
/newdefault ClassBaseFrame send
(Scroll Me) /setlabel 2 index send
100 100 300 300 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Meta'
then
echo shar: "will not over-write existing file 'Meta'"
else
cat << \SHAR_EOF > 'Meta'
/KeyCanvas ClassCanvas
dictbegin
/CurrentKey (?) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
} def
/PaintCanvas {
/PaintCanvas super send
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray CurrentKey cshow
} def
/setcurrentkey {
/CurrentKey exch def
/paint self send
} def
/HandleKey { % event => -
/Name get dup 128 gt {
128 sub cvis (-M) append
}{
cvis
} ifelse
/setcurrentkey self send
} def
/MakeInterests {
/HandleKey Canvas soften buildsend
Canvas /metakeys ClassKeysInterest send
} def
classend
def
KeyCanvas nullarray framebuffer /newdefault ClassBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map exch send
%newprocessgroup
%currentfile closefile
SHAR_EOF
fi
if test -f 'AnotherMenu'
then
echo shar: "will not over-write existing file 'AnotherMenu'"
else
cat << \SHAR_EOF > 'AnotherMenu'
%
% A menu with multiple callbacks
%
/SCanvas ClassCanvas
dictbegin
/Message (Your Momma) def
/Grey 0 def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
[
(Your Momma) null { (your Mother) /setmessage /sendtarget 4 -1 roll send }
(Your Daddy) null { (your Father) /setmessage /sendtarget 4 -1 roll send }
(Grey) null { .8 /setcolor /sendtarget 4 -1 roll send }
(Black) null { 0 /setcolor /sendtarget 4 -1 roll send }
]
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/PaintCanvas {
1 fillcanvas
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
Grey setgray Message cshow
} def
/setmessage {
/Message exch def
/paint self send
} def
/setcolor {
/Grey exch def
/paint self send
} def
classend
def
SCanvas [] framebuffer /new OpenLookBaseFrame send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (Amazing) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/SimpleHello exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Circle'
then
echo shar: "will not over-write existing file 'Circle'"
else
cat << \SHAR_EOF > 'Circle'
%
% Circle Rubberband
%
/DrawCanvas ClassCanvas []
classbegin
/DoCircle { % event => -
pop
{
Canvas InitOverlay
}
{ % forked process handling drags
erasepage x y x0 y0 points2rect ovalpath stroke
}
{
Canvas setcanvas
x y x0 y0 points2rect ovalpath stroke
}
/UpTransition getfromuser
} def
/MakeInterests {
/MakeInterests super send
/LeftMouseButton
/DoCircle /DownTransition Canvas
/MakeInterest self send
} def
classend
def
DrawCanvas [/Reshape false] framebuffer /newdefault ClassBaseFrame send
(Circle) /setlabel 2 index send
100 100 300 300 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'Resize'
then
echo shar: "will not over-write existing file 'Resize'"
else
cat << \SHAR_EOF > 'Resize'
%
% Resize test
%
/RCanvas ClassCanvas []
classbegin
/newinit {
/newinit super send
null 100 200 100 rgbcolor null /setcolors self send
} def
/reshape {
/reshape super send
(Canvas - % % Parent - % %\n)
[/size self send /size /parent self send send]
printf
} def
classend
def
/ButtonBag FlexBag []
classbegin
/newinit {
/newinit super send
/b [/c {
self WIDTH .5 mul self HEIGHT .5 mul
}
(Button) nullnotify OpenLookButton]
/addclient self send
} def
classend
def
/TwoBag ClassBag []
classbegin
/PanelPixels 30 def
/newinit {
/newinit super send
/topclient ButtonBag /addclient self send
/bottomclient RCanvas /addclient self send
40 200 /lockminsize self send
} def
/PaintCanvas {
FillColor /FillCanvas self send
} def
/Layout {
/bottomclient /getbyname self send {
BagBegin
0 0 /size self send PanelPixels sub
/reshape 6 -1 roll send
BagEnd
} if
/topclient /getbyname self send {
BagBegin
0
/size self send % 0 bw bh
PanelPixels sub exch PanelPixels % 0 bh' bw
/reshape 6 -1 roll send
BagEnd
} if
} def
classend
def
TwoBag nullarray framebuffer /newdefault ClassBaseFrame send
(Automatic Resize) /setlabel 2 index send
100 100 300 300 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
SHAR_EOF
fi
if test -f 'FrameOpen'
then
echo shar: "will not over-write existing file 'FrameOpen'"
else
cat << \SHAR_EOF > 'FrameOpen'
%
% Simple Frame
%
/F OpenLookBaseFrame []
classbegin
%
% Override to catch transition to or from icon
%
/open { % bool => -
dup {(icon -> frame\n)} {(frame -> icon\n)} ifelse
console exch [] fprintf
/open super send
} def
classend def
null nullarray framebuffer /new F send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'OldButtons'
then
echo shar: "will not over-write existing file 'OldButtons'"
else
cat << \SHAR_EOF > 'OldButtons'
%
% Example of Bags and Buttons
%
/SimpleCanvas ClassCanvas
dictbegin
/Message (Hello Programmers) def
/Position (Middle) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 20 null /settextparams self send
[
(Your Momma)
(Your Daddy)
(Your Sister)
]
null
/setmessage self soften buildsend
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/setmessage {
/valuething exch send
/Message exch def
/paint self send
} def
/setposition {
/Position exch def
/paint self send
} def
/PaintCanvas {
/PaintCanvas super send
Position {
(Left) {
/size self send 2 div 10 exch moveto pop
}
(Middle) {
/size self send 2 div exch 2 div exch moveto
}
(Right) {
/size self send 2 div exch 40 sub exch moveto
}
(Sideways) {
/size self send 2 div exch 2 div exch moveto
90 rotate
}
} case
TextFont setfont Message cshow
} def
classend
def
/ButtonBag ClassBag []
classbegin
/ButtonWidth 70 def
/ButtonHeight 25 def
/ButtonGap 30 def
/newinit {
/left (Left) /doupdate self soften buildsend
self soften /new OpenLookButton send
/addclient self soften send
/middle (Middle) /doupdate self soften buildsend
self soften /new OpenLookButton send
/addclient self soften send
/right (Right) /doupdate self soften buildsend
self soften /new OpenLookButton send
/addclient self soften send
/sideways (Sideways) /doupdate self soften buildsend
self soften /new OpenLookButton send
/addclient self soften send
} def
/PaintCanvas {
FillColor /FillCanvas self send
} def
/doupdate { % button => -
/graphic exch send /thing exch send dup
(Status:) exch /setfooter
/Parent /Parent self send send
send
cvn /setposition
/bottomclient /getbyname /Parent self send send pop
send
} def
/Layout {
BagBegin
2 dict
begin
/xposition
/size self send pop % w
/clientcount self send dup % w n n
ButtonWidth mul exch % w bw*n n
1 sub ButtonGap mul % w bw*n bg*n-1
add sub 2 div floor
def
/yposition
/size self send exch pop
2 div 10 sub floor
def
/clientlist self send {
xposition yposition ButtonWidth ButtonHeight
/reshape 6 -1 roll send
/xposition xposition
ButtonWidth ButtonGap add add def
} forall
end
BagEnd
} def
classend
def
/TwoBag ClassBag []
classbegin
/PanelPercentage .20 def
/newinit {
/newinit super send
/topclient exch /addclient self send
/bottomclient exch /addclient self send
} def
/PaintCanvas {
FillColor /FillCanvas self send
} def
/Layout {
/bottomclient /getbyname self send {
BagBegin
0 0 /size self send
1 PanelPercentage sub mul floor
/reshape 6 -1 roll send
BagEnd
} if
/topclient /getbyname self send {
BagBegin
/size self send
2 dict
begin
/bh exch def
/bw exch def
0 bh 1 PanelPercentage sub mul floor
bw bh PanelPercentage mul floor
/reshape 6 -1 roll send
end
BagEnd
} if
} def
classend
def
/f [[SimpleCanvas] [ButtonBag] TwoBag] nullarray
framebuffer /newdefault ClassBaseFrame send def
/reshapefromuser f send
/activate f send
/map f send
(Bags and Buttons with TNT) /setlabel f send
(Status:) (Waiting for Request) /setfooter f send
SHAR_EOF
fi
if test -f 'HelpProblem'
then
echo shar: "will not over-write existing file 'HelpProblem'"
else
cat << \SHAR_EOF > 'HelpProblem'
%
% Color Buttons!
%
/ButtonBag FlexBag []
classbegin
/HelpProc { % object -> -
/popuphelp self /parentdescendant ClassFrame send pop send
} def
% The help label and text comes from this dictionary.
%
/helpdict dictbegin
/Label (tNtmacs (user interface for GNU Emacs)) def
/Text [
(The tntmacs user interface for GNU Emacs consists of to major parts:)
(Info--- the GNU emacs manual browser)
] def
dictend def
/newinit {
/newinit super send
/b2 [
/w
{20 20}
%{/e /b1 POSITION 20 20 XYADD}
(Button2)
[
(Help) null
{pop f
/HelpProc
f send }
(One) null { pop }
]
framebuffer /new OpenLookMenu send
null
OpenLookButtonStack
]
/addclient self send
% set the fill color for the button
%null ColorDict /Green get null /setcolors
% /b1 /getbyname self send pop send
%null ColorDict /Wheat get null /setcolors
% /b2 /getbyname self send pop send
} def
classend
def
ButtonBag nullarray framebuffer /newdefault ClassBaseFrame send
(ONE Button) /setlabel 2 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'FrameQuit'
then
echo shar: "will not over-write existing file 'FrameQuit'"
else
cat << \SHAR_EOF > 'FrameQuit'
%
% Simple Frame
%
/F OpenLookBaseFrame []
classbegin
%
% Override to catch quit from either Window or Icon
%
/destroyfromuser {
console (destroy\n) [] fprintf
/destroyfromuser super send
} def
classend def
null nullarray framebuffer /new F send
(OPENLOOK Frame) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map exch send
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'PsAngles'
then
echo shar: "will not over-write existing file 'PsAngles'"
else
cat << \SHAR_EOF > 'PsAngles'
%
% PostScript
%
/SimpleCanvas ClassCanvas
dictbegin
/Message (PostScript) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
500 500 /lockminsize self send
} def
/PaintCanvas {
1 fillcanvas
5 5 moveto
/textfont self send setfont
0 setgray Message show
gsave
100 100 moveto
3 3 scale
.8 setgray
30 rotate
Message show
grestore
gsave
10 400 moveto
-20 rotate
2 2 scale
.6 setgray
Message show
grestore
} def
classend
def
SimpleCanvas nullarray framebuffer /newdefault ClassBaseFrame send
(Art Frame) /setlabel 2 index send
/place 1 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test ! -d 'BagDoodles'
then
mkdir 'BagDoodles'
fi
cd 'BagDoodles'
if test -f 'bag1'
then
echo shar: "will not over-write existing file 'bag1'"
else
cat << \SHAR_EOF > 'bag1'
%
% Subclassing ClassBag
%
/SimpleCanvas ClassCanvas []
classbegin
/PaintCanvas {
.5 fillcanvas
} def
/minsize {
20 20
} def
classend
def
/SimpleBag ClassBag []
classbegin
/newinit {
/newinit super send
% Build two clients for this bag, Instance is created
% by the /Instantiate method
/c1 [SimpleCanvas] /addclient self send
/c2 [SimpleCanvas] /addclient self send
} def
/Layout {
% Set currentcanvas to Bag
BagBegin
/c1 /getbyname self send {
20 20 /minsize 3 index send
/reshape 6 -1 roll send
} if
/c2 /getbyname self send {
100 20 /minsize 3 index send
/reshape 6 -1 roll send
} if
BagEnd
} def
/MinSize {
% This would be a calculation based on the size
% and the position of the clients
200 50
} def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag2'
then
echo shar: "will not over-write existing file 'bag2'"
else
cat << \SHAR_EOF > 'bag2'
%
% Subclassing ClassBag
%
/SimpleCanvas ClassCanvas []
classbegin
/PaintCanvas {
.5 fillcanvas
} def
/minsize {
20 20
} def
classend
def
/SimpleBag ClassBag []
classbegin
/newinit {
/newinit super send
% Build two clients for this bag, Instance is created
% by the /Instantiate method
/c1 [SimpleCanvas] /addclient self send
/c2 [SimpleCanvas] /addclient self send
} def
/NewClient {
% Loaded by Instantiate
/newdefault self send
0 0 /minsize 3 index send /reshape 5 index send
} def
/Layout {
% Set currentcanvas to Bag
BagBegin
/c1 /getbyname self send {
20 20 /move 3 index send
} if
/c2 /getbyname self send {
100 20 /move 3 index send
} if
BagEnd
} def
/MinSize {
% This would be a calculation based on the size
% and the position of the clients
200 50
} def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag3'
then
echo shar: "will not over-write existing file 'bag3'"
else
cat << \SHAR_EOF > 'bag3'
%
% Subclassing ClassBag
%
/SimpleCanvas ClassCanvas []
classbegin
/PaintCanvas {
.5 fillcanvas
} def
classend
def
/SimpleBag ClassBag []
classbegin
/newinit {
/newinit super send
% Build two clients for this bag, Instance is created
% by the /Instantiate method
% Baggage is [x y w h]
/c1 [10 10 30 30 SimpleCanvas] /addclient self send
/c2 [100 10 10 10 SimpleCanvas] /addclient self send
} def
/Layout {
% Set currentcanvas to Bag
BagBegin
/clientlist self send {
dup /baggage self send
aload pop /reshape 6 -1 roll send
} forall
BagEnd
} def
/MinSize {
% This would be a calculation based on the size
% and the position of the clients
200 50
} def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag4'
then
echo shar: "will not over-write existing file 'bag4'"
else
cat << \SHAR_EOF > 'bag4'
%
% Subclass of AbsoluteBag
%
/SimpleBag AbsoluteBag []
classbegin
/newinit {
/newinit super send
false /settopdown self send
% Build two clients for this bag, Instance is created
% by the /Instantiate method. Notice the Graphic instance
% is used, rather then the class.
% Baggage is [x y]
/b [10 10 (Button) nullproc OpenLookButton]
/addclient self send
/g [10 60 (Label) /new OpenLookLabelGraphic send]
/addclient self send
} def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag5'
then
echo shar: "will not over-write existing file 'bag5'"
else
cat << \SHAR_EOF > 'bag5'
%
% Instance of AbsoluteBag
%
/B framebuffer /new AbsoluteBag send def
false /settopdown B send
/b [10 10 (Button) nullproc OpenLookButton] /addclient B send
/g [10 60 (Label) /new OpenLookLabelGraphic send] /addclient B send
[B] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag6'
then
echo shar: "will not over-write existing file 'bag6'"
else
cat << \SHAR_EOF > 'bag6'
%
% Subclass of RowColumnBag
%
/SimpleBag RowColumnBag []
classbegin
/newinit {
/newinit super send
/b1 [(Button1) nullnotify OpenLookButton] /addclient self send
/b2 [(Button2) nullnotify OpenLookButton] /addclient self send
/b3 [(Button3) nullnotify OpenLookButton] /addclient self send
/b4 [(Button4) nullnotify OpenLookButton] /addclient self send
/b5 [(Button5) nullnotify OpenLookButton] /addclient self send
/b6 [(Button6) nullnotify OpenLookButton] /addclient self send
} def
/LayoutRows 2 def
/LayoutCols 3 def
/RowMajor? false def
/CellHorzGap 15 def
/CellVertGap 15 def
/Border 20 def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag7'
then
echo shar: "will not over-write existing file 'bag7'"
else
cat << \SHAR_EOF > 'bag7'
%
% SubClass of FlexBag
%
/SimpleBag FlexBag []
classbegin
/newinit {
/newinit super send
% The baggage for a flex bag is "corner literal" "proc"
% The proc should return the x y coords.
% There are a bunch of utilites which can be used in the "proc"
/b1 [/sw { 20 20 }
(Button1) nullnotify OpenLookButton]
/addclient self send
/b2 [/w { /e /b1 POSITION 20 20 XYADD }
(Button2) nullnotify OpenLookButton]
/addclient self send
/b3 [/c { /c self WIDTH .75 mul self HEIGHT .5 mul }
(Button3) nullnotify OpenLookButton]
/addclient self send
} def
/MinSize { 300 300 } def
classend
def
[SimpleBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map exch send
SHAR_EOF
fi
if test -f 'bag8'
then
echo shar: "will not over-write existing file 'bag8'"
else
cat << \SHAR_EOF > 'bag8'
%
% Bags in Bags ...
%
% Instance method
/simplecanvas framebuffer /new ClassCanvas send def
{ .5 fillcanvas } /setpaintproc simplecanvas send
% instances need to be reshaped before adding them
% to a
0 0 200 50 /reshape simplecanvas send
/buttonbag framebuffer /new FlexBag send def
/b1 [/c {/c self WIDTH .25 mul self HEIGHT .5 mul }
(Button1) nullnotify OpenLookButton]
/addclient buttonbag send
/b2 [/c {/c self WIDTH .75 mul self HEIGHT .5 mul }
(Button2) nullnotify OpenLookButton]
/addclient buttonbag send
200 50 /lockminsize buttonbag send
0 0 200 50 /reshape buttonbag send
/windowbag framebuffer /new RowColumnBag send def
true 2 1 /setlayoutstyle windowbag send
/c1 simplecanvas /addclient windowbag send
/c2 buttonbag /addclient windowbag send
[windowbag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
SHAR_EOF
fi
if test -f 'bag9'
then
echo shar: "will not over-write existing file 'bag9'"
else
cat << \SHAR_EOF > 'bag9'
%
% Bags in Bags ...
%
% Subclass Method
/SimpleCanvas ClassCanvas []
classbegin
/PaintCanvas {
.5 fillcanvas
} def
classend def
/ButtonBag FlexBag []
classbegin
/newinit {
/b1 [/c {/c self WIDTH .25 mul self HEIGHT .5 mul }
(Button1) nullnotify OpenLookButton]
/addclient self send
/b2 [/c {/c self WIDTH .75 mul self HEIGHT .5 mul }
(Button2) nullnotify OpenLookButton]
/addclient self send
200 50 /lockminsize self send
} def
classend def
/WindowBag RowColumnBag []
classbegin
/newinit {
true 2 1 /setlayoutstyle self send
/c1 [ButtonBag] /addclient self send
/c2 [SimpleCanvas] /addclient self send
} def
classend def
[WindowBag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
SHAR_EOF
fi
if test -f 'tntbagdoodles'
then
echo shar: "will not over-write existing file 'tntbagdoodles'"
else
cat << \SHAR_EOF > 'tntbagdoodles'
%
% Bag Doodles
%
% Subclassing Examples
%
% Do it all yourself style
%
/ButtonBag1 ClassBag []
classbegin
/newinit {
/newinit super send
% Build two clients for this bag, Instance is created
% by the /Instantiate method
/b1 [(Button1) nullnotify OpenLookButton] /addclient self send
/b2 [(Button2) nullnotify OpenLookButton] /addclient self send
} def
/Layout {
BagBegin
/b1 /getbyname self send {
20 20 /minsize 3 index send
/reshape 6 -1 roll send
} if
/b2 /getbyname self send {
100 20 /minsize 3 index send
/reshape 6 -1 roll send
} if
BagEnd
} def
/MinSize {
% This would probably be some calculation based on
% the size of the clients
200 50
} def
classend
def
%
% AbsoluteBags handle simple layout
%
/ButtonBag2 AbsoluteBag []
classbegin
/newinit {
/newinit super send
% Coordinates measured from bottom up
false /settopdown self send
% The coordinates become the "baggage" for each client
/b1 [20 20 (Button1) nullnotify OpenLookButton]
/addclient self send
/b2 [100 20 (Button2) nullnotify OpenLookButton]
/addclient self send
} def
/MinSize {
% This would probably be some calculation based on
% the size of the clients
200 50
} def
classend
def
%
% RowColumnBags for common layout algorithms
%
/ButtonBag3 RowColumnBag []
classbegin
/newinit {
/newinit super send
/b1 [(Button1) nullnotify OpenLookButton] /addclient self send
/b2 [(Button2) nullnotify OpenLookButton] /addclient self send
/b3 [(Button3) nullnotify OpenLookButton] /addclient self send
/b4 [(Button4) nullnotify OpenLookButton] /addclient self send
/b5 [(Button5) nullnotify OpenLookButton] /addclient self send
/b6 [(Button6) nullnotify OpenLookButton] /addclient self send
} def
/LayoutRows 2 def
/LayoutCols 3 def
/RowMajor? false def
/CellHorzGap 15 def
/CellVertGap 15 def
/Border 20 def
classend
def
%
% FlexBags for more complex layout needs
%
/ButtonBag4 FlexBag []
classbegin
/newinit {
/newinit super send
% The baggage for a flex bag is "corner literal" "proc"
% The proc should return the x y coords.
% There are a bunch of utilites which can be used in the "proc"
/b1 [/sw { 20 20 }
(Button1) nullnotify OpenLookButton]
/addclient self send
/b2 [/w { /e /b1 POSITION 20 20 XYADD }
(Button2) nullnotify OpenLookButton]
/addclient self send
/b3 [/c { /c self WIDTH .75 mul self HEIGHT .5 mul }
(Button3) nullnotify OpenLookButton]
/addclient self send
} def
/MinSize { 300 300 } def
classend
def
%
% No Subclassing
%
% AbsoluteBag
%
/buildabuttonbag1 {
/AButtonBag1 framebuffer /new AbsoluteBag send def
/b1 [20 20 (Button1) nullnotify OpenLookButton]
/addclient AButtonBag1 send
/b2 [100 20 (Button2) nullnotify OpenLookButton]
/addclient AButtonBag1 send
false /settopdown AButtonBag1 send
200 50 /lockminsize AButtonBag1 send
AButtonBag1
} def
%
% RowColumnBag
%
/buildabuttonbag2 {
/AButtonBag2 framebuffer /new RowColumnBag send def
/b1 [(Button1) nullnotify OpenLookButton]
/addclient AButtonBag2 send
/b2 [(Button2) nullnotify OpenLookButton]
/addclient AButtonBag2 send
/b3 [(Button3) nullnotify OpenLookButton]
/addclient AButtonBag2 send
/b4 [(Button4) nullnotify OpenLookButton]
/addclient AButtonBag2 send
/b5 [(Button5) nullnotify OpenLookButton]
/addclient AButtonBag2 send
/b6 [(Button6) nullnotify OpenLookButton]
/addclient AButtonBag2 send
false 3 2 /setlayoutstyle AButtonBag2 send
AButtonBag2
} def
/bagfun { % class|Instance => -
dup /class? exch send
{
dup /superclasses exch send
dup length 1 sub get
/classname exch send
(Subclass of %) exch 1 array astore sprintf
}{
dup /class exch send
/classname exch send
(Instance of %) exch 1 array astore sprintf
} ifelse
/s exch def
nullarray framebuffer /newdefault ClassBaseFrame send
s /setlabel 2 index send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map 1 index send
/client exch send /B exch def
} def
%
%citation 14: psh
%executive
%Welcome to X11/NeWS Version 2.0
%PS> (TnTtalks/tntbagdoodles) LoadFile ==
%true
%PS> ButtonBag1 bagfun
%PS> B ==
%canvas(0x44a680,200x50,transparent,parent)
%PS> /paint B send
%PS> /clientlist B send ==
%[canvas(0x44a750,63x21,transparent) canvas(0x44a8f0,72x21,transparent)]
%PS> /b1 /getbyname B send stack
%canvas(0x44a750,63x21,transparent) true
%PS> clear
%PS> gsave B setcanvas 20 30 /move /b1 /sendclient B send /paint B send grestore
%
%
%PS> ButtonBag2 bagfun
%PS> /b1 /getbyname B send pop
%PS> /Baggage get ==
%[20 20]
%
%PS> ButtonBag3 bagfun
%PS> false 3 2 /setlayoutstyle B send
%PS> 10 400 /minsize /parent B send send /reshape /parent B send send
%PS>
%PS> ButtonBag4 bagfun
%PS> /b4 [/s {/n /b2 POSITION 0 50 XYADD}
%PS> (Button4) nullnotify OpenLookButton] /addclient B send
%PS> /paint B send
%PS> /b4 /getbyname B send pop
%PS> /Baggage get ==
%[/s {/n /b2 POSITION 0 50 XYADD}]
%PS> buildabuttonbag1 bagfun
%PS> buildabuttonbag2 bagfun
SHAR_EOF
fi
if test -f 'bag8fix'
then
echo shar: "will not over-write existing file 'bag8fix'"
else
cat << \SHAR_EOF > 'bag8fix'
%
% Bags in Bags ...
%
% Instance method
/simplecanvas framebuffer /new ClassCanvas send def
{ .5 fillcanvas } /setpaintproc simplecanvas send
% instances need to be reshaped before adding them
% to a bag with the standard NewClient
0 0 200 50 /reshape simplecanvas send
/buttonbag framebuffer /new FlexBag send def
/b1 [/c {/c self WIDTH .25 mul self HEIGHT .5 mul }
(Button1) nullnotify OpenLookButton]
/addclient buttonbag send
/b2 [/c {/c self WIDTH .75 mul self HEIGHT .5 mul }
(Button2) nullnotify OpenLookButton]
/addclient buttonbag send
200 50 /lockminsize buttonbag send
% instances need to be reshaped before adding them
% to a bag with the standard NewClient
0 0 200 50 /reshape buttonbag send
/windowbag framebuffer /new RowColumnBag send def
true 2 1 /setlayoutstyle windowbag send
/c1 simplecanvas /addclient windowbag send
/c2 buttonbag /addclient windowbag send
[windowbag] nullarray framebuffer /newdefault ClassBaseFrame send
10 400 /minsize 3 index send /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
SHAR_EOF
fi
cd ..
if test -f 'pswin'
then
echo shar: "will not over-write existing file 'pswin'"
else
cat << \SHAR_EOF > 'pswin'
#! /bin/sh
USAGE="Usage: pswin PS-file"
if [ ${#} -ne 1 ]; then
echo ${USAGE}; exit 1
fi
psh <<EOF
/win [ClassCanvas] [] framebuffer
/newdefault ClassBaseFrame send def
{ clippath pathbbox
exch 8.5 72 mul div
exch 11 72 mul div
scale pop pop
(${1}) run
} /setpaintproc /client win send send
(PS Window) /setlabel win send
100 50 700 800 /reshape win send
/activate win send
/map win send
EOF
SHAR_EOF
chmod +x 'pswin'
fi
if test -f 'scoutclock'
then
echo shar: "will not over-write existing file 'scoutclock'"
else
cat << \SHAR_EOF > 'scoutclock'
%!
%%Creator: David A. LaVallee
%%Owner: Sun Microsystems, Inc. copyright 1989
%%+
%%+ Inspired by the Brent K. Thaeler, Josh Seigel Digital Clock
%%+
/TimeOfDay ClassCanvas [/Sec /Min /Hour /Date /Day /Month /Year]
classbegin
/newinit {
/newinit super send
gettime
gettick
} def
/TextFont /GillSans-Bold findfont 32 scalefont def
/PaintCanvas {
FillColor fillcanvas
TextColor setcolor
TextFont setfont
10 70 moveto
Hour (:) Min 2 {append} repeat
show
10 40 moveto
DAYS Day get ( ) Date dup (th ) exch
dup length 1 sub get cvis {
(1) {pop (st )}
(2) {pop (nd )}
(3) {pop (rd )}
} case
3 {append} repeat
show
10 10 moveto
MONTHS Month get ( ) Year 2 {append} repeat
show
} def
/gettime {
[
(%socketc13) (r) file dup
60 string readstring
pop exch closefile
( ) search pop /Day exch def pop
( ) search pop /Month exch def pop
( ) search pop /Date exch def pop
(:) search pop /Hour exch def pop
(:) search pop /Min exch def pop
( ) search pop /Sec exch def pop
(\n) search pop /Year exch def pop
cleartomark
} def
/gettick {
Canvas
createevent dup begin
/Name /TimeOfDay def
/Canvas 3 -1 roll def
/TimeStamp currenttime 1 add def
end sendevent
} def
/DAYS 7 dict dup begin
/Mon (Monday) def
/Tue (Tuesday) def
/Wed (Wednesday) def
/Thu (Thursday) def
/Fri (Friday) def
/Sat (Saturday) def
/Sun (Sunday) def
end def
/MONTHS 12 dict dup begin
/Jan (January) def
/Feb (February) def
/Mar (March) def
/Apr (April) def
/May (May) def
/Jun (June) def
/Jul (July) def
/Aug (August) def
/Sep (September) def
/Oct (October) def
/Nov (November) def
/Dec (December) def
end def
/UpdateTimeOfDay {
gettime
gettick
Canvas setcanvas 0 0 size rectpath extenddamage
} def
/MakeInterests {
/MakeInterests super send
/TimeOfDay /UpdateTimeOfDay
null Canvas MakeInterest
} def
classend def
/win
[TimeOfDay] [/Reshape false /Footer false] framebuffer
/newdefault ClassBaseFrame send
def
0 0 280 130 /reshape win send
/activate win send
/place win send
/map win send
SHAR_EOF
fi
if test -f '..NewDocument'
then
echo shar: "will not over-write existing file '..NewDocument'"
else
cat << \SHAR_EOF > '..NewDocument'
SHAR_EOF
fi
if test -f '..#HelloMenuPullRight#'
then
echo shar: "will not over-write existing file '..#HelloMenuPullRight#'"
else
cat << \SHAR_EOF > '..#HelloMenuPullRight#'
/SimpleCanvas ClassCanvas
dictbegin
/Message (Your Momma) def
dictend
classbegin
/newinit {
/newinit super send
/Times-Bold 30 null /settextparams self send
[
(New Message)
[ (Your Momma) (Your Daddy) (Your Sister) ]
null
{
/valuething 1 index send
/setmessage /sendtarget 4 -1 roll send
}
framebuffer /new OpenLookMenu send
null
(New Font)
[ (Times-Roman) (Times-Italic) (Times-Bold) ]
null
{
/valuething 1 index send cvn
/setfontname /sendtarget 4 -1 roll send
}
framebuffer /new OpenLookMenu send
null
]
framebuffer /new OpenLookMenu send
true /setpinnable 2 index send
(Message) /setlabel 2 index send
/setmenu self send
} def
/PaintCanvas {
1 fillcanvas
/size self send 2 div exch 2 div exch moveto
/textfont self send setfont
0 setgray Message cshow
} def
/setmessage { % string => -
/Message exch def
/paint self send
} def
/setfontname { % fontname => -
null null /settextparams self send
/paint self send
} def
classend
def
SimpleCanvas nullarray framebuffer /new OpenLookBaseFrame send
(HelloMenu with a PullRight) /setlabel 2 index send
(Status:) (totally awesome) /setfooter 3 index send
100 100 400 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'flippers.ps'
then
echo shar: "will not over-write existing file 'flippers.ps'"
else
cat << \SHAR_EOF > 'flippers.ps'
% flippers.ps: creates a canvas that (when it has the focus) flips flippers
% based on the state of the shift keys.
/FlipperCanvas ClassCanvas dictbegin
/Left false def
/Right false def
dictend
classbegin
% Give this canvas a 0-1 0-1 coordinate system.
/Transform { % x y w h => x' y' w' h
4 2 roll % w h x y
translate % w h
scale % -
0 0 1 1
} def
/PaintCanvas {
FillColor /FillCanvas self send
.2 .5 moveto .25 Left .1 -.1 ifelse rlineto
.8 .5 moveto -.25 Right .1 -.1 ifelse rlineto
.025 setlinewidth StrokeColor setcolor stroke
} def
/KeyMap dictbegin
/LeftShift /keyforsymbol ClassKeyboard send /Left def
/RightShift /keyforsymbol ClassKeyboard send /Right def
dictend def
/MakeInterests {
/MakeInterests super send
self soften /new ClassFocusSelfInterest send % Nint
dup
[true /KeyEvent] self soften buildsend
[false /KeyEvent] self soften buildsend
[KeyMap] nulldict /new ClassKeysInterest send % Nint Nint Kint
dup /Exclusivity false put
/addsuite exch send % Nint
} def
/KeyEvent { % event bool => -
exch /Name get exch def
/paint self send
} def
classend def
/fc FlipperCanvas nullarray framebuffer /newdefault ClassBaseFrame send def
(Flippers) /setlabel fc send
/activate fc send
/reshapefromuser fc send
/map fc send
SHAR_EOF
fi
if test -f 'FunnyCanvas'
then
echo shar: "will not over-write existing file 'FunnyCanvas'"
else
cat << \SHAR_EOF > 'FunnyCanvas'
%
% FunnyCanvas
%
/FunnyCanvas ClassCanvas []
classbegin
/path {
pop pop pop pop
0 0 moveto 100 100 rect
150 150 moveto 200 200 rect
} def
/newinit {
/newinit super send
false /settransparent self send
} def
/PaintCanvas {
.8 fillcanvas
} def
classend
def
/c framebuffer /new FunnyCanvas send def
0 0 400 400 /reshape c send
/activate c send
/map c send
%
%FunnyCanvas nullarray framebuffer /newdefault ClassBaseFrame send
%(Funny Frame) /setlabel 2 index send
%/place 1 index send
%/activate 1 index send
%/map 1 index send
%/f exch def
%
%newprocessgroup
%currentfile closefile
SHAR_EOF
fi
if test -f 'SimpleAppBag'
then
echo shar: "will not over-write existing file 'SimpleAppBag'"
else
cat << \SHAR_EOF > 'SimpleAppBag'
% The following example code shows how an application programmer
% might typically subclass ClassBag, and use the result as the client
% of an OpenLook frame (or any bag for that matter).
% The task of a SimpleAppBag is to provide the layout policy for a basic
% OpenLook application. The inside of the window in such an application
% is occupied by two areas -- a control area of fixed height, and a
% stretchable canvas that is the main focus of interraction. A
% SimpleAppBag manages these two canvases.
% The control area sits above the stretchable canvas, and both must
% adjust their widths to fill the frame interior when the user reshapes
% the frame.
/SimpleAppBag ClassBag []
classbegin
% This bag always has exactly two clients. It expects them
% to be presented as arguments to /new, and hence consumes them
% during /newinit. This bag takes the responsibility of giving
% names to clients: /Fixed for the upper area, and /Floating
% for the lower stretchable region. No baggage is required for
% clients of a SimpleAppBag.
%
/newinit { % fixed-client floating-client -> -
/Floating exch /addclient self send
/Fixed exch /addclient self send
{
% We set the height of the /Fixed client once to its
% ideal size, and never alter in again. Arguably, we
% shouldn't mess with it at all and just trust the
% application to hand in a canvas with the desired height.
% This approach fails though when the application passes in a
% class rather than an instance.
%
% The "0 0" and width arguments to /reshape are just
% placeholders -- they are overridden in % /Layout.
%
0 0 /minsize self send /reshape self send
} /Fixed /sendclient self send
} def
% Here's where we decide how small we allow the user to make
% this bag and its clients. Since we aren't overriding
% /preferredsize as well, its /preferrsedsize will default to
% its /minsize. In the calculation below, we say that the min width
% is the maximum of the min widths for each of the clients, and the
% min height is the sum of the min heights of the clients. This is
% the obvious choice given the layout of the bag.
%
% Subtle point: we override /MinSize rather than /minsize
% just in case one of our clients is a graphic rather than a
% canvas as expected. When graphics calculate their minimum size
% they make use of the current canvas. Overriding /MinSize allows
% us to assume that the bag *is* the current canvas.
%
/MinSize { % - -> w h
/minsize /Fixed /sendclient self send % w1 h1
/minsize /Floating /sendclient self send % w1 h1 w2 h2
3 -1 roll add 3 1 roll max exch % max(w1,w2) h1+h2
} def
% This procedure is called automatically just before painting
% the bag *if* something has changed in the bag's geometry since
% the last time it was called. See `Layout and Invalidation'
%
% Here we reshape the two clients to fill the space available
% in the bag (as returned by /size self send). The /Fixed client
% may be stretched horizontally, but its height will not change.
% The floating client will be streched in both dimensions to
% take up the rest of the space.
%
/Layout { % - -> -
/size /Fixed /sendclient self send exch pop % h-Fi
/size self send % h-Fi w h
2 index sub % h-Fi w h'
0 1 index 3 index 6 -1 roll % w h' 0 w h-Fi
/reshape /Fixed /sendclient self send % w h'
0 0 4 2 roll /reshape /Floating /sendclient self send
} def
% This type of bag doesn't want to stroke its border or fill itself
% so we give it a null paint proc.
%
/PaintCanvas nullproc def
classend def
%
% Below we show how a SimpleAppBag might be used in an application.
% We make the /Fixed client a FlexBag with a couple of controls in it,
% and the /Floating client a brightly colored canvas.
/ColorCanvas ClassCanvas []
classbegin
/setrgb { % rvalue gvalue bvalue -> -
/FillColor 4 1 roll rgbcolor def
/paint self send
} def
/minsize { % - -> minw minh
50 50
} def
classend def
/ControlArea FlexBag []
classbegin
/PaddingWidth 10 def % Leave some space around controls
/PaddingHeight 10 def % Ditto
/PaintCanvas nullproc def % No paint is fine here
% Set every client to its preferred size, when it is added
% to the bag. This obviates the need for tedious reshaping
% code outside the bag.
%
/RegisterClient { % name client -> -
0 0 /preferredsize 3 index send /reshape 5 index send
/RegisterClient super send
} def
classend def
% Make the stretchable color canvas
/cc framebuffer /new ColorCanvas send def
% Make three buttons to put in the flexbag
/bb (Black) {0 0 0 /setrgb /sendtarget 6 -1 roll send}
framebuffer /new OpenLookButton send def
0 0 /preferredsize bb send /reshape bb send
/wb (White) {1 1 1 /setrgb /sendtarget 6 -1 roll send}
framebuffer /new OpenLookButton send def
0 0 /preferredsize wb send /reshape wb send
/rb (Random) {random random random /setrgb /sendtarget 6 -1 roll send}
framebuffer /new OpenLookButton send def
0 0 /preferredsize rb send /reshape rb send
% Make the color canvas the target of all buttons.
cc /settarget bb send
cc /settarget wb send
cc /settarget rb send
% Make the flexbag and add the buttons to it.
/fb framebuffer /new ControlArea send def
null [/nw {/nw self POSITION 10 -10 XYADD} bb] /addclient fb send
null [/nw {/sw Previous POSITION 10 sub} wb] /addclient fb send
null [/ne {/ne self POSITION 10 10 XYSUB} rb] /addclient fb send
% Create a frame containing a SimpleAppBag which in turn contains
% the flexbag and the color canvas.
/win [fb cc SimpleAppBag] [/Footer false]
framebuffer /new OpenLookBaseFrame send def
(Bag Subclassing) /setlabel win send
/place win send
/activate win send
/map win send
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'scouticoneditor'
then
echo shar: "will not over-write existing file 'scouticoneditor'"
else
cat << \SHAR_EOF > 'scouticoneditor'
%!
%%tnt1.0
%%Creator: David A. LaVallee scout@sun.com
%%Owner: Sun Microsystems, Inc. copyright 1989
%%+
%%BeginningOf: IconEditor
%%+ Icon editor 16 32 64 square bit editor.
/SmallIcon ClassCanvas [
/bitsize /iconsize /bitmap /clear? /pointlist /Complete
/minx /miny /maxx /maxy
]
classbegin
/newinit {
/newinit super send
/bitmap exch def
/pointlist [] def
/clear? false def
/Complete {stroke} def
} def
/PaintCanvas {
0 setgray
bitmap imagecanvas
} def
/setibsize {
/bitsize exch def
/iconsize exch def
} def
/pointfeedback { % x y => x y
} def
/addpaintpoint { % x y => -
pointlist length 0 eq {
0 index dup /miny exch def /maxy exch def
1 index dup /minx exch def /maxx exch def
} {
dup miny min /miny exch def
dup maxy max /maxy exch def
1 index minx min /minx exch def
1 index maxx max /maxx exch def
} ifelse
pointfeedback [3 1 roll] [exch] pointlist exch append
/pointlist exch def
} def
/adddamagepath { % x y w h => -
canvas setcanvas
rectpath extenddamage
} def
/paintpointlist {
bitmap setcanvas
/style parent send /EraseIt eq {1} {0} ifelse setgray
pointlist {aload pop 1 add moveto 0 0 rlineto stroke} forall
/pointlist [] def
minx miny maxx 1 add maxy 1 add points2rect
/adddamagepath parent send
} def
/paintlinelist {
bitmap setcanvas
/style parent send /EraseIt eq {1} {0} ifelse setgray
pointlist 0 get aload pop 1 add moveto
pointlist {aload pop 1 add lineto} forall
/style parent send /FillIt eq {closepath fill} {stroke} ifelse
/pointlist [] def
minx miny maxx 1 add maxy 1 add points2rect
/adddamagepath parent send
} def
/paintline {
bitmap setcanvas
/style parent send {
/StrokeIt {0}
/FillIt {0}
/EraseIt {1}
/default {0}
} case setgray
4 copy 4 2 roll 1 add moveto 1 add lineto stroke
points2rect 1 add exch 1 add exch /adddamagepath parent send
} def
/paintrect {
bitmap setcanvas
4 copy
/style parent send {
/StrokeIt {/Complete {eofill} def 0}
/FillIt {/Complete {fill} def 0}
/EraseIt {/Complete {fill} def 1}
/default {/Complete {eofill} def 0}
} case setgray
1 5 1 roll points2rect 1 add exch 1 add exch rectframe Complete
points2rect 1 add exch 1 add exch /adddamagepath parent send
} def
/HandleDrag {
canvas setcanvas
begin XLocation YLocation end
addpaintpoint
} def
/HandlePoint {
canvas setcanvas
begin XLocation YLocation end
/clear? false def
addpaintpoint
[
/MouseDragged /HandleDrag
null canvas MakeInterest
null {
pop currentprocess killprocess
} /UpTransition null MakeInterest
] forkeventmgr pop
} def
/HandleUp {
paintpointlist
} def
/HandleAdjust {
canvas setcanvas
begin XLocation YLocation end
/clear? true def
addpaintpoint
} def
/MakeInterests {
/MakeInterests super send
PointButton /HandlePoint
/DownTransition Canvas MakeInterest
PointButton /HandleUp
/UpTransition Canvas MakeInterest
AdjustButton /HandlePoint
/DownTransition Canvas MakeInterest
AdjustButton /HandleUp
/UpTransition Canvas MakeInterest
} def
classend def
/BigIcon SmallIcon [/strokelength /x0 /y0 /x1 /y1]
classbegin
/HandleDrag {
/mode parent send {
(Point) {
canvas setcanvas
gsave
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
addpaintpoint
grestore
}
(Polyline) {
canvas setcanvas
gsave
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
addpaintpoint
grestore
}
(Line) {
erasepage
begin XLocation truncate cvi YLocation truncate cvi end
/y1 exch def /x1 exch def
x0 .5 add y0 .5 add moveto x1 .5 add y1 .5 add lineto
stroke
}
(Rect) {
erasepage
begin XLocation truncate cvi YLocation truncate cvi end
/y1 exch def /x1 exch def
x0 .5 add y0 .5 add x1 .5 add y1 .5 add points2rect rectpath
stroke
}
} case
} def
/HandlePoint {
/mode parent send {
(Point) {
canvas setcanvas
gsave
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
/clear? false def
addpaintpoint
grestore
}
(Polyline) {
canvas setcanvas
gsave
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
/clear? false def
addpaintpoint
grestore
}
(Line) {
canvas createoverlay setcanvas
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
/y0 exch def /x0 exch def /y1 y0 def /x1 x0 def
}
(Rect) {
canvas createoverlay setcanvas
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
/y0 exch def /x0 exch def /y1 y0 def /x1 x0 def
}
} case
[
/MouseDragged /HandleDrag
null canvas MakeInterest
null {
pop currentprocess killprocess
} /UpTransition null MakeInterest
] forkeventmgr pop
} def
/HandleAdjust {
/mode parent send {
(Point) {
canvas setcanvas
gsave
bitsize 1 add dup scale
begin XLocation truncate cvi YLocation truncate cvi end
/clear? true def
addpaintpoint
grestore
}
} case
} def
/HandleUp {
pop
/mode parent send {
(Point) {
paintpointlist
}
(Polyline) {
paintlinelist
} def
(Line) {
erasepage
canvas setcanvas
x0 y0 x1 y1
paintline
}
(Rect) {
erasepage
canvas setcanvas
x0 y0 x1 y1
paintrect
}
} case
} def
/pointfeedback { % x y => x y
canvas setcanvas
gsave
0 1 translate
bitsize 1 add dup scale
2 copy moveto
.5 setgray
1 1 rlineto -1 0 rmoveto 1 -1 rlineto stroke
/mode parent send /Polyline eq pointlist length 0 gt and {
2 copy
.5 add exch .5 add exch
moveto
pointlist dup length 1 sub get aload pop
.5 add exch .5 add exch
lineto stroke
} if
grestore
} def
/PaintCanvas {
gsave
1 fillcanvas
gsave
0 setgray
bitsize 1 add dup scale
bitmap imagecanvas
grestore
.65 setgray
0 bitsize 1 add iconsize bitsize 1 add mul 1 add dup
/strokelength exch def {
0 2 copy moveto 0 strokelength rlineto
exch 1 add moveto strokelength 0 rlineto
} for
stroke
grestore
} def
/adddamagepath { % x y w h => -
canvas setcanvas
bitsize 1 add dup scale
rectpath extenddamage
} def
classend def
/IconEditor ClassBag [/iconsize /bitsize /bitmap /mode /style]
classbegin
/newinit {
/newinit super send
/iconsize 64 def
/bitmap iconsize dup 1 [1 0 0 -1 0 iconsize] {<FFFF>} buildimage def
/mode /Point def
/style /StrokeIt def
/bitsize 6 def
/smallicon [bitmap SmallIcon] addclient
/bigicon [bitmap BigIcon] addclient
0 0 iconsize dup /reshape /smallicon sendclient
0 0 iconsize bitsize 1 add mul 1 add dup /reshape /bigicon sendclient
iconsize bitsize 2 copy /setibsize /smallicon sendclient
/setibsize /bigicon sendclient
} def
/adddamagepath { % x y w h => -
/adddamagepath /bigicon sendclient
/paint /smallicon sendclient
} def
/Layout {
10 10 /move /smallicon sendclient
20 iconsize add 10 /move /bigicon sendclient
} def
/PaintCanvas {
.9 fillcanvas 0 setgray
} def
/minsize {
30 iconsize add
iconsize bitsize 1 add mul 1 add dup 3 1 roll add
exch 20 add
} def
/initiatesize {
pop % ***
} def
/changetool {
{
(Point) { /mode /Point def }
(Polyline) {/mode /Polyline def}
(Line) { /mode /Line def }
(Rect) { /mode /Rect def }
(Clear) {
gsave bitmap setcanvas 1 fillcanvas grestore
paint
}
} case
} def
/ToolMenu [
(Point) (Polyline) (Line) (Rect) (Clear)
] null {
/valuething 1 index send /changetool /sendtarget 4 -1 roll send
} framebuffer /newdefault ClassMenu send def
/changestyle {
{
(Stroke) {/StrokeIt}
(Fill) {/FillIt}
(Erase) {/EraseIt}
} case
/style exch def
} def
/StyleMenu [
(Stroke) (Fill) (Erase)
] null {
/valuething 1 index send /changestyle /sendtarget 4 -1 roll send
} framebuffer /newdefault ClassMenu send def
/changesize {
{
(16 x 16) {16}
(32 x 32) {32}
(64 x 64) {64}
} case
initiatesize
} def
/SizeMenu [
(16 x 16) (32 x 32) (64 x 64)
] null {
/valuething 1 index send /changesize /sendtarget 4 -1 roll send
} framebuffer /newdefault ClassMenu send def
/fileoperation {
{
(Write) {
bitmap setcanvas (/tmp/screen) writecanvas
}
/default {
}
} case
} def
/FileMenu [
(Write)
] null {
/valuething 1 index send /fileoperation /sendtarget 4 -1 roll send
} framebuffer /newdefault ClassMenu send def
/CanvasMenu [
(Tool) ToolMenu null
(Style) StyleMenu null
(Size) SizeMenu null
(File) FileMenu null
] framebuffer /newdefault ClassMenu send def
classend def
%%EndOf: IconEditor
/win [IconEditor] [] framebuffer /newdefault ClassBaseFrame send def
{
gsave
-1 dup translate
.5 setgray clippath fill
0 setgray
/bitmap /client win send send imagecanvas
grestore
} /seticon win send
(Icon Editor) /setlabel win send
/activate win send
0 0 /minsize /client win send send /fitclient win send /reshape win send
/place win send
/map win send
SHAR_EOF
fi
if test -f 'Meter'
then
echo shar: "will not over-write existing file 'Meter'"
else
cat << \SHAR_EOF > 'Meter'
% A MeterCanvas monitors some system parameter and displays its
% result digitally in real time. By default the current memory being
% used by X/NeWS (the 2nd number returned by vmstatus) is shown.
% To change the parameter, hand in a non null executable to /new,
% or override /Probe.
%
% By default the probe is executed every 3 seconds. For simple
% probes this has a negligable performance impact.
%
% Invoke help on this canvas to see what SELECT and ADJUST do.
% (In brief, they show absolute and relative sizes respectively.)
%
/MeterCanvas ClassCanvas
dictbegin
/ReferenceValue 0 def % Measurement subtracted from this.
/LastString nullstring def % Last string kept for un-painting
/DangerZone false def
dictend
classbegin
/Probe {vmstatus pop exch pop} def
/Timeout 3 60 div def
/TextFamily /ZapfChancery-MediumItalic def
/TextSize 64 def
% Initialize this canvas.
% If a procedure is handed in, make it the Probe.
% Probe procedures should return exactly one number.
%
/newinit { % probe-proc|null -> -
/newinit super send
dup null ne {/Probe exch def} {pop} ifelse
} def
% Show the exact value of the probe immediately.
% Stay in absolute (non-relative) mode thereafter.
%
/absolute { % event|null -> -
pop
/ReferenceValue 0 def
/update self send
} def
% Enter relative mode.
% All probe values hereafter will be considered relative to
% a probe reference value taken *now*.
%
% Subtle Point: We *really* want the reference value to be
% measured next time the timeout happens. That way any space
% effects of future timeouts will be cancelled. The DangerZone
% variable is used to alert us that this is the case the next
% time the timeout comes.
% **Erroneous readings will occur if the probed parameter
% changes in a non-Heisenburgian way between now and the next
% timeout.** We need to find a better way to get the same effect.
% Sending an immediate timeout would almost solve this problem.
%
/relative { % event|null -> -
pop
/ReferenceValue Probe def
/update self send
/DangerZone true def
} def
% A timeout event has come in.
% Update the display. See above for DangerZone business.
%
/timeout { % event|null -> -
pop
DangerZone {
/ReferenceValue Probe def
/DangerZone false def
} if
/update self send
} def
% If anything has changed, erase the last string (by repainting
% it in background color), then paint the new string.
%
/update { % - -> -
Probe ReferenceValue sub
10 string cvs
dup LastString ne { % string
gsave Canvas setcanvas
/textfont self send setfont
/FillColor self send setcolor
LastString /PaintString self send
dup /LastString exch def
1 setgray
/PaintString self send % -
grestore
} {pop} ifelse
} def
% Show this string in the center of the canvas.
%
/PaintString { % string -> -
/size self send 2 div exch 2 div exch
TextSize 4 div sub
moveto cshow
} def
% Repaint the entire canvas. Seeting /Laststring to nullstring
% forces update to do its job.
%
/PaintCanvas { % - -> -
FillColor /FillCanvas self send
/LastString nullstring def
/update self send
} def
% Interests are expressed for SELECT, ADJUST and timeout events.
%
/MakeInterests { % - -> interests
/MakeInterests super send
PointButton /absolute /DownTransition self MakeInterest
AdjustButton /relative /DownTransition self MakeInterest
Canvas soften /timeout self soften buildsend /new TimerInterest send
Timeout Timeout true /settimeouts 4 index send
} def
% These numbers look good for the default Probe and the default
% TextSize. Change them if you subclass.
%
/preferredsize {
260 60
} def
% Show help on this canvas.
%
/HelpProc { % object -> -
/popuphelp self /parentdescendant ClassFrame send pop send
} def
% The help label and text comes from this dictionary.
%
/helpdict dictbegin
/Label (X11/NeWS Memory Meter) def
/Text [
(The number show is the current amount of memory used by the)
(X11/NeWS server. It is the 2nd number returned by the)
(`vmstatus' operator.)
()
(In general, a MeterCanvas shows some system parameter as it)
(varies in real time. By default the measurement is take)
(every 3 seconds.)
()
(Pressing SELECT takes an absolute measurement immediately.)
(Pressing ADJUST puts the meter in relative mode --)
(a measurement is taken immediately and remembered.)
(Subsequent measurements are subtracted from this number)
(before being displayed.)
] def
dictend def
classend def
% A Frame that has no footer or reshape corners, has different selection
% feedback, *and* has a crazy jagged path.
% Don't ask me what this has to do with meters.
%
/YeOldFrame OpenLookBaseFrame []
classbegin
/Footer false def
/Close false def
/Reshape false def
/FillColor ColorDict /lightgray get def
/TextColor ColorDict /white get def
/Wiggle 6 def % max amplitute of vibration
/Travel 7 def % wavelength of vibration
% Here's the randomly jagged path.
% Unfortunately it gives a slightly different path each
% time its called!
%
/path { % x y w h ->
10 dict begin
/H exch def /W exch def /Y exch def /X exch def
X Y moveto
X Travel add Travel X W add { % across bottom
Y random Wiggle mul add lineto
} for
Y Travel add Travel Y H add { % up right
X W add random Wiggle mul sub exch lineto
} for
X W add Travel sub Travel neg X { % across top
Y H add random Wiggle mul add lineto
} for
Y H add Travel sub Travel neg Y { % down left
X random Wiggle mul add exch lineto
} for
closepath
end
} def
% Stroking the border of the canvas doesn't work well with
% crazy paths like this, so we never call /StrokeCanvas
%
/PaintCanvas { % - -> -
FillColor /FillCanvas self send
} def
% Since we don't stroke the border, have to work out some other
% way to reflect the fact that this frame is selected.
% We do it by darkening the fill color.
%
/reflectselected { % bool -> -
/FillColor ColorDict 3 -1 roll /gray /lightgray ifelse get def
/paint self send
} def
classend def
/f [null MeterCanvas] [] framebuffer /new YeOldFrame send def
(X11/NeWS Memory Usage (Kb)) /setlabel f send
/activate f send
/place f send
/map f send
newprocessgroup
currentfile closefile
SHAR_EOF
fi
if test -f 'FunnyEZ'
then
echo shar: "will not over-write existing file 'FunnyEZ'"
else
cat << \SHAR_EOF > 'FunnyEZ'
%
% Funny low level
%
/fixup {
pop
damagepath % set path to damaged area, clear record
gsave % show the damaged area
.8 setgray fill
.01 sleep
grestore
1 fillcanvas
} def
% Build path for canvas
% 0 0 200 200 rectpath
0 0 moveto 100 100 rect
150 150 moveto 200 200 rect
% Build canvas
/can framebuffer newcanvas dup
begin
/Transparent false def
/Retained false def
end
def
can reshapecanvas
can setcanvas
0 0 movecanvas
% Event handling
/ehandler {
createevent dup begin
/Name
dictbegin
/Damaged {fixup} def
/RightMouseButton
{currentprocess killprocessgroup} def
dictend def
/Canvas can def
end expressinterest
{
awaitevent
} loop
} fork def
pause
can /Mapped true put
SHAR_EOF
chmod +x 'FunnyEZ'
fi
if test -f 'ColorButton'
then
echo shar: "will not over-write existing file 'ColorButton'"
else
cat << \SHAR_EOF > 'ColorButton'
%
% Color Buttons!
%
/ButtonBag FlexBag []
classbegin
/newinit {
/newinit super send
% set the fill color for the bag
null ColorDict /Blue get null /setcolors self send
%/b1 [/w {10 10} (Button1) nullnotify OpenLookButton]
%/addclient self send
/b2 [
/w
{20 20}
%{/e /b1 POSITION 20 20 XYADD}
(Button2)
[
(One)
(Two)
(Three)
]
null
{ pop }
framebuffer /new OpenLookMenu send
null
OpenLookButtonStack
]
/addclient self send
% set the fill color for the button
%null ColorDict /Green get null /setcolors
% /b1 /getbyname self send pop send
%null ColorDict /Wheat get null /setcolors
% /b2 /getbyname self send pop send
} def
classend
def
ButtonBag nullarray framebuffer /newdefault ClassBaseFrame send
(ONE Button) /setlabel 2 index send
100 100 200 200 /reshape 5 index send
/activate 1 index send
/map 1 index send
/f exch def
newprocessgroup
currentfile closefile
SHAR_EOF
fi
cd ..
exit 0
# End of shell archive