old/PAS/STAR.PAS

Uses CRT, Graph;

Const
  otn = 3;
  sizeofplane = 30;
  numofbullets = 50;
  typeofstar = 5;
  NumOfTargets = 3;
  NumOfStars = 3;
{---------------------------------}
Type TStar = record
  x,y,radius,color,ang : integer;
end;
Type TPlane = record
  x,y,ang : integer;
end;
Type TFire = record
  x,y,ang : integer;
  isfired : boolean;
end;

Var
  i : integer;
  stars : array [1..numofstars] of Tstar;
  plane : Tplane;
  crash : boolean;
  shots : array [1..numofbullets] of TFire;
  LeftShot : boolean;
  GunL      : array [1..3] of pointtype;
  GunR      : array [1..3] of pointtype;
  Targets   : array [1..numoftargets] of pointtype;
  Score     : longint;
{---------------------------------------}
Function FreeShot : byte;
var i,rc : byte;
begin
  rc := 0;
  for i := 1 to numofbullets do if not shots[i].isfired then rc :=i;
  FreeShot := rc;
end;{FreeShot}
{--------------------------}
Procedure WriteTarget(index : integer);
Var i : integer;
Begin
  SetColor(White);
 for i := 5 downto 1 do
 if i mod 2 = 1 then begin
   SetFillStyle(SolidFill,Red);
   FillEllipse(targets[index].x,targets[index].y,i*4,i*4);
 end
 else
   begin
     SetFillStyle(SolidFill,White);
     FillEllipse(targets[index].x,targets[index].y,i*4,i*4);
   end;
End;{WriteTarget}
{-----------------------------------}
Procedure Star(x,y,radius,Color,a0: integer);
Var
 dx,dy,i,a : integer;
Begin
  SetColor(color);
  MoveTO(x+round((radius div otn)*cos(pi*a0/180)),
         y+round((radius div otn)*sin(pi*a0/180)));
  for i := 1 to typeofstar * 2 do begin
    a := i*(360 div (typeofstar*2))+a0;
    if i mod 2 = 1 then
      begin
        dx := round(radius*cos((Pi*a)/180));
        dy := round(radius*sin((Pi*a)/180))
      end
    else
      begin
        dx := round((radius div otn)*cos((Pi*a)/180));
        dy := round((radius div otn)*sin((Pi*a)/180))
      end;
    LineTo(x+dx,y+dy);
  end;
End;{Star}
{-------------------------}
Procedure INITG;
Var
  grDriver: Integer;
  grMode: Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
  SetWriteMode(XORPUT);
  randomize;
  for i :=1 to numofbullets do
    with shots[i] do
      begin
        x := 0;
        y := 0;
        ang := 0;
        isfired := false;
      end;
  for i :=1 to numoftargets do
    with targets[i] do
      begin
        x := random(640);
        y := random(480);
      end;
  for i :=1 to numofstars do
    with stars[i] do
      begin
        x := random(640);
        y := random(480);
        radius := random(155)+10;
        color := random(14)+1;
        ang :=0;
      end;
  with plane do
    begin
      x := 100;
      y := 240;
      ang := 0;
    end;
End;{INITG}
{-------------------------------------}
Procedure ShowPlane(x0,y0,ang:integer);
Var
  pl        : array [1..3] of PointType;
  wings     : array [1..3] of pointtype;
  ls        : array [1..3] of pointtype;
