bvs%carlisle@Sun.COM (Bruce Schwartz) (12/17/88)
#! /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:
# psint.cps
# draw.ps
# menubar.ps
# This archive created: Fri Dec 16 15:05:52 1988
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'psint.cps'
then
echo shar: "will not over-write existing file 'psint.cps'"
else
cat << \SHAR_EOF > 'psint.cps'
%!
%
% $Header: psint.cps,v 1.6 88/12/02 10:43:17 bvs Exp $
%
cdef ps_init(string buf)
/DEFSTR_TAG 0 def
/TOOL_TAG 100 def
/SELECT_TAG 200 def
/ADJUST_TAG 300 def
/POINT_TAG 400 def
/ANGLE_TAG 401 def
/KEY_TAG 500 def
/DAMAGE_TAG 600 def
/PROP_TAG 700 def
/STRETCH_MODE 0 def
/ROTATE_MODE 1 def
/BRUSH_MODE 2 def
/LINE_MODE 3 def
/RECT_MODE 4 def
/CIRC_MODE 5 def
/OVAL_MODE 6 def
/TEXT_MODE 7 def
/POLY_MODE 8 def
/FILL_KEY 1 def
/STROKE_KEY 2 def
/WIDTH_KEY 3 def
/PRINT_KEY 4 def
/TOTOP_KEY 5 def
/TOBOT_KEY 6 def
/TEXT_KEY 7 def
/REDRAW_KEY 8 def
/WRITE_KEY 9 def
/READ_KEY 10 def
buf (/menubar.ps) append LoadFile
buf (/draw.ps) append LoadFile
clear
#define DEFSTR_TAG 0
#define TOOL_TAG 100
#define SELECT_TAG 200
#define ADJUST_TAG 300
#define POINT_TAG 400
#define ANGLE_TAG 401
#define KEY_TAG 500
#define DAMAGE_TAG 600
#define PROP_TAG 700
cdef ps_fontsetup(string name, size, index, length, bbheight, descent) => \
DEFSTR_TAG(bbheight, descent, length)
name findfont size scalefont dup index fontsetup
cdef ps_setcanvas()
win begin ClientCanvas setcanvas end
cdef ps_setgray(float gray)
gray setgray
cdef ps_rotate(float angle) angle rotate
cdef ps_translate(x, y) x y translate
cdef ps_dorotate(int x, int y, float angle)
matrix currentmatrix
x y translate angle rotate
x neg y neg translate
cdef ps_unrotate()
setmatrix
cdef ps_moveinteractive(xinit, yinit, float angle, x0, y0, x1, y1)
xinit yinit angle x0 y0 x1 y1 /rectMoveInteractive win send
cdef ps_pencilCreateinteractive(x, y)
x y /pencilCreateInteractive win send
cdef ps_linecreateinteractive(x, y)
x y /lineCreateInteractive win send
cdef ps_rectcreateinteractive(x, y)
x y /rectCreateInteractive win send
cdef ps_ovalcreateinteractive(x, y)
x y /ovalCreateInteractive win send
cdef ps_circcreateinteractive(x, y)
x y /circCreateInteractive win send
cdef ps_rotateInteractive(float angle, xinit, yinit, xcenter, ycenter, x0, y0, x1, y1)
angle xinit yinit xcenter ycenter x0 y0 x1 y1 /rotateInteractive win send
cdef ps_stdcursor() /ptr /ptr_m win begin ClientCanvas end setstandardcursor
cdef ps_xcursor() /xhair /xhair_m win begin ClientCanvas end setstandardcursor
cdef ps_stroke() stroke
cdef ps_fill() fill
cdef ps_setlinewidth(width) width setlinewidth
cdef ps_pushclip(x0, y0, x1, y1)
gsave x0 y0 moveto x0 y1 lineto x1 y1 lineto x1 y0 lineto closepath clip
cdef ps_popclip() grestore
cdef ps_savearea(x, y, w, h)
x y w h /savearea win send
cdef ps_restorearea()
/restorearea win send
cdef ps_drawline(x0, y0, x, y)
x0 y0 moveto x y lineto
cdef ps_drawrect(x0, y0, x, y)
x0 y0 moveto x0 y lineto x y lineto x y0 lineto closepath
cdef ps_drawcirc(x0, y0, r)
x0 y0 r 0 360 arc
cdef ps_drawoval(x0, y0, x, y)
matrix currentmatrix
x0 y0 translate
x x0 sub y y0 sub scale
.5 .5 .5 0 360 arc
setmatrix
%% ps_drawoval(x, y, r)
%% x y r 0 360 arc
cdef ps_getcreatepoint(x, y) => POINT_TAG(x, y)
cdef ps_getcreateangle(float f) => ANGLE_TAG(f)
cdef ps_getmode(int mode) => TOOL_TAG(mode)
cdef ps_getselect(int x, int y) => SELECT_TAG(x, y)
cdef ps_getadjust(int x, int y) => ADJUST_TAG(x, y)
cdef ps_getkey(int key) => KEY_TAG(key)
cdef ps_getprop(int key) => PROP_TAG(key)
cdef ps_getdamage(int x0, int y0, int x1, int y1) => DAMAGE_TAG(x0, y0, x1, y1)
cdef ps_getint(int i) => (i)
cdef ps_getfloat(float f) => (f)
cdef ps_polyline(int count)
moveto count { lineto } repeat stroke
cdef ps_sendpoint(int x, int y) x y
cdef ps_doclick()
currentcanvas createoverlay setcanvas
getclick CLICK_TAG tagprint exch typedprint typedprint
pstack
SHAR_EOF
fi
if test -f 'draw.ps'
then
echo shar: "will not over-write existing file 'draw.ps'"
else
cat << \SHAR_EOF > 'draw.ps'
%!
%
% $Header: draw.ps,v 1.7 88/12/02 10:43:15 bvs Exp $
% Copyright (C) 1988 by Sun Microsystems. All rights reserved.
%
/XNeWS? where { pop } { /XNeWS? false def } ifelse
/pathscale { % x1 y1 x2 y2 => w h
%% 4 copy (pathscale % % % % \n) [ 6 2 roll ] dbgprintf
exch 4 1 roll sub neg 3 1 roll sub exch
} def
/ShowFillWindow {
{
newprocessgroup
10 dict begin
/FillWindow framebuffer /new DrawWindow send def
100 400 400 200 /reshape FillWindow send
/map FillWindow send
/FillWindow null def
end
} fork AddProcess
} def
/DrawWindow DefaultWindow
dictbegin
/FrameKbdMgr null def
/ScratchCanvas null def
/X0 null def
/Y0 null def
/X1 null def
/Y1 null def
/XCenter null def
/YCenter null def
/Theta null def
dictend
classbegin
/FrameLabel (NewsDraw) def
/PaintClient {
DAMAGE_TAG tagprint
clippath pathbbox
% 4 copy (send damage % % % %\n) [ 6 2 roll ] dbgprintf
4 -1 roll typedprint
3 -1 roll typedprint
2 -1 roll typedprint
typedprint
} def
/DefaultRotateInteractive { % x0 y0 proc -> angle
gsave
ClientCanvas createoverlay setcanvas
getanimated
waitprocess aload pop
ANGLE_TAG tagprint
YCenter sub exch XCenter sub exch atan Theta exch sub typedprint
grestore
} def
/rotateInteractive { % angle xinit yinit x0 y0 x1 y1 => angle
/Y1 exch def
/X1 exch def
/Y0 exch def
/X0 exch def
/YCenter exch def
/XCenter exch def
% xinit yinit
YCenter sub exch XCenter sub exch atan /Theta exch def
% /Theta X1 X0 sub Y1 Y0 sub atan def
% (theta is %\n) [ Theta ] dbgprintf
Theta add /Theta exch def
% (theta changed to %\n) [ Theta ] dbgprintf
XCenter YCenter
{
matrix currentmatrix
x0 y0 translate
x x0 sub y y0 sub atan Theta exch sub rotate
x0 neg y0 neg translate
% avoid drawing 0 width rectangle!
X0 X1 eq Y0 Y1 eq or
{ X0 Y0 moveto X1 Y1 lineto }
{ X0 Y0 moveto X0 Y1 lineto X1 Y1 lineto X1 Y0 lineto closepath}
ifelse
setmatrix
} DefaultRotateInteractive
} def
/DefaultCreateInteractive { % x0 y0 proc -> x0 y0 x1 y1
gsave
ClientCanvas createoverlay setcanvas
getanimated
waitprocess aload pop
POINT_TAG tagprint
exch
typedprint typedprint
grestore
} def
/lineCreateInteractive { % x y
{ x y lineto } DefaultCreateInteractive
} def
/rectCreateInteractive { % x y
{ x0 y lineto x y lineto x y0 lineto x0 y0 lineto }
DefaultCreateInteractive
} def
/circCreateInteractive { % x y
{
newpath
x0 x add 2 div y0 y add 2 div % x y
x0 x sub dup mul y0 y sub dup mul add sqrt 2 div % r
0 360 arc
}
DefaultCreateInteractive
} def
/ovalCreateInteractive { % x y
{
newpath
matrix currentmatrix
x0 y0 translate
x x0 sub y y0 sub scale
.5 .5 .5 0 360 arc
setmatrix
}
DefaultCreateInteractive
} def
/PencilDoitInteractive % x y -> points... length
{
10 dict begin
/y exch def
/x exch def
x y moveto
/pointlist [ y x ] def
/stopevt createevent def
stopevt begin /Action UpTransition def end
/evt createevent def
evt begin /Name MouseDragged def end
stopevt expressinterest
evt expressinterest
/pointlist
[
pointlist aload pop %% add first 2 points
{
awaitevent
begin
Action UpTransition eq { exit } if
XLocation YLocation lineto
currentpoint
stroke
moveto
YLocation XLocation % add another point
end
pause
} loop
]
def
stopevt revokeinterest
evt revokeinterest
[
pointlist aload pop
pointlist length
]
end
} def
/pencilCreateInteractive { % x y
gsave
ClientCanvas setcanvas
{ PencilDoitInteractive } fork waitprocess aload pop
POINT_TAG tagprint
0 0 typedprint typedprint
dup 2 div typedprint
{ typedprint } repeat
grestore
} def
/rectMoveInteractive { % xinit yinit angle x0 y0 x1 y1
/Y1 exch def
/X1 exch def
/Y0 exch def
/X0 exch def
/Theta exch def
/XCenter X0 X1 add 2 div def
/YCenter Y0 Y1 add 2 div def
{
matrix currentmatrix
x x0 sub y y0 sub translate
XCenter YCenter translate
Theta rotate
XCenter neg YCenter neg translate
X0 X1 eq Y0 Y1 eq or
{ X0 Y0 moveto X1 Y1 lineto }
{ X0 Y0 moveto X0 Y1 lineto X1 Y1 lineto X1 Y0 lineto closepath }
ifelse
setmatrix
}
DefaultCreateInteractive
} def
/ClientMenu
[
(Move) { TOOL_TAG tagprint STRETCH_MODE typedprint }
(Rotate) { TOOL_TAG tagprint ROTATE_MODE typedprint }
(Brush) { TOOL_TAG tagprint BRUSH_MODE typedprint }
(Line) { TOOL_TAG tagprint LINE_MODE typedprint }
(Box) { TOOL_TAG tagprint RECT_MODE typedprint }
(Oval) { TOOL_TAG tagprint OVAL_MODE typedprint }
(Circle){ TOOL_TAG tagprint CIRC_MODE typedprint }
(Polygon) { TOOL_TAG tagprint POLY_MODE typedprint }
(Text) { TOOL_TAG tagprint TEXT_MODE typedprint }
]
/new DefaultMenu send
def
/new {
/new super send
begin
/ScratchCanvas framebuffer newcanvas def
ScratchCanvas /Retained true put
% ScratchCanvas /Mapped true put
gsave
ScratchCanvas setcanvas
0 0 0 rgbcolor fillcanvas
0 0 movecanvas
grestore
currentdict
end
} def
/destroy {
/ScratchCanvas null def
/destroy super send
} def
/savearea { % x y w h
%% 4 copy (save area % % % %\n) [ 6 2 roll ] dbgprintf
gsave
newpath rectpath ScratchCanvas reshapecanvas
% scale ScratchCanvas by w/h of ClientCanvas
ClientCanvas setcanvas clippath pathbbox pathscale % w h
ScratchCanvas setcanvas
0 0 movecanvas
0 0 0 rgbcolor fillcanvas
% X11NEWS BUG!!!
XNeWS? { pop pop } { scale } ifelse
ClientCanvas imagecanvas
grestore
} def
/restorearea {
%% (restore area %\n) [ ScratchCanvas ] dbgprintf
gsave
ScratchCanvas setcanvas clippath
pathbbox pathscale pathbbox pop pop % w h x y
ClientCanvas setcanvas
% X11NEWS BUG!!!
XNeWS? { pop pop pop pop } { translate scale } ifelse
ScratchCanvas imagecanvas
grestore
} def
classend
def
/sendmouse {
Action /DownTransition eq
{ tagprint XLocation typedprint YLocation typedprint }
{ pop } ifelse
} def
/AddProcess { } def
/AcceptFocus { } def
/RestoreFocus { } def
/DeSelect { } def
/LeftMouseButton { SELECT_TAG sendmouse } def
/MiddleMouseButton { ADJUST_TAG sendmouse } def
/KeyStroke { KEY_TAG tagprint typedprint } def
/fontsetup { % font font index
setfileinputtoken
0 tagprint
dup setfont
begin
currentdict dup fontheight typedprint
fontdescent typedprint
WidthArray dup length typedprint
aload length 2 div { pop typedprint } repeat
end
} def
%
% Main...such as it is
%
/Times-Roman findfont 36 scalefont setfont
/win framebuffer /new DrawWindow send def % Create a window
100 100 8 72 mul 32 add dup /reshape win send
/map win send
/activate win send
win begin ClientCanvas setcanvas end
{ win begin
ClientCanvas addkbdinterests
/MouseDict 5 dict begin
/LeftMouseButton dup def
/MiddleMouseButton dup def
currentdict end def
createevent begin
/Canvas ClientCanvas def
/Name MouseDict def
currentdict end expressinterest
{ clear awaitevent begin
ClientCanvas setcanvas
{
Name type /integertype eq
{ Name KeyStroke }
{ Name cvx exec } ifelse
} exec%stopped
end
} loop
} fork
SHAR_EOF
fi
if test -f 'menubar.ps'
then
echo shar: "will not over-write existing file 'menubar.ps'"
else
cat << \SHAR_EOF > 'menubar.ps'
%!
%
% $Header: menubar.ps,v 1.7 88/12/02 11:36:56 bvs Exp $
% Copyright (C) 1988 by Sun Microsystems. All rights reserved.
%
systemdict begin
systemdict /Item known not { (NeWS/liteitem.ps) run } if
systemdict /SimpleScrollbar known not { (NeWS/liteitem.ps) run } if
end
/BarMenu DefaultMenu []
classbegin
/CenterItems? false def
classend
def
/MenuBar Object
dictbegin
/X null def
/Y null def
/Gap null def
/MenuBarCanvas null def
/Items [] def
/ItemMgr null def
dictend
classbegin
/new { % x y gap canvas -> -
/new super send
begin
/MenuBarCanvas exch def
/Gap exch def
/Y exch def
/X exch def
%% (new: % % % %\n) [ MenuBarCanvas Gap Y X ] dbgprintf
currentdict
end
} def
/addmenu { % menu name proc -> -
%% (addmenu: % % % %\n) [ MenuBarCanvas Gap Y X ] dbgprintf
MenuBarCanvas 0 0 /new MenuItem send % item
dup Items 999 3 -1 roll arrayinsert /Items exch def
dup X Y /move 4 -1 roll send % item
dup /bbox exch send pop % x y width
X add Gap add /X exch def pop pop
} def
/activate {
/ItemMgr Items forkitems def
} def
/paint {
Items paintitems
} def
classend
def
/MenuItem ButtonItem
[
/Menu null def
]
classbegin
/new {
/new super send
begin
/Menu exch def
% disgusting hack!! not my fault! blame ButtonItem!!
/ItemRadius 6 def
/ItemFrame 1 def
/ItemBorder 1 def
/ItemGap 2 def
currentdict
end
} def
/ItemButton [ RightMouseButton ] def
/ClientDown {
%% (client down\n) [] dbgprintf
true SetButtonValue
framebuffer setcanvas ItemCanvas getcanvaslocation
/showat Menu send
} def
/ClientUp {
%% (client up\n) [] dbgprintf
pause % let the menu die!
false SetButtonValue
/ItemValue null store
StopItem
} def
/ClientEnter {
%% (client enter\n) [] dbgprintf
} def
/ClientExit {
%% (client exit\n) [] dbgprintf
} def
/setmenu { % menu => -
/Menu exch def
} def
/getmenu { % menu => -
Menu
} def
classend
def
/MenuBarWindow DefaultWindow
dictbegin
/MenuBarItem null def
dictend
classbegin
/MenuBarSize 30 def
/ShapeClientCanvas { % - => - ([Re]set client canvas' shape)
ClientCanvas null ne {
gsave
FrameCanvas setcanvas
BorderLeft BorderBottom translate
0 0 ClientWidth ClientHeight MenuBarSize sub
ClientPath
ClientCanvas reshapecanvas
grestore
} if
} def
/PaintFrameBorder { % - => - (Paint frame border areas)
FrameFillColor fillcanvas FrameBorderColor strokecanvas
BorderLeft .5 sub BorderBottom .5 sub
FrameWidth BorderLeft BorderRight add sub 1 add
FrameHeight BorderBottom BorderTop add sub 1 add
FramePath stroke
BorderLeft .5 sub BorderBottom .5 sub
FrameWidth BorderLeft BorderRight add sub 1 add
FrameHeight BorderBottom BorderTop add sub 1 add MenuBarSize sub
FramePath stroke
/paint MenuBarItem send
} def
/activate {
/MenuBarItem
BorderLeft 5 add
FrameHeight BorderTop sub MenuBarSize sub 5 add
5 % gap!
FrameCanvas
/new MenuBar send
def
[
(About NewsDraw...)
{ currentcursorlocation
[
( NewsDraw consists of about 500 lines of NeWS and about 2000 lines of C. )
( NewsDraw is intended as a demonstration of the proper way to spit a NeWS)
( application into client and server sections. NewsDraw also demonstrates)
( how the PostScript imaging model allows text and graphics to be treated)
( with equal ease.)
()
( Bruce V. Schwartz)
( bvs@sun.com )
( \(c\) 1988 Sun Microsystems)
]
popmsg
}
]
/new BarMenu send (Info ) {} /addmenu MenuBarItem send
[
(Open NewsDraw "file.nd")
{ PROP_TAG tagprint READ_KEY typedprint }
(Save NewsDraw "file.nd")
{ PROP_TAG tagprint WRITE_KEY typedprint }
(Save PostScript "newsdraw.ps")
{ PROP_TAG tagprint PRINT_KEY typedprint }
]
/new BarMenu send (File) {} /addmenu MenuBarItem send
[
(Move) { TOOL_TAG tagprint STRETCH_MODE typedprint }
(Rotate) { TOOL_TAG tagprint ROTATE_MODE typedprint }
(Brush) { TOOL_TAG tagprint BRUSH_MODE typedprint }
(Line) { TOOL_TAG tagprint LINE_MODE typedprint }
(Box) { TOOL_TAG tagprint RECT_MODE typedprint }
(Oval) { TOOL_TAG tagprint OVAL_MODE typedprint }
(Circle){ TOOL_TAG tagprint CIRC_MODE typedprint }
(Polygon) { TOOL_TAG tagprint POLY_MODE typedprint }
(Text) { TOOL_TAG tagprint TEXT_MODE typedprint }
]
/new BarMenu send (Mode) {} /addmenu MenuBarItem send
[
(To Top) { PROP_TAG tagprint TOTOP_KEY typedprint }
(To Bottom) { PROP_TAG tagprint TOBOT_KEY typedprint }
(Redraw) { PROP_TAG tagprint REDRAW_KEY typedprint }
]
/new BarMenu send (Misc) {} /addmenu MenuBarItem send
[
(1) { PROP_TAG tagprint WIDTH_KEY typedprint 1 typedprint }
(2) { PROP_TAG tagprint WIDTH_KEY typedprint 2 typedprint }
(3) { PROP_TAG tagprint WIDTH_KEY typedprint 3 typedprint }
(4) { PROP_TAG tagprint WIDTH_KEY typedprint 4 typedprint }
(5) { PROP_TAG tagprint WIDTH_KEY typedprint 5 typedprint }
(6) { PROP_TAG tagprint WIDTH_KEY typedprint 6 typedprint }
(7) { PROP_TAG tagprint WIDTH_KEY typedprint 7 typedprint }
(8) { PROP_TAG tagprint WIDTH_KEY typedprint 8 typedprint }
(9) { PROP_TAG tagprint WIDTH_KEY typedprint 9 typedprint }
(10) { PROP_TAG tagprint WIDTH_KEY typedprint 10 typedprint }
]
/new BarMenu send (Line Width) {} /addmenu MenuBarItem send
[
(none)
{ PROP_TAG tagprint STROKE_KEY typedprint -1.0 typedprint }
(white)
{ PROP_TAG tagprint STROKE_KEY typedprint 1.0 typedprint }
(light gray)
{ PROP_TAG tagprint STROKE_KEY typedprint .75 typedprint }
(medium gray)
{ PROP_TAG tagprint STROKE_KEY typedprint .50 typedprint }
(dark gray)
{ PROP_TAG tagprint STROKE_KEY typedprint .25 typedprint }
(black)
{ PROP_TAG tagprint STROKE_KEY typedprint 0.0 typedprint }
]
/new BarMenu send (Outline) {} /addmenu MenuBarItem send
[
(none)
{ PROP_TAG tagprint FILL_KEY typedprint -1.0 typedprint }
(white)
{ PROP_TAG tagprint FILL_KEY typedprint 1.0 typedprint }
(light gray)
{ PROP_TAG tagprint FILL_KEY typedprint .75 typedprint }
(medium gray)
{ PROP_TAG tagprint FILL_KEY typedprint .50 typedprint }
(dark gray)
{ PROP_TAG tagprint FILL_KEY typedprint .25 typedprint }
(black)
{ PROP_TAG tagprint FILL_KEY typedprint 0.0 typedprint }
]
/new BarMenu send (Fill) {} /addmenu MenuBarItem send
[
(white)
{ PROP_TAG tagprint TEXT_KEY typedprint 1.0 typedprint }
(light gray)
{ PROP_TAG tagprint TEXT_KEY typedprint .75 typedprint }
(medium gray)
{ PROP_TAG tagprint TEXT_KEY typedprint .50 typedprint }
(dark gray)
{ PROP_TAG tagprint TEXT_KEY typedprint .25 typedprint }
(black)
{ PROP_TAG tagprint TEXT_KEY typedprint 0.0 typedprint }
]
/new BarMenu send (Text) {} /addmenu MenuBarItem send
/activate MenuBarItem send
{
createevent begin
/Canvas ClientCanvas def
/Name [ /LeftMouseButton /MiddleMouseButton ] def
currentdict end expressinterest
{
clear awaitevent begin
end
} loop
} fork pop
} def
classend
def
/DefaultWindow MenuBarWindow def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SHAR_EOF
fi
exit 0
# End of shell archive