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