program d;
uses crt,dos;
const namereg:array[1..12] of string[15]=
('ввод данных',
 'просмотр',
 'запись в файл',
 'открыть файл',
 'лучший игрок',
 'счет по таймам',
 'чистая база',
 'удалить запись',
 'добавить запись',
 'изменить запись',
 'открыть базу',
 'выход');
 type
  Tcom=record
   name:string;
    count:integer;
 end;
 ar=array [1..10] of tcom;
 ar1=array [1..2] of tcom;
 Tigrok=record
 name:string[30];
 ochki:integer;
 end;
 igrok=record
   com,surname:string[30];
      time:real;
      goal:byte;
      end;
  Tarr= array [1..100] of igrok;

  Igroktree=^Ttree;
  Ttree=record
   data:igrok;
   left,right:Igroktree;
   end;

 var key,sym:char;
 regime,j,i,o4ki,qu:integer;
 comname,str,name1,name:string;
 comands,comands1,c,q,q1:Tarr;
  k,z,z1:byte;
  a:ar;
  b:ar1;
  tree:igroktree;


   Procedure win(s: string);
 begin
  window(25,8,78,20);
  writeln( '╔═══════════════════════════════╗');
  writeln( '║                               ║');
  writeln( '║',s,'║');
  writeln( '║                               ║');
  writeln( '╚═══════════════════════════════╝');
  gotoxy(2,2);
 end;
{======функция добавляющая лист к дереву=============}
 Function AddTree(Top:igroktree;NewNode:igrok):igroktree;
  begin
   if top=nil then
     begin
      new(top);
      top^.data:=newnode;
      top^.left:=nil;
      top^.right:=nil;
     end
   else
    if top^.data.surname>newnode.surname then
     top^.left:=addtree(top^.left,newnode)
    else if top^.data.surname<newnode.surname then
     top^.right:=addtree(top^.right,newnode);
     addtree:=top;
   end;

   {=====  процедура организации дерева  ============}
Procedure OrgTree(name:string);
var
top:igroktree;
 f:file of igrok;
 r:igrok;
 begin
  win('идет построение дерева') ;
  readln;
  assign(f,name);
{$i-}
        reset(f);
          {$i+}
          if ioresult<>0 then win('      Файл не найден!          ')
          else

           while not eof(f) do
            begin
             read(f,r);
             top:=addtree(top,r);
            end;
           end;









  procedure Insert( b:tarr; var a:tarr; n:integer);
var i,j: byte;
    x,z:igrok;
    begin
    a:=b;
     for i:=2 to n do
      begin x:=a[i];
       j:=i-1 ;
        while (a[j].com>x.com) and (j>0) do
         begin
          a[j+1]:=a[j];
          dec(j);
         end;
        while (a[j].com = x.com) and (a[j].surname > x.surname) and (j>0) do
         begin
          a[j+1]:=a[j];
          dec(j);
         end;
        a[j+1]:=x;
        end;
       end;



   Function Upcase_rus(s:char):char;
   Begin
    If (s>='а')and(s<='п')then Upcase_rus:=chr(ord(s)-32) else
    If (s>='р')and(s<='я')then Upcase_rus:=chr(ord(s)-80) else
    Upcase_rus:=Upcase(s);
   End;
{----------------------------------------------------------------------------}
  Procedure Upcase_slovo(Var s:string);
   Var i:integer;
   Begin
    for i:=1 to length(s) do
     s[i]:=Upcase_rus(s[i]);
   End;


procedure skolko_o4kov(a:tarr;z:byte;var k:tarr ; var count : integer);
var i,j:integer;

 wasFounded : boolean;
begin
  k[1].com:= a[1].com;
  k[1].surname := a[1].surname;
  k[1].goal := a[1].goal;
  count := 1;
  for i:=2 to z do begin
      wasFounded := false;
      for j := 1 to count do begin
          if (a[i].surname = k[j].surname) then begin
              k[j].goal := k[j].goal + a[i].goal;
              wasFounded := true;
              break;
          end;
      end;
      if not(wasFounded) then begin
          count := count + 1;
          k[count].surname := a[i].surname;
          k[count].goal := a[i].goal;
          k[count].com:= a[i].com;
               end;
  end;
end;


Procedure sortByIndex(a:tarr; z:byte; var k:tarr);
  type TIndex = array [1..100] of integer;
  var index : TIndex;
      i, j, max, max_index, sr_elem : integer;

