#! /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
%
%
%	bounce 9.2 88/01/18
%
%  Bounce a puck around a window, using simple menus for control.
%
/puckxsize 16 def
/puckysize 16 def
/puckdelta 8 def
/paintpuck {setgray puckx pucky puckxsize puckysize rectpath fill} def
/forkpuckcanvas { % canvas  =>  process (Forks a bouncing ball in the canvas)
gsave
20 dict begin
    /can exch def
    /puckx 0 def
    /pucky 0 def
    /puckxdelta 1 def
    /puckydelta 1 def
    {
        {
	    can setcanvas
	    clippath pathbbox /ysize exch def /xsize exch def pop pop

	    1 paintpuck

	    /puckx puckx puckxdelta puckdelta mul add def
	    /pucky pucky puckydelta puckdelta mul add def

	    puckx 0 lt {/puckx 0 def /puckxdelta puckxdelta neg def} if
	    puckx xsize puckxsize sub ge {
		/puckx xsize puckxsize sub def /puckxdelta puckxdelta neg def
	    } if

	    pucky 0 lt {/pucky 0 def /puckydelta puckydelta neg def} if
	    pucky ysize puckysize sub ge {
		/pucky ysize puckysize sub def /puckydelta puckydelta neg def
	    } if

	    0 paintpuck
	    pause
        } loop
    } fork
end
grestore
} def

/main { % - => - (Drag a window & forkpuckcanvas)
    /puckbackground 1 def
    /setpuckbackground {/puckbackground exch store} def
    /setpucksize {/puckysize exch store /puckxsize exch store} def
    /setpuckdelta {puckxsize mul /puckdelta exch store} def
    /flipbounce {
        puckprocess
        bouncing? {suspendprocess (Go!)} {continueprocess (Stop!)} ifelse
	currentindex exch {flipbounce} /changeitem self send
        /bouncing? bouncing? not store
    } def

    /win framebuffer /new DefaultWindow send def	% Create a window
    {							% Install my stuff.
	/FrameLabel (Bounce!) def
	/IconLabel (Bounce!) def
	/PaintClient {puckbackground fillcanvas} def
    	/flipiconic {
	    /flipiconic super send
	    Iconic?
		{bouncing? {puckprocess suspendprocess} if}
		{bouncing? {puckprocess continueprocess} if} ifelse
    	} DefaultWindow methodcompile def
	/ClientMenu [
	    (Stop!)	{flipbounce}
            (Black)	{0 setpuckbackground /paintclient win send}
            (White)	{1 setpuckbackground /paintclient win send}
            (4x4)	{ 4  4 setpucksize   /paintclient win send}
            (8x8)	{ 8  8 setpucksize   /paintclient win send}
            (16x16)	{16 16 setpucksize   /paintclient win send}
            (32x32)	{32 32 setpucksize   /paintclient win send}
            (.5)	{ .5 setpuckdelta    /paintclient win send}
            (1)		{  1 setpuckdelta    /paintclient win send}
            (1.5)	{1.5 setpuckdelta    /paintclient win send}
            (2)		{  2 setpuckdelta    /paintclient win send}
	] /new DefaultMenu send def
    } win send
    /reshapefromuser win send				% Shape it.
    /map win send  % Map the window. (Damage causes PaintClient to be called)

    /bouncing? true def
    /puckprocess win /ClientCanvas get forkpuckcanvas def % start puck.
} def

main