home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / glitch.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-30  |  9KB  |  349 lines
  1. {
  2.   Demo for animated particles engine.
  3.   Coded by Mike Shirobokov(MSH) aka Mad Max / Queue Members (2:5057/1.5)
  4.   (c)1994 MSH, Samara, Russia
  5.   Warning! This code can be used in educational purposes only.
  6.   For any other use - please contact me.
  7. }
  8.  
  9. {$A-,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+}
  10. {$M 16384,0,655360}
  11.  
  12. program Glitch;
  13.  
  14. {$M $4000,$32000,$32000}
  15.  
  16. uses Objects, CRT, GraphObj, Points;
  17.  
  18. const
  19.   PointsNumber  = 300;
  20.   YSpeedMul: LongInt = Round( 3.5 * ScaleFactor );
  21.   YSpeedAdd: LongInt = Round( 0.7 * ScaleFactor );
  22.   XSpeedMul: LongInt = Round( 0.7 * ScaleFactor );
  23.   XSpeedAdd: LongInt = Round( 0 * ScaleFactor );
  24.  
  25.   ShadeSteps  = 16;
  26.   StarsNumber  = 200;
  27.   PartSteps  = 500;
  28.   AngleStep: Integer = 2;
  29.  
  30. type
  31.   TInsertType = ( itSpyralFromFloor,
  32.     itRandomFromFloor,
  33.     itSpyralFromCeil,
  34.     itInRing,
  35.     itRandomInCone,
  36.     itRandom );
  37.  
  38.   PPointsApp = ^TPointsApp;
  39.   TPointsApp = object( TGraphApplication )
  40.     Points: TPoints;
  41.     constructor Init;
  42.     procedure Run; virtual;
  43.     destructor Done; virtual;
  44.     procedure InsertPoint( How: TInsertType );
  45.   end;
  46.  
  47. procedure TPointsApp.InsertPoint( How: TInsertType );
  48.  
  49. var
  50.   Speed: TPoint3D;
  51.   Origin: TPoint3D;
  52.  
  53. procedure InsertSpyralFromFloor;
  54. const
  55.   PointsOrigin : TPoint3D = ( X:0;  Y:0; Z:0 );
  56.   Last:  Real = 2*Pi;
  57.   Step:  Real = Pi / 20;
  58. begin
  59.   Speed.X := Round( XSpeedMul * Cos(Last) );
  60.   Speed.Z := Round( XSpeedMul * Sin(Last) );
  61.   Last := Last - Step;
  62.   if Last < 0 then Last := 2*Pi;
  63.   Speed.Y := YSpeedMul + YSpeedAdd;
  64.   Points.Insert( New( PFlyingPoint, Init( PointsOrigin, Speed ) ) );
  65. end;
  66.  
  67. procedure InsertRandomFromFloor;
  68. const
  69.   PointsOrigin : TPoint3D = ( X:0;  Y:0; Z:0 );
  70. begin
  71.   repeat
  72.     Speed.X := XSpeedMul-Integer(Random(XSpeedMul*2));
  73.   until Abs(Speed.X) >= XSpeedAdd;
  74.   repeat
  75.     Speed.Z := XSpeedMul-Integer(Random(XSpeedMul*2));
  76.   until Abs(Speed.X) >= XSpeedAdd;
  77.   Speed.Y := YSpeedAdd + Random(YSpeedMul);
  78.   Points.Insert( New( PFlyingPoint, Init( PointsOrigin, Speed ) ) );
  79. end;
  80.  
  81. procedure InsertSpyralFromCeil;
  82. const
  83.   Last:  Real = 2*Pi;
  84.   Step:  Real = Pi / 20;
  85. begin
  86.   Origin.X := Round( Max.X * Cos(Last) /2 ) + 50*ScaleFactor;
  87.   Origin.Z := Round( Max.Z * Sin(Last) /2 );
  88.   Origin.Y := Max.Y;
  89.   Last := Last - Step;
  90.   if Last < 0 then Last := 2*Pi;
  91.   Speed.X := 0;
  92.   Speed.Z := 0;
  93.   Speed.Y := 0;
  94. {  Speed.Y := Round( YSpeedMul*Sin(Last) );}
  95. {  Speed.Y := YSpeedMul;}
  96.   Points.Insert( New( PFlyingPoint, Init( Origin, Speed ) ) );
  97. end;
  98.  
  99. procedure InsertInRing;
  100. const
  101.   PointsOrigin : TPoint3D = ( X:0;  Y:0; Z:0 );
  102.   Number = 20;
  103. var
  104.   I: Integer;
  105. begin
  106.   Speed.Y := YSpeedMul+YSpeedAdd;
  107.   for I := 1 to Number do
  108.   begin
  109.     Speed.X := Round( XSpeedMul*Sin(2*Pi*I/Number) );
  110.     Speed.Z := Round( XSpeedMul*Cos(2*Pi*I/Number) );
  111.     Points.Insert( New( PFlyingPoint, Init( PointsOrigin, Speed ) ) );
  112.   end;
  113. end;
  114.  
  115. procedure InsertRandomInCone;
  116. begin
  117.   Origin.Y := LongInt( Random( (Max.Y - Min.Y) shr 4 ) ) shl 3 + Min.Y;
  118.   Origin.X := LongInt( Random( (Origin.Y) shr 3 ) ) shl 5 - Origin.Y*2;
  119.   Origin.Z := LongInt( Random( (Origin.Y) shr 3 ) ) shl 5 - Origin.Y*2;
  120.   Speed.X := 0;
  121.   Speed.Z := 0;
  122.   Speed.Y := 0;
  123.   Points.Insert( New( PFlyingPoint, Init( Origin, Speed ) ) );
  124. end;
  125.  
  126. procedure InsertRandom;
  127. begin
  128.   Origin.Y := LongInt( Random( (Max.Y - Min.Y) shr 4 ) ) shl 4 + Min.Y;
  129.   Origin.X := LongInt( Random( (Max.X - Min.X) shr 4 ) ) shl 4 + Min.X;
  130.   Origin.Z := LongInt( Random( (Max.Z - Min.Z) shr 4 ) ) shl 4 + Min.Z;
  131.   Speed.X := 0;
  132.   Speed.Z := Random( XSpeedMul ) + XSpeedAdd;
  133.   Speed.Y := Random( XSpeedMul ) + XSpeedAdd;
  134.   Points.Insert( New( PFlyingPoint, Init( Origin, Speed ) ) );
  135. end;
  136.  
  137. begin
  138.   case How of
  139.     itSpyralFromFloor : InsertSpyralFromFloor;
  140.     itRandomFromFloor : InsertRandomFromFloor;
  141.     itSpyralFromCeil  : InsertSpyralFromCeil;
  142.     itInRing          : InsertInRing;
  143.     itRandomInCone    : InsertRandomInCone;
  144.     itRandom          : InsertRandom;
  145.   end;
  146. end;
  147.  
  148. constructor TPointsApp.Init;
  149. var
  150.   I,
  151.   J:  Integer;
  152.   Color: Byte;
  153. begin
  154.   inherited Init;
  155.   Randomize;
  156.   FillChar( Palette, SizeOf(Palette), 0 );
  157.   SetAllPalette( Palette );
  158.   for I := 199 downto 109 do
  159.   begin
  160.     for J := 0 to 319 do
  161.       PutPixel( J, I, 27 + I + Random(20) );
  162.   end;
  163.   for I := 1 to StarsNumber do
  164.     PutPixel( Random(320), Random(109), 128+Random(128) );
  165.   CopyPage( 0, 2 );
  166.   CopyPage( 0, 1 );
  167.   Points.Init( PointsNumber );
  168.   for I := 0 to 127 do
  169.   begin
  170.     Palette[I].R := I div 2;
  171.     Palette[I].G := I div 2;
  172.     Palette[I].B := I div 2;
  173.     Palette[I+128].R := 0;
  174.     Palette[I+128].G := 0;
  175.     Palette[I+128].B := I div 2;
  176.   end;
  177.   SetAllPalette(Palette);
  178. end;
  179.  
  180. procedure TPointsApp.Run;
  181.  
  182. function Ended: Boolean;
  183. const
  184.   ToEnd: Integer = 0;
  185.   IsEnded:      Boolean = False;
  186. var
  187.   I:  Integer;
  188. begin
  189.   Ended := False;
  190.   if KeyPressed then
  191.   begin
  192.     ReadKey;
  193.     IsEnded := True;
  194.   end;
  195.   if IsEnded then
  196.   begin
  197.     for I := 0 to 255 do
  198.     begin
  199.       if Palette[I].R > 64 div ShadeSteps then
  200.         Dec( Palette[I].R, 64 div ShadeSteps );
  201.       if Palette[I].G > 64 div ShadeSteps then
  202.         Dec( Palette[I].G, 64 div ShadeSteps );
  203.       if Palette[I].B > 64 div ShadeSteps  then
  204.         Dec( Palette[I].B, 64 div ShadeSteps );
  205.     end;
  206. {
  207.  
  208.    Uncomment this if you'll see flickering
  209.  
  210.     Repeat Until (Port[$3DA] And $08) = 0;
  211.     Repeat Until (Port[$3DA] And $08) <> 0;
  212. }
  213.     SetAllPalette( Palette );
  214.     Inc(ToEnd);
  215.     if ToEnd >= ShadeSteps then Ended := True;
  216.   end;
  217. end;
  218.  
  219. var
  220.   J,
  221.   I:  Integer;
  222.   Angle: LongInt;
  223. begin
  224.   Angle := 0;
  225.  
  226.   for I := 1 to PartSteps do
  227.   begin
  228.     if Ended then Exit;
  229.     if (Points.Count < PointsNumber ) and (I and 7 = 7) then
  230.       InsertPoint( itInRing );
  231.     Points.Update;
  232.     Inc( Angle, AngleStep );
  233.     if Angle >= RotateSteps shl 1 then Angle := 0;
  234.     ViewAngle := Angle shr 1;
  235.   end;
  236.   for I := 1 to Points.Count do
  237.     Inc( TFlyingPoint( Points.At(I-1)^ ).Speed.X, 7*ScaleFactor );
  238.  
  239.   XSpeedMul := Round( 2 * ScaleFactor );
  240.   YSpeedAdd := Round( 6 * ScaleFactor );
  241.   YSpeedMul := 3*ScaleFactor;
  242.   Gravity := Round( 0.25 * ScaleFactor );
  243.   for I := 1 to PartSteps do
  244.   begin
  245.     if Ended then Exit;
  246.     if (Points.Count < PointsNumber ) then
  247.       InsertPoint( itRandomFromFloor );
  248.     Points.Update;
  249. {
  250.     Inc( Angle, AngleStep );
  251.     if Angle >= RotateSteps shl 1 then Angle := 0;
  252.     ViewAngle := Angle shr 1;
  253. }
  254.   end;
  255.   for I := 1 to Points.Count do
  256.     Inc( TFlyingPoint( Points.At(I-1)^ ).Speed.X, 4*ScaleFactor );
  257.  
  258.   ReflectionRatio := 1;
  259.   Gravity := Round( 0.3 * ScaleFactor );
  260.   for I := 1 to PartSteps do
  261.   begin
  262.     if Ended then Exit;
  263.     if (Points.Count < PointsNumber) then
  264.       InsertPoint( itSpyralFromCeil );
  265.     Points.Update;
  266.     Inc( Angle, AngleStep );
  267.     Angle := Angle mod (RotateSteps shl 1);
  268.     ViewAngle := Angle shr 1;
  269.   end;
  270.  
  271.   for I := 1 to Points.Count do
  272.     Inc( TFlyingPoint( Points.At(I-1)^ ).Speed.Z, 5*ScaleFactor );
  273.  
  274.   Gravity := Round( 0.08 * ScaleFactor );
  275.   YSpeedAdd := Round( 0.4*ScaleFactor );
  276.   YSpeedMul := Round( 3.5 * ScaleFactor );
  277.   XSpeedMul := Round( 0.5 * ScaleFactor );
  278.   AngleStep := -AngleStep;
  279.   for I := 1 to PartSteps do
  280.   begin
  281.     if Ended then Exit;
  282.     if (Points.Count < PointsNumber) {and (I and 3 = 3)} then
  283.       InsertPoint( itSpyralFromFloor );
  284.     Points.Update;
  285.     Inc( Angle, AngleStep );
  286.     if Angle < 0 then Angle  := (RotateSteps shl 1) + Angle;
  287.     ViewAngle := Angle shr 1;
  288.   end;
  289.   for I := 1 to Points.Count do
  290.     TFlyingPoint( Points.At(I-1)^ ).Speed.Y := 0;
  291.  
  292.   Gravity := Round( -0.02 * ScaleFactor );
  293.   YSpeedAdd := Round( 6 * ScaleFactor );
  294.   XSpeedMul := Round( 2 * ScaleFactor );
  295.   Angle := Angle shl 4;
  296.   AngleStep := -AngleStep;
  297.   for I := 1 to PartSteps - 100 do
  298.   begin
  299.     if Ended then Exit;
  300. {    if Points.Count < PointsNumber then}
  301.       InsertPoint( itRandom );
  302.     Points.Update;
  303.     Inc( Angle, AngleStep );
  304.     Angle := Angle mod (RotateSteps shl 5);
  305.     Inc( AngleStep );
  306.     if Angle >= RotateSteps shl 5 then Angle := 0;
  307.     ViewAngle := Angle shr 5;
  308.   end;
  309.   for I := 1 to 32 do
  310.   begin
  311.     if Ended then Exit;
  312.     InsertPoint( itRandomInCone );
  313.     Points.Update;
  314.     Inc( Angle, AngleStep );
  315.     Angle := Angle mod (RotateSteps shl 5);
  316.     Inc( AngleStep, 1 );
  317.     if Angle >= RotateSteps shl 5 then Angle := 0;
  318.     ViewAngle := Angle shr 5;
  319.     for J := 0 to 255 do
  320.     begin
  321.       if Palette[J].R < 63 then Inc( Palette[J].R, 2 );
  322.       if Palette[J].R > 63 then Palette[J].R := 63;
  323.       if Palette[J].G < 63 then Inc( Palette[J].G, 2 );
  324.       if Palette[J].G > 63 then Palette[J].G := 63;
  325.       if Palette[J].B < 63 then Inc( Palette[J].B, 2 );
  326.       if Palette[J].B > 63 then Palette[J].B := 63;
  327.     end;
  328. {
  329.     Repeat Until (Port[$3DA] And $08) = 0;
  330.     Repeat Until (Port[$3DA] And $08) <> 0;
  331. }
  332.     SetAllPalette( Palette );
  333.   end;
  334. end;
  335.  
  336. destructor TPointsApp.Done;
  337. begin
  338.   Points.Done;
  339.   inherited Done;
  340. end;
  341.  
  342. var
  343.   GA:  TPointsApp;
  344. begin
  345.   GA.Init;
  346.   GA.Run;
  347.   GA.Done;
  348. end.
  349.