Begin
     for i := 1 to z do index[i]:=i;
     for i := 1 to z-1 do begin
         max := 0;
         max_index := i;
         for j := i to z do begin
             if (a[index[j]].goal > max) then begin
                 max := a[index[j]].goal;
                 max_index := j;
             end;
         end;
         sr_elem := index[max_index];
         index[max_index] := index[i];
         index[i] := sr_elem;
     end;
     for i := 1 to z do
         k[i] := a[index[i]];
End;


procedure window_input(name: string);
 begin
  textbackground(yellow);
  window(25,8,78,20);
  writeln( '╔═',name,'═╗');
  writeln( '║                             ║');
  writeln( '║                             ║' );
  writeln( '╚═════════════════════════════╝');

  gotoxy(2,2);
  textbackground(black);

 end;


procedure winmy(s:string);
begin
textbackground(yellow);
  window(25,8,78,20);
  writeln( '╔═',s,'═════════╗');
  writeln( '║                                    ║');
  writeln( '║                                    ║');
  writeln( '╚════════════════════════════════════╝');
  gotoxy(2,2);
  textbackground(black);
    end;

 procedure Menu(var pos:integer);
var i:integer;

  procedure Cursor(on:boolean);
   var r: registers;
    begin
     r.ah:=1;
      if on then begin
        r.ch:=6;
        r.cl:=7;
        end
      else r.ch:=$20;
      intr(16,r);
      end;
     begin
     window(1,1,80,25);
     textbackground(11);
     clrscr;
     textbackground(1);
     WINDOW(32,6,49,21);
     clrscr;
     textcolor(7);
     gotoxy(1,1);
     write('╔════════════════╗');
     for i:=1 to 14 do
       begin
        gotoxy(1,i+1);
     write('║                ║');
     end;
    WINDOW(32,6,49,23);
    gotoxy(1,16);
    write( '╚════════════════╝');
    for i:=1 to 12 do
      begin
       gotoxy(3,i+2);
       write(namereg[i]);
       end;
    textbackground(7);
    textcolor(1);
    gotoxy(3,pos+2);
    write(namereg[pos]);
    cursor(false);
    repeat
       key:=readkey;
       if ord(key)<>13 then
          begin

           textbackground(9);
           textcolor(7);
           gotoxy(3,pos+2);
           write(namereg[pos]);
           if ord(key)=0 then
            begin
            key:=readkey;
            if ord(key)=80
             then if pos=12 then pos:=1 else pos:=pos+1
             else if ord(key)=72 then if pos=1 then pos:=12 else pos:=pos-1;
            end;
          textbackground(7);
          textcolor(1);
          gotoxy(3,pos+2);
          write(namereg[pos]);
          end
       until key=chr(13);
       WINDOW(1,1,80,25);
       cursor(true);
       textbackground(0);
       textcolor(15);
       clrscr;
       end;

procedure readfromfile(name:string; var comands:tarr; var z:byte);
var                        {чтение в массив из файла}
f:file of igrok;
i,j:integer;
begin
j:=0;z:=0;
assign(f,name);
{$i-}
        reset(f);
          {$i+}
          if ioresult<>0 then win('      Файл не найден!          ')
          else
           begin
           while not eof(f) do
              begin
              j:=j+1;
              read(f,comands[j]);
              inc(z);
                   end;
             for i:=1 to z do
              if comands[i].com='' then z:=z-1;

             close(f);
             end;
             end;

procedure save(comands:tarr; name:string;z:byte);
var
 f:file of igrok;
 i:byte;
   begin
   assign(f,name);
        rewrite(f);
         for i:=1 to z do
         write(f,comands[i]);
         close(f) ;
    end;

procedure Filldata ( var r:Tarr; var z:byte);
 var i:byte;
     s:string;
 begin
  begin
   z:=0;
   i:=1;
    repeat
     with r[i] do
      begin
      inc(z);
    write('введите название команды:');
    readln(s);
    Upcase_slovo(s);
    com:=s;
    write('Ведите фамилию ',i,'-ого игрока:');
    readln(s);
    Upcase_slovo(s);
    surname:=s;
    repeat
    write('введите время попадания(мин.сек):');
    readln(time);
    until time>0;
    write('введите очки за мяч(1,2 или 3):');
    readln(goal);
     writeln;

    if  (goal<>1) and (goal<>2) and (goal<>3) then
     repeat
    writeln('Вы ввели недопустимое количество очков!');
    writeln('Повторите ввод! Очки за мяч:');
    readln(goal)
    until (goal=1) or (goal=2) or (goal=3) ;
    inc(i);
    end;
    write('Вы хотите продолжить ввод? Y/N:');
    repeat
     readln(sym);
    until ( sym='Д') or( sym='Н') or ( sym='Y') or ( sym='N')
    or ( sym='y') or ( sym='n') or ( sym='д') or  ( sym='н') ;
    until ( sym='N') or ( sym='n') or ( sym='н') or ( sym='Н') ;
    end;
   writeln('Спасибо!Ввод завершен.Нажмите ENTER! ');
  readln;
 end;

