home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / sphere.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-16  |  4KB  |  166 lines
  1. {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X-}
  2. {$M 16384,0,0}
  3.  
  4. {A Little Rotating Sphere, By Glen Jeh, 8/12/1994, Use Freely}
  5.  
  6. Program G_Ball;
  7.  
  8. {Try Messing With The Constants...Code Is Squished A Little}
  9.  
  10. Uses
  11.   Crt;
  12.  
  13. Const
  14.   Distance   : Integer  = 100;
  15.   Dir        : Shortint = -3;
  16.   Scale                 = 50;
  17.   Radius                = 80;    {Mystery Constant}
  18.   Delaytime             = 1;     {Delay(Delaytime) To Slow It Down..}
  19.   Slices                = 12;    {Number Of Slices}
  20.   Pps                   = 20;    {Points Per Slice}
  21.  
  22. Type
  23.   Pointtype = Record
  24.     X,Y,Z   : Integer;
  25.   End;  {(X,Y,Z) Point}
  26.  
  27.   Slicetype = Array[1..Pps] Of Pointtype;   {Array Of Points For A Slice}
  28.   Balltype = Array[1..Slices] Of Slicetype; {Array Of Slices For A Ball}
  29.  
  30. Var
  31.   Xangle,
  32.   Yangle,
  33.   Zangle     : Byte;
  34.   I          : Integer;
  35.   Sintable,
  36.   Costable   : Array[0..255] Of Integer;
  37.   Ball,
  38.   Points     : Balltype;  {Ball Is Constant Data, Points Is Rotated Data}
  39.  
  40. {----------------------------------------------------------------------------}
  41.  
  42. Procedure Drawpoints (Color : Byte);
  43.  
  44.   Var
  45.     I,
  46.     I2 : Integer;
  47.  
  48.   Begin
  49.     For I := 1 To Slices Do
  50.       For I2 := 1 To Pps Do
  51.         With Points[I,I2] Do
  52.           If (Z >= 0) And (X <= 319) And (X>=0) And (Y>=0) And (Y<199) Then
  53.             Mem[$A000:Word(Y) * 320 + X] := Color;
  54.   End;
  55.  
  56. {----------------------------------------------------------------------------}
  57.  
  58. Procedure Setupball; {Set Up The Points}
  59.  
  60. {Sets Up The Ball's Data..}
  61.  
  62.   Var
  63.     Sliceloop,
  64.     Ppsloop    : Integer;
  65.     Phi,
  66.     Theta      : Real;
  67.  
  68.   Begin
  69.     For Sliceloop := 1 To Slices Do
  70.       Begin
  71.         Phi := Pi/Slices*Sliceloop;     {0 <= Phi <= Pi}
  72.         For Ppsloop := 1 To Pps Do With Ball[Sliceloop,Ppsloop] Do
  73.           Begin
  74.             Theta := 2*Pi/Pps*Ppsloop;  {0 <= Theta <= 2*Pi}
  75.                 {convert Radius,Thetha,Phi To (X,Y,Z) Coordinates}
  76.             Y := Round(Radius * Sin(Phi) * Cos(Theta));
  77.             X := Round(Radius * Sin(Phi) * Sin(Theta));
  78.             Z := Round(Radius * Cos(Phi));
  79.           End;
  80.       End;
  81.   End;
  82.  
  83. {----------------------------------------------------------------------------}
  84.  
  85. Procedure Rotate;
  86.  
  87. {Updates All (X,Y,Z) Coordinates According To Xangle,Yangle,Zangle}
  88.  
  89.   Var
  90.     I,
  91.     I2,
  92.     TempX,
  93.     TempY,
  94.     TempZ,
  95.     OldTempX : Integer;
  96.  
  97.   Begin
  98.     For I := 1 To Slices Do
  99.       For I2 := 1 To Pps Do
  100.         With Ball[I,I2] Do
  101.           Begin
  102.  
  103.             {Rotate On X-axis}
  104.  
  105.             TempY := (Y*Costable[Xangle] - Z*Sintable[Xangle]) Div 128;
  106.             TempZ := (Y*Sintable[Xangle] + Z*Costable[Xangle]) Div 128;
  107.  
  108.             {Rotate On Y-axis}
  109.  
  110.             Tempx := (X*Costable[Yangle] - Tempz*Sintable[Yangle]) Div 128;
  111.             Tempz := (X*Sintable[Yangle] + Tempz*Costable[Yangle]) Div 128;
  112.  
  113.             {Rotate On Z-axis}
  114.  
  115.             Oldtempx := Tempx;
  116.             Tempx := (Tempx*Costable[Zangle] - Tempy*Sintable[Zangle]) Div 128;
  117.             Tempy := (Oldtempx*Sintable[Zangle] + Tempy*Costable[Zangle]) Div 128;
  118.             Points[I,I2].X := (Tempx*Scale) Div Distance + 320 Div 2;
  119.             Points[I,I2].Y := (Tempy*Scale) Div Distance + 200 Div 2;
  120.             Points[I,I2].Z := Tempz;
  121.           End;
  122.   End;
  123.  
  124. {----------------------------------------------------------------------------}
  125.  
  126. Begin
  127.   For I := 0 To 255 Do
  128.     Begin
  129.       Sintable[I] := Round(Sin(2*Pi/255*I) * 128);
  130.       Costable[I] := Round(Cos(2*Pi/255*I) * 128);
  131.     End;
  132.  
  133.   Asm
  134.     Mov Ax,$0013;
  135.     Int $10
  136.   End;
  137.  
  138.   Setupball;
  139.   Xangle := 0;
  140.   Yangle := 0;
  141.   Zangle := 0;
  142.  
  143.   Repeat
  144.     Rotate;
  145.     Drawpoints(Lightgreen);
  146.     Inc(Xangle,3);
  147.     Inc(Yangle,2);
  148.     Inc(Zangle,1);
  149.     Inc(Distance,Dir);
  150.     If Distance >= 300 Then
  151.       Dir := -3
  152.     Else
  153.       If Distance <= 30 Then
  154.         Dir := 2;
  155.     Delay(Delaytime);    {I Don't Know Why This Is Too Fast...}
  156.     Repeat
  157.     Until Port[$3Da] And 8 <> 0;
  158.     Drawpoints(0);
  159.   Until Keypressed;
  160.  
  161.   Asm
  162.     Mov Ax,$0003;
  163.     Int $10
  164.   End;
  165. End.
  166.