PROGRAM Univ_of_Utah (INPUT, OUTPUT);

{            Icosahedron display program               }
{ © Copyright 1986 University of Utah Computer Center, }
{      Written by John B. Halleck (NSS 20620)          }

{$i MemTypes.ipas  }
{$i QuickDraw.ipas }
{$i Osintf.ipas    }
{$i ToolIntf.ipas  }
{$T APPL UoUb}



CONST

   Full_Height = 128;	{ How big is our screen image? }
   Half_Height =  64;	{ Height of half of a screen image }
   Byte_Height =  16;	{ Full_Height covered divide 8}

   PI = 3.141592653;  { Pi }

   Num_VERTICES = 12; { Vertices in an Icosahedron }
   Num_FACES    = 20; { Faces in an Icosahedron    }
   Num_EDGES    = 30; { Edges in an Icosahedron    }

   Num_Views    = 20; { Rotation in how many steps?}
   


TYPE

   Transform   = Array [1..3, 1..3] of Real; { Transformation matrices }

   Coordinates = Array [1..3] of Real; { 3 space coordinates. }

   View        = Packed Array [1..Full_Height, 1..Byte_Height] of 0..255;
		 { Storage for the views. }
   
   Apoint   = Record { Information we keep for each point   }
	      DX, DY : Integer;     { Display Coordinates.  }
              Where  : Coordinates; { Original Coordinates. }
	      NowAt  : Coordinates; { Final Coordinates.    }
	      End;

   AnEdge   = Record { Information for each edge }
	      Visible:	     Boolean; { Is the edge visible?		}
	      Start, Finish: Integer; { Which vertices does it connect? }
	      End;

   Aface    = Record { Information about each face }
	      BEdges:    Array [1..3] of integer; { What bounding edges    }
	      BVert:     Array [1..3] of integer; { What corner vertices   }
	      ONormal:	 Coordinates;             { Original Surface Normal}
	      Normal:    Coordinates;             { Final Surface Normal   }
	      Shows:	 Boolean; 		  {Is it visible?          }
	      End;





