PROGRAM Game;

USES
 Dos, Crt, Graph;

CONST
 HowMuchBalls = 20;
 SecondForGame = 60;
 FramePerVerifyTime = 20;
 BallRadius = 10;
 MenuHelp = 'Press "DOWN", "UP" and "ENTER" to select action.';
 GameName = 'KYPCOBA9(';
 MenuElements: Array [1..4] of String = ('Play','Champions','Help','Exit');

TYPE
 Man = record
	name: String[15];
	score: Byte
       end; {man}

{------------------------------ Object "Ball" -------------------------------}

 Ball = object
	 x: Byte;
	 y: Real;
	 speed: Real;
	 active: Boolean;
	  Constructor Init(x0: Word);
	  procedure Draw(show: Boolean);
	  Destructor Done;
	end; {Ball}

 Constructor Ball.Init(x0: Word);
  begin
   active:=true;
   x:=x0;
   y:=31 + BallRadius
  end; {Ball.Init}

 Procedure Ball.Draw(show: Boolean);
  begin
    if show
    then SetColor(1)
    else SetColor(0);
   SetLineStyle(0,0,1);
   Circle(x*32, Round(y), BallRadius)
  end; {Ball.Draw}

 Destructor Ball.Done;
  begin
   active:=false
  end; {Ball.Done}

{----------------------------------------------------------------------------}

VAR
 gd, gm: Integer;
 ch: Char;
 men: Array [1..10] of man;

{----------------------------------------------------------------------------}

Procedure Help;
 begin
  ClearDevice;
   SetTextJustify(CenterText,0);
   SetColor(4);
   SetTextStyle(SmallFont,0,10);
  OutTextXY(320,40,'HELP');
   SetTextStyle(SmallFont,0,7);
  OutTextXY(320,80,'During game press LEFT and RIGHT to move trap.');
  OutTextXY(320,110,'Press ESC for exit.');
  OutTextXY(320,170,'Try to catch maximum balls.');
  OutTextXY(320,220,'Than time remaining less,');
  OutTextXY(320,250,'that balls fall quicker and their amount less.');
  OutTextXY(320,310,'When time not remain, game completed.');
  OutTextXY(320,340,'Maybe, you will get the place in table of champions!');
  OutTextXY(320,400,'Good luck!!!');

   SetTextStyle(SmallFont,0,7);
   SetColor(2);
  OutTextXY(320,450,'Press ESC to return to main menu.');

  repeat ch:=readkey
  until ord(ch) = 27
 end; {Help}

{----------------------------------------------------------------------------}

Procedure LoadChamp;
 var
  fil: File;
  i: Byte;
 begin
  Assign(fil,'DATA');
  Reset(fil,1);
   for i:=1 to 10
   do begin
       BlockRead(fil,men[i].name,15);
       BlockRead(fil,men[i].score,1)
      end;
  Close(fil)
 end; {LoadChamp}

{----------------------------------------------------------------------------}

Procedure SaveChamp;
 var
  fil: File;
  i: Byte;
 begin
  Assign(fil,'DATA');
  ReWrite(fil,1);
   for i:=1 to 10
   do with men[i] do
      begin
       BlockWrite(fil,name,15);
       BlockWrite(fil,score,1)
      end;
  Close(fil)
 end; {SaveChamp}

{----------------------------------------------------------------------------}

Procedure Champions;
 var
  i: Byte;
  ScoreString, NumberString: String;
 begin
  ClearDevice;
   SetTextStyle(TriplexFont,0,7);
   SetColor(1);
   SetTextJustify(CenterText,0);
  OutTextXY(320,50,'CHAMPIONS');
   SetColor(4);
   SetTextStyle(TriplexFont,0,5);
  for i:=1 to 10
  do with men[i] do
     begin
      Str(score,ScoreString);
      Str(i,NumberString);
       SetTextJustify(CenterText,0);
      OutTextXY(125,67+i*35,NumberString+'.');
      OutTextXY(515,67+i*35,ScoreString);
       SetTextJustify(LeftText,0);
      OutTextXY(155,67+i*35,name)
     end {with}
 end; {Champions}

{----------------------------------------------------------------------------}

