%
% 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
%
%
%	@(#)fish 23.2 90/06/19
%

/FishCanvas ClassCanvas
dictbegin
    /Level 0 def
    /FishPaintProcess null def
dictend
classbegin

% Class Variables:

% Defaults:

    % Set the colors explicitly rather than getting them from the
    % parent canvas (container hierarchy).
    /FillColor		1 1 1 rgbcolor def
    /StrokeColor	0 0 0 rgbcolor def
    /TextColor		StrokeColor def

% Methods:

    /newinit { % - => -
	/newinit super send
	/CreateMenu self send
    } def

    /destroy { % - => -
	FishPaintProcess null ne {
	    FishPaintProcess killprocess
	    /FishPaintProcess null store
	} if
	/destroy super send
    } def

    % return the current level of complexity to draw the "fish" at.
    /level { % - => level
	Level
    } def

    /PaintCanvas { % - => -
	% paint the canvas to have the right color and border
	StrokeColor 2 FillColor /StrokeAndFillCanvas self send

	% this takes a while, so fork the painting routine.
	% The second procedure is executed by refork to clear
	% any context that might be set when the first procedure
	% is killed.
	/FishPaintProcess {
	    % set up the coordinate space
	    % pathbbox requires that the current point be set
	    clippath emptypath {
		0 0 moveto
	    } if
	    pathbbox scale
	    StrokeColor setcolor
	    % paint the fish at the current /Level
	    Level fish
	    /FishPaintProcess null store
	} { newpath clipcanvas } refork
    } def

    /CreateMenu { % - => -
	/CanvasMenu [
	    (Complexity 0)
	    (Complexity 1)
	    (Complexity 2)
	    (Complexity 3)
	] null {
	    /value self send /SetLevel /sendtarget 4 -1 roll send
	} framebuffer /newdefault ClassMenu send def

	% add a pin to the menu
	true /setpinnable CanvasMenu send

	% set up a label and an owner for the menu.
	(Complexity) /setlabel CanvasMenu send
	(Fish: ) /setowner CanvasMenu send
    } def

    /SetLevel { % level => -
	/Level exch def
	null Level 20 string cvs /setfooter /Parent self send send
	/paint self 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

    %  The following are all the functions required to produce the famous
    %  "Square Limit" drawing by M. C. Escher. These functions were derived by
    %  Peter Henderson. See his paper in 1982 Conf. on LISP and Func. Prog.
    %  (C) Miranda coding by Michael Parsons, September 1985
    %  Translation to PostScript by Peter Bumbulis, July 1986
    
    % quartet combines 4 images, one image in each quadrant,
    % to produce one image.
    /quartet {
	4 -1 roll 1 2 div   0	1 zoom
	4 -1 roll 1 2 div   1	1 zoom
	4 -1 roll 1 2 div   0	0 zoom
	4 -1 roll 1 2 div   1	0 zoom
	4 {exec} /repeat cvx
	7 array astore cvx
    } def
    
    %  nonet arranges 9 images in equal sized squares to form 1 image.
    /nonet {
	9 -1 roll 1 3 div   0	1 zoom
	9 -1 roll 1 3 div 0.5	1 zoom
	9 -1 roll 1 3 div   1	1 zoom
	9 -1 roll 1 3 div   0 0.5 zoom
	9 -1 roll 1 3 div 0.5 0.5 zoom
	9 -1 roll 1 3 div   1 0.5 zoom
	9 -1 roll 1 3 div   0	0 zoom
	9 -1 roll 1 3 div 0.5	0 zoom
	9 -1 roll 1 3 div   1	0 zoom
	9 {exec} /repeat cvx
	12 array astore cvx
    } def
    
    %  cycle combines 4 smaller copies of an image, each rotated by a different
    %  multiple of 90 degrees.
    /cycle {
	dup 270 rot dup 180 rot dup  90 rot quartet
    } def
    
    %  t is one of the basic fish rearrangements.
    /t {
	{p} {q} {r} {s} quartet
    } def
    
    %  u is another of the basic fish rearrangements.
    /u {
	{q} 90 rot cycle
    } def
    
    %  side defines one side of the picture at level n.
    /side {
	dup 0 le
	  {  pop   {} dup t 90 rot t quartet}
	  {1 sub side dup t 90 rot t quartet}
	ifelse
    } def
    
    %  corner defines one corner of the picture at level n.
    /corner {
	dup 0 le
	  {  pop	 {}	   {}	      {} u quartet}
	  {1 sub dup corner exch side dup 90 rot u quartet}
	ifelse
    } def
    
    %  quadcorner forms one quarter of the image at level n;
    /quadcorner {
	dup corner exch side dup dup 90 rot dup u exch t 90 rot dup 3 1 roll
	{q} 90 rot nonet
    } def
    
    %  squarelimit produces the fish drawing.
    /squarelimit {
	quadcorner cycle
    } def
    
    %  fish gives a border to produce the final drawing.
    /fish {
	squarelimit exec
    } def
    
    /flip {
	0.5 0.5 translate 1 -1 scale -0.5 -0.5 translate
    } def
    
    %  All the data needed to draw the fish.
    /p {
	gsave flip
	newpath
	0 0.8125 moveto 0 0.5 lineto
	0 0.8125 moveto 0.1875 0.75 lineto
	0.75 0 moveto 0.8125 6.25e-2 lineto
	0.1875 0.75 moveto 0 0.5 lineto
	0.375 1 moveto 0.25 0.75 lineto
	0.25 0.6875 moveto 0.4375 0.625 lineto
	0.25 0.6875 moveto 0.25 0.375 lineto
	0.4375 0.625 moveto 0.25 0.375 lineto
	0.6875 1 moveto 0.625 0.75 lineto
	0.6875 1 moveto 0.875 0.875 lineto
	0.875 0.875 moveto 1 0.875 lineto
	0.625 0.75 moveto 0.8125 0.6875 lineto
	0.8125 0.6875 moveto 1 0.75 lineto
	0.625 0.75 moveto 0.5 0.5 lineto
	0.5625 0.625 moveto 0.75 0.5625 lineto
	0.75 0.5625 moveto 1 0.625 lineto
	0.5 0.5 moveto 0.75 0.4375 lineto
	0.75 0.4375 moveto 1 0.5 lineto
	0.5 0.5 moveto 0.25 0.1875 lineto
	0.25 0.1875 moveto 0 0 lineto
	0.5 0.25 moveto 1 0.375 lineto
	1 0.25 moveto 0.75 0.25 lineto
	0.75 0.25 moveto 0.5 0 lineto
	0.5 0 moveto 0.375 6.25e-2 lineto
	0.375 6.25e-2 moveto 0 0 lineto
	0.625 0 moveto 0.75 0.125 lineto
	0.75 0.125 moveto 1 0.1875 lineto
	1 0.125 moveto 0.8125 6.25e-2 lineto
	1 6.25e-2 moveto 0.875 0 lineto
	stroke pause
	grestore
    } def
    
    /q {
	gsave flip
	newpath
	0 0 moveto 0 0.25 lineto
	0 0.5 moveto 0 1 lineto
	0 1 moveto 0.5 1 lineto
	0.75 1 moveto 1 1 lineto
	0.125 1 moveto 0.25 0.6875 lineto
	0.25 1 moveto 0.375 0.6875 lineto
	0.375 1 moveto 0.5 0.6875 lineto
	0.5 1 moveto 0.625 0.625 lineto
	0.25 0.6875 moveto 0.25 0.5625 lineto
	0.375 0.6875 moveto 0.375 0.5625 lineto
	0.5 0.6875 moveto 0.5 0.5 lineto
	0.625 0.625 moveto 0.625 0.4375 lineto
	0.625 1 moveto 0.875 0.3125 lineto
	0.75 1 moveto 0.8125 0.75 lineto
	0.8125 1 moveto 1 0.625 lineto
	0.875 1 moveto 1 0.75 lineto
	0.9375 1 moveto 1 0.875 lineto
	0 0.25 moveto 0.1875 0.1875 lineto
	0 0.375 moveto 0.4375 0.3125 lineto
	0 0.5 moveto 0.25 0.5625 lineto
	0.125 0 moveto 0.1875 0.1875 lineto
	0.1875 0.1875 moveto 0.3125 0.125 lineto
	0.3125 0.125 moveto 0.25 0 lineto
	0.3125 0.125 moveto 0.4375 6.25e-2 lineto
	0.4375 6.25e-2 moveto 0.5 0 lineto
	0.5 6.25e-2 moveto 0.6875 6.25e-2 lineto
	0.6875 6.25e-2 moveto 0.5625 0.1875 lineto
	0.5625 0.1875 moveto 0.5 6.25e-2 lineto
	0.5625 0.25 moveto 0.75 0.25 lineto
	0.75 0.25 moveto 0.625 0.375 lineto
	0.625 0.375 moveto 0.5625 0.25 lineto
	1 0 moveto 0.75 0.375 lineto
	0.375 0 moveto 0.4375 6.25e-2 lineto
	0.75 0.375 moveto 0.375 0.5625 lineto
	0.375 0.5625 moveto 0.25 0.5625 lineto
	1 0 moveto 0.9375 0.375 lineto
	0.9375 0.375 moveto 1 0.5 lineto
	1 0.5 moveto 0.8125 0.75 lineto
	stroke pause
	grestore
    } def
    
    /r {
	gsave flip
	newpath
	0.5 0.5 moveto 0.125 0.25 lineto
	0.125 0.25 moveto 0 0 lineto
	0 0.5 moveto 0.125 0.25 lineto
	0 0.25 moveto 6.25e-2 0.125 lineto
	0 1 moveto 0.5 0.5 lineto
	0 0.75 moveto 0.3125 0.375 lineto
	6.25e-2 0.9375 moveto 0.25 1 lineto
	0.125 0.875 moveto 0.5 1 lineto
	0.1875 0.8125 moveto 0.5 0.875 lineto
	0.3125 0.6875 moveto 0.75 0.8125 lineto
	0.5 0.875 moveto 0.75 1 lineto
	0.75 0.8125 moveto 1 1 lineto
	0.5 0.5 moveto 0.875 0.625 lineto
	1 0.625 moveto 0.6875 0.375 lineto
	0.6875 0.375 moveto 0.375 0 lineto
	1 0.5 moveto 0.75 0.25 lineto
	1 0.75 moveto 0.875 0.625 lineto
	0.75 0.25 moveto 0.6875 0 lineto
	0.75 0.25 moveto 1 0 lineto
	1 0.375 moveto 0.8125 0.1875 lineto
	1 0.25 moveto 0.875 0.125 lineto
	1 0.125 moveto 0.9375 6.25e-2 lineto
	stroke pause
	grestore
    } def
    
    /s {
	gsave flip
	newpath
	0 1 moveto 0.25 0.875 lineto
	0.125 0.9375 moveto 0 0.75 lineto
	0.25 0.875 moveto 0.5 0.875 lineto
	0.5 0.875 moveto 1 1 lineto
	1 1 moveto 0.625 0.75 lineto
	0.625 0.75 moveto 0.5 0.625 lineto
	0 0.625 moveto 0.4375 0.75 lineto
	0 0.5 moveto 0.5 0.625 lineto
	0 0.375 moveto 0.4375 0.5 lineto
	0 0.25 moveto 0.4375 0.375 lineto
	0 0.125 moveto 0.4375 0.1875 lineto
	0.5 0.625 moveto 0.4375 0.5 lineto
	0.4375 0.5 moveto 0.4375 0.1875 lineto
	0.4375 0.1875 moveto 0.5 0 lineto
	0.625 0 moveto 0.6875 0.375 lineto
	0.75 0 moveto 0.8125 0.1875 lineto
	0.8125 0.1875 moveto 0.9375 0.4375 lineto
	0.9375 0.4375 moveto 1 0.5 lineto
	1 0.125 moveto 0.8125 0.1875 lineto
	1 0.25 moveto 0.875 0.3125 lineto
	1 0.375 moveto 0.9375 0.4375 lineto
	0.75 0.5625 moveto 0.75 0.75 lineto
	0.75 0.75 moveto 0.625 0.625 lineto
	0.625 0.625 moveto 0.75 0.5625 lineto
	0.8125 0.5625 moveto 0.9375 0.5 lineto
	0.9375 0.5 moveto 0.9375 0.6875 lineto
	0.9375 0.6875 moveto 0.8125 0.5625 lineto
	stroke pause
	grestore
    } def
    
    % rot rotates an image by th radians anti-clockwise, about the image center
    /rotcode {
	gsave
	    0.5 0.5 translate rotate -0.5 -0.5 translate exec
	grestore
    } def
    
    /rot {
	/rotcode cvx 3 array astore cvx
    } def
    
    %  zoom scales an image up or down with one fixed point.
    /zoomcode {
	gsave
	    2 copy neg exch neg exch 5 2 roll translate
	    dup scale translate exec
	grestore
    } def
    /zoom {
	/zoomcode cvx 5 array astore cvx
    } def
    
    /setup {
	72 8 mul dup scale .25 8 div dup translate .001 setlinewidth
    } def

classend def

/win [FishCanvas] [] framebuffer /newdefault ClassBaseFrame send def
(Escher's Fish) /setlabel win send
(Complexity) /level /client win send send 20 string cvs
    /setfooter win send

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

newprocessgroup
currentfile closefile