Begin
  SetColor(Green);
  with pl[1] do
    begin
      x := round(x0+(sizeofplane div 2)*cos((Pi*ang)/180));
      y := round(y0-(sizeofplane div 2)*sin((Pi*ang)/180));
    end;
  with pl[2] do
  begin
    x  := round(x0-(sizeofplane div 2)*cos((Pi*ang)/180)-(sizeofplane div 10)*cos((Pi*(90-ang))/180));
    y  := round(y0+(sizeofplane div 2)*sin((Pi*ang)/180)-(sizeofplane div 10)*sin((Pi*(90-ang))/180));
  end;
  with pl[3] do
  begin
    x  := round(x0-(sizeofplane div 2)*cos((Pi*ang)/180)+(sizeofplane div 10)*cos((Pi*(90-ang))/180));
    y  := round(y0+(sizeofplane div 2)*sin((Pi*ang)/180)+(sizeofplane div 10)*sin((Pi*(90-ang))/180));
  end;
  with wings[1] do
  begin
    x  := round(x0+(sizeofplane div 4)*cos((Pi*ang)/180));
    y  := round(y0-(sizeofplane div 4)*sin((Pi*ang)/180));
  end;
  with wings[2] do
  begin
    x  := round(x0-(sizeofplane div 2)*cos((Pi*(90-ang))/180));
    y  := round(y0-(sizeofplane div 2)*sin((Pi*(90-ang))/180));
  end;
  with wings[3] do
  begin
    x  := round(x0+(sizeofplane div 2)*cos((Pi*(90-ang))/180));
    y  := round(y0+(sizeofplane div 2)*sin((Pi*(90-ang))/180));
  end;
  with ls[1] do
  begin
    x  := round(x0-(sizeofplane div 3)*cos((Pi*ang)/180));
    y  := round(y0+(sizeofplane div 3)*sin((Pi*ang)/180));
  end;
  with ls[2] do
  begin
    x  := round(x0-(sizeofplane div 2)*cos((Pi*ang)/180)-(sizeofplane div 4)*cos((Pi*(90-ang))/180));
    y  := round(y0+(sizeofplane div 2)*sin((Pi*ang)/180)-(sizeofplane div 4)*sin((Pi*(90-ang))/180));
  end;
  with ls[3] do
  begin
    x  := round(x0-(sizeofplane div 2)*cos((Pi*ang)/180)+(sizeofplane div 4)*cos((Pi*(90-ang))/180));
    y  := round(y0+(sizeofplane div 2)*sin((Pi*ang)/180)+(sizeofplane div 4)*sin((Pi*(90-ang))/180));
  end;
  with GunL[1] do
  begin
    x  := round(x0-((sizeofplane div 4)-(sizeofplane div 32))*cos((Pi*(90-ang))/180));
    y  := round(y0-((sizeofplane div 4)-(sizeofplane div 32))*sin((Pi*(90-ang))/180));
  end;
  with GunL[2] do
  begin
    x  := round(x0-((sizeofplane div 4)+(sizeofplane div 32))*cos((Pi*(90-ang))/180));
    y  := round(y0-((sizeofplane div 4)+(sizeofplane div 32))*sin((Pi*(90-ang))/180));
  end;
  with GunL[3] do
  begin
    x  := round(GunL[2].X+(sizeofplane div 4)*cos((Pi*ang)/180));
    y  := round(GunL[2].Y-(sizeofplane div 4)*sin((Pi*ang)/180));
  end;
  with GunR[1] do
  begin
    x  := round(x0+((sizeofplane div 4)-(sizeofplane div 32))*cos((Pi*(90-ang))/180));
    y  := round(y0+((sizeofplane div 4)-(sizeofplane div 32))*sin((Pi*(90-ang))/180));
  end;
  with GunR[2] do
  begin
    x  := round(x0+((sizeofplane div 4)+(sizeofplane div 32))*cos((Pi*(90-ang))/180));
    y  := round(y0+((sizeofplane div 4)+(sizeofplane div 32))*sin((Pi*(90-ang))/180));
  end;
  with Gunr[3] do
  begin
    x  := round(GunR[2].X+(sizeofplane div 4)*cos((Pi*ang)/180));
    y  := round(GunR[2].Y-(sizeofplane div 4)*sin((Pi*ang)/180));
  end;
  SetColor(LightGray);
  SetFillStyle(SolidFill,blue);
  FillPoly(3,pl);
  SetFillStyle(SolidFill,Green);
  FillPoly(3,GunR);
  FillPoly(3,GunL);
  SetFillStyle(Solidfill,magenta);
  FillPoly(3,wings);
  SetFillStyle(Solidfill,Red);
  FillPoly(3,ls);
