#! /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
%
%
%	colorcube 9.2 88/01/18
%
%  Color cube:
%  Drag a window with a bunch of colors. The menu changes the colors.
%
/colorlabel {
    intensity sats hues (% Hues & % Saturations at Intensity=%) sprintf
} def
/paintcube {
    win /FrameLabel colorlabel put
    /paint win send
} def
/colorcube { % - => - (Paints a color-cube in the current canvas)
10 dict begin % removing the begin-end pair causes window stretch to reverse!
    gsave
    1 fillcanvas
    clippath pathbbox
    /xbit 1 3 index div def % Fudge to get rid of bit errors!  Note: div by 0
    /ybit 1 2 index div def % check not needed: ClientMin stuff in window
    scale pop pop	    % assures no 0 size canvases.
    
    /dx 1 hues div def
    /dy 1 sats div def

    0 dx 1 dx sub {
	0 dy 1 dy sub {
	    /y exch def
	    /x 1 index def
	    color?
	        {x dx add y dy add intensity sethsbcolor}
	        {x dy mul y add setgray} ifelse
	    x y dx xbit add dy ybit add rectpath fill pause
	} for
	pop
    } for
    grestore
end
} def

/hues		32 def
/sats		10 def
/intensity	1 def
/color?		framebuffer /Color get def
/getmenunumber	{/currentkey self send cvr} def

/main {
% Make pull-right menus:
    /huesmenu
	[(2) (4) (8) (16) (32) (64) (256)]
	[{/hues getmenunumber store paintcube}]
	/new DefaultMenu send def
    /intensitymenu
	[(.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9) (1.0)]
	[{/intensity getmenunumber store paintcube}]
	/new DefaultMenu send def
    /satsmenu
	[(1) (2) (3) (4) (5) (6) (7) (8) (9) (10)]
	[{/sats getmenunumber store paintcube}]
	/new DefaultMenu send def

% Make window:
    /win framebuffer /new DefaultWindow send def	% Create a window
    {							% Install my stuff.
	/FrameLabel colorlabel def
	/PaintClient {colorcube} def
	/PaintIcon {colorcube} def
	/ClientMenu [
	    (Hues =>)		huesmenu
	    (Saturations =>)	satsmenu
	    (Intensity =>)	intensitymenu
	    (Color)		{/color? true store paintcube}
	    (Black & White)	{/color? false store paintcube}
	] /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