Programmer 7500/MAX_PROGRAMMERS.iso/PROGRAMS/UTILS/EGA_VGA/FIREWKS1.ZIP/EGAFIRE.PAS

Pascal/Delphi Source File | 1987-08-09 | 7.9 KB | 380 lines

Program ArtExample;

const
  MemorySize = 5;
  Rays       = 90;
  Max_Rockets = 15;
  Max_Stars = 10;
  Wind : Integer = 0;
  PolarX : Integer = 320;
  PolarY : Integer = 50;
  Step   : integer    = 1;

Type
  Rocket_Type      = record
    X              : Array[0..MemorySize] of Integer;
    Y              : Array[0..MemorySize] of Integer;
    DX             : Integer;
    DY             : Integer;
    end;

  StarBurst        = Record
    Trail          : Array[0..Rays] of Rocket_type;
    Counter        : Integer;
    Head           : Integer;
    Color          : Integer;
    end;

  BlinkingStar     = Record
    Radius         : Integer;
    Angle          : Integer;
    Color          : Integer;
    end;
var
  Rockets   : Array[0..Max_Rockets] of StarBurst;
  Launched  : Array[0..1] of Integer;
  Delta_Theta : Real;
  Sine        : Array [ 0..1079 ] of Real;
  Cosine      : Array [ 0..1079 ] of Real;
  Stars       : Array [ 0..Max_Stars ] of BlinkingStar;

{$I GPAll.P }

procedure Check;

begin

  GPPARMS;

  if GDTYPE <> 5 then
    begin
    ClrScr;
    Writeln('Enhanced Graphic Adapter and Display not found!');
    Halt(1);
    end;

  if GDMEMORY = 64 then
    begin
    ClrScr;
    Writeln('This program works much better with 128k or more EGA memory!');
    Writeln;
    Delay(1000);
    end;

end;

Procedure New_Rocket(Var Rocket : StarBurst);
var
  i,j           : integer;
  XPosn         : Integer;
  Temp          : Integer;
  temp2         : Integer;

begin
Rocket.Counter := -(Random(30) + 15);
Rocket.Head := 0;
Rocket.Color := DarkGray;
if random(2) = 0
  then
    begin
    Launched[0] := Succ(Launched[0]);
    XPosn := Random(10) + 100;
    Temp := Random(3072);
    end
  else
    begin
    Launched[1] := Succ(Launched[1]);
    Xposn := Random(10) + 540;
    Temp := -Random(3072);
    end;
GPMove(Xposn,339);
GPMerge(3);
GPColor(Red);
for i := 1 to 2 do
  GPCir(i shl 2);

Xposn := XPosn Shl 6;
Temp2 := -(Random(256) + 2048);
for J := 0 to Rays do
  With Rocket.Trail[j] do
    For I := 0 to MemorySize do
      begin
      X[I] := Xposn;
      Y[I] := 339 Shl 6;
      DX := temp;
      DY := Temp2;
      end;
For I := 1 to 2 do
  GPCir(i shl 2);

GPMerge(0);
NoSound;


end;

procedure Init;
var
  i             : integer;
  Theta         : Real;
  X,Y           : Integer;
  Temp          : Real;
  RX,RY         : Real;


begin
Delta_Theta := 2.0 * Pi / 1080.0;
GPINIT;
GPColor(Black);
GPMove(0,0);
GPBox(639,349);
GPColor(White);
GPMove(9,9);
GPRect(630,340);
GPVIEWPORT(10,10,629,339);
For I := 0 to 1 do
  Launched[i] := 0;
for I := 0 to Max_Rockets do
  New_Rocket(Rockets[i]);
for I := 0 to 1079 do
  begin
  Theta := I * Delta_Theta;
  Sine[i] := Sin(Theta);
  Cosine[i] := Cos(Theta);
  end;
Stars[0].Radius := 0;
Stars[0].Angle := 0;
Stars[0].Color := White;
GPColor(White);
GPMove(PolarX,PolarY);
GPLine(PolarX,PolarY);
for I := 1 to Max_Stars do
  With Stars[i] do
    begin
    Radius := Random(150);
    Angle := Random(1080);
    Case Random(3) of
    0  : Color := White;
    1  : Color := LightGray;
    2  : Color := DarkGray;
    end;
    X := round(Radius shl 1 * Cosine[Angle] + PolarX);
    Y := round(Radius * Sine[Angle] + PolarY);
    GPColor(Color);
    GPmove(X,Y);
    GPLine(X,Y);
    end;
Stars[Max_Stars].Color := Brown;

end;


Procedure Draw_Rocket(Var Rocket : StarBurst);

var
  I,J       : Integer;
  Posn      : Integer;
  TX,TY     : Integer;

