Uses  Crt, Graph;
Const del = #219+#219+#219+#219;
Var   Gd,Gm:      Integer;
      x,y,lx,ly:  Integer;
      ang,forc:   LongInt;
      lin,x1,y1:  Integer;
      dx,dy:      Integer;
      direction:  Integer;
      dirx,diry:  Integer;
      radang:     Real;
      ax,ay:      Real;
      ch:         Char;
      s:          String;
      press,view: Boolean;

{ ===== Drawing BALL ===== }

Procedure Ball(bx,by,col:Integer);
Begin
  SetColor(col);
  SetFillStyle(1,col);
  FillEllipse(bx,by,5,5)
End;

{ ===== Drawing GameTABLE ===== }

Procedure Table;
Begin
  SetColor(LightGray);
  Rectangle(30,30,(GetMaxX-50),(GetMaxY-70));
  OutTextXY(10,10,'ANGLE:');
  OutTextXY(120,10,'FORCE:')
End;

{ ===== Start Significances ===== }

Procedure Initialize;
Begin
  Gd:=Vga;
  Gm:=VgaHi;
  InitGraph(Gd,Gm,'');
  SetTextStyle(0,0,0);
  Table;
  SetColor(Black);
  SetFillStyle(1,Red);
  SetLineStyle(0,1,0);
  x:=320;
  ax:=x;
  y:=240;
  ay:=y;
  direction:=1;
  ly:=415;
  Ball(x,y,White);
  view:=TRUE;
  dirx:=-1;
  diry:=-1
End;

{ ===== Playing 'BOOM!' ===== }

Procedure Play;
Begin
  Sound(100);
  Delay(6000);        {Podobrat'!}
  NoSound
End;

{ ===== Calculating Position Of The Ball ===== }

Procedure Calculate(angle:Real;force:Integer);
Begin
  ax:=ax+0.05*dirx*cos(angle)*force;
  ay:=ay+0.05*diry*sin(angle)*force;
  if ax < 37  then
  begin
    ax := 37;
    dirx := dirx * (-1);
    Play
  end
  else
  if ax > 582 then
  begin
    ax := 582;
    dirx := dirx * (-1);
    Play
  end;

  if ay < 37  then
  begin
    ay := 37;
    diry := diry * (-1);
    Play
  end
  else
  if ay > 402 then
  begin
    ay := 402;
    diry := diry * (-1);
    Play
  end
End;

{ ===== Drawing Stick ===== }

Procedure Stick(x,y,col:Integer);
Var ax1,ay1,ax2,ay2: Real;
    x1,x2,y1,y2: Integer;
Begin
   ax1 := 15  * cos(radang);
   ax2 := 100 * cos(radang);
   ay1 := 15  * sin(radang);
   ay2 := 100 * sin(radang);
   x1:=x+Trunc(ax1);
   x2:=x+Trunc(ax2);
   y1:=y+Trunc(ay1);
   y2:=y+Trunc(ay2);
   if view = TRUE then SetColor(col)
   else SetColor(Black);
   Line(x1,y1,x2,y2);
   Table
End;

{ ===== Interrogation Of Keys ===== }

Procedure AskKeys;

{ ----- Printing The Force Of Kick ----- }
Procedure PrintForce;
Begin
  forc:= 420-ly;
  Str(forc,s);
  SetColor(Black);
  OutTextXY(170,10,del);
  SetColor(LightBlue);
  OutTextXY(170,10,s);
End;

{ ----- Printing The Angle Of Stick ----- }
Procedure PrintAngle;
Begin
  Str(ang,s);
  SetColor(Black);
  OutTextXY(60,10,del);
  SetColor(LightBlue);
  OutTextXY(60,10,s)
End;

Begin
  Stick(x,y,White);
  if KeyPressed then begin
     Stick(x,y,Black);
     ch:=ReadKey;
     if ch = #0 then begin
        ch:=ReadKey;
        Case ch of
          #77: begin
                 ang:=ang+2;
                 radang:=(ang*PI)/180;
                 if ang >= 360 then ang:=ang-360
               end;
          #75: begin
                 ang:=ang-2;
                 radang:=(ang*PI)/180;
                 if ang < 0 then ang:=ang+360
               end
        end
     end;
     Stick(x,y,White);
     PrintAngle;
     if (ch = #32) AND (view = TRUE) then begin
        PrintForce;
        press:= TRUE
     end
  end
End;

{ ===== Seting The Force Of The Kick ===== }

Procedure Force;
Begin
  if view = TRUE then begin
    if (direction = -1) then
    begin
      ly:=ly+5;
      SetColor(Black);
      Line(600,ly,620,ly);
      Delay(5000);    {Podobrat'!}
      if ly > 410 then direction := 1
    end
    else
    begin
      ly:=ly-5;
      if ly > 25  then SetColor(LightRed);
      if ly > 80  then SetColor(Yellow);
      if ly > 300 then SetColor(Green);
      Line(600,ly,620,ly);
      Delay(5000);    {Podobrat'!}
      if ly < 31 then direction := -1
    end
  end
End;

{ ===== Moving The Ball ===== }

Procedure Kick;
Begin
  if press then begin
     view := FALSE;
     Stick(x,y,Black);
     Repeat
       x:=Round(ax);
       y:=Round(ay);
       Ball(x,y,Black);
       Calculate(radang,forc);
       forc:=forc-Round(Ln(forc));
       x:=Round(ax);
       y:=Round(ay);
       Ball(x,y,White);
       Table;
       Delay(10000);  {Podobrat'!}
     Until forc < 2;
     view := TRUE;
     press := FALSE;
     dirx := -1;
     diry := -1
  end
End;

{#########################################################
 ###                                                   ###
 ###                      M A I N                      ###
 ###                                                   ###
 #########################################################}

BEGIN
  Initialize;
  Repeat
    Force;
    AskKeys;
    Kick
  Until ch = #27;
  CloseGraph
END.