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.
„Kdo se umí smát sám sobě, má právo smát se smát všemu ostatnímu, co mu k smíchu připadá.“ Jan Werich