%
% 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
%
%
%	colormap 23.2 90/06/19
%
%  Colormap:
%  Display the installed colormap.  Also installs its own HSB ramp on
%  Enter and uninstalls it on Exit
%
%
/ColorWindow ClassCanvas
dictbegin
    /vis null def
    /cmap null def
    /segs null def
    /saturation	0.9 def
    /intensity	1.0 def
    /x 0 def
    /y 0 def
    /sqrtcmap 0 def	% dimensions of cmap square - sqrt of # of entries
dictend
classbegin

%
% class variables
%
    /PseudoColor 3 def
    /GrayScale 1 def

    % decide which form of colormap installation policy to use
    % neither will make sense once this is automatic
    /usefocus? false def		% use input focus to decide?
    /useenter? false def		% use Enter/Exit events to decide?

    /newobject	 {	 % parent => instance | null
	getvisual {
	    dup createcolormap		% cv vis cmap
	    2 copy 5 2 roll		% vis cmap cv vis cmap
	    /newobject super send	% instance
	} {
	    pop				% pop canvas
	    (Sorry, Colormap can't run on this display\n) printf
	    quit
	} ifelse
    } def

    /newinit {	 % vis cmap => -
	/cmap exch def
	/vis exch def
	/newinit super send
	/makecmap self send
    } def

    /MakeInterests {
	/MakeInterests super send

	usefocus? {
	    [/AcceptFocus /RestoreFocus /LoseFocus]
	    /NoticeFocus BuildCanvasSend
            null /canvas self send soften eventmgrinterest
	} if


	useenter? {
            Canvas soften null
	    2 dict dup begin
	        /EnterEvent		/ClientEnter self soften buildsend def
	        /ExitEvent		/ClientExit self soften buildsend def
	    end /new ClassInterest send
	} if

    } def

    usefocus? {
	/NoticeFocus { % event => -
    	    /Name get /LoseFocus eq {
		false /installcmap self send
	    } {
		true /installcmap self send
	    } ifelse
	} def

	/activate {
	    /activate super send
	    /canvas self send addfocusclient
	} def

	/deactivate {
	    /deactivate super send
	    /canvas self send removefocusclient
	} def
    } if

    /installcmap { % bool => -
       cmap /Installed 3 -1 roll put
    } def

    useenter? {
        /ClientEnter {
	    pop true /installcmap self send
        } def

        /ClientExit	{
	    pop false /installcmap self send
        } def
    } if

    /getvisual {	% - => vis true | false
	false
	framebuffer /VisualList get {
	    dup /Class get		% false vis class
	    dup
	    PseudoColor eq exch GrayScale eq or {
		exch pop		% wipe the false
		true exit		% vis true
	    } {
		pop
	    } ifelse
	} forall
    } def

    /makecmap	{
	/segs cmap cmap /Visual get /Size get 0 createcolorsegment def

	0 1 cmap /Visual get /Size get 1 sub {
	    dup					% i i
	    segs exch get			% i segment
	    dup /Slot get			% i segment slot
	    3 2 roll cmap /Visual get /Size get 
	    div					% make hue relative to cmap size
	    saturation intensity hsbcolor
	    putcolor				% store color into slot
	} for
	/sqrtcmap cmap /Visual get /Size get sqrt def
    } def

    % show colormap as a square
    /showmap {
	/x 0 def
	/y 0 def
	0 1 cmap /Visual get /Size get 1 sub {
		setpixel
		x y 1 1 rectpath
		fill
		/x x 1 add def
		x sqrtcmap eq {
			/y y 1 add def
			/x 0 def
			} if

	} for
    } def

    %
    % canvas dimensions are set so that each colormap 'square' is 1x1
    %
    /PaintCanvas {
	clippath pathbbox
	4 2 roll translate
	sqrtcmap div exch sqrtcmap div exch scale
	0 sqrtcmap translate 1 -1 scale
	showmap
    } def

    /destroy {
	% make sure we return the cmap to normal
	cmap null ne {
	    cmap /Installed false put
	} if
	/destroy super send
    } def

    /minsize { % - => w h
	/minsize super send
	64 max exch
	64 max exch
    } def

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

classend def

/win
    [ColorWindow] [/Footer false] framebuffer /newdefault ClassBaseFrame send
def

{
  growabledict begin
    gsave
	clippath pathbbox
	4 2 roll translate
	16 div exch 16 div exch scale
	0 16 translate 1 -1 scale
	/x 0 def
	/y 0 def
	0 1 255 {
		setpixel
		x y 1 1 rectpath
		fill
		/x x 1 add def
		x 16 eq {
			/y y 1 add def
			/x 0 def
			} if

	} for
    grestore
  end
} /seticon win send

(Colormap) /setlabel win send
null /seticonlabel win send

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

newprocessgroup
currentfile closefile
