#! /usr/NeWS/bin/psh
%
% This file is a product of Sun Microsystems, Inc. and is provided for
% unrestricted use provided that this legend is included on all tape
% media and as a part of the software program in whole or part. Users
% may copy or modify this file without charge, but are not authorized to
% license or distribute it to anyone else except as part of a product
% or program developed by the user.
%
% THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE
% WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
% PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE.
%
% This file is provided with no support and without any obligation on the
% part of Sun Microsystems, Inc. to assist in its use, correction,
% modification or enhancement.
%
% SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE
% INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE
% OR ANY PART THEREOF.
%
% In no event will Sun Microsystems, Inc. be liable for any lost revenue
% or profits or other special, indirect and consequential damages, even
% if Sun has been advised of the possibility of such damages.
%
% Sun Microsystems, Inc.
% 2550 Garcia Avenue
% Mountain View, California 94043
%
% colornames 9.2 88/01/18
%
% Color Names: Illustrates use of new menu & window classes.
%
/TextColor ColorDict /Yellow get def
/FillColor ColorDict /Tan get def
/Margin 10 def
/LineGap 5 def
/FontName (Times-Bold) def
/PointSize 14 def
/Document [ColorDict {pop} forall] def
/SetDocParameters {
userdict begin
/DocFont FontName findfont PointSize scalefont def
/LineHeight DocFont fontheight 2 mul def
/LineWidth LineHeight 24 mul def
/DocWidth LineWidth Margin 2 mul add def
/LinesInView win /ClientHeight get LineHeight div floor def
/DocLines Document length def
[ DocLines 0 1 LinesInView DocLines LinesInView div
] /setrange {VScrollbar} win send send
end
} def
/ShowLine { % colorname => -
gsave
ColorDict 1 index get setcolor
0 0 LineWidth LineHeight LineGap sub rectpath fill
30 string cvs dup dup
0 LineHeight 2 div LineGap sub 2 div
currentfont fontdescent 2 div add translate
0 setgray 10 0 moveto show
TextColor setcolor LineWidth 3 div 0 moveto show
1 setgray LineWidth 3 div 2 mul 0 moveto show
grestore
} def
/ShowDocument { % - => -
gsave
FillColor fillcanvas
DocFont setfont
HScrollbar /ItemValue get DocWidth mul neg Margin add
ClientHeight translate
userdict /DocLine VScrollbar /ItemValue get put
DocLine 1 DocLine LinesInView add Document length 1 sub min {
0 LineHeight neg translate
Document 1 index get ShowLine
% Pause: Good manners & allows forked paint client to run.
5 mod 0 eq {pause} if
} for
grestore
} def
/main {
/PaintColors {/paintclient win send} def
/colorsquare { % color keyword => -
/paint eq
{20 20 rect setcolor fill}
{pop 20 20} ifelse
} def
/SetTextOrFillColor { % color => -
/currentindex colorsmenu send 0 eq {/TextColor} {/FillColor} ifelse
exch store PaintColors
} def
/colormenu
[ColorDict { exch pop [exch {colorsquare}] } forall]
[{currentkey 0 get SetTextOrFillColor}]
/new DefaultMenu send def
{ /LayoutStyle [8 ColorDict length 1 index div ceiling] def
/StrokeSelection? true def
/CellHorizGap 2 def
/CellVertGap 2 def
/RetainCanvas? true def
} colormenu send
/colorsmenu [
(Text Color =>) colormenu
(Fill Color =>) colormenu
] /new DefaultMenu send def
/fontkey {findfont FntPts scalefont} def
/fontaction {/FontName exch store SetDocParameters PaintColors} def
/FntPts 14 def
/fontmenu [
[(Times) /Times-Roman fontkey]
[(\274Bold) /Times-Bold fontkey]
[(\274Italic) /Times-Italic fontkey]
[(\274BoldItalic) /Times-BoldItalic fontkey]
[(Helvetica) /Helvetica fontkey]
[(\274Bold) /Helvetica-Bold fontkey]
[(\274Oblique) /Helvetica-Oblique fontkey]
[(\274BoldOblique) /Helvetica-BoldOblique fontkey]
[(Courier) /Courier fontkey]
[(\274Bold) /Courier-Bold fontkey]
[(\274Oblique) /Courier-Oblique fontkey]
[(\274BoldOblique) /Courier-BoldOblique fontkey]
] [{currentkey 1 get /FontName get fontaction}]
/new DefaultMenu send def
{ /LayoutStyle [4 3] def
/RowMajor? false def
/CenterItems? false def
} fontmenu send
/pointsizemenu
[(6) (8) (10) (12) (14) (16) (18) (24) (32) (64)]
[{/PointSize currentkey cvi store SetDocParameters PaintColors}]
/new DefaultMenu send def
{ /LayoutStyle [2 5] def
/CellHorizGap 5 def
} pointsizemenu send
/MyWindow ScrollWindow []
classbegin
/FrameLabel (Color Names) def
/PaintClient {ShowDocument} def
/PaintIcon {
/bar { % y /colorname => -
ColorDict exch get setcolor
0 exch 64 16 rectpath fill
} def
gsave
0 /SeaGreen bar
16 /Turquoise bar
32 /MediumAquamarine bar
48 /LightGray bar
grestore
} def
/createscrollbars { % - => -
/createscrollbars super send
HScrollbar /NotifyUser {PaintColors} put
VScrollbar /NotifyUser {PaintColors} put
} def
/shapescrollbars { % - => -
/shapescrollbars super send
SetDocParameters
} def
/ClientMenu { % deferred initialization: need FrameMenu.
/ClientMenu [
/sun30 FrameMenu
(Fonts) fontmenu
(Points) pointsizemenu
(Colors) colorsmenu
] /new DefaultMenu send store
{ /LayoutStyle /Horizontal def
/PullRightDelta 0 def
/Border 2 def
/CenterItems? false def
/PullRightDelta 0 def
} ClientMenu send
ClientMenu
} def
classend def
/win framebuffer /new MyWindow send def % Create a window
/reshapefromuser win send % Shape it.
SetDocParameters
/map win send % Map the window. (Damage causes PaintClient to be called)
} def
main