cole@utah-cs.UUCP (Allen Cole) (03/05/86)
This is the source to the ICOSAHEDRON ROTATE program already posted in binhex
form.
(C) Copyright 1986 by the University of Utah Computer Center.
Written by John Halleck (NSS 20620)
This program was written in TML pascal.
--------------------------------------------------------------------------
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.