Procedure Play;
 var
  score: Byte;
  time: Integer;
  i, j, frame, place: Byte;
  p: LongInt;
  xTrap: Byte;
  BallAmount, ActiveBallAmount, TotalBalls: Integer;
  TotalBallsString, ScoreString, name: String;
  exit: Boolean;
  win: Boolean;
  balls: Array [1..HowMuchBalls] of Ball;
  places: Array [1..19] of Boolean;
  h1,m1,s1,d1,h2,m2,s2,d2: Word;

 procedure DrawTrap(x,c: Byte);
  begin
    SetColor(c);
    SetLineStyle(0,0,3);
   Line((x-1)*32+1+16, 425, (x-1)*32+1+16, 444);
   Line(x*32-2+16, 425, x*32-2+16, 444);
   Line((x-1)*32+1+16, 444, x*32-2+16, 444)
  end; {DrawTrap}

 procedure WriteScore(show: Boolean);
  var
   string_score: String;
  begin
   if show
   then SetColor(1)
   else SetColor(0);
    Str(score,string_score);
    SetTextJustify(0,0);
    SetTextStyle(TriplexFont,0,3);
    OutTextXY(150,20,string_score)
  end; {WriteScore}

 procedure WriteTime(show: Boolean);
  var
   string_time: String;
  begin
   if show
   then SetColor(1)
   else SetColor(0);
    Str(time,string_time);
    SetTextJustify(0,0);
    SetTextStyle(TriplexFont,0,3);
    OutTextXY(490,20,string_time)
  end; {WriteScore}

 begin
  ClearDevice;

  SetColor(1);
  BallAmount:=HowMuchBalls;
  ActiveBallAmount:=0;
  TotalBalls:=0;
  Score:=0;
  time:=SecondForGame;
  frame:=0;
  SetLineStyle(0,0,1);
  RecTangle(10,30,629,450);

  SetTextJustify(0,0);
  SetTextStyle(TriplexFont,0,3);

  OutTextXY(50,20,'Score: ');
  WriteScore(true);

  OutTextXY(290,20,'Time remaining: ');
  WriteTime(true);
  OutTextXY(530,20,'seconds');

  xTrap:=10;
  exit:=false;

  for i:=1 to BallAmount
  do with balls[i] do
     begin
      active:=false
     end;

  for i:=1 to 19
  do places[i]:=true;

  GetTime(h1,m1,s1,d1);

  repeat
   begin
    Inc(frame);
     if frame = FramePerVerifyTime
     then begin
	   frame:=0;
	   GetTime(h2,m2,s2,d2);
	   p:=(h2*3600+m2*60+s2)-(h1*3600+m1*60+s1);
	    if time <> SecondForGame-p
	    then begin
		  WriteTime(false);
		  time:=SecondForGame-p;
		   if time <= 0
		   then begin
			 time:=0;
			 exit:=true
			end;
		  WriteTime(true)
		 end
	  end;

    if not(balls[BallAmount].active)
    then BallAmount:=Round(5 + (HowMuchBalls-5)*(time/SecondForGame));

     for i:=1 to BallAmount
     do if balls[i].active
	then balls[i].Draw(true);
    DrawTrap(xTrap,15);

     for i:=1 to BallAmount
     do balls[i].speed:=(20 - 15*(time/SecondForGame));

    Delay(1000);

    if keypressed
    then begin
	  ch:=readkey;
	   case ch of
	    #27: begin
		   SetTextJustify(CenterText,0);
		   SetColor(4);
		   SetTextStyle(TriplexFont,0,7);
		  OutTextXY(320,220,'Quit? (y/n)');
		   repeat ch:=readkey
		   until (ord(UpCase(ch)) in [78,89]);
		  if ord(UpCase(ch)) = 89
		  then exit:=true;
		   SetColor(0);
		   OutTextXY(320,220,'Quit? (y/n)')
		 end;
	    #75: if xTrap <> 1
		 then begin
		       DrawTrap(xTrap,0);
		       Dec(xTrap)
		      end;
	    #77: if xTrap <> 19
		 then begin
		       DrawTrap(xTrap,0);
		       Inc(xTrap)
		      end
	   end {case}
	 end;

    for i:=1 to BallAmount
    do with balls[i] do
       begin
	if active
	then begin
	      Draw(false);
	      y:=y + speed*0.1;
	       if y > 40 + 2*BallRadius
	       then places[x]:=true;
	       if (y > 422-BallRadius)and(xTrap = x)
	       then begin
		      WriteScore(false);
		      Inc(Score);
		      WriteScore(true);
		     Done;
		     Inc(TotalBalls);
		     Draw(false);
		     Dec(ActiveBallAmount)
		    end;
	       if y > 447-BallRadius
	       then begin
		     Done;
		     Inc(TotalBalls);
		     Draw(false);
		     Dec(ActiveBallAmount)
		    end
	     end
	else if ActiveBallAmount < BallAmount
	     then if Random(Round(BallAmount*(1000/HowMuchBalls))) = 0
		  then begin
			j:=Random(19)+1;
			 if places[j]
			 then begin
			       Init(j);
			       places[j]:=false;
			       Inc(ActiveBallAmount)
			      end
		       end
       end {with}

   end
  until exit;

  if time = 0
  then begin
	Str(score,ScoreString);
	Str(TotalBalls,TotalBallsString);
	 SetTextStyle(TriplexFont,0,3);
	 SetColor(4);
	 SetTextJustify(CenterText,0);
	OutTextXY(320,180,'End of time!');
	OutTextXY(320,220,'Total balls: '+TotalBallsString+'.   '
			  +'Catched balls: '+ScoreString+'.');
	OutTextXY(320,260,'Press ESC to look the champions.');
	 repeat ch:=readkey
	 until ord(ch) = 27;

	 win:=false;
	 i:=1;
	repeat
	 begin
	  if score > men[i].score
	  then begin
		win:=true;
		place:=i;
		 for j:=10 downto i+1
		 do men[j]:=men[j-1];
		men[i].score:=score;
		men[i].name:=''
	       end
	  else Inc(i)
	 end
	until (win)or(i = 11);

	Champions;
	 SetColor(2);
	 SetTextStyle(TriplexFont,0,3);
	 SetTextJustify(CenterText,0);
	if win
	then begin
	      exit:=false;
	      OutTextXY(320,450,'Write your name and press ENTER.');
	       SetTextStyle(TriplexFont,0,5);
	       SetTextJustify(LeftText,0);
	      name:='';
	      repeat
	       begin
		ch:=readkey;
		 if ord(ch) <> 8
		 then if (length(name) < 15)and(ord(ch) <> 13)
		      then begin
			    name:=name + chr(ord(ch));
			    SetColor(4);
			    OutTextXY(155,67+place*35,name)
			   end
		      else
		 else if name <> ''
		      then begin
			     SetColor(0);
			    OutTextXY(155,67+place*35,name);
			    Delete(name,Length(name),1);
			     SetColor(4);
			    OutTextXY(155,67+place*35,name)
			   end;
		if ord(ch) = 13
		then if length(name) <> 0
		     then exit:=true
	       end
	      until exit;
	      men[place].name:=name;
	      SaveChamp
	     end
	else begin
	      OutTextXY(320,440,'You didn''t get place in the table of chempions.');
	      OutTextXY(320,465,'Press ESC for exit.');
	       repeat ch:=readkey
	       until ord(ch) = 27
	     end
       end
 end; {Play}

