Program na tipovanie zapasov

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)

Autor: Maros Zatko
Program: TIPOVANI.PAS
Potrebné: Ucebnica.doc,  TIPOVANI.zip

Program na tipovanie zapasov. 
{ TIPOVANI.PAS                            Copyright (c) Maros Zatko }
{                                                                   }
{ v programe sa používajú tlacítka:                                 }
{  A až Z, Escape, šípka hore, šípka dole                           }
{                                                                   }
{ Author: Maros Zatko                                               }
{ Date  : 2022                                 http://www.trsek.com }
 
 
program na_TIPovanie_v_stavkovych_kancelariach;
 
{ PREPINANIE klavesou TAB:  p'F' - Tab=1 | '2' - Tab=2 | 'H' - Tab=3  }
 
{A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 16384,0,655360}
 
uses
  crt,dos;
label
  0,1;
const
  c2=2;        { 2 alebo 3 body za vyhru ? - prepinanie F2/F3 }
  c48=46;      { maximalny pocet lig                          }
  c24=24;      { maximalny pocet muzstiev                     }
  c2212=2630;  { c2212=24*(24-1)*4+4 - pre 24 muzstiev & '.'! }
  c84=84;      { maximalny pocet kol: 84 v NHL                }
  c28=28;      { copy('Everton Liverp;ool...',1,28)           }
 
  c16='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ...';
var
  j,k,l,sto: byte;                          { l[1..3]    pocet Lig           }
  fh,sipka: char;                                      { Fotbal/Hokej        }
  y: string[20];                                       { Years_.txt          }
  r: string[4];                                        { Rok                 }
  m: array[1..c24] of byte;                            { pocet Muzstiev      }
  n: array[1..c48] of word;                            { dlzka dat           }
  p: array[0..c48] of string[c24];                     { zaciatocne Pismeno  }
  d: array[1..c48,0..c24] of string[c28];              { Data/nazvy muzstiev }
  v: array[1..c2212] of char;                          { Vysledky            }
  t: array[1..c48,1..c24,0..2,1..7] of byte;           { Tabulky             }
  s: array[1..25,1..80,1..2] of byte absolute 47104:0; { Screen              }
  ss: array[1..4000] of byte;                          { ScreenSaver;        }
  z: array[1..c48] of word;                            { Zaciatok vysledkov  }
  f: text;                                             { File;               }
 
procedure Key;
label
  2;
var
  sk:string[3];  { Shift Keys }
  m1:byte;
begin
  s[hi(windmin)+wherey,lo(windmin)+wherex,2]:=16*black;  { zmizne kurzor }
2:repeat
    m1:=mem[64:23]                 { Shift Keys }
  until KeyPressed;
  k:=ord(readkey);
  sk:='   ';
  if m1 AND 2<>0 then sk[1]:='S';  { Shift }
  if m1 AND 4<>0 then sk[2]:='C';  { Control }
  if m1 AND 8<>0 then sk[3]:='A';  { Alt }
  if k=0 then
  begin
    k:=ord(readkey); 
    case k of
      72: begin sipka:=''; exit; end;  { o rok menej  }
      80: begin sipka:=''; exit; end;  { o rok viacej }
    else
      begin
        sipka:=' ';
        goto 2;
      end;
    end;
  end;
  case k of
    27: ;                               { Escape }
    ord('a')..ord('z'): k:=k AND (255-96);
    ord('A')..ord('Z'): k:=k AND (255-64)
  else
    goto 2;
  end;
end;
 
procedure Pause(sek:real);
var
  h1,m1,s1,n1,
  h2,m2,s2,n2:word;
  t1,t2:real;
begin
  gettime(h1,m1,s1,n1);
  t1:=3600*h1+60*m1+s1+n1/100;
  repeat
    gettime(h2,m2,s2,n2);
    t2:=3600*h2+60*m2+s2+n2/100;
  until t2-t1>=sek;
end;
 
procedure Roky;
var
    DirInfo11: SearchRec;
  i11,j11,l11: byte;
  f11,o11,r11: word;
          c11: integer;
         li11: longint;
          v11: string[1];
      y11,z11: string;
begin
  y11:='';
  FindFirst('Year*.txt',Archive,DirInfo11);
  while DosError=0 do
  begin
    val(copy(DirInfo11.Name,5,4),o11,c11);
    y11:=concat(y11,chr(o11-1900));
    FindNext(DirInfo11);
  end;
  l11:=length(y11);
  for i11:=1 to l11-1 do
    for j11:=i11+1 to l11 do
      if y11[i11]>y11[j11] then
      begin
        v11[1]:=y11[i11];
        y11[i11]:=y11[j11];
        y11[j11]:=v11[1];
      end;
 
  r11:=1900+ord(y11[length(y11)]);
  li11:=r11;
  str(li11,r);   {  r='2010'  posledne udaje }
{
  for i11:=1 to length(y11) do
  begin
    textattr:=16*lightgray+green;
    if r11=1900+ord(y11[i11]) then
      textattr:=16*lightgray+brown;
    gotoxy(4,wherey);
    write(1900+ord(y11[i11]));
    gotoxy(1,wherey);
    writeln(1899+ord(y11[i11]),'/');
  end;
  pause(2.5);
}
  y:=y11;
end;
 
procedure SipkamiHoreDole;
var
  i22,u22: byte;
      s22: string;
begin
  for i22:=1 to length(y) do
  begin
    str(1900+ord(y[i22]),s22);
    if s22=r then u22:=i22;
  end;
 
  if sipka='' then
  begin
    dec(u22);
    if u22=0 then u22:=length(y);
  end;
 
  if sipka='' then
  begin
    inc(u22);
    if u22>length(y) then u22:=1;
  end;
 
  sipka:=' ';
  str(1900+ord(y[u22]),r);
end;
 
function DownCase(p:char):char;
begin
  downcase:=chr(ord(p) or 32);   { if p in ['A'..'Z'] then inc(p,32); }
end;
 
procedure Chyba(ch:string);
begin
  window(10,12,70,14);
  textattr:=16*brown+red;
  clrscr;
  gotoxy(8,2);
  write('ERROR: ',ch);
  Pause(5.5);
{ textattr:=16*black+lightgray; }
  halt;
end;
 
procedure Load;  
var
  t2:text;
  i2,j2,p2:byte;
  r2:string[80];
  l2:word;
begin
  CheckBreak:=False;
  assign(t2,concat('Year',r,'.txt'));
  reset(t2);
  if ioresult<>0 then
    Chyba('subor Year20__.txt sa nenasiel.');
  i2:=1;
  n[1]:=0;
  j2:=255;
  while not eof(t2) do
  begin
    readln(t2,r2);
    if r2<>'' then
    begin
      if r2[2]=' ' then   
      begin
        inc(j2);                                  
        p[i2,j2]:=DownCase(r2[1]);   { nech to ostane tak ! }
       {p2:=pos(';',r2);
        if p2>0 then
          r2:=copy(r2,1,pred(p2));}
        d[i2,j2]:=copy(r2,3,255);
      end
      else
      begin
        if r2[1]<>'Ä' then
        begin
          l2:=length(r2);
          dec(l2,2);
          if (l2 mod 4<>0) and (r2[length(r2)]<>'.') then     { ** BODKA ** }
          begin
            writeln('V riadku ',r2,' je nejaky znak naviac !');
            readln;
            halt;
          end;
          inc(n[i2],l2);
        end
        else
          inc(n[i2],4);
        if n[i2]>c2212 then
          Chyba('dlzka dat > 2212');   { pre NHL to bude viac }
      end;
    end
    else
    begin
      m[i2]:=j2;   p[i2,0]:=chr(j2);   { pocet muzstiev }
      inc(i2);
      n[i2]:=0;
      j2:=255;
    end;
  end;
  close(t2);
  m[i2]:=j2;
  l:=i2;     
end;
 
procedure Riadky01;   
var
  p9:byte;
  i9:word;
  r9:string;
  d9:array[1..15000] of char;
begin
  i9:=0;
  p9:=0;
  reset(f);
  while not eof(f) do
  begin
    inc(i9);
    readln(f,r9);        
    d9[i9]:=r9[1];;
    if (d9[i9]='0') and (d9[pred(i9)] in ['A'..'z']) then
    begin
      if (d9[pred(i9)] in ['A'..'z']) then
      begin
        inc(p9);
      { if p9>c48 then
          Chyba('je vela napocitanych riadkov 01____ .'); }
        z[p9]:=i9;   
      end;
    end;
  end;
end;
 
procedure Vysledky(xb:byte);
var
  jb,nb:word;
  rb:string;
begin
  jb:=0;
  nb:=0;
  reset(f);
  while not eof(f) do          
  begin
    inc(jb);
    readln(f,rb);
    if jb>=z[xb] then        
    begin
      if length(rb)=0 then
        exit;
      if rb[1]<>'Ä' then
        delete(rb,1,2)
      else
        rb[0]:=chr(4);
      move(rb[1],v[succ(nb)],length(rb));
      inc(nb,length(rb));
    end;
  end;
  { n[xb]:=nb; }
end;
 
procedure Nulovanie(segment,zaciatok,velkost:word); assembler; 
asm
        MOV AL,0        
        MOV ES,segment
        MOV DI,zaciatok
        MOV CX,velkost
        CLD              
        REP              
        STOSB            { hodnota AL do ES:DI }
end;
 
procedure MemSet(segment,zaciatok,velkost:word); assembler;
asm
        MOV AX,65535     { AL:=255  AH:=255 }
        MOV ES,segment
        MOV DI,zaciatok
        MOV CX,velkost
        SHR CX,1
        CLD
        REP
        STOSW
end;
 
procedure SciTabulky;  { Scitanie Tabulky }
label
  4;
var
  i4,j4,k4,l4,a4,b4,c4,d4,e4,home,away:byte;
  w4:word;
  p4:array[ord('A')..ord('z')] of byte;
  r4:array[0..255] of byte;                    
  s4:string;
begin
  Nulovanie(seg(t),ofs(t),sizeof(t));
 
  MemSet(seg(r4),ofs(r4),sizeof(r4));
 
  s4:=#0#1#2#3#4#5#6#7#8#9;
  move(s4[1],r4[ord('0')],10);
  s4:=#10#11#12#13#14#15#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31#32#33#34#35;
  move(s4[1],r4[ord('A')],26);
 
  for i4:=1 to l do
  begin
 
    if n[i4]<4 then
    begin
      clrscr;
      write('n[i4]=',n[i4]);
      readln;
      halt;
    end;
 
    Nulovanie(seg(p4),ofs(p4),sizeof(p4));
 
    for j4:=1 to m[i4] do
    begin
      p4[ord(DownCase(p[i4,j4]))]:=j4;
      p4[ord(UpCase(p[i4,j4]))]:=j4;
    end;
 
    Vysledky(i4);   
    w4:=1;
    repeat       
      home:=0;
      if v[w4] in ['A'..'Z'] then   { v predlzeni vyhrali domaci }
        home:=1;
      a4:=p4[ord(v[w4])];
      inc(w4);
 
      away:=0;
      if v[w4] in ['A'..'Z'] then   { v predlzeni vyhrali hostia }
        away:=1;
      b4:=p4[ord(v[w4])];
      inc(w4);
 
      if home AND away<>0 then
        chyba('dve pismenka vedla seba su velke');
 
      c4:=r4[ord(v[w4])];
      inc(w4);
      d4:=r4[ord(v[w4])];
      inc(w4);     
 
      if (a4=0) or (b4=0) or (c4=255) or (d4=255) then
      begin
        TextAttr:=16*Black+Red;
        gotoxy(1,25);
        write('Error: ',d[i4,0],' ',d[i4,a4],' - ',d[i4,b4],' ',
              c4,':',d4,' (',w4,'/',n[i4],')');
        readln;
        halt;
      end;
 
      if c4>d4 then
        e4:=2
      else
        if c4=d4 then
          e4:=1
        else
          e4:=0;
      inc(t[i4,a4,1,3-e4]);
      inc(t[i4,a4,1,4],c4);
      inc(t[i4,a4,1,5],d4);
      inc(t[i4,b4,2,1+e4]);
      inc(t[i4,b4,2,4],d4);
      inc(t[i4,b4,2,5],c4);
 
      if home+away=1 then
      begin
 
        if c4<>d4 then
        begin
          gotoxy(1,25);
          textattr:=16*black+red;
          write('v hokejovom predlzeni nie je rovnake skore.');
          readln;
          halt;
        end;
 
        if home<>0 then  { home=1 }
        begin
          inc(t[i4,a4,1,4]);
          inc(t[i4,b4,2,5]);
        end
        else             { away=1 }
        begin
          inc(t[i4,a4,1,5]);
          inc(t[i4,b4,2,4]);
        end;
      end;
 
      if v[w4]='Ä' then   { * winter / zimna prestavka * }
        inc(w4,4);
 
      if v[w4]='.' then   { * BODKA * }
      begin
        n[i4]:=pred(w4);
        goto 4;
      end;
    until w4>=n[i4];
 
4:  for j4:=1 to m[i4] do
    begin
      for k4:=1 to 2 do
      begin
        t[i4,j4,k4,6]:=t[i4,j4,k4,1]+t[i4,j4,k4,2]+t[i4,j4,k4,3];  { zapasy }
        t[i4,j4,k4,7]:=c2*t[i4,j4,k4,1]+t[i4,j4,k4,2];             { body   }
      end;
      for l4:=1 to 7 do
        t[i4,j4,0,l4]:=t[i4,j4,1,l4]+t[i4,j4,2,l4];                { celkom }
    end;
  end;
end;
 
procedure FotbalHokej;
var
  i3,j3,f3,h3:byte;
  x3:word;
begin
  f3:=0;  
  h3:=0;  
  for i3:=1 to l do
  begin
    x3:=0;
    for j3:=1 to m[i3] do
      inc(x3,t[i3,j3,0,4]);
 
    { if n[i3]<48 then - je to len prve kolo }
 
    if x3/(n[i3] SHR 2)/2<2.05 then
      inc(f3)                         { fotbal: 1.05 - 1.67 }
    else
      inc(h3);                        { hokej:  2.22 - 3.20 }
  end;
 
  TextMode(CO80);     { Mem[64:73]:=3;  TextMode(BW80); }
  window(1,1,80,25);
  clrscr;
  TextAttr:=16*Black+Cyan;
  write('Euro');
  if f3=l then           { h3<>0 }
    write('.Fotbal')                      
  else
    if h3=l then         { f3<>0 }
      write('p.Hokej')                    
    else
    begin
      gotoxy(1,1);
      write('FOT:',f3,' HO:',h3);   { v sezone 1996/1997 }
    end;                            
 
  if f3>=h3 then fh:='F'            { treba to uchovat v poli }
            else fh:='H';
end;
 
procedure KurzorDoprava;
begin
  gotoxy(succ(wherex),wherey); 
end;
 
procedure k3(rr:real);  { kurz sa vypise ako 3 cisla }
begin
  if rr<10 then
    write(rr:1:2)
  else
    write(rr:2:1);
end;
 
procedure KurzyRemiz;   { priemerne Kurzy na remizu v Ligach }
var
  a5,b5,c5,i5,j5,y5:byte;
  s5,o5:word;
  r5:real;
  code:integer;
begin
  val(r,o5,code);
  KurzorDoprava;
  write(pred(o5),'/',copy(r,3,2));
  y5:=(26-l) div 2;
 
  for i5:=1 to l do
  begin
    gotoxy(1,i5+y5);
    textattr:=16*black+white;
    write(chr(i5+64),' ');
    textattr:=16*black+lightgray;
    write(d[i5,0]);                  { PORTUGALSKO 2 }
    gotoxy(15,wherey);               { 16,y !        }
    write(' ');
 
    a5:=0; 
    b5:=0;
    c5:=0;
    for j5:=1 to m[i5] do
    begin
      inc(a5,t[i5,j5,1,1]);    
      inc(b5,t[i5,j5,1,2]);
      inc(c5,t[i5,j5,1,3]);
    end;
    s5:=a5+b5+c5;
{   write(' (',s5 SHL 1/m[i5]:2:0,') ');    je to zle }
    if b5=0 then
      write('ÄÄÄÄ')    
    else
    begin
      r5:=s5/b5;
      if (r5<=3.40) or ((fh='H') and (r5<=4.50)) then
        textattr:=16*black+green;
      k3(r5);
    { write('x'); }
    end
  end
end;
 
{function Datum:string;
const
  mes:array[1..12] of string[3]=
  ('jan','feb','mar','apr','maj','jun','jul','aug','sep','okt','nov','dec');
var
  rok,mesiac,den,dow:Word;
  d6:string[2];
begin
  GetDate(rok,mesiac,den,dow);
  Str(den,d6);
  Datum:=concat('K_',d6,'_',mes[mesiac],'.txt'); 
end;}
 
function hex(b:byte):char;  { Cislo 0..9  Pismeno A..F,Z }
var
  s:string[1];
begin
  s:=copy(c16,succ(b),1); 
  hex:=s[1];
end;
 
{ procedure znak(x,y:byte; z:char; f:byte);
begin
  s[y,x,1]:=ord(z);
  s[y,x,2]:=16*black+f;
end; }
 
procedure znak80x25y(z:char; f:byte);
begin
  MemW[47104:3998]:=ord(z)+(16*black+f) shl 8;
end;
 
function DoBodkociarky(aa,bb:byte):string;
var
  pp:byte;     { Pomocna Premenna }
  nm:string;   { Nazov Muzstva    }
begin
  nm:=d[aa,bb];
  pp:=pos(';',nm);
  if pp=0 then
    DoBodkociarky:=copy(nm,1,15)
  else
    DoBodkociarky:=copy(nm,1,pred(pp));
end;
 
function Seria(jj0,kk0:byte):string;
var
  rr0: string;                              { Retazec          }
  pp0: word;                                { Pomocna Premanna }
  aa0,bb0: byte;
  mm0: shortint;                            { Minus            }
  gg0: array[ord('0')..ord('Ä')] of byte;   { Goly             }
begin
  rr0:=#0#1#2#3#4#5#6#7#8#9':;<=>?@'#10#11#12#13#14#15#16#17#18#19#20;
  move(rr0[1],gg0,length(rr0));
  rr0:='';                        
  Vysledky(jj0);
  pp0:=1;
  repeat
    aa0:=pos(DownCase(v[pp0]),p[jj0]);
    inc(pp0);
    bb0:=pos(DownCase(v[pp0]),p[jj0]);
    inc(pp0);
 
    mm0:=gg0[ord(v[pp0])]-gg0[ord(v[succ(pp0)])];   
    inc(pp0,2);
    if kk0=aa0 then         
    begin
      inc(rr0[0]);
      case mm0 of
        1..127: rr0[length(rr0)]:='2';   {   ţ .  - ZNAKY.PAS }
             0: rr0[length(rr0)]:='1';
      else
        rr0[length(rr0)]:='0';
      end;
    end;
    if kk0=bb0 then
    begin
      inc(rr0[0]);
      case mm0 of
        1..127: rr0[length(rr0)]:='0';
             0: rr0[length(rr0)]:='1';
      else
        rr0[length(rr0)]:='2';
      end;
    end;
  until pp0>=n[jj0];
  Seria:=rr0;
end;
 
procedure Vymen(segm,ofs1,ofs2:word); assembler;  { procedure Vymen6bytes }
asm
        MOV   DX,DS
        MOV   DS,segm
        MOV   ES,segm
        MOV   SI,ofs1
        MOV   DI,ofs2
        INC   SI
        INC   DI
 
        CLD
        MOV   CX,3
@1:     LODSW
        MOV   BX,[DI]
        MOV   [SI-2],BX
        STOSW
        LOOP  @1
 
        MOV   DS,DX
        MOV   ES,DX
end;
 
procedure Tutovky;  { klavesou SPACE: muzstva, ktore vyhravaju / prehravaju }
label
  3;
var
  i0,j0,l0,m0,x0,y0,a0,b0,d0:byte;
  n0,k0,p0:word;                      { n0 - pocet vsetkych muzstiev }
  u0:array[1..1200] of string[6];
  t0:text;
  r0:real;
  int:integer;
  s0:string;
 
  pa:word;
  aa,ba,ca,da:char;
  za:char;
  xa,ia:byte;
 
  procedure QuickSort(l,p:word);  { krokovat tento aj obycajny QuickSort }
  var
    m,i:word;
    v:string[6];
 
  begin
    if l<p then
    begin
    { vymen(u0[l],u0[l+random(p+1-l)]); }
      m:=l;
      for i:=succ(l) to p do
        if u0[i]<u0[l] then
        begin
          inc(m);
        { v:=u0[m]; u0[m]:=u0[i]; u0[i]:=v; }
          Vymen(seg(u0),ofs(u0[m]),ofs(u0[i]));
        end;
    { v:=u0[l]; u0[l]:=u0[m]; u0[m]:=v; }
      Vymen(seg(u0),ofs(u0[l]),ofs(u0[m]));
      QuickSort(l,pred(m));
      QuickSort(succ(m),p)
    end;
  end;
 
begin
  n0:=0; 
  for i0:=1 to l do
    for j0:=1 to m[i0] do
      if (t[i0,j0,1,6]<>0) and (t[i0,j0,2,6]<>0) then    { t[i0,j0,0,6]>2 }
      begin
        int:=t[i0,j0,0,4]-t[i0,j0,0,5]+128;
        if (int>=0) and (int<=255) then
          b0:=int
        else
        begin
          if int>255 then
            b0:=255;
          if int<0 then
            b0:=0;
        end;
        inc(n0);
        u0[n0]:=concat(chr(round(t[i0,j0,0,7]/t[i0,j0,0,6]*50)),
             chr(t[i0,j0,0,6]),chr(b0),chr(t[i0,j0,0,4]),chr(i0),chr(j0));
      end;
  if n0<25 then
    exit;
  QuickSort(1,n0);
 
  y0:=0;
  for k0:=n0 downto n0-24 do
  begin                             
    inc(y0);
    a0:=ord(u0[k0,5]);
    b0:=ord(u0[k0,6]);
    d0:=t[a0,b0,0,6];
    TextAttr:=16*Black+LightGray;
    gotoxy(21,y0);                   {  >>> WINDOW(21,1,80,25); <<< }
    if d0<10 then
      write(' ');  { '0' }
    write(d0,' ',DoBodkociarky(a0,b0),' - ',d[a0,0,1]);
    for i0:=2 to length(d[a0,0]) do
      write(downcase(d[a0,0,i0]));
    gotoxy(49,y0);
{   write(' ',abs(t[a0,b0,0,7]/t[a0,b0,0,6]*50-50):2:1);  PERCENTA }
    for m0:=1 to 2 do
    begin
      KurzorDoprava;
      for l0:=1 to 3 do
      begin
        case l0 of
          1: TextAttr:=16*Black+Yellow;
          2: TextAttr:=16*Black+Green;
          3: TextAttr:=16*Black+Red;
        end;
        if (wherey=25) and (wherex=76) then  
        begin
          write(' ');
          if t[a0,b0,m0,l0]<>0 then
          begin
            r0:=t[a0,b0,m0,6]/t[a0,b0,m0,l0];
            if r0<10 then
            begin
              write(r0:1:1);
              znak80x25y(chr( ord('0')+round(r0)*100 mod 10 ),red);
            end
            else
            begin
              write(r0:2:0,'.');
              znak80x25y('',red); {  '' >>> ord('0')+round(r0)*100 mod 10; }
            end;
          end
          else
          begin
            write('ÄÄÄ');
            znak80x25y('Ä',red);
          end;
        end
        else
        begin
          write(' ');
          if t[a0,b0,m0,l0]<>0 then
            k3(t[a0,b0,m0,6]/t[a0,b0,m0,l0])
          else
            write('ÄÄÄÄ');
        end;
      end;
    end;
 
{ * VYSVIETENIE * }
 
    Vysledky(a0);            
    za:=p[a0,b0];
    pa:=n[a0];
    repeat
      da:=v[pa];  dec(pa);
      ca:=v[pa];  dec(pa);
      ba:=v[pa];  dec(pa);
      aa:=v[pa];  dec(pa);
      if downcase(aa)=za then
      begin
        if ca>da then xa:=51;
        if ca=da then xa:=56;
        if ca<da then xa:=61;
        goto 3;
      end;
      if downcase(ba)=za then
      begin                     
        if ca<da then xa:=67;
        if ca=da then xa:=72;
        if ca>da then xa:=77;
        goto 3;
      end;
    until false;
 3: for ia:=xa to xa+3 do
      s[y0,ia,2]:=16*LightGray+Black;    { 16*Blue+LightCyan; }
 
  end;           
  GotoXY(2,25);
  s[25,2,2]:=16*black;
 
  { procedure SaveInfo: 'INFO2010.txt' }
 
  GetDir(0,s0);     
  if s0[1] in ['C'..'D'] then            { A:\>  C:\> D:\> }
  begin
    Assign(t0,concat('Info',r,'.txt'));
    Rewrite(t0);
    p0:=0;
    for k0:=n0 downto 1 do
    begin
      inc(p0);
      a0:=ord(u0[k0,5]);
      b0:=ord(u0[k0,6]);
{     Write(t0,' #');
      case p0 of
            1..9: Write(t0,' #00');
          10..99: Write(t0,' #0');
        100..255: Write(t0,' #');
      end; }
      WriteLn(t0,#13#10' #',p0:3,' ',copy(d[a0,0],1,3),' - ',DoBodkociarky(a0,b0),
        ' - ',t[a0,b0,0,7]/(t[a0,b0,0,6] SHL 1)*100:2:3,'%'#13#10,
        '   doma: ',t[a0,b0,1,1],' ',t[a0,b0,1,2],' ',t[a0,b0,1,3],' ',t[a0,b0,1,4],':',t[a0,b0,1,5],#13#10,
        '  vonku: ',t[a0,b0,2,1],' ',t[a0,b0,2,2],' ',t[a0,b0,2,3],' ',t[a0,b0,2,4],':',t[a0,b0,2,5],#13#10,
        ' celkom: ',t[a0,b0,0,1],' ',t[a0,b0,0,2],' ',t[a0,b0,0,3],' ',t[a0,b0,0,4],':',t[a0,b0,0,5],#13#10,
        '  seria: ',seria(a0,b0));
    end;
    Close(t0);
  end;
end;
 
procedure Tabulka2;
const
  f8:array[1..3] of word=(16*black+yellow,16*black+green,16*black+red);
var
  i8,j8:byte;
begin
  clrscr;
  for i8:=1 to m[k] do
  begin
    textattr:=16*black+lightgray;
    write(i8:2,' ',d[k,i8]);  
    gotoxy(20,wherey);
    for j8:=1 to 3 do
    begin
      textattr:=f8[j8];
      write(t[k,i8,1,j8]);
      KurzorDoprava;
    end;
    for j8:=1 to 3 do
    begin
      KurzorDoprava;
      textattr:=f8[j8];
      write(t[k,i8,2,j8]);
    end;
    KurzorDoprava;
    KurzorDoprava;
    textattr:=16*black+lightgray;
    writeln(t[k,i8,0,4],':',t[k,i8,0,5]);
  end;
end;
 
{procedure Seria(s9:string);   ved som to urobil na ATARI !
var
  a9,b9,i9,p9:byte;
begin
  p9:=length(s9);
 
  s9[succ(p9)]:=#0;
  s9[succ(succ(p9))]:=#0;
 
  textattr:=16*black+lightgray;
  write('  ');
  for i9:=1 to length(s9) do write(ord(s9[i9]));
  write('  ');
 
  i9:=0;
  repeat
    inc(i9);
  until s9[i9]=#0;
  a9:=i9;
 
  repeat
    inc(i9);
  until s9[i9]=#0;
  b9:=i9;
 
  write(' a=',a9,'  b=',b9,'  ');
 
  textattr:=16*black+yellow;
  case p9 of
    1: ...
    2: ...
  end;
end;}
 
procedure Tabulka;
 
{ >>> Celkom, aj Doma a Vonku <<<  zmeni sa 0 na 1 alebo 2
  napr. vo Svajciarsku od 23-tieho kola do 35-teho }
 
var
  a6,b6,c6,d6,e6,h6,i6,j6,p6,r6,u6:byte;
  s6:shortint;
  k6:word;
  m6:string[c84];
  z6:char;
  t6:array[1..c24] of real;
  v6,w6:real;
  pm:string[15];
  nm6:string;
begin
  p6:=0;
  h6:=0;
  for i6:=1 to m[k] do
  begin
    if t[k,i6,0,4]>=110 then
      inc(p6);
    if t[k,i6,0,5]>=110 then
      inc(p6);                   
    if t[k,i6,0,6]>=47 then    { v hokeji ma tym odohratych vyse 47 kol }
      inc(h6);
  end;
  sto:=0;
  if p6<>0 then
    sto:=2;       { posunutie okna doprava o dve pozicie }
 
  textattr:=16*black+lightgray;
  clrscr;
  for i6:=1 to m[k] do
  begin
    if t[k,i6,0,6]=0 then
      t6[i6]:=10000             { 255 }
    else
      t6[i6]:=t[k,i6,0,7]/t[k,i6,0,6]*5000+t[k,i6,0,4]-t[k,i6,0,5]+t[k,i6,0,4]*0.01
  end;
 
  { takto:  var t6:array[1..c24] of string[3]; }
 
  { t6[i6]:=concat( chr(round(50*t[k,i6,0,7)/t[k,i6,0,6))),
                    chr(128+t[k,i6,0,4)-t[k,i6,0,5)),
                    chr(t[k,i6,0,4));                         }
 
  gotoxy(1,(26-m[k]) div 2);
  for i6:=1 to m[k] do     
  begin
    gotoxy(1,succ(wherey));
    u6:=1;                    
    for j6:=2 to m[k] do
      if t6[j6]>t6[u6] then
        u6:=j6;
    nm6:=DoBodkociarky(k,u6);
    p6:=pos(upcase(p[k,u6]),nm6);
    if p6=0 then
      p6:=pos(p[k,u6],nm6);
    if p6=0 then
    begin
      textattr:=16*black+white;  
      write(upcase(p[k,u6]),' ')
    end;
    textattr:=16*black+lightgray;
    write(nm6);
    if p6>0 then
      s[wherey,p6,2]:=16*black+white; 
 
    gotoxy(17,wherey);
    write(t[k,u6,0,6]:2);
 
    p6:=t[k,u6,0,4];
    if sto=0 then
    begin
      if (p6>=100) and (p6<=109) then
        write(' 0',p6-100)
      else
        write(p6:3);
    end
    else
      write(p6:4);
    write(':');
    p6:=t[k,u6,0,5];
    if sto=0 then
    begin
      if (p6>=100) and (p6<=109) then
        write('0',p6-100)
      else
        write(p6);
    end
    else
      write(p6);
 
{ pri hokeji: ak je pocet golov > 100:100, tak posunut okno doprava }
 
    gotoxy(26+sto,wherey); 
    if t[k,u6,0,6]=0 then
      write(' 0')               { & __ }
    else
    begin
      s6:=round(t[k,u6,0,7]/t[k,u6,0,6]*50-50);
      if (s6>0) and (s6<10) then
        write('+',s6)
      else
      begin
        if s6<=-10 then
          s6:=0-s6;
        write(s6:2)
      end;
 
      { Seria }
 
      Vysledky(k);
      k6:=n[k];
      p6:=0;
      repeat
        d6:=pred(pos(v[k6],c16));  { pozri: r4[ ] }
        dec(k6);
        c6:=pred(pos(v[k6],c16));
        dec(k6);
        b6:=pos(v[k6],p[k]);
        dec(k6);
        a6:=pos(v[k6],p[k]);
        dec(k6);
        if (a6=u6) or (b6=u6) then
        begin
          if c6>d6 then
            e6:=2
          else
            if c6=d6 then
              e6:=1
            else
              e6:=0;
          if b6=u6 then          
            e6:=2-e6;
          inc(p6);
          m6[p6]:=chr(e6);
        end;
      until k6=0;   
      m6[0]:=chr(p6);
 
      z6:=#0;
      repeat
        p6:=pos(z6,m6);
        if p6=0 then
          p6:=length(m6)
        else
        begin
          r6:=pos(z6,copy(m6,succ(p6),255));
          dec(p6);
          if r6=0 then
            r6:=length(m6)
          else
            inc(r6,p6);
          if r6-p6>1 then
            p6:=r6
        end;
        if z6=#0 then
          a6:=p6
        else
          b6:=p6;
        inc(z6,2)
      until z6=#4;
 
      if a6>b6 then
      begin
        c6:=a6;
        textattr:=16*black+yellow;
      end
      else
      begin
        c6:=b6;
        textattr:=16*black+red;
      end;
      write(' ');    
      if c6<16 then      
        write(hex(c6))
      else
        write('<');  { <Ž }
 
      { nebudu sa ratat posledne zapasy, iba skorsie }
 
      v6:=0;
      p6:=0;
      j6:=0;
      repeat
        inc(j6);
        inc(p6,ord(m6[j6]));
        w6:=abs(p6-j6*t[k,u6,0,7]/t[k,u6,0,6]);
        if w6>v6 then
          v6:=w6;
      until j6=c6;
 
      { v poslednych kolach body navyse '+++' oproti priemeru }
 
      if v6>=3 then            { ak je nizky pocet kol, tak: 2,3,4 }
      begin
        pm:=copy(c16,2,16);    { PlusMinus +/- }
        if a6>b6 then
          FillChar(pm,11,'+')
        else
          FillChar(pm,11,'-');
        pm[0]:=chr(trunc(v6));
        write(pm);
      end;
 
      { fotbalisti maju vyse 50% remiz, hokejisti vyse 35% }
 
      w6:=t[k,u6,0,2]/t[k,u6,0,6];
      if (w6>=0.50) or ((fh='H') and (w6>=0.35)) then
      begin
        textattr:=16*black+green;
        gotoxy(29+sto,wherey);
        w6:=w6*10;
        if w6<10 then
          write(int(w6):1:0)
        else
          write('A');
      end;
 
      { SERIA - ZA TABULKOU VIDITELNE VSETKY ZAPASY }
 
      if h6=0 then                
        gotoxy(31+sto,wherey)
      else
        gotoxy(19,wherey);      { pre hokej: 47 kol a viac }
      write(' ');
 
      nm6:=Seria(k,u6);
      for j6:=1 to length(nm6) do
      begin
        case nm6[j6] of
          '2': textattr:=16*black+yellow;
          '1': textattr:=16*black+green;
          '0': textattr:=16*black+red;
        end;
        write('');
      end;
 
    end;
    t6[u6]:=-500;
  end;
end;
 
procedure Muzstvo;
 
{ prezeranie vysledkov nielen poslednych 20 zapasov }
 
label
  7;                   
const                  
  f7:array[0..2] of byte=(red,green,yellow);
var
  a7,b7,c7,d7,e7,i7,j7,m7,n7,p7,v7:byte;
  k7:word;
  r7:string[c84];
  w7:string[28];                { ciara Winter }
  body:array[1..c24] of byte;
begin
  k:=pos(chr(k+96),p[j]);
  if (k=0) or (t[j,k,0,6]=0) then
    exit;
  window(31+sto,1,80,25);
  textattr:=16*black+lightgray;
  clrscr;
  window(32+sto,1,80,12);
  clrscr;                     
  write(d[j,0]);
  gotoxy(14-sto,1);
  if k<10 then
    KurzorDoprava;
  write('(',k,'/',m[j],')');
  window(53,1,80,3);           {  BOLO:  window(53+sto,1,80,3);  }
  clrscr;
  write(copy(d[j,k],1,c28));
  window(32+sto,1,80,12);
 
{ *** NASKOK PRVEHO MUZSTVA *** }
{ alebo kolko bodov stracaju na prveho v tabulke }
 
  for i7:=1 to m[j] do
    body[i7]:=3*t[j,i7,0,1]+t[j,i7,0,2];  
  m7:=0;
  for i7:=1 to m[j] do
  begin
    if body[i7]>m7 then
    begin
      m7:=body[i7];
      p7:=i7;
    end;
  end;      
  body[p7]:=0;
  n7:=0;
  for i7:=1 to m[j] do
  begin
    if body[i7]>n7 then
      n7:=body[i7];
  end;
  if (fh='F') and (k=p7) and (m7-n7>0) then
  begin
    gotoxy(44,1);
    if m7-n7<10 then
      KurzorDoprava;
    textattr:=16*black+brown;
    write(' n:+',m7-n7);
  end;
  gotoxy(1,2);
 
  for i7:=0 to 2 do
  begin
    writeln;
    if i7<>0 then
    begin
      case i7 of
        1: write('Home');  { Ho:  Doma_ }
        2: write('Away');  { Aw:  Vonku }
      end;
      for j7:=1 to 3 do
      begin
        write(' ');
        case j7 of
          1: textattr:=16*black+yellow;
          2: textattr:=16*black+green;
          3: textattr:=16*black+red;
        end;
        if t[j,k,i7,j7]<>0 then
          write(t[j,k,i7,j7])
        else
        { textattr:=16*black+lightgray; }
          write('đ');
      end;
      textattr:=16*black+lightgray;
      write(' ',t[j,k,i7,4],':',t[j,k,i7,5],#13#10#10);
    end;
 
    Vysledky(j);           
    r7[0]:=chr(0);
    k7:=1;
    repeat
      a7:=pos(DownCase(v[k7]),p[j]);   { DownCase kvoli hokeju ! }
      inc(k7);
      b7:=pos(DownCase(v[k7]),p[j]);
      inc(k7);
      if (a7=k) or (b7=k) then
      begin
        c7:=pred(pos(v[k7],c16));
        inc(k7);
        d7:=pred(pos(v[k7],c16));
        inc(k7);
        if c7>d7 then
          e7:=2
        else
          if c7=d7 then  { c7<d7 }
            e7:=1
          else
            e7:=0;
        if b7=k then
          e7:=2-e7;
        if (i7<>2) and (a7=k) or (i7<>1) and (b7=k) then
          r7:=concat(r7,chr(f7[e7]));
      end
      else
        inc(k7,2);
    until k7>n[j];
    p7:=1;
    if i7=0 then
    begin
      if length(r7)>48-sto then
        p7:=length(r7)-(47-sto)  { o jedno viac !!! }
                                 { - radsej aby bolo vidiet vsetky zapasy }
                                 { - tabulka bude uzsia }
    end
    else
    begin
      if length(r7)>(20-sto) then
        p7:=length(r7)-(19-sto)
    end;
    for j7:=p7 to length(r7) do
    begin
      textattr:=16*black+ord(r7[j7]);
      write('');
    end;
    textattr:=16*black+lightgray;
    writeln;
  end;                      
 
  window(53,5,80,25);
  clrscr;
  Vysledky(j);          { pre HOKEJ:  DownCase ! }
  k7:=n[j]-3;
  p7:=0;
  repeat
    if (DownCase(v[k7])=p[j,k]) or (DownCase(v[succ(k7)])=p[j,k]) or (v[k7]='Ä') then
    begin
      inc(p7);
      if p7=21 then  { na obrazovku poslednych 21 zapasov }
        goto 7
    end;
    dec(k7,4);
  until k7=1;
{                  pole: array[1..46+1] of word; - pozicie 'A' - Ajaxu
  k7:=1;
  repeat
    if (v[k7]=p[j,k]) or (v[succ(k7)]=p[j,k]) or (v[k7]='Ä') then
      pole[1,2,3,4...]:=k7;
    inc(k7,4);
  until k7>n[j];
}
  k7:=1;
7:p7:=0;
  repeat
    inc(p7);
    if v[k7]='Ä' then
    begin
      inc(k7,4);
      textattr:=16*black+blue;
      FillChar(w7,29,'Ä');  { zimna prestavka ÄÄÄ WINTER ÄÄÄ }
      w7[0]:=chr(28);
      write(w7);            { 22 kol vo Svajciarsku a potom je ciara }
    end;
    a7:=pos(DownCase(v[k7]),p[j]);
    inc(k7);
    b7:=pos(DownCase(v[k7]),p[j]);
    inc(k7);
    if (a7=k) or (b7=k) then
    begin
      c7:=pred(pos(v[k7],c16));
      inc(k7);
      d7:=pred(pos(v[k7],c16));
      inc(k7);
      if c7>d7 then
        e7:=2
      else
        if c7=d7 then
          e7:=1
        else
          e7:=0;
      if b7=k then
        e7:=2-e7;
 
      textattr:=16*black+f7[e7];
      if a7=k then
        write(DoBodkociarky(j,b7))
      else
        write(' ',DoBodkociarky(j,a7));
      gotoxy(18,wherey);
      textattr:=16*black+lightgray;
      if a7=k then
        for j7:=0 to 2 do
        begin
          textattr:=16*black+lightgray;
          if j7=e7 then
            textattr:=16*black+f7[j7];
          write(hex(t[j,b7,2,succ(j7)]),' ');
        end
      else
        for j7:=0 to 2 do
        begin
          textattr:=16*black+lightgray;
          if j7=e7 then
            textattr:=16*black+f7[j7];
          write(hex(t[j,a7,1,succ(j7)]),' ')
        end;
      textattr:=16*black+f7[e7];
      write(hex(abs(c7-d7)),' ');
      textattr:=16*black+lightgray;
      if a7<>k then
      begin
        v7:=c7;
        c7:=d7;
        d7:=v7;
      end;
      write(hex(c7),':');
      if wherey<21 then            
        write(hex(d7))
      else
        znak80x25y(hex(d7),lightgray);
    end
    else
      inc(k7,2);
  until k7>n[j];
  window(1,1,80,25);
  gotoxy(51,25);
  { aby sa procedura urobila iba raz - pri stlaceni toho isteho pismena
    predchadzajuce_pismeno:=k; }
end;
 
{procedure NovaSezona;
var
  f:text;
begin
  Rok;
  Load;
  SciTabulky;
  c2:=3;
  assign(f,'Year2006.txt');
  rewrite(f);
  for k:=1 to l do
  begin
    writeln(f,'  ',d[k,0]);
    Tabulka2;                        writeln(f,p[k,u6],' ',d[k,u6]);
    writeln(f,'01ab00'#13#10);
  end;
  close(f);
  halt;
end;}
 
procedure Beep;
begin
{ Write(#7); }
  Sound(5000);
  Delay(100);
  NoSound;
end;
 
begin    
  Roky;   { Sezony }
0:Load;
  Assign(f,concat('Year',r,'.txt'));
  Riadky01;
  SciTabulky;
  FotbalHokej;
  KurzyRemiz;
  Tutovky;              
  move(s,ss,4000);  { prepinanie TABom na: Fotbal 1 - Fotbal 2 - Hokej }
1:Key;
  if ((sipka='') or (sipka='')) and (length(y)>1) then
  begin
    SipkamiHoreDole;
    Close(f);
    goto 0;
  end;
  if k<>27 then
  begin
    if k>l then
      goto 1
    else
    begin
      Tabulka;      { ukazu sa vysledky posledneho kola s prekvapeniami }
      j:=k;       
      repeat
        Key;
        if k=27 then
        begin
          move(ss,s,4000);
          gotoxy(20,25);
          goto 1;
        end;
        Muzstvo;
      until false;
    end;
  end;
  Close(f);
end.
 
{
   pouzivat aj asm. instrukcie: NOT AND OR XOR SHL SHR
 
>> rutinu z AMOUSE.COM  pre pohyb MYSi v textovom mode <<
 
   napisat KNIHU "Ako tipujem ja"
 
   v Lige Majstrov je 32 muzstiev !  (a..z)&(A..Z) - to je 64 horucich klaves
 
1. stlacenim F1 - LOAD('readme.txt') - pouzit klavesy SPACE, ...
 
   kurzy:  MTK - BVCS  1.90 3.25 4.05  fa+2  1X 12 X2  handicap o 1 gol
 
2. PP: S - Ferencvaros 4:1   ( Slovan )   poharove zapasy
 
3. Text.mod >>> Gr.mod
 
   ukradnut z obrazovky nejeku znakovu sadu cez GEPIXEL
 
   pouzit rutinu supertext (z ATARI) & moju znakovu sadu
}