program matches;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, crt, {timerutils}time
{ you can add units after this };
var
pole,hrac1,hrac2 : array [0..21,0..31] of string[5];
pom_prom : string[20];
typ : string[2];
//polex,poley jsou pripravena do budoucna na dynamicka pole, zatim jsou jenom staticky dana
x,y,i,
tah,prodleva,
polex,poley,
skore1,skore1old,
skore2,skore2old : smallint;
//v souvislosti se zmenou casove prodlevy za behu typu hry cc
{currenttime : longint;}
const
cekani : smallint = 3000;
(****************************************************)
(* vypise napovedu *)
(****************************************************)
procedure help;
begin
writeln ('---------------------------- help ----------------------------');
writeln ;
writeln (paramstr(0));
writeln ;
writeln (' -h help');
writeln (' vypise tuto napovedu');
writeln ;
writeln (' -t type [ hh | hc | cc ]');
writeln (' typ hry: hh - human X human [ default ]');
writeln (' hc - human X computer');
writeln (' cc - computer X computer');
writeln ;
writeln (' -d delay ( interval 0 az 32767 ) [ default: 1000 ]');
writeln (' casova prodleva mezi tahy (v milisekundach)');
writeln (' ! lze pouzit jen s volbou -t cc !');
writeln ;
end;
(****************************************************)
(* vraci vstupni parametry programu *)
(****************************************************)
procedure input_param (var typ:string[2]; var prodleva:smallint);
var
parametry : array [1..3] of string[10];
allparamok : boolean;
returned : smallint;
begin
parametry[1]:='-h';
parametry[2]:='-t';
parametry[3]:='-d';
prodleva:=-1;
typ:='hh';
allparamok := false;
if paramcount>=1 then
for i:=1 to paramcount do begin
//jestli nektery parametr odpovida, tak break
for y:=1 to length(parametry) do
if paramstr(i) = parametry[y] then begin
allparamok := true;
break;
end
//jestli predchozi parametr byl "mozny", treba toto bude jeho hodnota
else if paramstr(i-1) = parametry[y] then begin
allparamok := true;
break;
end;
//kdyz nektery parametr neodpovida
if allparamok = false then begin
writeln ;
writeln ('neexistujici parametr nebo spatna hodnota parametru: ',paramstr(i));
writeln ;
break;
end;
end
else allparamok:=true;
if allparamok = false then begin
help;
halt(0);
end
else if paramcount >= 1 then begin
for i:=1 to paramcount do begin
//jestli napoveda
if paramstr(i)=parametry[1] then begin
help;
halt(0);
end;
//jestli typ
if paramstr(i)=parametry[2] then begin
if (paramstr(i+1)='hh') or
(paramstr(i+1)='hc') or
(paramstr(i+1)='cc') then typ:=paramstr(i+1)
else if (i+1) > paramcount then begin
writeln ('ERROR: prazdny parametr ',parametry[2]);
halt(0);
end
else begin
writeln ('spatna hodnota parametru ',parametry[2]);
halt(0);
end;
continue;
end;
//jestli prodleva
if paramstr(i)=parametry[3] then begin
if (i+1) > paramcount then begin
writeln ('ERROR: prazdny parametr ',parametry[3]);
halt(0);
end
else begin
val(paramstr(i+1),prodleva,returned);
if returned<>0 then begin
writeln ('hodnota parametru ',parametry[3],' neni cislo');
halt(0);
end
//neslo to pres interval, nevim proc, docela by me to zajimalo
else if not((prodleva <= 32767) and (prodleva >= 0)) then begin
writeln ('cislo v parametru ',parametry[3],' neni z intervalu 0 az 32767');
halt(0);
end;
end;
end;
end;
end;
end;
(****************************************************)
(* maze pocet radku, vcetne nynejsiho *)
(****************************************************)
procedure smazradky (radku:byte);
var
i : byte;
begin
delline;
for i:=1 to radku-1 do begin
y:=wherey-1;
gotoxy(1,y);
clreol;
end;
end;
(****************************************************)
(* vykresli hraci pole *)
(****************************************************)
procedure drawtab(x,y:smallint);
begin
for y:=0 to length(pole[0])-1 do begin
for x:=0 to length(pole)-1 do
if (hrac1[x,y][1]=' ') and (hrac2[x,y][1]=' ') then write (pole[x,y])
else
if hrac1[x,y][1]=' ' then begin
//svitiva zelena
textcolor(10);
write (hrac2[x,y]);
normvideo;
end
else begin
//svitiva zluta
textcolor(14);
write (hrac1[x,y]);
normvideo;
end;
writeln;
end;
end;
(****************************************************)
(* vraci souradnice uzivatele *)
(****************************************************)
procedure OwnSouradnice (var x,y : smallint);
var
xovain, yova : string;
ok, z : smallint;
begin
//opakovat zadavani x a y, dokud nebudou sedet
repeat
(* xova *)
ok:=1;
repeat
write ('zadejte souradnice sirky: x = ');
readln (xovain);
val(xovain,x,ok);
if not(ok=0) then begin
writeln;
write ('zadane znaky nelze povazovat za cislo, zadejte je znovu');
delay(cekani);
smazradky(3);
end
else
if not(x in [1..length(pole)-1]) then begin
ok:=1;
writeln;
write ('zadane cislo neni z cisel na ose x, zadejte je znovu');
delay(cekani);
smazradky(3);
end;
until (ok=0);
(* yova *)
//vypocte posledni pismenko z osy y
i:=0;
for z:=1 to length(pole[0])-1 do
if (z mod 3) = 0 then i:=i+1
else
if (z mod 3) = 1 then i:=i+1;
ok:=1;
repeat
write (' y = ');
readln (yova);
if (yova[1]='1') or (length(yova)>1) or not(yova[1] in ['a'..chr(96+i)]) then begin
writeln;
write ('tomu rikate male pismenko z osy y ?! - zadejte znovu');
delay(cekani);
smazradky(3);
end
else
if ((((ord(yova[1])-ord('a')+1) mod 2)=0) and ((x mod 2)=0)) or
((((ord(yova[1])-ord('a')+1) mod 2)=1) and ((x mod 2)=1)) or
((ord(yova[1])-ord('a')+1) = x) then begin
writeln;
write ('tato souradnice prece neexistuje!');
delay(cekani);
smazradky(4);
break;
end
else ok:=0;
until ok=0;
until ok=0;
//vypocet radku
y:=(ord(yova[1])-ord('a')+1) + ((ord(yova[1])-ord('a')+1) div 2);
end;
(****************************************************)
(* vraci kolik uzavira kruhu *)
(****************************************************)
function kruhu(x,y:smallint):smallint;
begin
kruhu:=0;
// pro '|'
if (hrac1[x,y][1]='|') or (hrac2[x,y][1]='|') then begin
//kruh vlevo
//aby nesahal mimo pole - nekam do pameti, kde nevim, co je
if ( x-1 > 1 ) and
((hrac1[x-2,y ][1]='|') or (hrac2[x-2,y ][1]='|')) and
((hrac1[x-1,y-2][1]='_') or (hrac2[x-1,y-2][1]='_')) and
((hrac1[x-1,y+1][1]='_') or (hrac2[x-1,y+1][1]='_')) then kruhu:=kruhu+1;
//kruh vpravo
//aby nesahal mimo pole - nekam do pameti, kde nevim, co je
if ( x+1 < length(pole)-1 ) and
((hrac1[x+2,y ][1]='|') or (hrac2[x+2,y ][1]='|')) and
((hrac1[x+1,y-2][1]='_') or (hrac2[x+1,y-2][1]='_')) and
((hrac1[x+1,y+1][1]='_') or (hrac2[x+1,y+1][1]='_')) then kruhu:=kruhu+1;
end;
// pro '_'
if (hrac1[x,y][1]='_') or (hrac2[x,y][1]='_') then begin
//kruh nad
//aby nesahal mimo pole - nekam do pameti, kde nevim, co je
if ( y-1 > 1 ) and
((hrac1[x,y-3][1]='_') or (hrac2[x,y-3][1]='_')) and
((hrac1[x-1,y][1]='|') or (hrac2[x-1,y][1]='|')) and
((hrac1[x+1,y][1]='|') or (hrac2[x+1,y][1]='|')) then kruhu:=kruhu+1;
//kruh pod
//aby nesahal mimo pole - nekam do pameti, kde nevim, co je
if ( y+1 < length(pole[0])-1 ) and
((hrac1[x ,y+3][1]='_') or (hrac2[x ,y+3][1]='_')) and
((hrac1[x-1,y+2][1]='|') or (hrac2[x-1,y+2][1]='|')) and
((hrac1[x+1,y+2][1]='|') or (hrac2[x+1,y+2][1]='|')) then kruhu:=kruhu+1;
end;
end;
(****************************************************)
(* vraci nahodny integer ze zadaneho intervalu *)
(****************************************************)
function randomint (min, max: integer): integer;
begin
if min < max then randomint := min + random (max - min)
else randomint := min - random (min - max)
end;
(****************************************************)
(* vraci idealni souradnice *)
(****************************************************)
procedure ideal(var a,b : smallint);
var
skonci : boolean;
begin
skonci:=false;
//nahodne generovat tah dokud se netrefi prazdne pole :)
//(maximalne vsak 39x, pak se vezme prvni prazdne misto,
// kvuli setreni procesorovym casem)
for i:=1 to 40 do begin
x:=randomint(1,length(pole)-1);
y:=randomint(1,length(pole[0])-1);
if ( (((y mod 3)=0) and ((x mod 2)=1)) or
(((y mod 3)=1) and ((x mod 2)=0)) ) and
//je tam volno?
(hrac1[x,y][1]=' ') and
(hrac2[x,y][1]=' ') then break;
end;
//vraci souradnice prvniho prazdneho mista
if i=40 then begin
for y:=1 to length(pole[0])-1 do begin
for x:=1 to length(pole)-1 do
//spravna souradnice?
if ( (((y mod 3)=0) and ((x mod 2)=1)) or
(((y mod 3)=1) and ((x mod 2)=0)) ) and
//je tam volno?
((hrac1[x,y][1]=' ') and (hrac2[x,y][1]=' '))
then begin
skonci:=true;
break;
end
else continue;
if skonci=true then break;
end;
end;
a:=x;
b:=y;
end;
(****************************************************)
(****************************************************)
(* *)
(* START *)
(* *)
(****************************************************)
(****************************************************)
begin
//kontrola/vyplneni vstupnich parametru
prodleva:=1000;
typ:='hh';
input_param(typ,prodleva);
if (typ<>'cc') and (prodleva>=0) then begin
writeln ('nemuzete zadavat casovou prodlevu, kdyz to neni typ hry cc');
halt(0);
end;
//kdyz neni parametr -d VUBEC zadany
if prodleva<0 then prodleva:=1000;
//zaplneni hracu mezerami
for y:=0 to length(hrac1[0])-1 do
for x:=0 to length(hrac1)-1 do begin
hrac1[x,y]:=(' ');
end;
for y:=0 to length(hrac2[0])-1 do
for x:=0 to length(hrac2)-1 do begin
hrac2[x,y]:=(' ');
end;
(****************************************************)
(* hraci pole *)
(****************************************************)
//prvni radek
y:=0;
for x:=0 to length(pole)-1 do
if x=0 then pole[x,y]:=(' ')
else
if (x mod 2) = 0 then
if x > 9 then begin
str(x,pom_prom);
pole[x,y]:=(' '+pom_prom+' ')
end
else begin
str(x,pom_prom);
pole[x,y]:=(' '+pom_prom+' ')
end
else begin
str(x,pom_prom);
pole[x,y]:=(pom_prom);
end;
//ostatni radky
i:=0;
for y:=1 to length(pole[0])-1 do begin
for x:=0 to length(pole)-1 do begin
//jestli JE to prvni "string" v radku
if x=0 then
//jestli JE to prvni radek
if y=1 then begin
i:=i+1;
pole[x,y]:=(chr(96+i)+' _');
end
//kdyz to NEni prvni radek
else
if (y mod 3) = 0 then begin
i:=i+1;
pole[x,y]:=(chr(96+i)+' ');
end
else
if (y mod 3) = 1 then begin
i:=i+1;
pole[x,y]:=(chr(96+i)+' _');
end
else pole[x,y]:=(' ')
//kdyz to NEni prvni "string" v radku
else
if (y mod 3) = 1 then
if (x mod 2) = 0 then pole[x,y]:=('_____')
else pole[x,y]:=('|')
else
if (x mod 2) = 0 then pole[x,y]:=(' ')
else pole[x,y]:=('|');
end;
end;
//naplneni dulezitych promennych
tah:=1;
skore1:=0;
skore2:=0;
skore1old:=0;
skore2old:=0;
polex:=10;
poley:=10;
(****************************************************)
(* vysledny vypis na obrazovku *)
(****************************************************)
repeat
clrscr;
drawtab(x,y);
skore1old:=skore1;
skore2old:=skore2;
writeln ('--------------------------- skore ----------------------------');
write (' zluty hrac: ',skore1);
write (' ');
writeln ('zeleny hrac: ',skore2);
if skore1+skore2 <> polex*poley then
repeat
//hrac1
if tah = 1 then begin
write ('------------------- na tahu je ');
//svitiva zluta
textcolor(14);
write ('zluty');
normvideo;
writeln (' hrac --------------------');
//kdyz typ = hh
if (typ='hh') or (typ='hc') then begin
// toto je zakomentovane, protoze je to pekne otravne - hlavne to je podvod pri hre :)
// jiny zpusob reseni me nenapadnul,
// jedine zmacknuti klavesy F1, s tim jsem se ale uz nechtel delat,
// protoze mi to prislo zbytecne - tu hru by to zkazilo :)
{ repeat
write ('chce aby tento tah za Vas provedl pocitac? y/n : ');
readln (pom_prom);
if (pom_prom <> 'y') and (pom_prom <> 'n') then begin
writeln ('nezadal jste "y" nebo "n", zkuste to znovu !');
delay(cekani);
smazradky(3);
end;
until (pom_prom = 'y') or (pom_prom = 'n');
if pom_prom='y' then ideal(x,y)
else }ownsouradnice(x,y);
if hrac1[x,y][1]=' ' then
if hrac2[x,y][1]=' ' then
if (x mod 2)=0 then begin
hrac1[x,y]:=('_____');
skore1:=skore1+kruhu(x,y);
end
else begin
hrac1[x,y+1]:=('|');
hrac1[x,y ]:=('|');
hrac1[x,y-1]:=('|');
//skore
skore1:=skore1+kruhu(x,y);
end
else begin
writeln ('to nevidis, ze tam Tvuj protihrac ma uz svoji sirku?!');
delay(cekani);
smazradky(5);
end
else begin
writeln ('to nevidis, ze uz sis tam jednou sirku dal(a)?!');
delay(cekani);
smazradky(5);
end;
end;
//kdyz typ = cc
if typ='cc' then begin
ideal(x,y);
if (x mod 2)=0 then begin
hrac1[x,y]:=('_____');
skore1:=skore1+kruhu(x,y);
end
else begin
hrac1[x,y+1]:=('|');
hrac1[x,y ]:=('|');
hrac1[x,y-1]:=('|');
//skore
skore1:=skore1+kruhu(x,y);
end;
end;
end
//hrac2
else begin
write ('------------------ na tahu je ');
//svitiva zelena
textcolor(10);
write ('zeleny');
normvideo;
writeln (' hrac --------------------');
//kdyz typ = hh
if typ='hh' then begin
// toto je zakomentovane, protoze je to pekne otravne - hlavne to je podvod pri hre :)
// jiny zpusob reseni me nenapadnul,
// jedine zmacknuti klavesy F1, s tim jsem se ale uz nechtel delat,
// protoze mi to prislo zbytecne - tu hru by to zkazilo :)
{ repeat
write ('chce aby tento tah za Vas provedl pocitac? y/n : ');
readln (pom_prom);
if (pom_prom <> 'y') and (pom_prom <> 'n') then begin
writeln ('nezadal jste "y" nebo "n", zkuste to znovu !');
delay(cekani);
smazradky(3);
end;
until (pom_prom = 'y') or (pom_prom = 'n');
if pom_prom='y' then ideal(x,y)
else }ownsouradnice(x,y);
if hrac2[x,y][1]=' ' then
if hrac1[x,y][1]=' ' then
if (x mod 2)=0 then begin
hrac2[x,y]:=('_____');
skore2:=skore2+kruhu(x,y);
end
else begin
hrac2[x,y+1]:=('|');
hrac2[x,y ]:=('|');
hrac2[x,y-1]:=('|');
//skore
skore2:=skore2+kruhu(x,y);
end
else begin
writeln ('to nevidis, ze tam Tvuj protihrac ma uz svoji sirku?!');
delay(cekani);
smazradky(5);
end
else begin
writeln ('to nevidis, ze uz sis tam jednou sirku dal(a)?!');
delay(cekani);
smazradky(5);
end;
end;
//kdyz typ = cc nebo hc
if (typ='cc') or (typ='hc') then begin
ideal(x,y);
if (x mod 2)=0 then begin
hrac2[x,y]:=('_____');
skore2:=skore2+kruhu(x,y);
end
else begin
hrac2[x,y+1]:=('|');
hrac2[x,y ]:=('|');
hrac2[x,y-1]:=('|');
//skore
skore2:=skore2+kruhu(x,y);
end;
end;
end;
until (hrac1[x,y][1]='|') or (hrac1[x,y][1]='_') or
(hrac2[x,y][1]='|') or (hrac2[x,y][1]='_')
//aby se vyskocilo z cyklu - kvuli hezcimu vypisu
else skore1:=skore1+1;
if tah=1 then
if skore1>skore1old then tah:=1
else tah:=2
else
if skore2>skore2old then tah:=2
else tah:=1;
//toto je reseni zmeny casove prodlevy pri typu hry cc
//ale nefunguje mi - nejde zkompilovat, i kdyz by to melo jit
{
currenttime:=start_timer;
if typ='cc' then begin
writeln ('Muzete menit rychlost obnovovani,');
writeln ('staci zadat casovou prodlevu v milisekundach.');
repeat
write ('prodleva: ');
readln (pom_prom);
val(pom_prom,prodleva,i);
if i<>0 then begin
writeln ('Zadane znaky nelze povazovat za cislo! Zkuste to znovu.');
delay(prodleva);
smazradky(4);
end
else smazradky(3);
until i=0;
end
wait_to (currenttime, (prodleva div 1000));
}
if typ='cc' then delay(prodleva);
//pricitam jednicku, aby se cyklus nacal jeste jednou
// - proste kvuli "hezcimu" vystupu na obrazovce
until skore1+skore2 = polex*poley+1;
writeln ;
writeln ('This program is licensed under the terms of GNU-GPLv3 or higher');
writeln ('If You want to know something more, look at this web-page:');
writeln ('www.gymnachod.cz/~pacner.jan');
writeln ;
writeln ('written by Globator007 on 6/2008 in Lazarus');
writeln ('for EXIT press Enter');
readln;
end.