#! /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
%
%
%	colorwheel 9.2 88/01/18
%
%  Color wheel:
%  Drag a window with a bunch of colors. The menu changes the colors.
%
/colorlabel { % - => string
    color?
        {intensity saturation nseg (% Colors; Saturation %, Intensity %)}
        {nseg (% Values of Gray)} ifelse
    sprintf
} def
/paintwheel {
    win /FrameLabel colorlabel put
    /paint win send
} def
/colorwheel { % -  =>  -  (Paints a color-oval in the current canvas)
    gsave
    1 fillcanvas
    clippath pathbbox scale pop pop

    /segang 360 nseg div def
    
    0 1 nseg 1 sub {
        dup nseg div color?
            {saturation intensity sethsbcolor}
            {setgray} ifelse
	segang mul /ta exch def
	.5 .5 moveto
	.5 .5 .5 ta ta segang add arc
	closepath fill pause
    } for
    grestore
} def

/nseg		36 def
/saturation	.9 def
/intensity	1 def
/color?		framebuffer /Color get def
/getmenunumber	{/currentkey self send cvr} def

/main {
% Make pull-right menus:
    /segmentsmenu
        [(6) (12) (24) (36) (64) (128) (256)]
        [{/nseg getmenunumber store paintwheel}]
        /new DefaultMenu send def
    /intensitymenu
        [(.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9) (1.0)]
        [{/intensity getmenunumber store paintwheel}]
        /new DefaultMenu send def
    /saturationmenu
        [(.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9) (1.0)]
        [{/saturation getmenunumber store paintwheel}]
        /new DefaultMenu send def

% Make window:
    /win framebuffer /new DefaultWindow send def	% Create a window
    {							% Install my stuff.
	/FrameLabel colorlabel def
	/ShapeIconCanvas {
	    ParentCanvas setcanvas
	    0 0 translate 0 0 IconWidth IconHeight ovalpath
	    IconCanvas reshapecanvas
	} def
	/PaintClient {colorwheel} def
	/PaintIcon {colorwheel} def
	/ClientMenu [
	    (Color)		{/color? true store paintwheel}
	    (Black & White)	{/color? false store paintwheel}
	    (Saturation =>)	saturationmenu
	    (Intensity =>)	intensitymenu
	    (Segments =>)	segmentsmenu
	] /new DefaultMenu send def
    } win send
    /reshapefromuser win send				% Shape it.

% Activate window
    /map win send  % Map the window. (Damage causes PaintClient to be called)
} def

main