#!/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, modify or distribute this file at will.
	%
	% 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
	%
	% Copyright (C) 1988 by Sun Microsystems. All rights reserved.

% granite - make NeWS desktop look like granite
%
% Bruce V. Schwartz
% Sun Microsystems
% November 1988
% bschwartz@sun.com
%
% Fixed to work with sjs's winwin by Don Hopkins.
% I also made arg 1 control how dark the granite is (default is still 2000).
%
20 dict begin

systemdict /XNeWS? known not { systemdict /XNeWS? false put } if



/GraniteCanvas { % width height => canvas
	gsave
	10 dict begin
	/h exch def
	/w exch def
	/can framebuffer newcanvas def
	0 0 w h rectpath can reshapecanvas
	can setcanvas
	can /Retained true put

	.85 .85 .85  rgbcolor fillcanvas

	%% pink
	0 .25 1 hsbcolor setcolor
	0 % 1000 
	{
		random w mul
		random h mul
		moveto
		0 2 rlineto 
		stroke
	} repeat
	% pause
		
	%% white
	1 1 1 rgbcolor setcolor
	2000
	{
		random w mul
		random h mul
		moveto
		0 2 rlineto 
		stroke
	} repeat
	% pause

	%% black
	0 0 0 rgbcolor setcolor
	300 
	{
		random w mul
		random h mul
		moveto
		0 1 rlineto 
		stroke
	} repeat
	% pause

	can % return canvas
	end

	grestore
} def


/canarray 
[
	100 100 GraniteCanvas
	100 100 GraniteCanvas
	100 100 GraniteCanvas
	100 100 GraniteCanvas
	100 100 GraniteCanvas
] def
 
/GraniteArray
[
	framebuffer setcanvas clippath pathbbox
	/h exch def
	/w exch def
	pop pop
	h 100 div ceiling 1 add w 100 div ceiling 1 add mul
	{
		canarray dup length random mul cvi get 
	} repeat
] store

/framebuffer where not {systemdict} if % Fixed to work w/ sjs's winwin
/PaintRoot
{
	% (PaintRoot % % % %\n) [clipcanvaspath pathbbox] dbgprintf
	10 dict begin
	/i 0 def
	/ImageIt { % canvas x y scalex scaley => -
		gsave
		framebuffer setcanvas
		4 2 roll
		XNeWS?
			{ translate pop pop }
			{ translate scale }
		ifelse
		% dup (can %\n) [ 3 2 roll ] dbgprintf 
 		imagecanvas
% 		5 setrasteropcode false imagemaskcanvas
		grestore	
	} def

	mark
%	systemdict /GraniteArray get aload pop
	/GraniteArray load aload pop
	framebuffer setcanvas clippath pathbbox
	/h exch def
	/w exch def
	pop pop
	0 100 w {
		/x exch def
		0 100 h {
			/y exch def
			x y 100 100 ImageIt
			pause
		} for
	} for
	cleartomark
	end % tmp dictionary
} put

/framebuffer where not {systemdict} if % Fixed to work w/ sjs's winwin
/GraniteArray
[
	framebuffer setcanvas clippath pathbbox
	/h exch def
	/w exch def
	pop pop
	h 100 div ceiling 1 add w 100 div ceiling 1 add mul
	{
		canarray dup length random mul cvi get 
	} repeat
] put

end


PaintRoot