#! /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
%
%
% "@(#)imagespin 9.3 88/01/18
%
% Copyright (c) 1985 by Sun Microsystems, Inc.
%

/unixpath (NEWSHOME) getenv def
/imagedirectory (/smi/) def
/picturename (founders) def
/x0 0 def
/y0 0 def
/A 0 def
/B 0 def
/C 0 def
/angle 0 def
/thefont /Times-Roman findfont 48 scalefont def

/background {.5 fillcanvas .4 setgray 45 10 8 Sunlogo
	 .6 setgray thefont setfont 45 15 moveto (NeWS) show} def

/startpoint {0 0 {moveto -40 40 rect} getanimated waitprocess aload pop} def

/secondpoint {
	{	/A y y0 sub store
		/B x x0 sub store
		lineto
		A neg B rlineto
		B neg A neg rlineto
		x0 y0 lineto
	} getanimated  waitprocess aload pop
	} def

/spinrect {
    win begin {
	ClientCanvas createoverlay dup setcanvas
	startpoint
	/y0 exch store
	/x0 exch store
	x0 y0 secondpoint
	/y1 exch def
	/x1 exch def
	/angle A B atan store
	/C A dup mul B dup mul add sqrt store
	DisplayImage
    } stopped pop end
} def
/DisplayImage { 
	gsave
	ClientCanvas setcanvas
	background
	x0 y0 translate angle rotate C dup scale
	0 0 moveto theimage imagecanvas
	grestore
} def
/SetImage { /theimage
		unixpath imagedirectory picturename (.im8)
		append append append
		readcanvas store } def
SetImage
/win {
	/FrameLabel (image spin) def
	/IconLabel (SPIN!) def
	/PaintClient {
		ClientCanvas setcanvas
		C 0 le { background spinrect } { DisplayImage } ifelse
		} def
	} makewindowfromuser def

/HandleMenuSelection {/picturename MenuKeys MenuValue get store
    { pause SetImage win begin PaintClient } fork pop } def
/davincipicturemenu [
	(angel)
	(ermine)
	(lady)
	(man)
	(mona-face)
	(mona-hands)
	(mona-smile)
%	(mona-hires)
	(mona)
	(stjerome)
	(virgin)
	(virgino)
] [{ HandleMenuSelection }] makemenu def
/japanesepicturemenu [
	(cherries)
	(fuji)
	(geese)
	(puppet)
	(snow)
	(stormy)
	(washing)
%	(wash-hires)
	(writing)
] [{ HandleMenuSelection }] makemenu def
/sunpicturemenu [
	(founders)
	(sun3110)
	(sun3160c)
	(sun3160m)
	(sun3260h)
	(sun350)
	(sun352)
	(sun352w)
	(sunballs)
	(suncase)
	(sungame)
	(sunnet)
	(sunnfs)
	(sunprism)
] [{ HandleMenuSelection }] makemenu def
/travelpicturemenu [
	(bryce)
	(harem)
	(joshua)
	(lascruces)
	(new_york)
	(pagosa)
	(saturn)
	(shroom)
	(taj-detail)
	(taj)
	(vla)
	(zion)
] [{ HandleMenuSelection }] makemenu def
/winpicturemenu [
	(Spin)		{ { win begin spinrect } fork}
	(Da Vinci =>)	davincipicturemenu
	(Japanese =>)	japanesepicturemenu
	(Sun =>)		sunpicturemenu
	(Travel =>)	travelpicturemenu
	(Zap)		{currentprocess killprocessgroup}
] makemenu def

/wineventmgr
	[	MenuButton {winpicturemenu showmenu}
		DownTransition win /ClientCanvas get
		eventmgrinterest
		MiddleMouseButton { { lspinproc } fork pop}
		DownTransition win /ClientCanvas get
		eventmgrinterest
	] forkeventmgr def
/lspinproc { 
    10 dict begin
    /startpoint { currentmouse } def
    spinrect
    end
} def


%spinrect