procedure showtable (comands:Tarr; size:byte);
var i:integer;


begin

writeln('+---------------+----------+----------+---------+');
writeln('|  КОМАНДА      |    ИГРОК |    ВРЕМЯ |   ОЧКИ  |');
writeln('+---------------+----------+----------+---------+');

 for i:=1 to size do
  with comands[i] do
   if  com<>'' then
    begin
    if time>=10 then
     writeln('|',i,com:9,'|':6, surname:7,'|':4,time:2:3,'|':5,goal:4,'|':6)
     else
     writeln('|',i,com:9,'|':6, surname:7,'|':4,time:2:3,'|':6,goal:4,'|':6);
     writeln('+---------------+----------+----------+---------+');
    end;
     writeln('ОБЩИЙ СЧЕТ  :', a[1].name:5,' | ',a[7].name);
     writeln('                 ', b[1].count,' : ', b[2].count);
readln;
end;

procedure delete_file;
{Удаление файла}
var ff: File of igrok;
    put: string;
 begin
  window_input('Введите полное имя файла═══');
  readln(put);
  assign(ff,put);

  {$I-}
              erase(ff);
  {$I+}
  if IOresult<>0 then
    begin
     clrscr;
     textcolor(4);
     textbackground(black);

     win('  Такого файла не существует!  ');

     readln;
    end
  else
    begin
     clrscr;
     textcolor(4);
     win('         Файл удален!          ');

     readln;
    end
 end;

Procedure igrokresult
(comands:tarr; com:string; var name:string; var ochki:integer);
var i,j,k,t,max,maxi:integer;
  mas : array [1..10] of Tigrok;
   begin
   maxi:=0;
   name:='';
   ochki:= 0;
      for i:=1 to 50 do
      if comands[i].com=com then
      begin
      j:=1;
      while (mas[j].name<>'')and(mas[j].name<>comands[i].surname) do inc(j);
      mas[j].name:=comands[i].surname;
      mas[j].ochki:=mas[j].ochki+comands[i].goal;
      end;

 maxi:=1;

 for i:=2 to 10 do
 if mas[maxi].ochki<mas[i].ochki then
 maxi:=i else maxi:=1;

 name:=mas[maxi].name;
 ochki:=mas[maxi].ochki;
  mas[maxi].ochki:=0;
  mas[maxi].name:='';
 end;

procedure times (comands:tarr; var a:ar ;var b:ar1);
var i,j:integer;
begin
i:=1;
a[1].count:=0;  a[5].count:=0;  a[1].name:='';  a[6].name:='';
a[2].count:=0;  a[6].count:=0; a[2].name:='';   a[7].name:='';
a[3].count:=0;  a[7].count:=0; a[3].name:='';   a[8].name:='';
a[4].count:=0;  a[8].count:=0; a[4].name:='';   a[9].name:='';
a[9].count:=0;  a[10].count:=0; a[5].name:='';  a[10].name:='';
b[1].name:='';  b[2].name:='';   b[1].count:=0; b[2].count:=0;

while comands[i].surname<>'' do
begin
if a[1].name='' then
    begin
     a[1].name:=comands[i].com;
     a[2].name:=comands[i].com;
     a[3].name:=comands[i].com;
     a[4].name:=comands[i].com;
     a[9].name:=comands[i].com;

    end;

if (a[5].name='')and (a[1].name<>comands[i].com) then
begin
a[5].name:=comands[i].com;
a[6].name:=comands[i].com;
a[7].name:=comands[i].com;
a[8].name:=comands[i].com;
a[10].name:=comands[i].com;

end;

if (comands[i].com=a[1].name) and (comands[i].time<=12) then
a[1].count:=a[1].count+comands[i].goal;

if (comands[i].com=a[2].name) and (comands[i].time>12) and
(comands[i].time<=24)  then
a[2].count:=a[2].count+comands[i].goal;

if (comands[i].com=a[5].name) and (comands[i].time<=12) then
a[5].count:=a[5].count+comands[i].goal;