begin
With Rocket do
  begin
  Posn := (Head + 1 + MemorySize) Mod MemorySize;
  For J := 0 to Rays do
    With Rocket.Trail[J] do
      begin
      GPColor(Black);
      TX := (X[Posn] Shr 6) and $3FF;
      TY := (Y[Posn] shr 6) and $3FF;
      GPMove(TX,TY);
      GPLine(TX,TY);
      X[Posn] := X[Head] + DX;
      Y[Posn] := Y[Head] + DY;
      TX := (X[Posn] Shr 6) and $3FF;
      TY := (Y[Posn] shr 6) and $3FF;
      GPColor(Rocket.Color);
      if TY > 339
        then
          begin
          DX := DX div 3;
          DY := -DY div 3;
          Y[Posn] := 339 shl 6;
          end;
      GPMove(TX,TY);
      GPLine(TX,TY);
      DY := DY + 8 - (DY DIV 8);
      Dx := Dx - ((DX - Wind) DIV 8);
      end;
  Head := Posn;
  Counter := Succ(Counter);
  end;
end;

Procedure End_Rocket(Var Rocket : StarBurst);

var
  I,J       : Integer;
  Posn      : Integer;
  TX,TY     : Integer;

begin
With Rocket do
  begin
  Posn := (Head + 1 + MemorySize) Mod MemorySize;
  For J := 0 to Rays do
    With Rocket.Trail[J] do
      begin
      GPColor(Black);
      TX := (X[Posn] Shr 6) and $3FF;
      TY := (Y[Posn] shr 6) and $3FF;
      GPMove(TX,TY);
      GPLine(TX,TY);
      end;
  Head := Posn;
  Counter := Succ(Counter);
  end;
end;


Procedure Explode_Rocket(Var Rocket : StarBurst);

var
  J         : Integer;
  Temp      : Integer;
  Temp2     : Integer;
  BurstSize : Integer;
  TX,TY     : Integer;
  Range     : Real;
  Angle     : Integer;

begin
Temp := Random(6) + 1;
BurstSize := Temp Shl 1;
Temp2 := Temp Shl 8;
Temp := Temp shl 7;
Rocket.Color := Random(3) + 13;
J := Rocket.Head;
GPMerge(3);
GPColor(White);
With Rocket.Trail[J] do
  begin
  TX := (X[J] Shr 6) and $3FF;
  TY := (Y[J] shr 6) and $3FF;
  end;
GPMove(TX,TY);
{Sound(8 * BurstSize);}
for J := 1 to BurstSize do
  GPCir(j);
For J := 0 to Rays do
  With Rocket.Trail[J] do
    begin
    Range := (Random(temp2) - Temp);
    Angle := Random(1080);
    DY := Round(Range * Sine[Angle]) + DY;
    DX := Round(Range * Cosine[Angle]) shl 1 + DX;
    end;
For J := 1 to BurstSize do
  GPCir(J);
NoSound;
GPMerge(0);
end;

Procedure Time_Step;

var
  i           : Integer;
  X           : Integer;
  Y           : Integer;
begin
for I := 0 to Max_Stars do
  With Stars[i] do
    begin
    X := round(Radius shl 1 * Cosine[Angle] + PolarX);
    Y := round(Radius * Sine[Angle] + PolarY);
    GPColor(Black);
    GPmove(X,Y);
    GPLine(X,Y);
    Angle := (Angle + Step) mod 1080;
    X := round(Radius shl 1 * Cosine[Angle] + PolarX);
    Y := round(Radius * Sine[Angle] + PolarY);
    GPColor(Color);
    GPmove(X,Y);
    GPLine(X,Y);
    end;

end;

Procedure Rockets_Red_Glare;

Var
  I,J         : Integer;
  X,Y,C       : Integer;
  Star        : Integer;

Begin
GPMerge(0);
Star := 0;
Repeat
  Star := Succ(Star) Mod (Max_Stars + 1);
{  if Star = 0
    then
      Time_Step;}
  GPColor(Black);
  With Stars[Star] do
    begin
    X := round(Radius shl 1* Cosine[Angle] + PolarX);
    Y := round(Radius * Sine[Angle] + PolarY);
    C := Color;
    GPmove(X,Y);
    GPLine(X,Y);
    Angle := (Angle + step) mod 1080;
    X := round(Radius shl 1* Cosine[Angle] + PolarX);
    Y := round(Radius * Sine[Angle] + PolarY);
    end;
  For J := 0 to Max_Rockets do
    Begin
    Case Rockets[J].Counter of

      0          : Begin
                   Draw_Rocket(Rockets[J]);
                   Explode_Rocket(Rockets[J]);
                   end;
      -200 .. -1 ,
      1 .. 2,
      4 .. 28,
      30         : Draw_Rocket(Rockets[J]);
      3          : begin
                   Sound(50);
                   Rockets[J].color := Random(15) + 1;
                   Draw_Rocket(Rockets[J]);
                   Nosound;
                   end;

      29          : begin
                   Rockets[J].color := DarkGray;
                   Draw_Rocket(Rockets[J]);
                   end;


      31 .. 1000 : begin
                   End_Rocket(Rockets[J]);
                   if Rockets[J].Counter > (31 + MemorySize)
                     then
                       New_Rocket(Rockets[J]);
                   end;
      end;
    end;
  GPColor(C);
  GPMove(X,Y);
  GPLine(X,Y);
  Until KeyPressed;
end;

begin
  ClrScr;
  Check;
  Init;
  Rockets_Red_Glare;
  TextMode;
end.