[comp.windows.news] 3-D pyramid fractal for NeWS

gerard@CGL.UCSF.EDU (09/21/88)

 > {allegra,philabs,cmcl2,rutgers}!phri!roy -or- phri!roy@uunet.uu.net
 >	I still maintain that NeWS is different enough from PostScript to
 >   make in inadvisable to use the former as a tool for learning the latter.

   Roy,

   Curt.McDowell (cm26+@andrew.cmu.edu) has recently posted (in comp.graphics)
   an interesting 3-D pyramid fractal, written in PostScript. You can adjust
   the viewing angle by modifying alpha and beta parameters. 
   Unfortunately, sending the program to a laser printer is not very fast. 
   You can also view it with psview, but it is also slow.
   However, by modifying SLIGHTLY Curt's program, to run it under NeWS,
   You get a much faster response time, and you can learn some PostScript
   tips (I did !).

   Nota bene, 
   The program below has been written by Curt McDowell, I just made some 
   small modifications to run it with NeWS. (More than 3/4 is `pure' 
   PostScript less than 1/4 is NeWS !).
   ___________________________________________________________________________

#! /usr/NeWS/bin/psh

%                                                | Z
% alpha -> Rotation around the Z axis            |
%         (front corner moving left)             |_________ X
% beta  -> Rotation around the Y                /
%         (top corner moving away)             / 
%                                             / Y

/alpha          -11   def       /beta           -10   def
/shadeleft       1    def        /shaderight     0.1   def
/pagew          300    def      /pageh          400    def
/StartSize      1.6   def       /MinSize        0.2   def

/sina alpha sin def             /sinb beta sin def
/cosa alpha cos def             /cosb beta cos def

% Transformation from 3-D coordinates to 2-D

/xform  % alpha,beta,x,y,z ==> x',y'
{    
        /zz exch def
        /yy exch def
        /xx exch def
	/Beta exch def
	/Alpha exch def

        yy 
	Alpha cos 
		  mul 
        xx 
	Alpha sin 
		  mul sub
        pagew 2 div mul         % Compute X and
        pagew 2 div add         % leave on stack

        xx 
	Beta sin
	     mul 
	Alpha cos 
		 mul 
        yy 
	Alpha sin 
		 mul 
	Beta sin
	         mul add 
        zz 
	Beta cos
		 mul add
        pageh 2 div mul         % Compute Y and
        pageh 2 div add         % leave on stack
} def

% Constants

/sqr3o4   3 sqrt    4 div       def
/sqr3o2   3 sqrt    2 div       def
/sqr3o6   3 sqrt    6 div       def
/sqr6o3   6 sqrt    3 div       def
/sqr3o12  3 sqrt    12 div      def
/sqr6o6   6 sqrt    6 div       def

/pyramid    % alpha,beta,x,y,z,size ==> --
{    
gsave
        /size exch def 
	/z exch def 
	/y exch def 
	/x exch def
	/beta exch def
	/alpha exch def

        % (ax, ay) = Left bottom point
	alpha
	beta
        x 
	y 
	z 
	   xform 
	/ay exch def 
	/ax exch def

        % (bx, by) = bottom front point
	alpha
	beta
        sqr3o2 size mul x add  
	size 2 div y add 
	z 
	   xform 
	/by exch def 
	/bx exch def

        % (cx, cy) = Right bottom point
	alpha
	beta
        x  
	size y add 
	z 
	   xform 
	/cy exch def 
	/cx exch def

        % (dx, dy) = top point
	alpha
	beta
        sqr3o6 size mul x add  
	size 2 div y add 
	sqr6o3 size mul z add 
	   xform 
	/dy exch def 
	/dx exch def

        % Fill the 2 visible faces with different shades

        ax ay moveto    bx by lineto    dx dy lineto    closepath
        shadeleft       setgray         fill
        cx cy moveto    bx by lineto    dx dy lineto    closepath
        shaderight      setgray         fill

        % Draw the 5 visible segments

        0 setgray 0.1 72 div setlinewidth

        ax ay moveto    bx by lineto    cx cy lineto    dx dy lineto
        closepath       dx dy moveto    bx by lineto    stroke
grestore
} def

% Recursive routine to build a pyramid out of subpyramids

/buildsave { alpha beta x y z size } def
/buildrest { /size exch def 
             /z exch def 
	     /y exch def 
	     /x exch def 
	     /beta exch def
	     /alpha exch def
} def

/build {  % alpha,beta,x,y,z,size ==> --
        /size exch def 
	/z exch def 
	/y exch def 
	/x exch def
	/beta exch def
	/alpha exch def

        size MinSize lt
        {       buildsave
                alpha  beta x   y   z   size   pyramid
                buildrest
        }
        {       buildsave
                alpha  beta x   y   z   size 2 div   build
                buildrest

                buildsave
                alpha beta  x   size 2 div y add   z   size 2 div   build
                buildrest

                buildsave
		alpha
		beta
                sqr3o12 size mul x add   size 4 div y add
                sqr6o6 size mul z add   size 2 div   build
                buildrest

		alpha
		beta
                sqr3o4 size mul x add   size 4 div y add
                z   size 2 div   build
        } ifelse
} def

/go {
       Zrot 
       Yrot
       0 StartSize 
       -2 div StartSize 
       sqr6o6 mul -2 div StartSize 
       build
} def

/main {
/Zrot    1 def
/Yrot    1 def
    /Zrotchoice                              
	         [(-180)(-120)(-90)(-20)(-10)(0)(10)(20)(30)]
	         [{ /Zrot currentkey cvi store
	            /paint win send}] 
                 /new DefaultMenu send def
    /Yrotchoice                              
	         [(-180)(-120)(-100)(-80)(-60)(-50)
		 (-30)(-20)(-10)(0)(10)(20)(30)]
	         [{ /Yrot currentkey cvi store
	            /paint win send}] 
                 /new DefaultMenu send def
    /setstartsize
		 [(0.5)(1.0)(1.5)(2)(2.5)(3.0)]
	         [{ /StartSize currentkey cvr store
	            /paint win send}] 
                 /new DefaultMenu send def
    /setminsize
		 [(0.2)(0.5)(1.0)(1.5)]
	         [{ /MinSize currentkey cvr store
	            /paint win send}] 
                 /new DefaultMenu send def

    /win framebuffer /new DefaultWindow send def {
        /PaintClient {
		      gsave
		      alpha go
		      grestore
        } def		
        /FrameLabel (Receptor) def
	/PaintIcon {} def
        /ClientMenu [ 
		    (Z Rotation =>) Zrotchoice
		    (Y Rotation =>) Yrotchoice
		    (StartSize =>) setstartsize
		    (MinSize =>) setminsize
	 ] /new DefaultMenu send def
    } win send
    500 600 400 600 /reshape win send
    /map win send		
} def
main