Аэродром в горах и управляемый самолет

Program laba13a;
uses
 graph,crt;

 Var
 xc,yc,x,y,vx,vy:array[1..950] of integer;
 l:array[1..950] of boolean;
 gd,gm,x1,x2,y1,y2,x3,x4,y3,y4,y8,dx:integer;
 n,i,j,m:integer;
 c:char;
 p:boolean;

 Procedure cam(x1,x2,y1,y2:integer);
begin
 SetFillStyle(1,10);
 bar(x1,y1,x2,y2);          { Tela camoLetuka }
 
 x3:=((x2-x1) div 2)-5+X1;  { KoopduHaTbl }
 x4:=((x2-x1) div 2)+5+X1;   { HoJKu }
 bar(x3,y2+1,x4,y2+9);           {HojKa}
 
 bar(x3-25,y2+9,x4+25,y2+15);    {nlatfoPma}
 
 setcolor(10);
 y8:=round((y2-y1) div 2)+y1;
 FillEllipse(x1,y8,20,15);     {Cama kabuHa}
                         {noDDepjKa Dl9 lonocTeU}
 bar(x3+3,y1-10,x4-3,y1);    {Cama noddepjka}
 bar(x3-33,y1-13,x4+33,y1-10); {Cama lonaCtb}
 
 bar(x2,y2-9,x2+45,y2);  {KoopDuHaTbl}
 FillEllipse(x2+41,y2-10,10,10);{nPaBou 4aCtu}
end;
 

procedure del(x1,y1,x2,y2:integer); {YdaLeHue caMoLeTuka}
begin
 SetFillStyle(1,1);
 bar(x1,y1-9,x2,y2+15);
 setcolor(1);
 y8:=round((y2-y1) div 2)+y1;
 FillEllipse(x1,y8,20,15);
 bar(x3-33,y1-13,x4+33,y1-10);
 bar(x2,y2-9,x2+45,y2);
 FillEllipse(x2+41,y2-10,10,10);
end;

 procedure boom(x1,y1:integer);
begin
 ClearDevice;
 for i:=1 to 500 do
 begin
  X[i]:= x1+ i mod 10;
  Y[i]:= y1+ i div 10;
  PutPixel(X[i], Y[i], 15);
  VX[i]:= -10 + random(25);
  VY[i]:= -10 + random(25);
  l[i]:=true;
  if vx[i]=0 then
   vx[i]:=10;
  if vy[i]=0 then
   vy[i]:=10
 end;
 for i:=1 to 150 do
 begin
  sound(random(80));
  delay(1);
  nosound
 end;
 Delay(1000);
 SetColor(0);
 Repeat
  p:=false;
  for i:=1 to 500 do
  begin
  if l[i] then
  begin
   if(X[i]+VX[i] > 0) and (X[i]+VX[i] < Getmaxx) and
     (Y[i]+VY[i] > 0) and
     (getpixel(x[i]+vx[i],y[i]+vy[i])<>6) and (getpixel(x[i]+vx[i],y[i]+vy[i])<>4)
   then
   begin
    PutPixel(X[i],Y[i],0);
    X[i]:= X[i]+VX[i];
    Y[i]:= Y[i]+VY[i];
    PutPixel(X[i], Y[i], 14);
    p:=true
   end
    else
    begin
     l[i]:=false;
     VX[i]:= 0;
     VY[i]:= 0;
     sound(200);
     delay(2);
     nosound
    end;
  end;
  if i=300 then
    setbkcolor(random(20+1))
  end;
 Until not(p);
 exit;
end;
 

procedure goPa;
var
 i,j:integer;
begin
 SetFillStyle(1,6);
 i:=1;
 while i<=getmaxx do
 begin
  repeat
   j:=random(450)
  until j>200;
  bar(i,j,i+40,getmaxy);
  inc(i,15);
 end;
 i:=random(getmaxx-115);
 repeat
  j:=random(getmaxy-22);
 until j>300;
 SetFillStyle(1,4);
 bar(i,j,i+60,j+21);
 SetFillStyle(1,0);
 bar(i-25,0,i+115,j)
end;
 

Procedure nobeda;
begin
 closegraph;
 Gotoxy(30,12);
 Writeln('nocaDka bblLa ycneLLIHoU');
 readln;
end;
 