End;{ShowPlane}
{-------------------------------}
Procedure ShowStars;
Var
 i : integer;
Begin
  ClearDevice;
  for i := 1 to numofstars do
    with stars[i] do star(x,y,radius,color,ang);
  ShowPlane(plane.x,plane.y,plane.ang);
end;
{---------------------------}
Procedure MoveStars;
Var i,j : byte;shooted:boolean;
Begin
  for i := 1 to numofstars do
    begin
      stars[i].x := stars[i].x+round(stars[i].radius/5);
      inc(stars[i].ang,stars[i].radius div 10);
      if stars[i].ang = 360 then stars[i].ang := 0;
      if stars[i].x+stars[i].radius > 630 then
       with stars[i] do
       begin
        y := random(480);
        radius := random(55)+5;
        color := random(14)+1;
        x := radius;
        ang := 0;
       end;
    end;
  for i := 1 to numofbullets do
    if shots[i].isfired then
      begin
        SetColor(Yellow);
        Line(shots[i].x,shots[i].y,
             shots[i].x+round(20*cos(pi*shots[i].ang/180)),
             shots[i].y-round(20*sin(pi*shots[i].ang/180)));
        shots[i].x := shots[i].x+round((sizeofplane/6)*cos(pi*shots[i].ang/180));
        Shots[i].y := shots[i].y-round((sizeofplane/6)*sin(pi*shots[i].ang/180));
        if (Shots[i].y<2)or(Shots[i].y>478)or(Shots[i].x<2)or(Shots[i].x > 638) then
           Shots[i].isfired := false;
      end;
{  for i := 1 to numoftargets do
      begin
        inc(targets[i].x,sizeofplane div 8);
       if (targets[i].x+20 > 640) then
          begin
            shooted := false;
            targets[i].x:=20;
            targets[i].y:=random(440)+20;
          end
        else
         WriteTarget(i);
      end;}
End;{MoveStars}
{------------------------------}
Procedure movePlane(ang:integer);
Begin
   if (plane.x+round((sizeofplane div 12)*cos(pi*plane.ang/180))-(sizeofplane div 2)  >  1) and
      (plane.x+round((sizeofplane div 12)*cos(pi*plane.ang/180))+(sizeofplane div 2)  < 640)then
        plane.x := plane.x+round((sizeofplane div 12)*cos(pi*plane.ang/180)) else crash := true;
   if (plane.y-round((sizeofplane div 12)*sin(pi*plane.ang/180))-(sizeofplane div 2) > 1) and
      (plane.y-round((sizeofplane div 12)*sin(pi*plane.ang/180))+(sizeofplane div 2) < 480 ) then
        plane.y := plane.y-round((sizeofplane div 12)*sin(pi*plane.ang/180)) else crash := true;
End;
{---------------------------------------------}
Procedure Game;
Var
  ch : char;
  ifexit : boolean;
Begin
 ifexit := false;
 crash := false;
 repeat
   if keypressed then
     begin
       ch := readkey;
       if ch = #0 then ch :=readkey;
       case ch of
         #75 : inc(plane.ang,5);
         #77 : dec(plane.ang,5);
         #27,#13 : ifexit := true;
         #32 : if freeshot <> 0 then
                begin
                 if leftshot then begin
                   shots[Freeshot].x:=gunl[3].X;
                   shots[Freeshot].y:=gunl[3].Y;
                   Leftshot := false;
                  end
                 else begin
                   shots[Freeshot].x:=gunr[3].X;
                   shots[Freeshot].y:=gunr[3].Y;
                   leftshot := true;
                  end;
                 shots[FreeShot].ang := plane.ang;
                 shots[FreeShot].isfired := true;
                end;
       end;
     end;
   MovePlane(plane.ang);
   MoveStars;
   showstars;
 until ifexit or crash;
End;{Game}
{---------------------------------}
Begin
  Initg;
  Game;
  CloseGraph;
End.