home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / code / p_icosah.sit < prev    next >
Encoding:
Text File  |  1988-06-20  |  21.2 KB  |  715 lines
  1. 18-Jun-88 14:32:58-MDT,22377;000000000000
  2. Return-Path: <u-lchoqu%sunset@cs.utah.edu>
  3. Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:32:30 MDT
  4. Received: by cs.utah.edu (5.54/utah-2.0-cs)
  5.     id AA22280; Sat, 18 Jun 88 14:32:32 MDT
  6. Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
  7.     id AA24655; Sat, 18 Jun 88 14:32:28 MDT
  8. Date: Sat, 18 Jun 88 14:32:28 MDT
  9. From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
  10. Message-Id: <8806182032.AA24655@sunset.utah.edu>
  11. To: rthum@simtel20.arpa
  12. Subject: Icosahedron6.pas
  13.  
  14. PROGRAM Univ_of_Utah (INPUT, OUTPUT);
  15.  
  16. {            Icosahedron display program               }
  17. { (c) Copyright 1986 University of Utah Computer Center, }
  18. {      Written by John B. Halleck (NSS 20620)          }
  19.  
  20. {$i MemTypes.ipas  }
  21. {$i QuickDraw.ipas }
  22. {$i Osintf.ipas    }
  23. {$i ToolIntf.ipas  }
  24. {$T APPL UoUb}
  25.  
  26.  
  27.  
  28. CONST
  29.  
  30.    Full_Height = 128;    { How big is our screen image? }
  31.    Half_Height =  64;    { Height of half of a screen image }
  32.    Byte_Height =  16;    { Full_Height covered divide 8}
  33.  
  34.    PI = 3.141592653;  { Pi }
  35.  
  36.    Num_VERTICES = 12; { Vertices in an Icosahedron }
  37.    Num_FACES    = 20; { Faces in an Icosahedron    }
  38.    Num_EDGES    = 30; { Edges in an Icosahedron    }
  39.  
  40.    Num_Views    = 20; { Rotation in how many steps?}
  41.    
  42.  
  43.  
  44. TYPE
  45.  
  46.    Transform   = Array [1..3, 1..3] of Real; { Transformation matrices }
  47.  
  48.    Coordinates = Array [1..3] of Real; { 3 space coordinates. }
  49.  
  50.    View        = Packed Array [1..Full_Height, 1..Byte_Height] of 0..255;
  51.          { Storage for the views. }
  52.    
  53.    Apoint   = Record { Information we keep for each point   }
  54.           DX, DY : Integer;     { Display Coordinates.  }
  55.               Where  : Coordinates; { Original Coordinates. }
  56.           NowAt  : Coordinates; { Final Coordinates.    }
  57.           End;
  58.  
  59.    AnEdge   = Record { Information for each edge }
  60.           Visible:         Boolean; { Is the edge visible?        }
  61.           Start, Finish: Integer; { Which vertices does it connect? }
  62.           End;
  63.  
  64.    Aface    = Record { Information about each face }
  65.           BEdges:    Array [1..3] of integer; { What bounding edges    }
  66.           BVert:     Array [1..3] of integer; { What corner vertices   }
  67.           ONormal:     Coordinates;             { Original Surface Normal}
  68.           Normal:    Coordinates;             { Final Surface Normal   }
  69.           Shows:     Boolean;           {Is it visible?          }
  70.           End;
  71.  
  72.  
  73.  
  74.  
  75.  
  76. VAR
  77.    
  78.    Index:    Integer; { General loop index}
  79.  
  80.    { How does the Icosahedron connect together? }
  81.    Vertices: Array [1..Num_Vertices] of Apoint;
  82.    Edges:    Array [1..Num_Edges]    of AnEdge;
  83.    Faces:    Array [1..Num_Faces]    of Aface;
  84.  
  85.    Light:    Coordinates; {Where is the light source?}
  86.  
  87.    Patterns: Array [0..64] of Pattern; {Brightness patterns for shading}
  88.  
  89.    ImageTransform:    Transform;  { How to get to our viewing point. }
  90.    RotationTransform: Transform;  { How far we have rotated it.      }
  91.    TotalTransform:    Transform;  { Composition of the above.        }
  92.  
  93.    OurBitMaps  : Array [1..Num_Views] of Bitmap; { Storage for the frames }
  94.  
  95.    SystemGrafPtr: GrafPtr; { Where is TML pascal's window? }
  96.    SystemBitMap: Bitmap;   { Copy of that windows original bitmap }
  97.    Limits:  Rect;       { Boundrys of the window, more or less }
  98.  
  99.    Fifth : Real;  { Fractions of a complete circle }
  100.    Tenth : Real;
  101.  
  102.    Axis_X: Real; { Axis of rotation that we should rotate around. }
  103.    Axis_Y: Real;
  104.    Axis_Z: Real;
  105.  
  106. { ******************************************************************** }
  107.  
  108. { Identity rotation matrix }
  109.  
  110. Procedure IdentTransform (Var Atransform:Transform);
  111. Var Row, Column: Integer;
  112. Begin
  113. For Row := 1 to 3 do For Column := 1 to 3 do Atransform[Row,Column] := 0.0;
  114. For Row := 1 to 3 do Atransform[Row,Row] := 1.0
  115. End;
  116.  
  117.  
  118. { ******************************************************************** }
  119.  
  120. { Form rotation matrices }
  121.  
  122. { Rotation matrices for rotation around }
  123. {    X                 Y                  Z }
  124.  
  125. {   1   0   0        C   0   S        C   S   0   }
  126. {   0   C   S        0   1   0       -S   C   0   }
  127. {   0  -S   C       -S   0   C        0   0   1   }
  128.  
  129. { Where C= COS (Angle)   and   S= SIN (angle) }
  130.  
  131. { Around 1 means around X, 2 means around Y, and 3 means around Z}
  132.  
  133.  
  134. Procedure FormRot (Angle: Real; Around: Integer; Var Result: Transform);
  135. Var S, C: Real;
  136.     Left, Right: Integer; { The lower and upper row and column to fill }
  137. Begin
  138. IdentTransform (Result);
  139. S := SIN (Angle); C := COS (Angle);
  140. case Around of 
  141.  1: Begin Left:=2; Right:=3 end;
  142.  2: Begin Left:=1; Right:=3 end;
  143.  3: Begin Left:=1; Right:=2 end;
  144.  end;
  145. Result [Left, Left] := C;   Result [Left, Right] := S;
  146. Result [Right,Left] :=-S;   Result [Right,Right] := C;
  147. End;
  148.  
  149. { ******************************************************************** }
  150.  
  151.  
  152. { Multiply two transformation matricies together forming a third }
  153.  
  154. Procedure TTransform (First, Second: Transform;  Var Result: Transform);
  155. Var Row, Column: integer;
  156. begin
  157. For Row := 1 to 3 do
  158.     For Column := 1 to 3 do
  159.         Result [Row, Column] := First[Row,1]*Second[1,Column]+
  160.                             First[Row,2]*Second[2,Column]+
  161.                 First[Row,3]*Second[3,Column]
  162. end;
  163.  
  164.  
  165.  
  166. { ******************************************************************** }
  167.  
  168. { Add the effect of doing a given rotation onto a transformation matrix }
  169.  
  170. Procedure AddRot (Angle: Real; Around: Integer; Var Result: Transform);
  171. Var Temp, Final: Transform;
  172. Begin
  173. FormRot (Angle, Around, Temp); TTransform (Result, Temp, Final);
  174. Result := Final
  175. End;
  176. { ******************************************************************** }
  177.  
  178.  
  179. { Transform a point by the Total transformation matrix. }
  180.  
  181. Procedure TPoint (What: Coordinates; Var Into:Coordinates);
  182. Var Dimension: Integer;
  183. begin
  184. For Dimension := 1 to 3 do
  185.      Into[Dimension] := What[1]*TotalTransform[1,Dimension]+
  186.                         What[2]*TotalTransform[2,Dimension]+
  187.             What[3]*TotalTransform[3,Dimension]
  188.   end;
  189.  
  190. { ******************************************************************** }
  191.  
  192. { Assuming the point given discribes a vector from the origin, produce }
  193. { a point that discribes a unit length vector from the origin.}
  194.  
  195. Procedure Normalize (Var ThePoint: Coordinates);
  196. var
  197.   Length: Real;
  198. begin
  199. Length := SQRT(ThePoint[1]*ThePoint[1]
  200.              + ThePoint[2]*ThePoint[2]
  201.          + ThePoint[3]*ThePoint[3]);
  202. ThePoint[1] := ThePoint[1] / Length;
  203. ThePoint[2] := ThePoint[2] / Length;
  204. ThePoint[3] := ThePoint[3] / Length
  205. end;
  206.  
  207.  
  208. { ******************************************************************** }
  209.  
  210. PROCEDURE INITIALIZE;
  211.  
  212. var  Edges_So_Far: Integer; 
  213.  
  214. PROCEDURE INITPOINTS; { Where are the coordinates of an icosahedron? }
  215. { (Icosahedron with unit edges, with center at the origin) }
  216. BEGIN
  217. With Vertices[ 1] do begin
  218.   Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:=-0.95105650 end;
  219. With Vertices[ 2] do begin
  220.   Where[1]:= 0.00000000; Where[3]:= 0.85065080; Where[2]:=-0.42532537 end;
  221. With Vertices[ 3] do begin
  222.   Where[1]:= 0.80901699; Where[3]:= 0.26286555; Where[2]:=-0.42532537 end;
  223. With Vertices[ 4] do begin
  224.   Where[1]:= 0.49999999; Where[3]:=-0.68819096; Where[2]:=-0.42532537 end;
  225. With Vertices[ 5] do begin
  226.   Where[1]:=-0.50000001; Where[3]:=-0.68819094; Where[2]:=-0.42532537 end;
  227. With Vertices[ 6] do begin
  228.   Where[1]:=-0.80901698; Where[3]:= 0.26286557; Where[2]:=-0.42532537 end;
  229. With Vertices[ 7] do begin
  230.   Where[1]:= 0.49999999; Where[3]:= 0.68819095; Where[2]:= 0.42532537 end;
  231. With Vertices[ 8] do begin
  232.   Where[1]:= 0.80901699; Where[3]:=-0.26286556; Where[2]:= 0.42532537 end;
  233. With Vertices[ 9] do begin
  234.   Where[1]:= 0.00000000; Where[3]:=-0.85065080; Where[2]:= 0.42532537 end;
  235. With Vertices[10] do begin
  236.   Where[1]:=-0.80901699; Where[3]:=-0.26286555; Where[2]:= 0.42532537 end;
  237. With Vertices[11] do begin
  238.   Where[1]:=-0.50000001; Where[3]:= 0.68819094; Where[2]:= 0.42532537 end;
  239. With Vertices[12] do begin
  240.   Where[1]:= 0.00000000; Where[3]:= 0.00000000; Where[2]:= 0.95105650 end
  241. END;
  242.  
  243.  
  244.  
  245. PROCEDURE INITFACES; { How are those vertices connected? }
  246. BEGIN
  247. With Faces[ 1] do begin Bvert[1]:=  1; Bvert[2]:= 3; Bvert[3]:= 2 end;
  248. With Faces[ 2] do begin Bvert[1]:=  1; Bvert[2]:= 4; Bvert[3]:= 3 end;
  249. With Faces[ 3] do begin Bvert[1]:=  1; Bvert[2]:= 5; Bvert[3]:= 4 end;
  250. With Faces[ 4] do begin Bvert[1]:=  1; Bvert[2]:= 6; Bvert[3]:= 5 end;
  251. With Faces[ 5] do begin Bvert[1]:=  1; Bvert[2]:= 2; Bvert[3]:= 6 end;
  252. With Faces[ 6] do begin Bvert[1]:=  2; Bvert[2]:= 7; Bvert[3]:=11 end;
  253. With Faces[ 7] do begin Bvert[1]:=  2; Bvert[2]:= 3; Bvert[3]:= 7 end;
  254. With Faces[ 8] do begin Bvert[1]:=  3; Bvert[2]:= 8; Bvert[3]:= 7 end;
  255. With Faces[ 9] do begin Bvert[1]:=  3; Bvert[2]:= 4; Bvert[3]:= 8 end;
  256. With Faces[10] do begin Bvert[1]:=  4; Bvert[2]:= 9; Bvert[3]:= 8 end;
  257. With Faces[11] do begin Bvert[1]:=  4; Bvert[2]:= 5; Bvert[3]:= 9 end;
  258. With Faces[12] do begin Bvert[1]:=  5; Bvert[2]:=10; Bvert[3]:= 9 end;
  259. With Faces[13] do begin Bvert[1]:=  5; Bvert[2]:= 6; Bvert[3]:=10 end;
  260. With Faces[14] do begin Bvert[1]:=  6; Bvert[2]:=11; Bvert[3]:=10 end;
  261. With Faces[15] do begin Bvert[1]:=  6; Bvert[2]:= 2; Bvert[3]:=11 end;
  262. With Faces[16] do begin Bvert[1]:= 11; Bvert[2]:= 7; Bvert[3]:=12 end;
  263. With Faces[17] do begin Bvert[1]:=  7; Bvert[2]:= 8; Bvert[3]:=12 end;
  264. With Faces[18] do begin Bvert[1]:=  8; Bvert[2]:= 9; Bvert[3]:=12 end;
  265. With Faces[19] do begin Bvert[1]:=  9; Bvert[2]:=10; Bvert[3]:=12 end;
  266. With Faces[20] do begin Bvert[1]:= 10; Bvert[2]:=11; Bvert[3]:=12 end;
  267. END;
  268.  
  269.  
  270. PROCEDURE INITnormals;
  271. { A normal vector to a face is a vector perpendicular to the face }
  272. { In this case, defined to point outwards. }
  273. var ThisFace: Integer;
  274.   
  275.       { One could compute the normal from the three edge vertices, and }
  276.     { in general this is correct.      But, since the Icosahedron is }
  277.     { defined around the origin, the normal is in the direction of   }
  278.     { the average of the directions to the vertices }
  279.     Procedure FindNormal (Vertex1, Vertex2, Vertex3: Integer;
  280.                           VAR Norm: Coordinates);
  281.       Var Index: Integer;
  282.      begin
  283.       { Find the average of the vertices }
  284.     For Index := 1 to 3 do
  285.       Norm[Index]:=(Vertices[Vertex1].Where[Index]
  286.                      +Vertices[Vertex2].Where[Index]
  287.                    +Vertices[Vertex3].Where[Index])/3.0;
  288.       { Make it a unit normal }
  289.     Normalize (Norm)
  290.       end;
  291. Begin
  292. { For each face, find the surface normal }
  293. for ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  294.     FindNormal (Bvert[1],Bvert[2],Bvert[3],ONormal)
  295. End;
  296.  
  297.  
  298.  
  299. PROCEDURE INITEDGES; { Given the face information, derive the edges }
  300. var
  301.  ThisFace: Integer;
  302.  
  303.      { IF an edge is not in the table, add it. }
  304.      Function ADDedge (Vertex1, Vertex2: Integer):Integer;
  305.      Var
  306.          First, Second: Integer;
  307.          ThisEdge: Integer;
  308.          Found: Boolean;
  309.      Begin
  310.      { Put edge in standard order }
  311.      if Vertex1<Vertex2 then Begin First := Vertex1; Second := Vertex2 end
  312.                         else Begin First := Vertex2; Second := Vertex1 end;
  313.      
  314.      { Search the table for it }
  315.      ThisEdge := 0; Found:= False;
  316.      Repeat
  317.      ThisEdge := ThisEdge+1;
  318.      if ThisEdge<=Edges_so_far then With Edges[ThisEdge] do 
  319.         Found := (First = Start) AND (Second = Finish);
  320.      until (ThisEdge>=Edges_so_far) OR FOUND;
  321.      
  322.      { If we don't have one, add it on. }
  323.      if Not Found then
  324.         Begin
  325.         Edges_So_far := Edges_So_far + 1;  ThisEdge := Edges_So_far;
  326.         With Edges[ThisEdge] do begin Start:=First; Finish:=Second end
  327.         end;
  328.      
  329.      { Return an index to it.}
  330.      AddEdge := ThisEdge
  331.      End;
  332.  
  333. BEGIN
  334. Edges_So_Far := 0;
  335.  
  336. { For each face, add its edges to the list }
  337. For ThisFace := 1 to Num_Faces do With Faces [ThisFace] do
  338.     Begin
  339.      Bedges[1] := AddEdge (Bvert[1], Bvert[2]);
  340.      Bedges[2] := AddEdge (Bvert[2], Bvert[3]);
  341.      Bedges[3] := AddEdge (Bvert[1], Bvert[3])
  342.     End;
  343. END;
  344.  
  345.  
  346.  
  347. { Come up with some shading patterns. }
  348.  
  349. Procedure InitPat;
  350. var Row, Column, Entry, Sample: integer;
  351.     Loc, Temp, Size: Integer;
  352.     TwoToThe: Array [0..7] of 0..255;
  353. Begin
  354. { Initialize a table of powers of 2 }
  355. Sample := 1;For Temp := 0 to 7 do Begin
  356.       TwoToThe [Temp] := Sample;
  357.       Sample := Sample + Sample
  358.       End;
  359.  
  360. { Start shading patterns Black }
  361. For Entry := 0 to 64 do For Row := 0 to 7 do Patterns[Entry][Row] := 0;
  362.  
  363. { Place dots in as evenly as practical }
  364. { The Macintosh has the convention that a bit =1 is black, and a }
  365. { a bit = 0 is white. }
  366. For Entry := 63 Downto 0 do
  367.     Begin
  368.     Loc:= Entry; Row:=0; Column:=0; Size:=8;
  369.     For Temp := 1 to 3 do
  370.        Begin
  371.           Row := Row+Row;  Column := Column+Column;
  372.       case Loc Mod 4 of
  373.            { Dither matrix recursively applied: }
  374.            { 0 3 }
  375.            { 2 1 }
  376.         0: ;
  377.         1: Begin Row:=Row+1; Column := Column+1 End;
  378.         2:       Row:=Row+1;
  379.         3:                   Column := Column+1;
  380.       end;
  381.       Loc := Loc div 4
  382.        end;
  383.     Sample := TwoToThe [Column];
  384.     For Temp := Entry Downto 0 do
  385.         Patterns[Temp][Row]:=Patterns[Temp][Row]+Sample
  386.     end
  387. end;
  388.  
  389.  
  390.  
  391. { Start out with no transformations }
  392. Procedure InitTransforms;
  393. Begin
  394. IdentTransform (TotalTransform);
  395. IdentTransform (RotationTransform);
  396. IdentTransform (ImageTransform);
  397. End;
  398.  
  399.  
  400.  
  401. { Get memory for the frames }
  402. Procedure InitFrames;
  403. Type Kludge = Record
  404.           Case Boolean of
  405.           true:   (ViewP: ^View);
  406.           false:  (NoneP: QDPtr);
  407.           end;
  408. Var
  409.   Index: Integer;
  410.   Hack:  Kludge;
  411. Begin
  412. { Obtain and Initialize frame records }
  413. For Index := 1 to Num_Views do With OurBitMaps [Index] do
  414.     Begin
  415.     Bounds   := Limits;
  416.     RowBytes := Byte_Height;
  417.     New (Hack.ViewP); BaseAddr := Hack.NoneP
  418.     End;
  419. end;
  420.  
  421.  
  422. { What axis should this thing seem to rotate around? }
  423. Procedure InitAxis;
  424. begin
  425.  
  426. { The direction }
  427. Axis_X := -Tenth;
  428. Axis_Y :=  0.0;
  429. Axis_Z :=  Tenth;
  430.  
  431. { Matrix to get us there }
  432. FormRot (Axis_X, 1, ImageTransform);
  433. AddRot  (Axis_Y, 2, ImageTransform);
  434. AddRot  (Axis_Z, 3, ImageTransform);
  435. end;
  436.  
  437.  
  438.  
  439. Procedure InitLight; { Set up the light source }
  440. { Shading is going to be Cosine shading.  Brightness is proportional to }
  441. { the cosine of the angle between Bright vector and the Eye.  Bright    }
  442. { Vector is the direction of the bright spot on the object, which is    }
  443. { Half way between the Eye and the light. }
  444.  
  445. Var  Eye: Coordinates; { Direction to the Eye }
  446. Begin
  447.  
  448. { Intended direction of light}
  449. Light[1] :=  3.0;   Light[2] := -1.0;    Light[3] := 1.0;
  450. Normalize (Light); { Unit directions only. }
  451.  
  452. { Direction of Eye. Forced by physical model, Don't Change this. }
  453. Eye  [1] :=  0.0;   Eye  [2] :=  0.0;    Eye  [3] := 1.0;
  454. Normalize (Eye);
  455.  
  456. { Average of unit vector to the eye and the light }
  457. Light[1]:=(Light[1]+Eye[1])/2.0;
  458. Light[2]:=(Light[2]+Eye[2])/2.0;
  459. Light[3]:=(Light[3]+Eye[3])/2.0;
  460. Normalize (Light)      { Make it a unit direction}
  461. End;
  462.  
  463.  
  464.  
  465.  
  466. BEGIN { Get everything we need }
  467. Fifth := (2*PI)/5.0; Tenth := PI/5.0;
  468. GetPort (SystemGrafPtr); SystemBitMap := SystemGrafPtr^.PortBits;
  469. SetRect (Limits, 0, 0, Full_Height, Full_Height);
  470. INITPOINTS; INITFACES; InitNormals; INITEDGES; InitPat;
  471. InitTransforms; InitFrames; InitAxis; InitLight
  472. END;
  473.  
  474.  
  475. { ******************************************************************** }
  476.  
  477. { Find the visible faces and edges }
  478.  
  479. Procedure FindVisible;
  480. Var
  481.   ThisFace: Integer; ThisEdge: Integer;
  482. begin
  483. For ThisEdge := 1 to Num_Edges do With Edges[ThisEdge] do Visible := False;
  484.  
  485. { For each face, if the face is visible, mark it and it's edges visible }
  486. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  487.    Begin
  488.    { Assuming that we have a CONVEX object, Then the face pointing towards }
  489.    { us means that it MUST be visible }
  490.    Shows := Normal [3] >= 0.0;
  491.    if Shows then
  492.       begin
  493.         Edges[Bedges[1]].Visible:=true;
  494.     Edges[Bedges[2]].Visible:=true;
  495.     Edges[Bedges[3]].Visible:=true
  496.       end
  497.    End
  498. end;
  499.  
  500. { ******************************************************************** }
  501.  
  502. { Compute Display Coordinates for each point}
  503. { (with the current transformation) }
  504.  
  505. Procedure SetDisplay;
  506. Var
  507.    ThisPoint: Integer;
  508. Begin
  509. { We assume that the Object is defined centered around the origin. }
  510. For ThisPoint := 1 to Num_Vertices do With Vertices[ThisPoint] do
  511.    Begin
  512.    DX := ROUND ((NowAt[1] + 1.0) * Half_Height);
  513.    DY := ROUND ((NowAt[2] + 1.0) * Half_Height)
  514.    End;
  515. End;
  516.  
  517. { ******************************************************************** }
  518.  
  519. { Display the visible edges }
  520.  
  521. Procedure DrawEdges;
  522. Var
  523.    ThisEdge : Integer;
  524. Begin
  525. SetDisplay;
  526. For ThisEdge := 1 to Num_Edges Do With Edges[ThisEdge] do if Visible then
  527.     BEGIN
  528.     With Vertices[Start]  do MoveTo (DX, DY);
  529.     With Vertices[Finish] do LineTo (DX, DY)
  530.     END
  531. End;
  532.  
  533. { ******************************************************************** }
  534.  
  535. { Compute the brightnesses of the faces. }
  536.  
  537. Procedure ShadeFaces;
  538. Var
  539.   ThisFace:Integer;
  540.   Aregion: RgnHandle;
  541.   Level:Integer;
  542.  
  543.     Function Bright (PlaneNorm, LightNorm: Coordinates):Real;
  544.     begin
  545.     { Brightness should be proportional to the cosine of the angle }
  546.     { between the face normal and the Bright spot.  The dot        }
  547.     { product of the Normal and the Bright spot vectors would give }
  548.     { Cosine angle * Length Bright * Length Face Normal,           }
  549.     { But since we have arranged for both lengths to be 1, this    }
  550.     { gives just Cosine Angle which is what we want.               }
  551.     Bright := ((PlaneNorm[1]*LightNorm[1] +
  552.                 PlaneNorm[2]*LightNorm[2] +
  553.             PlaneNorm[3]*LightNorm[3] ) + 1.0)/2.0
  554.     { We scale the value to lie between 0 (Black) and 1 (White)    }
  555.     end;
  556. Begin
  557. Aregion:=NewRgn;
  558. { For each visible face... }
  559. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do if Shows then
  560.     Begin
  561.     
  562.     { Form the region for the face for the MacIntosh primitives }
  563.     OpenRgn;
  564.     With Vertices[Bvert[3]] do MoveTo (DX, DY);
  565.     With Vertices[Bvert[1]] do LineTo (DX, DY);
  566.     With Vertices[Bvert[2]] do LineTo (DX, DY);
  567.     With Vertices[Bvert[3]] do Lineto (DX, DY);
  568.     CloseRgn (Aregion);
  569.     
  570.     { Fill with the computed brightness }
  571.     Level := Round (Bright (Normal, Light) * 64.0);
  572.     FillRgn (Aregion, Patterns[Level]);
  573.     SetEmptyRgn(Aregion)
  574.     end;
  575. DisposeRgn(Aregion)
  576. End;
  577.  
  578. { ******************************************************************** }
  579.  
  580.  
  581. { Transform the faces and vertices by the current transformation }
  582.  
  583. Procedure DoTransform;
  584. Var
  585.   ThisFace, ThisPoint: Integer;
  586.   Begin
  587. For ThisFace := 1 to Num_Faces do With Faces[ThisFace] do
  588.     TPoint (ONormal, Normal);
  589. For ThisPoint:= 1 to Num_Vertices do With Vertices[ThisPoint] do
  590.     Tpoint (Where, NowAt)
  591. End;
  592.  
  593. { ******************************************************************** }
  594.  
  595. { Build the current transformation from its parts, apply the transform, }
  596. { and compute the visible faces and edges. }
  597.  
  598. Procedure SetupFrame;
  599. Begin 
  600. TTransform (RotationTransform, ImageTransform, TotalTransform);
  601. DoTransform; SetDisplay; FindVisible
  602. End;
  603.  
  604. { ******************************************************************** }
  605.  
  606. { Draw one frame }
  607. Procedure OutFrame;
  608. Begin
  609. SetupFrame; FillRect (Limits, Patterns[0]); ShadeFaces; DrawEdges
  610. end;
  611.  
  612. { ******************************************************************** }
  613.  
  614. { Draw the frames of the Object in each orientation. }
  615.  
  616. Procedure ComputeFrames;
  617. Var
  618.   Index: Integer;
  619.   This_Angle, Step_Angle: Real;
  620. Begin
  621. Step_Angle := Fifth / Num_Views; { Assume 5 fold rotational symetry }
  622. For Index:=1 to Num_Views do
  623.     Begin
  624.        This_Angle := Index * Step_Angle;
  625.        FormRot (This_Angle, 2, RotationTransform);
  626.        SetPortBits (OurBitMaps[Index]);
  627.        OutFrame;
  628.        CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Limits, srcCopy,
  629.             SystemGrafPtr^.visRgn);
  630.     end;
  631. SetPortBits (SystemBitMap)
  632. end;
  633.  
  634.  
  635. { ******************************************************************** }
  636.  
  637. { Thumb through the frames, copying each to the screen.  Change the }
  638. { Aiming point (and thumb direction ) to mimic bouncing }
  639.  
  640. Procedure Thumb;
  641. Var Index: Integer;
  642.     Dest: Rect;
  643.     Offset_X, Direction_X: Integer;
  644.     Offset_Y, Direction_Y: Integer;
  645.     Direction_Rot: Integer;
  646.     Bounce: Rect;
  647. Begin
  648. Index   := 0; Direction_Rot:= 1;
  649. Offset_X:= 0; Direction_X  := 1;
  650. Offset_Y:= 0; Direction_Y  := 1;
  651. SetOrigin (0,0);
  652.  
  653. { Use TML pascals window }
  654. Bounce := SystemGrafPtr^.PortBits.Bounds;
  655. Bounce.Right := Bounce.Right - Full_Height;
  656. Bounce.Bottom := Bounce.Bottom - Full_Height;
  657. Dest := Limits;
  658.  
  659. While Not Button do
  660.   Begin
  661. { Select frame, Force wrap if off ends of frame list. }
  662.   Index := Index + Direction_Rot;
  663.   If Index > Num_Views then Index := 1 else
  664.   if Index < 1         then Index := Num_Views;
  665.   
  666. { Copy this frame to screen }
  667.   CopyBits (OurBitMaps[Index], SystemBitMap, Limits, Dest, srcCopy,
  668.             SystemGrafPtr^.visRgn);
  669.  
  670. { Update X, check for bounce }
  671.   Offset_X := Offset_X + direction_X;
  672.   if (Offset_X >Bounce.Right) or (Offset_X <Bounce.Left) Then
  673.      Begin
  674.      Direction_X := -Direction_X;
  675.      Direction_Rot := Direction_X*Direction_Y;
  676.      end;
  677.  
  678. { Update Y, check for bounce }
  679.   Offset_Y := Offset_Y + direction_Y;
  680.   if (Offset_Y >Bounce.Bottom) or (Offset_Y <Bounce.Top) Then
  681.      Begin
  682.      Direction_Rot := Direction_X*Direction_Y;
  683.      Direction_Y := -Direction_Y;
  684.      end;
  685.  
  686. { Update current location for transfer. }
  687.   Dest := Limits;
  688.   OffsetRect (Dest, Offset_X, Offset_Y);
  689.  
  690.   End;
  691.  
  692. While Button do { Nothing };
  693. end;
  694.  
  695.  
  696. { ******************************************************************** }
  697.  
  698.  
  699.  
  700. BEGIN
  701. ObscureCursor;
  702. Writeln ('                Icosahedron Version 0.6');
  703. Writeln ('(c) Copyright 1986 By the University of Utah Computer Center');
  704. Writeln ('          Written by John Halleck  (NSS 20620)');
  705. INITIALIZE;
  706. For Index := 64 Downto 0 do
  707.     FillRect (SystemGrafPtr^.PortBits.Bounds, Patterns[Index]);
  708. BackPat (Patterns[0]);
  709. SetupFrame;
  710. PenPat (Patterns[64]); DrawEdges;
  711. PenPat (Patterns[0]);  ShadeFaces; DrawEdges;
  712. ComputeFrames;
  713. Thumb
  714. END.
  715.