begin
 clrscr;
 repeat
  Gotoxy(30,12);
  writeln('Bblbepute ckoPoCtb ot 0-9');
  c:=readkey;
 until c in [#48..#57];
 case c of
  #48: dx:=0;
  #49: dx:=2;
  #50: dx:=4;
  #51: dx:=6;
  #52: dx:=8;
  #53: dx:=10;
  #54: dx:=12;
  #55: dx:=14;
  #56: dx:=16;
  #57: dx:=18;
 end;
 gd:=Detect;
 InitGraph(gd,gm,'c:\tp7\bgi');
 setbkcolor(1);
 randomize;
 gopa;
 x1:=getmaxx div 2;
 y1:=getmaxy div 2 -150;
 
 cam(x1,x1+60,y1,y1+30);
 if dx=0 then
 begin
  repeat
   dx:=15;
   p:=true;
   if y1+46+dx<getmaxy then
   begin
    m:=x3-25;
    n:=y1+53;
    p:=true;
    while (m<=x4+25) and (p) do
    begin
     if getpixel(m,n)=6 then
     begin
      boom(x1,y1);
      c:=#27;
      p:=false;
     end;
      inc(m);
     end;
    if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
    then
     p:=false;
    if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
    then
     p:=false;
    m:=x1+61;
    while (m<=x1+110) and (p) do
    begin
    if getpixel(m,y1+37)=6 then
    begin
     boom(x1,y1);
     c:=#27;
     p:=false;
    end;
    inc(m);
    end;
   if not(p) then
   begin
    boom(x1,y1);
    p:=false;
   end
   else
   begin
    SetFillStyle(1,1);
    del(x1,y1,x1+60,y1+30);
    y1:=y1+dx;
    cam(x1,x1+60,y1,y1+30)
   end
  end
  else
  begin
   SetFillStyle(1,1);
   del(x1,y1,x1+60,y1+30);
  if y1+46+1<=getmaxy then
  begin
   y1:=y1+1;
   cam(x1,x1+60,y1,y1+30)
  end
  else
   cam(x1,x1+60,y1,y1+30)
  end;
  Delay(60000);
 until not(p)
 end
 
 else
 begin
 
  repeat
   if keypressed then
   begin
    c:=readkey;
    case ord(c) of  {Huz,Bepx,Lebo,npabo}
     49: dx:=2;
     50: dx:=4;
     51: dx:=6;
     52: dx:=8;
     53: dx:=10;
     54: dx:=12;
     55: dx:=14;
     56: dx:=16;
     57: dx:=18;
         {////////BnpaBo//////////////}
     77: if x1+111+dx<getmaxx then
          begin
           p:=true;
           if getpixel(x1+115,y1+25)=6 then
           begin
             boom(x1,y1);
             c:=#27;
             p:=false;
           end;
           Putpixel(x1+115,y1+25,9);
           m:=x1+61;
           while (m<=x1+110) and (p) do
           begin
            if getpixel(m,y1+33)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
            inc(m);
           end;
           m:=y1+32;
           while (m<=y1+45) and (p) do
           begin
            if getpixel(x1+64,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
            inc(m);
           end;
           if p then
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            x1:=x1+dx;
            cam(x1,x1+60,y1,y1+30);
            m:=x1+61;
           end;
          end
         else
         begin
          SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);;
           if x1+111+1<=getmaxx then
           begin
            x1:=x1+1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
         {////////BnpaBo//////////////}
 
         {////////BLeBo//////////////}
     75: if x1-dx-20>0 then
          begin
           p:=true;
           if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
           then
            p:=false;
            if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8-5)=6) or (getpixel(x1-20,y8-10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8-15)=6) or (getpixel(x1-10,y8-17)=6)
            then
            p:=false;
           m:=y8+19;
            while (m<y8+31) and (p) do
            begin
            if GetPixel(x1-5,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
             inc(m);
            end;
           m:=y8-17;
           while (m>=y8-28) and p do
           begin
            if GetPixel(x1-10,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;   
            dec(m);
           end;
           if not(p) then
           begin
            boom(x1,y1);
            c:=#27;
            p:=false;
           end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            x1:=x1-dx;
            cam(x1,x1+60,y1,y1+30);
           end
          end
          else
          begin
           SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           if x1-1-20>=0 then
           begin
            x1:=x1-1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
       {////////BLeBo//////////////}
 
       {////////BBepX//////////////}
     72: if y1-13-dx>0 then
          begin
           SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           y1:=y1-dx;
           cam(x1,x1+60,y1,y1+30);
          end
         else
         begin
          SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           if y1-13-1>=0 then
           begin
            y1:=y1-1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
         {////////BBepX//////////////}
 
         {////////BHu3//////////////}
     80: if y1+46+dx<getmaxy then
          begin
           p:=true;
           m:=x3-5;
           n:=y1+60;
            while (m<=x4+5) and (p) do
            begin
             if getpixel(m,n)=4 then
              p:=false;
             inc(m);
            end;
           if not p then
           begin
            c:=#27;
            nobeda;
           end;
           m:=x3-25;
           n:=y1+50;
           p:=true;
            while (m<=x4+25) and (p) do
            begin
             if getpixel(m,n)=6 then
             begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end;
             inc(m);
            end;
           if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
           then
            p:=false;
            m:=x1+61;
            while (m<=x1+110) and (p) do
            begin
             if getpixel(m,y1+35)=6 then
             begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end;
             inc(m);
            end;
           if not(p) then
           begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            y1:=y1+dx;
            cam(x1,x1+60,y1,y1+30)
           end
           end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
           if y1+46+1<=getmaxy then
           begin
            y1:=y1+1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
           end
         {////////BHu3//////////////}
    end;
   end;
  until c=#27;
 end;
 closegraph;
end.

автор lexus_ilia