if (comands[i].com=a[6].name) and (comands[i].time>12)and
 (comands[i].time<=24)  then
a[6].count:=a[6].count+comands[i].goal;
 {++++++++++++++++++++++++++++++=}
if (comands[i].com=a[3].name) and (comands[i].time>24) and
(comands[i].time<=36) then
a[3].count:=a[3].count+comands[i].goal;

if (comands[i].com=a[7].name) and (comands[i].time>24)  and
(comands[i].time<=36) then
a[7].count:=a[7].count+comands[i].goal;

if (comands[i].com=a[4].name) and (comands[i].time>36) and
(comands[i].time<=48) then
a[4].count:=a[4].count+comands[i].goal;

if (comands[i].com=a[7].name) and (comands[i].time>36) and
(comands[i].time<=48) then
a[8].count:=a[8].count+comands[i].goal;

if (comands[i].com=a[9].name) and (comands[i].time>48) and
(comands[i].time<=60) then
a[9].count:=a[9].count+comands[i].goal;
if (comands[i].com=a[10].name) and (comands[i].time>48) and
(comands[i].time<=60) then
a[10].count:=a[10].count+comands[i].goal;
b[1].name:=a[1].name;
b[2].name:=a[6].name;
inc(i);
end;

b[1].count:=a[1].count+ a[2].count +a[3].count+a[4].count+a[9].count;
b[2].count:=a[5].count+ a[6].count +a[7].count+a[8].count+a[10].count;
end;

procedure fillforone(comands:tarr; name:string; var z1:byte; var comands1:tarr);
var i:integer;
s:string;
begin
for i:=1 to z1-1 do comands1[i]:=comands[i];
with comands1[z1] do
      begin
    write('введите название команды:');
    readln(s);
    Upcase_slovo(s);
    com:=s;
    write('Ведите фамилию  ',z1,'-ого игрока:');
    readln(s);
    Upcase_slovo(s);
    surname:=s;
    repeat
    write('введите время попадания(мин.сек):');
    readln(time);
    until time>0;
    write('введите очки за мяч(1,2 или 3):');
    readln(goal);
      if  (goal<>1) and (goal<>2) and (goal<>3) then
     repeat
    writeln('Вы ввели недопустимое количество очков!');
    writeln('Повторите ввод! Очки за мяч:');
    readln(goal)
    until (goal=1) or (goal=2) or (goal=3) ;
    end;
    end;

procedure dobavka(z:byte; comands:tarr;name:string ;var comands1:tarr);
var f:file of igrok;
begin
readfromfile(name,comands,z);
z1:=z+1;
fillforone(comands,name,z1,comands1);
assign(f,name);
        rewrite(f);
         for i:=1 to z1 do
         write(f,comands1[i]);
         close(f) ;
readfromfile(name,comands1,z1);
end;

procedure smenabazi ( var name:string);
var f:file of igrok;
begin
window_input('Введите название новой базы');
readln(name);
assign(f,name);
rewrite(f);
win('  Файл  найден и заменен!      ');
readln;
end;
procedure delet
(z:byte; comands:tarr; name:string; var comands1:tarr; var z1:byte);
var f:file of igrok;
n,i:byte;
begin
readfromfile(name,comands,z);
window_input('══Введите номер записи   ══');
repeat
readln(n);
if n<1 then win(' Повторите ввод!!!    ')
until n>=1;
for i:=1 to n-1 do
comands1[i]:=comands[i];
for i:=n to z-1 do
comands1[i]:=comands[i+1];
z1:=z-1;
assign(f,name);
        rewrite(f);
         for i:=1 to z1 do
         write(f,comands1[i]);
         close(f) ;
readfromfile(name,comands1,z1);
end;

