%
% 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 23.2 90/06/19
%
% Color Names: Illustrates use of new menu & window classes.
%


/ColorNamesCanvas ClassCanvas []
classbegin

% Class Variables:

    /HSValue		0 def
    /VSValue		0 def
    /LinesInView	0 def
    /CurrentHeight	0 def

% Defaults:

    /TextColor		ColorDict /Yellow get def
    /FillColor		ColorDict /Wheat get def
    /TextFont		(Lucida-Bright) def
    /TextSize		14 def
    /Margin		10 def
    /LineGap		5 def
    /Document		[ColorDict {pop} forall] def
    /DocLines		Document length def
    /DocFont		TextFont findfont TextSize scalefont def
    /LineHeight     	DocFont fontheight 2 mul def
    /LineWidth      	LineHeight 24 mul def
    /DocWidth       	LineWidth Margin 2 mul add def

% Methods:

    % Override - arbitrary minimum size.
    %
    /minsize { % - => w h
	/minsize super send
	64 max exch
	64 max exch
    } def

    /preferredsize { % - => w h
	/preferredsize super send
	210 max exch
	170 max exch
    } def

    % Readjust the number of visable lines and vertical scrollbar
    % settings before repainting the canvas.
    %
    /setdocparameters { % - => -
	/CurrentHeight /size /Parent self send send exch pop def
        /LinesInView CurrentHeight LineHeight div cvi def
	/VSbar /getbyname /parent self send send {
		[
		/View DocLines LinesInView div 
		/Page LinesInView
		/Line 1
		] /setdelta 2 index send
		0 DocLines /setrange 3 index send
		pop
	} if
    } def

    % Paint one color line along with its name.
    %
    /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

    % Paint the canvas with color name stripes.
    %
    /PaintCanvas { % - => -
	/setdocparameters self send
    	gsave
     	    FillColor fillcanvas
	    DocFont setfont
    	    HSValue DocWidth mul neg Margin add
            CurrentHeight translate
     	    /DocLine VSValue cvi def
	    0 LineHeight neg 2 div translate
    	    DocLine 1 DocLine LinesInView add Document length 1 sub min {
		Document 1 index get /ShowLine self send
		% Pause: Good manners & allows forked paint client to run.
        	5 mod 0 eq {pause} if
    		0 LineHeight neg translate
    	    } for
    	grestore
    } def

    % Reset the horizontal scrollbar value and repaint the canvas.
    %
    /setHSvalue { % num => -
        /HSValue exch def
        /paint self send
    } def

    % Reset the vertical scrollbar value and repaint the canvas.
    %
    /setVSvalue { % num => -
        /VSValue exch def
        /paint self send
    } def

classend def


/SimplePane OpenLookPane []
classbegin

    % Override the behavior of scrollbars so that notification
    % only occurs on the Up events (rather than on every drag).
    %
    /newinit { % - => -

        /newinit super send

        /HSbar /getbyname self send {
            /CallNotify? { % event | null => bool
		dup type /eventtype eq {
		    /Name get /MouseDragged eq {
		    	false
		    }{
		    	true
		    } ifelse
		}{
		    true
		} ifelse
            }
            /installmethod 4 -1 roll send
        } if

        /VSbar /getbyname self send {
	    /CallNotify? { % event | null => bool
                dup type /eventtype eq {
                    /Name get /MouseDragged eq {
                        false
                    }{
                        true
                    } ifelse
                }{
                    true
                } ifelse
            }
            /installmethod 4 -1 roll send
        } if
    } def

    % Callback for the horizontal scrollbar.
    %
    /CreateHSbarNotify { % - => proc
        {
            /value exch send
            /setHSvalue
            /parent self send
            /client exch send
            send
        }
    } def

    % Callback for the vertical scrollbar.
    %
    /CreateVSbarNotify { % - => proc
        {
            /value exch send
            /setVSvalue
            /parent self send
            /client exch send
            send
        }
    } def

classend
def


% create a window
%
/win [[ColorNamesCanvas] SimplePane ] [/Footer false]
    framebuffer /newdefault ClassBaseFrame send def

% customize the icon
%
/IconCanvas ColorNamesCanvas []
classbegin

% Methods:

    /PaintCanvas {
	/bar { % y /colorname => -
            ColorDict exch get setcolor
	    0 exch 64 16 rectpath fill
	} def
	gsave
	    0 /Green bar
	    16 /Blue bar
	    32 /Yellow bar
	    48 /Red bar
	grestore
    } def

classend def

[IconCanvas] /seticon win send
    
(Color Names) /setlabel win send
null /seticonlabel win send

/place win send
/activate win send
/map win send

newprocessgroup
currentfile closefile
