{ 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
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