{----------------------------------------------------------------------------}

Procedure Menu;
 var
  i: Byte;
  n: Byte;
 procedure WriteElementMenu(number: Byte);
  begin
   SetTextStyle(TriplexFont,0,5);
    if number = n
    then SetColor(4)
    else SetColor(3);
   OutTextXY(320,140+number*50,MenuElements[i])
  end; {WriteElementMenu}
 begin
  repeat
   begin
  ClearDevice;
  n:=1;
   SetTextStyle(TriplexFont,0,7);
   SetTextJustify(CenterText,0);
  SetColor(1);
  OutTextXY(320,50,GameName);
   SetTextStyle(TriplexFont,0,5);
  SetColor(3);
   for i:=1 to 4
   do WriteElementMenu(i);
  SetColor(2);
   SetTextStyle(TriplexFont,0,1);
  OutTextXY(320,450,MenuHelp);

   repeat
    begin
     ch:=ReadKey;
      case ch of
       #72: if n > 1
	    then Dec(n);
       #80: if n < 4
	    then Inc(n)
      end;
     for i:=1 to 4
     do WriteElementMenu(i)
    end
   until (ch = #13);

  case n of
   1: Play;
   2: begin
       Champions;
	SetColor(2);
	SetTextStyle(TriplexFont,0,3);
	SetTextJustify(CenterText,0);
       OutTextXY(320,450,'Press ESC for exit.');
	repeat ch:=readkey
	until ord(ch) = 27
      end;
   3: Help
  end {case}
   end
  until n = 4

 end; {Menu}

{****************************************************************************}

Begin
 Randomize;
 gd:=Detect;
 InitGraph(gd, gm, '');

 LoadChamp;

 SetRGBPalette(0, 0, 0, 0);
 SetRGBPalette(1,63,63,63);
 SetRGBPalette(2,31,31,31);
 SetRGBPalette(3, 0,25, 0);
 SetRGBPalette(4, 0,63, 0);

 Menu;

 CloseGraph
End.