home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / rot5.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  4KB  |  159 lines
  1.  
  2. {$N+}
  3.  
  4. program Rotation;
  5. { 3d rotating plane, uses slow math somewhere, by Bas van Gaalen, Holland, PD }
  6. { SVGABGI... }
  7. uses
  8.   dos,crt,graph;
  9.  
  10. const
  11.   NofPoints = 99;
  12.   Speed = 1;
  13.   Xc : word = 0;
  14.   Yc : word = 0;
  15.   Zc : word = 500;
  16.   SinTab : array[0..255] of integer = (
  17.     0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,
  18.     71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,
  19.     113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,
  20.     128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,
  21.     121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,
  22.     91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,
  23.     28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,
  24.     -37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,
  25.     -84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,
  26.     -113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,
  27.     -126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,
  28.     -127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,
  29.     -114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,
  30.     -88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,
  31.     -46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);
  32.  
  33. type
  34.   PointRec = record
  35.                X,Y,Z : integer;
  36.              end;
  37.   PointPos = array[0..NofPoints] of PointRec;
  38.  
  39. var
  40.   Point : PointPos;
  41.  
  42. {----------------------------------------------------------------------------}
  43.  
  44. procedure SetGraphics;
  45. var GrMd,GrDr : integer;
  46.  
  47. {$F+} function DetectVGA : Integer; begin DetectVGA := 2; end; {$F-}
  48.  
  49. begin
  50.   InstallUserDriver('SVGA256',@DetectVGA); GrDr := 0;
  51.   InitGraph(GrDr,GrMd,'i:\bgi');
  52. end;
  53.  
  54. {----------------------------------------------------------------------------}
  55.  
  56. procedure Init;
  57.  
  58. var
  59.   x,z : integer; i : byte;
  60.  
  61. begin
  62.   {randomize;
  63.   for I := 0 to NofPoints do begin
  64.     Point[I].X := random(300)-150;
  65.     Point[I].Y := random(300)-150;
  66.     Point[I].Z := random(300)-150;
  67.   end;}
  68.  
  69.   i := 0;
  70.   z := -150;
  71.   while z < 150 do begin
  72.     x := -150;
  73.     while x < 150 do begin
  74.       point[i].x := x;
  75.       point[i].y := 100;
  76.       point[i].z := z;
  77.       inc(i);
  78.       inc(x,30);
  79.     end;
  80.     inc(z,30);
  81.   end;
  82.  
  83.   for I := 1 to 63 do begin
  84.     port[$3C8] := I;
  85.     port[$3C9] := I;
  86.     port[$3C9] := I;
  87.     port[$3C9] := 0;
  88.   end;
  89. end;
  90.  
  91. {----------------------------------------------------------------------------}
  92.  
  93. function Sinus(Idx : byte) : integer; begin
  94.   Sinus := SinTab[Idx]; end;
  95.  
  96. {----------------------------------------------------------------------------}
  97.  
  98. function Cosin(Idx : byte) : integer; begin
  99.   Cosin := SinTab[(Idx+192) mod 255]; end;
  100.  
  101. {----------------------------------------------------------------------------}
  102.  
  103. procedure Rotate;
  104.  
  105. const
  106.   Xstep = -1;
  107.   Ystep = 1;
  108.   Zstep = 1;
  109.  
  110. var
  111.   Xp,Yp : array[0..NofPoints] of word;
  112.   X,Y,Z,X1,Y1,Z1 : integer;
  113.   I : word;
  114.   PhiX,PhiY,PhiZ : byte;
  115.  
  116. begin
  117.   PhiX := 30; PhiY := 60; PhiZ := 90;
  118.   repeat
  119.     while (port[$3da] and 8) <> 8 do;
  120.     while (port[$3da] and 8) = 8 do;
  121.  
  122.     {port[$3c8] := 0; port[$3c9] := 0; port[$3c9] := 0; port[$3c9] := 25;}
  123.  
  124.     for I := 0 to NofPoints do begin
  125.  
  126.       if (Xp[I] < 640) and (Yp[I] < 480) then
  127.         putpixel(Xp[I],Yp[I],0);
  128.  
  129.       X1 := (Cosin(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z) div 128;
  130.       Y1 := (Cosin(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1) div 128;
  131.       Z1 := (Cosin(PhiY)*Point[I].Z+Sinus(PhiY)*Point[I].X) div 128;
  132.       X  := (Cosin(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y) div 128;
  133.       Y  := (Cosin(PhiX)*Y1+Sinus(PhiX)*Z1) div 128;
  134.       Z  := (Cosin(PhiX)*Z1-Sinus(PhiX)*Y1) div 128;
  135.       Xp[I] := 320+(Xc*Z-X*Zc) div (Z-Zc);
  136.       Yp[I] := 240+(Yc*Z-Y*Zc) div (Z-Zc);
  137.  
  138.       if (Xp[I] < 640) and (Yp[I] < 480) then
  139.         putpixel(Xp[I],Yp[I],31+round(Z/10));
  140.  
  141.     end;
  142.     inc(PhiX,Xstep);
  143.     inc(PhiY,Ystep);
  144.     inc(PhiZ,Zstep);
  145.  
  146.     {port[$3c8] := 0; port[$3c9] := 0; port[$3c9] := 0; port[$3c9] := 0;}
  147.  
  148.   until keypressed;
  149. end;
  150.  
  151. {----------------------------------------------------------------------------}
  152.  
  153. begin
  154.   SetGraphics;
  155.   Init;
  156.   Rotate;
  157.   textmode(lastmode);
  158. end.
  159.