%
% 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
%
%	fader 23.4 90/06/19
%
%  Fader:
%  Fade 2 strings in and out
%
% Fader uses colormap double buffering to get its results.  4 pixels
% are allocated by asking for 1 cell and 2 planes.  combining this one 
% cell with the 4 possible plane mask combinations gives the 4 pixels
% used.  the base cell with no planes ORd in is used as the background
% for the window.  the cell with either plane turned on gives the two
% foreground colors.  the cell with both planes turned on is the
% pixel value of the combined foregrounds.
%
% usually, what happens is that the cell is at 0, and the two planes
% are 1 and 2.
%
% so:
% background 0	(cell)
% foreground1 1 (cell or plane1)
% foreground2 2 (cell or plane2)
% sum	      3 (cell or plane1 or plane2)
%
% the sum pixel is painted wherever the two strings intersect.
											%
% the background cell is set to white.  the sum is set to black.
% the two foregrounds are changed over time to be fading between
% black and white.  since the sum is always black, the intersected
% areas are as well.
%

% make a subclass of BaseFrame that catches iconification
%
/FadeBaseFrame /defaultclass ClassBaseFrame send []
classbegin
    /open {
	dup
	/open super send
	/open /client self send send
    } def
classend def

/FadeWindow ClassCanvas dictbegin
    /vis null def			% the visual
    /cmap null def			% the colormap
    /segs null def			% the segments
    /own_cmap false def			% using non-default colormap

    /pix1 0 def				% the foreground pixels
    /pix2 0 def
    /mask1 0 def			% the planemasks
    /mask2 0 def

    /color1 0 0 0 rgbcolor def		% the foreground colors
    /color2 1 1 1 rgbcolor def
    /bg 1 1 1 rgbcolor def		% the background
    /fg 0.1 0 0 rgbcolor def		% the sum color

    /stepsize 32 def			% number of steps between White & Black
    /stepsleep .005 def			% sleep time between steps
    /up? true def			% fade direction

    /string1 (Tastes Great) def		% the strings
    /string2 (Less Filling) def

    /x .5 def				% string positioning information
    /y .5 def
    /basewidth 0 def			% window sizing info
    /baseheight 0 def

    /fadeproc null def			% the process handling the animation
    /sleepsecs 1 60 div def		% how long to sleep between steps
    /wasfading? false def		% bool for handling iconification

    /minfadescale 20 def		% initial text size
    /fadefontname /Times-Roman def	% the font we use

    /StepMenu null def			% some menus
    /SloganMenu null def

