#! /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 1.8 87/09/01
%
%  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 MacWindow []
    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