VAR
   
   Index:    Integer; { General loop index}

   { How does the Icosahedron connect together? }
   Vertices: Array [1..Num_Vertices] of Apoint;
   Edges:    Array [1..Num_Edges]    of AnEdge;
   Faces:    Array [1..Num_Faces]    of Aface;

   Light:    Coordinates; {Where is the light source?}

   Patterns: Array [0..64] of Pattern; {Brightness patterns for shading}

   ImageTransform:    Transform;  { How to get to our viewing point. }
   RotationTransform: Transform;  { How far we have rotated it.      }
   TotalTransform:    Transform;  { Composition of the above.        }

   OurBitMaps  : Array [1..Num_Views] of Bitmap; { Storage for the frames }

   SystemGrafPtr: GrafPtr; { Where is TML pascal's window? }
   SystemBitMap: Bitmap;   { Copy of that windows original bitmap }
   Limits:  Rect;	   { Boundrys of the window, more or less }

   Fifth : Real;  { Fractions of a complete circle }
   Tenth : Real;

   Axis_X: Real; { Axis of rotation that we should rotate around. }
   Axis_Y: Real;
   Axis_Z: Real;

{ ******************************************************************** }

{ Identity rotation matrix }

Procedure IdentTransform (Var Atransform:Transform);
Var Row, Column: Integer;
Begin
For Row := 1 to 3 do For Column := 1 to 3 do Atransform[Row,Column] := 0.0;
For Row := 1 to 3 do Atransform[Row,Row] := 1.0
End;


{ ******************************************************************** }

{ Form rotation matrices }

{ Rotation matrices for rotation around }
{    X                 Y                  Z }

{   1   0   0        C   0   S        C   S   0   }
{   0   C   S        0   1   0       -S   C   0   }
{   0  -S   C       -S   0   C        0   0   1   }

{ Where C= COS (Angle)   and   S= SIN (angle) }

{ Around 1 means around X, 2 means around Y, and 3 means around Z}


Procedure FormRot (Angle: Real; Around: Integer; Var Result: Transform);
Var S, C: Real;
    Left, Right: Integer; { The lower and upper row and column to fill }
Begin
IdentTransform (Result);
S := SIN (Angle); C := COS (Angle);
case Around of 
 1: Begin Left:=2; Right:=3 end;
 2: Begin Left:=1; Right:=3 end;
 3: Begin Left:=1; Right:=2 end;
 end;
Result [Left, Left] := C;   Result [Left, Right] := S;
Result [Right,Left] :=-S;   Result [Right,Right] := C;
End;

{ ******************************************************************** }


{ Multiply two transformation matricies together forming a third }

Procedure TTransform (First, Second: Transform;  Var Result: Transform);
Var Row, Column: integer;
begin
For Row := 1 to 3 do
    For Column := 1 to 3 do
        Result [Row, Column] := First[Row,1]*Second[1,Column]+
	                        First[Row,2]*Second[2,Column]+
				First[Row,3]*Second[3,Column]
end;



{ ******************************************************************** }

{ Add the effect of doing a given rotation onto a transformation matrix }

Procedure AddRot (Angle: Real; Around: Integer; Var Result: Transform);
Var Temp, Final: Transform;
Begin
FormRot (Angle, Around, Temp); TTransform (Result, Temp, Final);
Result := Final
End;
{ ******************************************************************** }


{ Transform a point by the Total transformation matrix. }

Procedure TPoint (What: Coordinates; Var Into:Coordinates);
Var Dimension: Integer;
begin
For Dimension := 1 to 3 do
     Into[Dimension] := What[1]*TotalTransform[1,Dimension]+
                        What[2]*TotalTransform[2,Dimension]+
			What[3]*TotalTransform[3,Dimension]
  end;

{ ******************************************************************** }

{ Assuming the point given discribes a vector from the origin, produce }
{ a point that discribes a unit length vector from the origin.}

Procedure Normalize (Var ThePoint: Coordinates);
var
  Length: Real;
begin
Length := SQRT(ThePoint[1]*ThePoint[1]
             + ThePoint[2]*ThePoint[2]
	     + ThePoint[3]*ThePoint[3]);
ThePoint[1] := ThePoint[1] / Length;
ThePoint[2] := ThePoint[2] / Length;
ThePoint[3] := ThePoint[3] / Length
end;


{ ******************************************************************** }

PROCEDURE INITIALIZE;

var  Edges_So_Far: Integer; 

PROCEDURE INITPOINTS; { Where are the coordinates of an icosahedron? }
{ (Icosahedron with unit edges, with center at the origin) }
BEGIN
With Vertices[ 1] do begin
  Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:=-0.95105650 end;
With Vertices[ 2] do begin
  Where[1]:= 0.00000000; Where[3]:= 0.85065080; Where[2]:=-0.42532537 end;
With Vertices[ 3] do begin
  Where[1]:= 0.80901699; Where[3]:= 0.26286555; Where[2]:=-0.42532537 end;
With Vertices[ 4] do begin
  Where[1]:= 0.49999999; Where[3]:=-0.68819096; Where[2]:=-0.42532537 end;
With Vertices[ 5] do begin
  Where[1]:=-0.50000001; Where[3]:=-0.68819094; Where[2]:=-0.42532537 end;
With Vertices[ 6] do begin
  Where[1]:=-0.80901698; Where[3]:= 0.26286557; Where[2]:=-0.42532537 end;
With Vertices[ 7] do begin
  Where[1]:= 0.49999999; Where[3]:= 0.68819095; Where[2]:= 0.42532537 end;
With Vertices[ 8] do begin
  Where[1]:= 0.80901699; Where[3]:=-0.26286556; Where[2]:= 0.42532537 end;
With Vertices[ 9] do begin
  Where[1]:= 0.00000000; Where[3]:=-0.85065080; Where[2]:= 0.42532537 end;
With Vertices[10] do begin
  Where[1]:=-0.80901699; Where[3]:=-0.26286555; Where[2]:= 0.42532537 end;
With Vertices[11] do begin
  Where[1]:=-0.50000001; Where[3]:= 0.68819094; Where[2]:= 0.42532537 end;
With Vertices[12] do begin
  Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:= 0.95105650 end
END;



PROCEDURE INITFACES; { How are those vertices connected? }
BEGIN
With Faces[ 1] do begin Bvert[1]:=  1; Bvert[2]:= 3; Bvert[3]:= 2 end;
With Faces[ 2] do begin Bvert[1]:=  1; Bvert[2]:= 4; Bvert[3]:= 3 end;
With Faces[ 3] do begin Bvert[1]:=  1; Bvert[2]:= 5; Bvert[3]:= 4 end;
With Faces[ 4] do begin Bvert[1]:=  1; Bvert[2]:= 6; Bvert[3]:= 5 end;
With Faces[ 5] do begin Bvert[1]:=  1; Bvert[2]:= 2; Bvert[3]:= 6 end;
With Faces[ 6] do begin Bvert[1]:=  2; Bvert[2]:= 7; Bvert[3]:=11 end;
With Faces[ 7] do begin Bvert[1]:=  2; Bvert[2]:= 3; Bvert[3]:= 7 end;
With Faces[ 8] do begin Bvert[1]:=  3; Bvert[2]:= 8; Bvert[3]:= 7 end;
With Faces[ 9] do begin Bvert[1]:=  3; Bvert[2]:= 4; Bvert[3]:= 8 end;
With Faces[10] do begin Bvert[1]:=  4; Bvert[2]:= 9; Bvert[3]:= 8 end;
With Faces[11] do begin Bvert[1]:=  4; Bvert[2]:= 5; Bvert[3]:= 9 end;
With Faces[12] do begin Bvert[1]:=  5; Bvert[2]:=10; Bvert[3]:= 9 end;
With Faces[13] do begin Bvert[1]:=  5; Bvert[2]:= 6; Bvert[3]:=10 end;
With Faces[14] do begin Bvert[1]:=  6; Bvert[2]:=11; Bvert[3]:=10 end;
With Faces[15] do begin Bvert[1]:=  6; Bvert[2]:= 2; Bvert[3]:=11 end;
With Faces[16] do begin Bvert[1]:= 11; Bvert[2]:= 7; Bvert[3]:=12 end;
With Faces[17] do begin Bvert[1]:=  7; Bvert[2]:= 8; Bvert[3]:=12 end;
With Faces[18] do begin Bvert[1]:=  8; Bvert[2]:= 9; Bvert[3]:=12 end;
With Faces[19] do begin Bvert[1]:=  9; Bvert[2]:=10; Bvert[3]:=12 end;
With Faces[20] do begin Bvert[1]:= 10; Bvert[2]:=11; Bvert[3]:=12 end;
END;


PROCEDURE INITnormals;
{ A normal vector to a face is a vector perpendicular to the face }
{ In this case, defined to point outwards. }
var ThisFace: Integer;
  
  	{ One could compute the normal from the three edge vertices, and }
	{ in general this is correct.      But, since the Icosahedron is }
	{ defined around the origin, the normal is in the direction of   }
	{ the average of the directions to the vertices }
	Procedure FindNormal (Vertex1, Vertex2, Vertex3: Integer;
                    	  VAR Norm: Coordinates);
  	Var Index: Integer;
 	begin
  	{ Find the average of the vertices }
	For Index := 1 to 3 do
  	Norm[Index]:=(Vertices[Vertex1].Where[Index]
                     +Vertices[Vertex2].Where[Index]
	      	     +Vertices[Vertex3].Where[Index])/3.0;
  	{ Make it a unit normal }
	Normalize (Norm)
  	end;
Begin
{ For each face, find the surface normal }
for ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
    FindNormal (Bvert[1],Bvert[2],Bvert[3],ONormal)
End;



PROCEDURE INITEDGES; { Given the face information, derive the edges }
var
 ThisFace: Integer;

     { IF an edge is not in the table, add it. }
     Function ADDedge (Vertex1, Vertex2: Integer):Integer;
     Var
     	First, Second: Integer;
     	ThisEdge: Integer;
     	Found: Boolean;
     Begin
     { Put edge in standard order }
     if Vertex1<Vertex2 then Begin First := Vertex1; Second := Vertex2 end
                        else Begin First := Vertex2; Second := Vertex1 end;
     
     { Search the table for it }
     ThisEdge := 0; Found:= False;
     Repeat
     ThisEdge := ThisEdge+1;
     if ThisEdge<=Edges_so_far then With Edges[ThisEdge] do 
        Found := (First = Start) AND (Second = Finish);
     until (ThisEdge>=Edges_so_far) OR FOUND;
     
     { If we don't have one, add it on. }
     if Not Found then
        Begin
        Edges_So_far := Edges_So_far + 1;  ThisEdge := Edges_So_far;
        With Edges[ThisEdge] do begin Start:=First; Finish:=Second end
        end;
     
     { Return an index to it.}
     AddEdge := ThisEdge
     End;

BEGIN
Edges_So_Far := 0;

{ For each face, add its edges to the list }
For ThisFace := 1 to Num_Faces do With Faces [ThisFace] do
    Begin
     Bedges[1] := AddEdge (Bvert[1], Bvert[2]);
     Bedges[2] := AddEdge (Bvert[2], Bvert[3]);
     Bedges[3] := AddEdge (Bvert[1], Bvert[3])
    End;
END;



{ Come up with some shading patterns. }

Procedure InitPat;
var Row, Column, Entry, Sample: integer;
    Loc, Temp, Size: Integer;
    TwoToThe: Array [0..7] of 0..255;
Begin
{ Initialize a table of powers of 2 }
Sample := 1;For Temp := 0 to 7 do Begin
      TwoToThe [Temp] := Sample;
      Sample := Sample + Sample
      End;

{ Start shading patterns Black }
For Entry := 0 to 64 do For Row := 0 to 7 do Patterns[Entry][Row] := 0;

{ Place dots in as evenly as practical }
{ The Macintosh has the convention that a bit =1 is black, and a }
{ a bit = 0 is white. }
For Entry := 63 Downto 0 do
    Begin
    Loc:= Entry; Row:=0; Column:=0; Size:=8;
    For Temp := 1 to 3 do
       Begin
          Row := Row+Row;  Column := Column+Column;
	  case Loc Mod 4 of
	       { Dither matrix recursively applied: }
	       { 0 3 }
	       { 2 1 }
	    0: ;
	    1: Begin Row:=Row+1; Column := Column+1 End;
	    2:       Row:=Row+1;
	    3:                   Column := Column+1;
	  end;
	  Loc := Loc div 4
       end;
    Sample := TwoToThe [Column];
    For Temp := Entry Downto 0 do
        Patterns[Temp][Row]:=Patterns[Temp][Row]+Sample
    end
end;



{ Start out with no transformations }
Procedure InitTransforms;
Begin
IdentTransform (TotalTransform);
IdentTransform (RotationTransform);
IdentTransform (ImageTransform);
End;



{ Get memory for the frames }
Procedure InitFrames;
Type Kludge = Record
	      Case Boolean of
	      true:   (ViewP: ^View);
	      false:  (NoneP: QDPtr);
	      end;
Var
  Index: Integer;
  Hack:  Kludge;
Begin
{ Obtain and Initialize frame records }
For Index := 1 to Num_Views do With OurBitMaps [Index] do
    Begin
    Bounds   := Limits;
    RowBytes := Byte_Height;
    New (Hack.ViewP); BaseAddr := Hack.NoneP
    End;
end;


{ What axis should this thing seem to rotate around? }
Procedure InitAxis;
begin

{ The direction }
Axis_X := -Tenth;
Axis_Y :=  0.0;
Axis_Z :=  Tenth;

{ Matrix to get us there }
FormRot (Axis_X, 1, ImageTransform);
AddRot  (Axis_Y, 2, ImageTransform);
AddRot  (Axis_Z, 3, ImageTransform);
end;



Procedure InitLight; { Set up the light source }
{ Shading is going to be Cosine shading.  Brightness is proportional to }
{ the cosine of the angle between Bright vector and the Eye.  Bright    }
{ Vector is the direction of the bright spot on the object, which is    }
{ Half way between the Eye and the light. }

Var  Eye: Coordinates; { Direction to the Eye }
Begin

{ Intended direction of light}
Light[1] :=  3.0;   Light[2] := -1.0;    Light[3] := 1.0;
Normalize (Light); { Unit directions only. }

{ Direction of Eye. Forced by physical model, Don't Change this. }
Eye  [1] :=  0.0;   Eye  [2] :=  0.0;    Eye  [3] := 1.0;
Normalize (Eye);

{ Average of unit vector to the eye and the light }
Light[1]:=(Light[1]+Eye[1])/2.0;
Light[2]:=(Light[2]+Eye[2])/2.0;
Light[3]:=(Light[3]+Eye[3])/2.0;
Normalize (Light)      { Make it a unit direction}
End;




BEGIN { Get everything we need }
Fifth := (2*PI)/5.0; Tenth := PI/5.0;
GetPort (SystemGrafPtr); SystemBitMap := SystemGrafPtr^.PortBits;
SetRect (Limits, 0, 0, Full_Height, Full_Height);
INITPOINTS; INITFACES; InitNormals; INITEDGES; InitPat;
InitTransforms; InitFrames; InitAxis; InitLight
END;


{ ******************************************************************** }

{ Find the visible faces and edges }

Procedure FindVisible;
Var
  ThisFace: Integer; ThisEdge: Integer;
begin
For ThisEdge := 1 to Num_Edges do With Edges[ThisEdge] do Visible := False;

{ For each face, if the face is visible, mark it and it's edges visible }
For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
   Begin
   { Assuming that we have a CONVEX object, Then the face pointing towards }
   { us means that it MUST be visible }
   Shows := Normal [3] >= 0.0;
   if Shows then
      begin
        Edges[Bedges[1]].Visible:=true;
	Edges[Bedges[2]].Visible:=true;
	Edges[Bedges[3]].Visible:=true
      end
   End
end;

{ ******************************************************************** }

{ Compute Display Coordinates for each point}
{ (with the current transformation) }

Procedure SetDisplay;
Var
   ThisPoint: Integer;
Begin
{ We assume that the Object is defined centered around the origin. }
For ThisPoint := 1 to Num_Vertices do With Vertices[ThisPoint] do
   Begin
   DX := ROUND ((NowAt[1] + 1.0) * Half_Height);
   DY := ROUND ((NowAt[2] + 1.0) * Half_Height)
   End;
End;

{ ******************************************************************** }

{ Display the visible edges }

Procedure DrawEdges;
Var
   ThisEdge : Integer;
Begin
SetDisplay;
For ThisEdge := 1 to Num_Edges Do With Edges[ThisEdge] do if Visible then
    BEGIN
    With Vertices[Start]  do MoveTo (DX, DY);
    With Vertices[Finish] do LineTo (DX, DY)
    END
End;

{ ******************************************************************** }

{ Compute the brightnesses of the faces. }

Procedure ShadeFaces;
Var
  ThisFace:Integer;
  Aregion: RgnHandle;
  Level:Integer;

	Function Bright (PlaneNorm, LightNorm: Coordinates):Real;
	begin
	{ Brightness should be proportional to the cosine of the angle }
	{ between the face normal and the Bright spot.  The dot        }
	{ product of the Normal and the Bright spot vectors would give }
	{ Cosine angle * Length Bright * Length Face Normal,           }
	{ But since we have arranged for both lengths to be 1, this    }
	{ gives just Cosine Angle which is what we want.               }
	Bright := ((PlaneNorm[1]*LightNorm[1] +
	            PlaneNorm[2]*LightNorm[2] +
		    PlaneNorm[3]*LightNorm[3] ) + 1.0)/2.0
	{ We scale the value to lie between 0 (Black) and 1 (White)    }
	end;
Begin
Aregion:=NewRgn;
{ For each visible face... }
For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do if Shows then
    Begin
    
    { Form the region for the face for the MacIntosh primitives }
    OpenRgn;
    With Vertices[Bvert[3]] do MoveTo (DX, DY);
    With Vertices[Bvert[1]] do LineTo (DX, DY);
    With Vertices[Bvert[2]] do LineTo (DX, DY);
    With Vertices[Bvert[3]] do Lineto (DX, DY);
    CloseRgn (Aregion);
    
    { Fill with the computed brightness }
    Level := Round (Bright (Normal, Light) * 64.0);
    FillRgn (Aregion, Patterns[Level]);
    SetEmptyRgn(Aregion)
    end;
DisposeRgn(Aregion)
End;

{ ******************************************************************** }


{ Transform the faces and vertices by the current transformation }

Procedure DoTransform;
Var
  ThisFace, ThisPoint: Integer;
  Begin
For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
    TPoint (ONormal, Normal);
For ThisPoint:= 1 to Num_Vertices do With Vertices[ThisPoint] do
    Tpoint (Where, NowAt)
End;

{ ******************************************************************** }

{ Build the current transformation from its parts, apply the transform, }
{ and compute the visible faces and edges. }

Procedure SetupFrame;
Begin 
TTransform (RotationTransform, ImageTransform, TotalTransform);
DoTransform; SetDisplay; FindVisible
End;

{ ******************************************************************** }

{ Draw one frame }
Procedure OutFrame;
Begin
SetupFrame; FillRect (Limits, Patterns[0]); ShadeFaces; DrawEdges
end;

{ ******************************************************************** }

{ Draw the frames of the Object in each orientation. }

Procedure ComputeFrames;
Var
  Index: Integer;
  This_Angle, Step_Angle: Real;
Begin
Step_Angle := Fifth / Num_Views; { Assume 5 fold rotational symetry }
For Index:=1 to Num_Views do
    Begin
       This_Angle := Index * Step_Angle;
       FormRot (This_Angle, 2, RotationTransform);
       SetPortBits (OurBitMaps[Index]);
       OutFrame;
       CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Limits, srcCopy,
            SystemGrafPtr^.visRgn);
    end;
SetPortBits (SystemBitMap)
end;


{ ******************************************************************** }

{ Thumb through the frames, copying each to the screen.  Change the }
{ Aiming point (and thumb direction ) to mimic bouncing }

Procedure Thumb;
Var Index: Integer;
    Dest: Rect;
    Offset_X, Direction_X: Integer;
    Offset_Y, Direction_Y: Integer;
    Direction_Rot: Integer;
    Bounce: Rect;
Begin
Index   := 0; Direction_Rot:= 1;
Offset_X:= 0; Direction_X  := 1;
Offset_Y:= 0; Direction_Y  := 1;
SetOrigin (0,0);

{ Use TML pascals window }
Bounce := SystemGrafPtr^.PortBits.Bounds;
Bounce.Right := Bounce.Right - Full_Height;
Bounce.Bottom := Bounce.Bottom - Full_Height;
Dest := Limits;

While Not Button do
  Begin
{ Select frame, Force wrap if off ends of frame list. }
  Index := Index + Direction_Rot;
  If Index > Num_Views then Index := 1 else
  if Index < 1         then Index := Num_Views;
  
{ Copy this frame to screen }
  CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Dest, srcCopy,
            SystemGrafPtr^.visRgn);

{ Update X, check for bounce }
  Offset_X := Offset_X + direction_X;
  if (Offset_X >Bounce.Right) or (Offset_X <Bounce.Left) Then
     Begin
     Direction_X := -Direction_X;
     Direction_Rot := Direction_X*Direction_Y;
     end;

{ Update Y, check for bounce }
  Offset_Y := Offset_Y + direction_Y;
  if (Offset_Y >Bounce.Bottom) or (Offset_Y <Bounce.Top) Then
     Begin
     Direction_Rot := Direction_X*Direction_Y;
     Direction_Y := -Direction_Y;
     end;

{ Update current location for transfer. }
  Dest := Limits;
  OffsetRect (Dest, Offset_X, Offset_Y);

  End;

While Button do { Nothing };
end;


{ ******************************************************************** }



BEGIN
ObscureCursor;
Writeln ('                Icosahedron Version 0.6');
Writeln ('© Copyright 1986 By the University of Utah Computer Center');
Writeln ('          Written by John Halleck  (NSS 20620)');
INITIALIZE;
For Index := 64 Downto 0 do
    FillRect (SystemGrafPtr^.PortBits.Bounds, Patterns[Index]);
BackPat (Patterns[0]);
SetupFrame;
PenPat (Patterns[64]); DrawEdges;
PenPat (Patterns[0]);  ShadeFaces; DrawEdges;
ComputeFrames;
Thumb
END.