dictend classbegin

    /PseudoColor 3 def			% visual types are returned as numbers
					% so make a constant
    /GrayScale 1 def

    /non_icccm_wm? false def		% install own colormaps if true

    % returns true if colormap is dynamic (Grayscale, PseudoColor, Directcolor)
    /isdynamic? {	% cmap => bool
	/Visual get /Class get 2 mod 1 eq
    } def

    %
    % tries to find a visual of the given class and return it and a boolean
    %
    /getvisual {	% class => vis true | false
	1 dict begin
	    /class exch def
	    false
	    framebuffer /VisualList get {
		dup /Class get		% false vis class
		class eq {
		    exch pop		% wipe the false
		    true exit		% vis true
		} {
		    pop
		} ifelse
	    } forall
	end
    } def

    % returns the root window visual and the default colormap.
    /default_cmap {		% - => vis cmap
	framebuffer /Visual get
	framebuffer /Colormap get
    } def

    % returns the visual and a newly created colormap for a given visual class.
    % returns false if it cannot find a visual or create the colormap.
    /alternate_cmap {		% class => vis cmap true | false
	getvisual dup {
	    pop dup createcolormap true
	} if
    } def

    %
    % attempts to allocate the necessary number of pixels from
    % cmap.  Returns false if cannot, otherwise returns the colormap
    % entries.
    %
    /trycmap {	% cmap => seg true | false
	dup isdynamic? dup {
	    pop { 1 2 createcolorsegment } stopped not {
		0 get true
	    }{
		pop pop pop false		% colormap full
	    } ifelse
	}{
	    exch pop				% toss cmap
	} ifelse
    } def

    %
    % Attempts to create an alternate (non-default) colormap and
    % allocate colors in it.  Returns false on failure.
    %
    /tryalternate {	% class => vis cmap seg true | false
	alternate_cmap dup {
	    pop dup trycmap {		
		/own_cmap true def
		true
	    }{
		pop pop false
	    } ifelse
	} if
    } def

    %
    % Searches for a dynamic colormap to use than it can allocate RW cells in.
    % Preference is in following order:
    %	default colormap, alternate PseudoColor, alternate Grayscale.
    %
    % Returns the visual, colormap, entries allocated, and true if succeeds in
    % finding a desirable visual, otherwise returns false.
    %
    /findcmap {	% - => vis cmap seg true | false
	default_cmap dup trycmap dup not {
	    pop pop pop 
	    PseudoColor tryalternate dup not {
		pop GrayScale tryalternate 
	    } if
	} if				% vis cmap seg true | false
    } def

    %
    % creates the client canvas
    %
    % finds the proper visual if it can and builds the colormap,
    % then passes both (eventually, via newinit) to newcanvas so that it is
    % built with the proper visual & colormap
    %
    /newobject {	% parent => cv
	findcmap {
	    4 1 roll			% seg parent vis cmap 
	    2 copy 5 2 roll		% seg vis cmap parent vis cmap 
		%
		% Note: /newobject for ClassCanvas is documented to take a
		% single argument: ParentCanvas.  However, since it simply
		% does a 'newcanvas', we can also pass it a visual and a
		% cmap to create a canvas with a (potentially) non-default
		% colormap.
		%
	    /newobject super send	% seg vis cmap instance
	} {
	    pop				% toss parent
	    (Sorry, Fader can't run on this display\n) printf
	    quit
	} ifelse
    } def

    %
    % gets the new canvas (with the proper visual and colormap),
    % the visual and the colormap.  stashes the last two, and
    % initilaizes the colormap, the text and the menus.
    % seg is a colormap segment of the proper size which has
    % already been allocated in cmap.
    %
    /newinit {	% seg vis cmap => -
	/cmap exch def
	/vis exch def
	/newinit super send
	/segs exch def
	/initcolors self send
	text_size
	/CreateMenu self send
	[self soften] /setcolormapclients /parent self send send
    } def

    % 
    % calculate proper text scale factors for strings
    %
    /text_size {
	gsave
	    fadefontname findfont minfadescale scalefont setfont
	    string1 stringbbox 4 -2 roll pop pop	% w1 h1
	    string2 stringbbox 4 -2 roll pop pop	% w1 h1 w2 h2
	    3 -1 roll					% h1 h2 w1 w2
	    max 3 1 roll max				% [h1 | h2 ] [w1 | w2 ]
	    /baseheight exch 20 div x 2 mul add def
	    /basewidth exch 20 div y 1.5 mul add def
	grestore
    } def

    %
    % does the installation of the colormap so that the proper colors 
    % are displayed
    %
    non_icccm_wm? {
	/installcmap { % bool => -
	    cmap /Installed 3 -1 roll put
	} def
    } if

    %
    % express interest in Enter & Exit events so that the colormap
    % can be (un)installed as required
    %
    /MakeInterests {
	/MakeInterests super send

	non_icccm_wm? {
	    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

    % REMIND -- may want to add turning fadeproc on & off on
    % Enter/Exit
    %
    % handle the events
    %
    non_icccm_wm? {
	/ClientEnter {
	    pop true /installcmap self send
	} def
	/ClientExit {
	    pop false /installcmap self send
	} def
    } if

    % build the colormap and get the proper pixels & masks
    /initcolors { 

	% calculate masks
	/mask1 segs /Mask get dup neg and def
	/mask2 segs /Mask get mask1 xor def

	% save the pixels
	/pix1 segs /Slot get mask1 or def
	/pix2 segs /Slot get mask2 or def

	% store the fg & bg into the proper places
	segs segs /Slot get bg putcolor
	segs segs /Slot get segs /Mask get or fg putcolor

	% init the colors
	segs pix1 color1 putcolor
	segs pix2 color2 putcolor
    } def

    % display the strings
    /showtext {
	fadefontname findfont 1 scalefont setfont
	% show the first set
	mask1 setplanemask  	    	% affect only plane1
	0 setpixel clippath fill	% clear out extraneous bits
	pix1 setpixel			% use pixel1
	x y moveto string1 show

	mask2 setplanemask
	0 setpixel clippath fill
	pix2 setpixel
	x y moveto string2 show
    } def

    % adjust the colors up or down, sleeping between changes to keep
    % things smooth
    %
    % the colors are N and abs(1 - N)
    /fadetext {
	up? {
	    0 1 stepsize {
		dup
		/color1 exch stepsize div dup dup rgbcolor def
		/color2 exch stepsize sub abs stepsize div dup dup rgbcolor def
		segs pix1 color1 putcolor
		segs pix2 color2 putcolor
		stepsleep sleep
	    } for
	    /up? false def
	    sleepsecs sleep
	} {
	    0 1 stepsize {
		dup
		/color2 exch stepsize div dup dup rgbcolor def
		/color1 exch stepsize sub abs stepsize div dup dup rgbcolor def
		segs pix1 color1 putcolor
		segs pix2 color2 putcolor
		stepsleep sleep
	    } for
	    /up? true def
	    sleepsecs sleep
	} ifelse
    } def

    % adjust font size to fit in given window
    /scaletext {
	clippath pathbbox		% x y w h
	basewidth div			% x y w h'
	exch baseheight div exch	% x y w' h'
	scale
	pop pop
    } def

    /PaintCanvas {
	/scaletext self send
	% clean the slate so we have no garbage interfering
	segs /Slot get setpixel
	0 not setplanemask  	% paint all planes
	clippath fill
	showtext		% display the text
    } def

    % turn the fader off when we go iconic, and restore when we
    % come back
    /open {	% bool => -
	{
	    wasfading? {
		/fadeproc { { fadetext } loop } fork def
	    } if
	} {
	    wasfading? {
		fadeproc killprocess
		/fadeproc null def
	    } if
	} ifelse
    } def

    /destroy {
	% make sure we return the cmap to normal
	non_icccm_wm? own_cmap and {
	    cmap /Installed false put
	} if
	
        StepMenu null ne {
	    /destroy StepMenu send
	    /StepMenu null def
        } if

        SloganMenu null ne {
	    /destroy SloganMenu send
            /SloganMenu  null def
        } if

	fadeproc null ne {
	    fadeproc killprocess
	    /fadeproc null def
	} if

	/destroy super send
    } def

    % set up the minimum size
    /minsize {	% => width height
	/minsize super send			% mw mh
	baseheight minfadescale mul max
	exch basewidth minfadescale mul max
    } def

    /preferredsize {	% => width height
	/minsize self send			% mw mh
    } def

    % turn the fader proc on & off
    /fadetoggle {
	fadeproc null ne {
	    fadeproc killprocess
	    /fadeproc null def
	    /wasfading? false def
	} {
	    /fadeproc { { fadetext } loop } fork def
	    /wasfading? true def
	} ifelse
    } def

    % convert the menu entry into a numeric sleep time
    /setstepfrommenu {
	dup
	/value exch send
	[ .01 .005 .001 .0005 .00001 .00005 0 ] exch get
	/stepsleep exch def
	null /valuething 3 -1 roll send /setfooter /Parent self send send
    } def

    /showstep {	% - => stepsleep
	stepsleep
    } def

    % change the strings and adjust the scale
    /changestring {	% str1 str2
	/string2 exch store
	/string1 exch store
	text_size
	/paint self send
    } def

    /CreateMenu {
    % menu choice for how long to sleep between color changes
        /StepMenu
	    [ (slowest) (slower) (slow) (normal) (fast) (faster) (fastest) ]
	    null /setstepfrommenu self soften buildsend
	    framebuffer /newdefault ClassMenu send def
	    3 /setdefault StepMenu send

	/SloganMenu
	    [
		(Beer) null { pop (Tastes Great) (Less Filling) /changestring }
			self soften buildsend
		(Focus) null { pop (Follow Mouse) (Click To Type) /changestring }
			self soften buildsend
		(Editors) null { pop (    Vi) (Emacs) /changestring }
			self soften buildsend
		(Politics) null { pop (Republican) (Democrat) /changestring }
			self soften buildsend
		% space NeWS out so they combine to X11NeWS...
		(Window Systems) null { pop (       NeWS) (X11) /changestring }
			self soften buildsend
		(Operating Systems) null { pop (UNIX) (VMS) /changestring }
			self soften buildsend
	    ]
	    framebuffer /newdefault ClassMenu send def

        /CanvasMenu
	    [
		(Toggle Fade)	null { pop /fadetoggle } self soften buildsend
		(Slogans) SloganMenu null
		(Fade Time) StepMenu null
	    ]
	    framebuffer /newdefault ClassMenu send
	    (Fader) /setlabel 2 index send
	    (Fader) /setowner 2 index send
        def

    } def

classend def

[FadeWindow] [] framebuffer /new FadeBaseFrame send
/win exch def
(Fader) /setlabel win send
(Fade Time) (normal)
    /setfooter win send

% icon painter
{
    gsave
	1 fillcanvas
	clippath pathbbox scale pop pop		% got 0-1, 0-1 coords
	/Helvetica-Bold findfont .30 scalefont setfont

	% top row
	.8 setgray
	.1 .7 moveto
	(F) show
	.6 setgray
	(a) show
	.4 setgray
	(d) show
	.2 setgray
	(e) show
	0 setgray
	(r) show

	% middle row
	0 setgray
	.1 .4 moveto
	(Fader) show

	% bottom row
	0 setgray
	.1 .1 moveto
	(F) show
	.2 setgray
	(a) show
	.4 setgray
	(d) show
	.6 setgray
	(e) show
	.8 setgray
	(r) show
    grestore
} /seticon win send

null /seticonlabel win send

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

newprocessgroup
currentfile closefile