procedure izmena(comands:tarr; name:string; var comands1:tarr);
var f:file of igrok;
ch:char;  n:byte;
com,surname:string;
time:real;
goal:byte;
begin
readfromfile(name,comands,z);
comands1:=comands;
window_input('══Введите номер записи   ══');
repeat
readln(n);
if n<1 then win(' Повторите ввод!!!    ')
until n>=1;
window(10,15,20,35);
  writeln('╔═══════════════════╗');
  writeln('║Что будем менять?  ║');
  writeln('║1-команду          ║');
  writeln('║2-фамилию          ║');
  writeln('║3-время            ║');
  writeln('║4-очки             ║');
  writeln('╚═══════════════════╝');
  writeln;
  repeat

  readln(ch);
  if (ch<>'1') and (ch<>'2') and (ch<>'3') and  (ch<>'4')
  then writeln('Повторите ввод!');
  until  (ch='1') or (ch='2') or (ch='3') or  (ch='4');
  case ch of
  '1': begin
  clrscr;
 writeln(  comands1[n ].com);

   writeln('Введите новое название:');
   readln(com);
   comands1[n].com:=com;
   end;
   '2': begin
   clrscr;
   writeln(comands1[n].surname);
   writeln('Введите новую фамилию:');
   readln(surname);
   comands1[n].surname:=surname;
   end;
   '3':begin
   clrscr;
   writeln( comands1[n].time);
   writeln('Введите новое время:');
   readln(time );
   comands1[n].time:=time;
   end;
   '4':begin
   clrscr;
   writeln( comands1[n].goal);
   writeln('Введите новый счет:');

   readln(goal);
   if  (goal<>1) and (goal<>2) and (goal<>3) then
     repeat
    writeln('Вы ввели недопустимое количество очков!');
    writeln('Повторите ввод! Очки за мяч:');
    readln(goal)
    until (goal=1) or (goal=2) or (goal=3) ;
   comands1[n].goal:=goal;
   end;
   end;
   assign(f,name);
        rewrite(f);
         for i:=1 to z do
         write(f,comands1[i]);
         close(f) ;
readfromfile(name,comands1,z);
end;

procedure openbase(var name:string; var comands:tarr; var z:byte);
var namef:string;
     f:file of igrok;
     j:byte;
 begin
 j:=1; z:=0;
  window_input('═══Введите имя файла═══════');
  readln(namef);
  assign(f,namef);
{$i-}
        reset(f);
          {$i+}
	  if ioresult<>0 then
	  begin
	  win('      Файл не найден!          ');readln;
	  end

          else
           begin
           while not eof(f) do
              begin

              read(f,comands[j]);
              inc(z);
              j:=j+1;
                   end;
             for i:=1 to z do
              if comands[i].com='' then z:=z-1;

             close(f);
           name:=namef;
           end;
           end;










{═════╗╗╗╗╗ ОСНОВНАЯ ПРОГРАММА╗╗╗╗╗════════}
begin
 clrscr;
  name:='dat.dat';
   regime:=1;
        repeat
         menu(regime);
         case regime of
         1:begin
         filldata(comands,z);
         save(comands,name,z);
         end;
         2:begin;
         readfromfile(name,comands,z);
         times(comands,a,b);
         showtable(comands,z);
          end;
         3:begin

         insert(comands,c,z);
          for i:=1 to z do writeln(c[i].com,' ',c[i].surname);
          readln;
         end;

         4:begin
         skolko_o4kov (comands,z,c,qu);
         sortByIndex(c, z, q) ;
         for i:=1 to qu do writeln(q[i].goal,' ',q[i].surname);
         readln;
         end;
         5: begin
         writeln('ВВЕДИТЕ НАЗВАНИЕ КОМАНДЫ:');
         READLN(STR);
         igrokresult (comands,str,name1,o4ki);
         writeln(name1,'  ', o4ki);
         readln;
         end;
         6: begin
        readfromfile(name,comands,z);
        times(comands,a,b);
        textbackground(1);
        WINDOW(32,6,49,19);
        writeln( a[1].name,'|',a[5].name);
        for i:=1 to 4 do
         begin
           writeln(i,' тайм ',a[i].count,'|',a[i+4].count);
            end;
           if (a[9].count>0) or (a[10].count>0) then
         begin
         textbackground(1);
        WINDOW(32,6,49,19);
        writeln( a[1].name,'|',a[5].name);
          for i:=1 to 4 do  begin
          writeln(i,' тайм ',a[i].count,'|',a[i+4].count);
                   end;
                   writeln(5,' тайм ',a[9].count,'|',a[10].count);
                  end;
                  writeln('Общий счет:');
                  writeln(b[1].name,' : ', b[2].name);
                   writeln(b[1].count,' : ', b[2].count);

         a[i+2].count:=0;
         readln;
          end;
        7:smenabazi(name) ;
        8: begin
         delet(z,comands,name,comands1,z1);
         comands:=comands1;
         z:=z1;
         end  ;
        9:  begin
        dobavka(z,comands,name,comands1);
        comands:=comands1;
        end;
        10:begin
        izmena(comands, name, comands1);
        comands:=comands1;
        end;
         11:openbase(name,comands,z);
         12:;
         end;
     until regime=12;
   end.