{ SACH.PAS                                  Copyright (c) Miro Kuki }
{                                                                   }
{ Je tu konečne šach pre dvoch (síce s hroznou grafilkou, ale čo už)}
{ Ovládanie je vežmi jednoduché pohybuje sa pomocou:                }
{ ‹ čo umožní pohyb smerom do žava                                  }
{ Ą čo umožní pohyb smerom dolu                                     }
{ › čo umožní pohyb smerom do prava                                 }
{ ^ čo umožní pohyb smerom nahor                                    }
{ medzerník čo umožní  zobratie figúrky                             }
{                                                                   }
{ V - znamená veža                                                  }
{ K - znamená kôň                                                   }
{ S - znamená strelec                                               }
{ Q - znamená krážovna                                              }
{ + - znamená kráž, s ktorým sa ešte nepohlo                        }
{ R - znamená kráž, s ktorým sa pohlo                               }
{ P - znamená pešiak                                                }
{                                                                   }
{ Pre ukončenie nápovedy stisnite "ENTER" a pre ukončenie hry       }
{ stisnite k (ale až po tom,ako stlačíte "ENTER" )                  }
{ Prajem príjenu zábavu                                             }
{                                                                   }
{ Author: Miro Kuki                                                 }
{ Date  : 28.8.2006                            http://www.trsek.com }
 
program sach;
 
uses    crt;
 
const   biely  = 15;
        cierny =  9;
        minx   = 30; {UrŸuje, kde sa nach dza prvě bod}
        miny   = 10;
        hlaska = 12;
        z      = 15;
        vy     = 14;
        ak     = 13;
        ine    = 11;
        koniec = 12;
 
var     sachovnica            : array [minx..minx+16,miny..miny+16] of char;
                                {tu sa uklada, Ÿi ide o Ÿierneho alebo bieleho}
        pole                  : array [minx..minx+16,miny..miny+16] of char;
        poradie               : byte;
        pomocna               : char;
        p                     : char;
        x,y                   : byte;
        px,py                 : byte;
        nic                   : char;
        j,i                   : integer;     {na vymazanie sachovnice, ale d  sa hocikde pou§iœ}
        ozaj                  : boolean;
        kral1pohyb,kral2pohyb : boolean;
        prvytah               : array [1..16,1..2] of boolean;{pre prvy tah pesiaka}
        e,f                   : byte;
        koniechry             : boolean;
 
 
 
Function zistenieciniektonevyhral:boolean;
var     a,b,c:byte;
begin
c:=0;
zistenieciniektonevyhral:=false;
for a:=miny to miny+16 do
  for b:=minx to minx+16 do
    begin
      if sachovnica[b,a] = 'Ĺ' then inc(c);
    end;
if c < 2 then zistenieciniektonevyhral:=true;
end;
 
 
Procedure pohyb;
begin
  case p of
    'H': dec(y,2);
    'P': inc(y,2);
    'K': dec(x,2);
    'M': inc(x,2);
  end;
if x >= minx+17 then x:=minx+2;
if x <= minx    then x:=minx+16;
if y >= miny+17 then y:=miny+2;
if y <= miny    then y:=miny+16;
end;
 
Procedure vymena;
var proc:boolean;
begin
proc:=true;
if pomocna = 'P' then
  begin
    if (y = 12)
     or (y = 26) then
       begin
         repeat
           gotoxy(35,30);
           write('NapĄç ktorŁ chceç figŁrku: ');
           readln(pomocna);
           case pomocna of
             'v': begin
                    if poradie = 1 then pole[x,y]:='c'
                                   else pole[x,y]:='b';
                    pomocna:='V';
                    proc:=true;
                  end;
             'q': begin
                    if poradie = 1 then pole[x,y]:='c'
                                   else pole[x,y]:='b';
                    pomocna:='Q';
                    proc:=true;
                  end;
             's': begin
                    if poradie = 1 then pole[x,y]:='c'
                                   else pole[x,y]:='b';
                    pomocna:='S';
                    proc:=true;
                  end;
             'k': begin
                    if poradie = 1 then pole[x,y]:='c'
                                   else pole[x,y]:='b';
                    pomocna:='K';
                    proc:=true;
                  end;
             else
               begin
                 proc:=false;
                 gotoxy(46,30);
                 write(' ');
               end;
             end;
         until proc=true;
       end;
  end;
gotoxy(35,30);
write('                             ');
end;
 
Function skusp:boolean;    {pre peçiakov}
begin
skusp:=false;
if pomocna = 'P' then
begin
f:=(px-minx);
  if poradie = 1 then
    begin  {Zaciatok cierneho}
      if ((pole[x,y] = 'b') and ((px = x+2) and (py = y+2)))
       or ((pole[x,y] = 'b') and ((px = x-2) and (py = y+2))) then skusp:=false
                                                              else
         begin
           if ((py >= (y+4)) and (prvytah[f,2] = true))
            or ((py >= (y+6)) and (prvytah[f,2] = false))
            or (pole[x,y] = 'c')
            or (py < y)
            or ((pole[x,y] = ' ') and (px <> x))
            or ((pole[x,y] = ' ') and (py = y))
            or ((pole[x,y] = 'b') and (px = x))
            or ((pole[x,y] = 'b') and (py = y))
            or (pole[x,y] = 'c')
            or (px <> x) then
              begin
                skusp:=true;
                y:=py;
                x:=px;
                textcolor(cierny);
              end;
         end;
    end {koniec cierneho}
                 else    {Zaciatok bieleho}
    begin
      if ((pole[x,y] = 'c') and ((px = x+2) and (py = y-2)))
       or ((pole[x,y] = 'c') and ((px = x-2) and (py = y-2))) then skusp:=false
                                                              else
         begin
           if ((py <= (y-4)) and (prvytah[f,1] = true))
            or ((py <= (y-6)) and (prvytah[f,1] = false))
            or (pole[x,y] = 'b')
            or (py > y)
            or ((pole[x,y] = ' ') and (px <> x))
            or ((pole[x,y] = ' ') and (py = y))
            or ((pole[x,y] = 'c') and (px = x))
            or ((pole[x,y] = 'c') and (py = y))
            or (pole[x,y] = 'b')
            or (px <> x) then
              begin
                skusp:=true;
                y:=py;
                x:=px;
                textcolor(biely);
              end;
         end;
    end; {Koniec Bieleho}
end;
vymena; {odkaz na proceduru, ktor  vymenĄ peçiaka za nieŸo ine}
end;
Function skusv:boolean;   {pre ve§u}
begin
skusv:=false;
if pomocna = 'V' then
begin
  if poradie = 1 then
    begin
                    {Skuska, Ÿi niekto nestojĄ v ceste}
      if px > x then        {do–va}
          for i:=x+1 to px do
              if pole[i,y] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(cierny);
                end;
      if px < x then        {doprava}
          for i:=px to x-1 do
            begin
              if pole[i,y] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(cierny);
                end;
            end;
      if py > y then        {hore}
          for i:=y+1 to py do
              if pole[x,i] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(cierny);
                end;
      if py < y then        {dolu}
          for i:=py to y-1 do
            begin
              if pole[x,i] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(cierny);
                end;
            end;
                     {Koniec preskakovania}
      if (py <> y) and (px <> x)
        or (py = y) and (px = x)
        or (pole[x,y] = 'c')
        or (pole[x,y] = 'c') then
          begin
            skusv:=true;
            y:=py;
            x:=px;
            textcolor(cierny);
          end
    end          else
    begin
                    {preskakovanie}
      if px > x then        {do–va}
          for i:=x+1 to px do
              if pole[i,y] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(biely);
                end;
      if px < x then        {doprava}
          for i:=px to x-1 do
            begin
              if pole[i,y] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(biely);
                end;
            end;
      if py > y then        {hore}
          for i:=y+1 to py do
              if pole[x,i] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(biely);
                end;
      if py < y then        {dolu}
          for i:=py to y-1 do
            begin
              if pole[x,i] <> ' ' then
                begin
                  skusv:=true;
                  y:=py;
                  x:=px;
                  textcolor(biely);
                end;
            end;
                     {Koniec preskakovania}
      if (py <> y) and (px <> x)
        or (py = y) and (px = x)
        or (pole[x,y] = 'b')
        or (pole[x,y] = 'b') then
          begin
            skusv:=true;
            y:=py;
            x:=px;
            textcolor(biely);
          end;
    end;
end;
end;
Function skuss:boolean;     {pre strelca}
var k:byte;
begin
skuss:=false;
if pomocna = 'S' then
begin
   {ci nieco nestojĄ v ceste}
j:=0;
if (x > px) and (py < y) then
  for i:=px to x-1 do
    begin
      k:=py+j;
      if pole[i,k] <> ' ' then
        begin
          skuss:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
j:=-1;
if (px > x) and (py < y) then
  for i:=x+1 to px do
    begin
      k:=y+j;
      if pole[i,k] <> ' ' then
        begin
          skuss:=true;
          i:=px;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      dec(j);
    end;
 
j:=0;
if (x > px) and (py > y) then
  for i:=px to x-1 do
    begin
      k:=py-j;
      if pole[i,k] <> ' ' then
        begin
          skuss:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
j:=1;
if (px > x) and (py > y) then
  for i:=x+1 to px do
    begin
      k:=y+j;
      if pole[i,k] <> ' ' then
        begin
          skuss:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
        {u§ vieme Ÿi nieŸo stjĄ v ceste, alebo nie}
 
  if poradie = 1 then
    begin
      if (abs(py-y) <> abs(px-x))
        or (py = y) and (px = x)
        or (pole[x,y] = 'c')
        or (pole[x,y] = 'c') then
          begin
            skuss:=true;
            y:=py;
            x:=px;
            textcolor(cierny);
          end
    end          else
    begin
      if (abs(py-y) <> abs(px-x))
        or (py = y) and (px = x)
        or (pole[x,y] = 'b')
        or (pole[x,y] = 'b') then
          begin
            skuss:=true;
            y:=py;
            x:=px;
            textcolor(biely);
          end;
    end;
end;
end;
Function skusk:boolean;     {pre koĺa}
begin
skusk:=false;
if pomocna = 'K' then
begin
  if poradie = 1 then
    begin
      if (py <> y-4) or (px <> x+2)
       or (pole[x,y] = 'c') then
         begin
           if (py <> y-4) or  (px <> x-2)
            or (pole[x,y] = 'c') then
              begin
                if (px <> x-4) or (py <> y+2)
                 or (pole[x,y] = 'c') then
                   begin
                     if (px <> x-4) or (py <> y-2)
                      or (pole[x,y] = 'c') then
                        begin
                          if (py <> y+4) or (px <> x+2)
                            or (pole[x,y] = 'c') then
                              begin
                                if ((py <> y+4) or  (px <> x-2))
                                 or (pole[x,y] = 'c') then
                                   begin
                                     if ((px <> x+4) or (py <> y+2))
                                      or (pole[x,y] = 'c') then
                                        begin
                                          if ((px <> x+4) or (py <> y-2))
                                           or (pole[x,y] = 'c') then
 
                                             begin
                                               skusk:=true;
                                               y:=py;
                                               x:=px;
                                               textcolor(cierny);
                                             end;
                                        end;
                                   end;
                              end;
                        end;
                   end;
              end;
         end;
    end          else
    begin
      if (py <> y-4) or (px <> x+2)
       or (pole[x,y] = 'b') then
         begin
           if (py <> y-4) or  (px <> x-2)
            or (pole[x,y] = 'b') then
              begin
                if (px <> x-4) or (py <> y+2)
                 or (pole[x,y] = 'b') then
                   begin
                     if (px <> x-4) or (py <> y-2)
                      or (pole[x,y] = 'b') then
                        begin
                          if (py <> y+4) or (px <> x+2)
                            or (pole[x,y] = 'b') then
                              begin
                                if ((py <> y+4) or  (px <> x-2))
                                 or (pole[x,y] = 'b') then
                                   begin
                                     if ((px <> x+4) or (py <> y+2))
                                      or (pole[x,y] = 'b') then
                                        begin
                                          if ((px <> x+4) or (py <> y-2))
                                           or (pole[x,y] = 'b') then
 
                                             begin
                                               skusk:=true;
                                               y:=py;
                                               x:=px;
                                               textcolor(biely);
                                             end;
                                        end;
                                   end;
                              end;
                        end;
                   end;
              end;
         end;
    end;
end;
end;
Function skusq:boolean;  {pre kr –ovnu}
var k:byte;
begin
skusq:=false;
if pomocna = 'Q' then
  begin
    if poradie = 1 then
      begin
        if (py <> y) and (px = x) and (pole[x,y] <> 'c')
         or (py = y) and (px <> x) and (pole[x,y] <> 'c') then skusq:=false
                                   else
          begin
            if (abs(py-y) <> abs(px-x))
             or (py = y) and (px = x)
             or (pole[x,y] = 'c') then
               begin
                 skusq:=true;
                 y:=py;
                 x:=px;
                 textcolor(cierny);
               end;
          end;
      end          else
      begin
        if (py <> y) and (px = x) and (pole[x,y] <> 'b')
         or (py = y) and (px <> x) and (pole[x,y] <> 'b') then skusq:=false
                                                         else
          begin
            if (abs(py-y) <> abs(px-x))
             or (py = y) and (px = x)
             or (pole[x,y] = 'b') then
               begin
                 skusq:=true;
                 y:=py;
                 x:=px;
                 textcolor(biely);
               end;
          end;
      end;
if skusq = true then
                else
begin
                {Skuska, Ÿi niekto nestojĄ v ceste vodorovne a zvysle}
  if (abs(py-y) <> abs(px-x)) then
    begin
      if px > x then        {do–va}
          for i:=x+1 to px do
              if pole[i,y] <> ' ' then
                begin
                  skusq:=true;
                  y:=py;
                  x:=px;
                  if poradie = 1 then textcolor(cierny)
                                 else textcolor(biely);
                end;
      if px < x then        {doprava}
          for i:=px to x-1 do
            begin
              if pole[i,y] <> ' ' then
                begin
                  skusq:=true;
                  y:=py;
                  x:=px;
                  if poradie = 1 then textcolor(cierny)
                                 else textcolor(biely);
                end;
            end;
      if py > y then        {hore}
          for i:=y+1 to py do
              if pole[x,i] <> ' ' then
                begin
                  skusq:=true;
                  y:=py;
                  x:=px;
                  if poradie = 1 then textcolor(cierny)
                                 else textcolor(biely);
                end;
      if py < y then        {dolu}
          for i:=py to y-1 do
            begin
              if pole[x,i] <> ' ' then
                begin
                  skusq:=true;
                  y:=py;
                  x:=px;
                  if poradie = 1 then textcolor(cierny)
                                 else textcolor(biely);
                end;
            end;
    end                       else
                 {Koniec vertik lneho a horizont lneho zisœovania}
begin
j:=0;
                 {Zisœovanie Ÿi nieco nestojĄ v çikmej ceste}
if (x > px) and (py < y) then
  for i:=px to x-1 do
    begin
      k:=py+j;
      if pole[i,k] <> ' ' then
        begin
          skusq:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
j:=-1;
if (px > x) and (py < y) then
  for i:=x+1 to px do
    begin
      k:=y+j;
      if pole[i,k] <> ' ' then
        begin
          skusq:=true;
          i:=px;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      dec(j);
    end;
 
j:=0;
if (x > px) and (py > y) then
  for i:=px to x-1 do
    begin
      k:=py-j;
      if pole[i,k] <> ' ' then
        begin
          skusq:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
j:=1;
if (px > x) and (py > y) then
  for i:=x+1 to px do
    begin
      k:=y+j;
      if pole[i,k] <> ' ' then
        begin
          skusq:=true;
          y:=py;
          x:=px;
          if poradie = 1 then textcolor(cierny)
                         else textcolor(biely);
        end;
      inc(j);
    end;
 
  end;      {u§ vieme Ÿi nieŸo stjĄ v ceste, alebo nie}
end;
end;
end;
Function skuskr:boolean;    {pre kr –a}
begin
skuskr:=false;
if pomocna = 'Ĺ' then
  begin
    if (kral1pohyb = false) and (poradie = 0)
     or (kral2pohyb = false) and (poradie = 1) then
      begin
        if (px <= x-2)
         or (px >= x+2)
         or (py >= y+2)
         or (py <= y-2) then
           begin
             if poradie = 1 then
               begin
                 if (pole[x,y] = 'c') then
                   begin
                     skuskr:=true;
                     y:=py;
                     x:=px;
                     textcolor(cierny);
                   end                else
                 begin
                   if (py = y-2) and (px = x)       {zaciatok vodorovne a zvysle}
                    or ((py = y+2) and (px = x))
                    or ((py = y) and (px = x+2))
                    or ((py = y) and (px = x-2))    {koniec vodorovne a zvysle}
                    or ((py = y-2) and (px = x-2))  {zaciatok krĄ§}
                    or ((py = y-2) and (px = x+2))
                    or ((py = y+2) and (px = x-2))  {koniec krĄ§ + to potom}
                    or ((py = y+2) and (px = x+2))
                    or ((px = x-4) and (py = y))
                    or ((px = x+4) and (py = y)) then
                      begin
                        skuskr:=false;
                      end
                                                 else
                      begin
                        skuskr:=true;
                        y:=py;
                        x:=px;
                        textcolor(cierny);
                      end;
                 end;
               end                    else
               begin
                 if (pole[x,y] = 'b') then
                   begin
                     skuskr:=true;
                     y:=py;
                     x:=px;
                     textcolor(biely);
                   end                else
                   begin
                     if (py = y-2) and (px = x)       {zaciatok vodorovne a zvysle}
                      or ((py = y+2) and (px = x))
                      or ((py = y) and (px = x+2))
                      or ((py = y) and (px = x-2))    {koniec vodorovne a zvysle}
                      or ((py = y-2) and (px = x-2))  {zaciatok krĄ§}
                      or ((py = y-2) and (px = x+2))
                      or ((py = y+2) and (px = x-2))  {koniec krĄ§ + to potom}
                      or ((py = y+2) and (px = x+2))
                      or ((px = x-4) and (py = y))
                      or ((px = x+4) and (py = y))   then
                        begin
                          skuskr:=false;
                        end
                                                     else
                        begin
                          skuskr:=true;
                          y:=py;
                          x:=px;
                          textcolor(biely);
                        end;
                   end;
               end;
           end;
                        {ROç DA}
        if (px = x-4) and (py = y) then  {doprava}
           begin
             if poradie = 1 then
               begin
                 if pole[42,26] <> ' ' then
                   skuskr:=true
                                       else
                   begin  {kr –}
                     pole[40,26]:=' ';
                     pole[44,26]:='c';
                     sachovnica[40,26]:=' ';
                     sachovnica[44,26]:='Ĺ';
                          {ve§a}
                     pole[46,26]:=' ';
                     pole[42,26]:='c';
                     sachovnica[46,26]:=' ';
                     sachovnica[42,26]:='V';
                     gotoxy(46,26);write(' ');
                     textcolor(cierny);
                     gotoxy(42,26);write('V');
                   end;
               end
                            else
               begin
                 if pole[42,12] <> ' ' then
                   skuskr:=true
                                       else
                   begin  {kr –}
                     pole[40,12]:=' ';
                     pole[44,12]:='b';
                     sachovnica[40,12]:=' ';
                     sachovnica[44,12]:='Ĺ';
                          {ve§a}
                     pole[46,12]:=' ';
                     pole[42,12]:='b';
                     sachovnica[46,12]:=' ';
                     sachovnica[42,12]:='V';
                     gotoxy(46,12);write(' ');
                     gotoxy(42,12);write('V');
                   end;
               end;
           end;
        if (px = x+4) and (py = y) then  {do–ava}
          begin
             if poradie = 1 then
               begin
                 if pole[38,26] <> ' ' then skuskr:=true
                                       else
                   begin  {kr –}
                     pole[40,26]:=' ';
                     pole[36,26]:='c';
                     sachovnica[32,26]:=' ';
                     sachovnica[36,26]:='Ĺ';
                          {ve§a}
                     pole[32,26]:=' ';
                     pole[38,26]:='c';
                     sachovnica[32,26]:=' ';
                     sachovnica[38,26]:='V';
                     gotoxy(32,26);write(' ');
                     textcolor(cierny);
                     gotoxy(38,26);write('V');
                   end;
               end
                            else
               begin
                 if pole[38,12] <> ' ' then skuskr:=true
                                       else
                   begin  {kr –}
                     pole[40,12]:=' ';
                     pole[36,12]:='b';
                     sachovnica[40,12]:=' ';
                     sachovnica[36,12]:='Ĺ';
                          {ve§a}
                     pole[32,12]:=' ';
                     pole[38,12]:='b';
                     sachovnica[32,12]:=' ';
                     sachovnica[38,12]:='V';
                     gotoxy(32,12);write(' ');
                     gotoxy(38,12);write('V');
                   end;
               end;
           end;
      end                 else
      begin
        if poradie = 1 then
          begin
            if (pole[x,y] = 'c') then
              begin
                skuskr:=true;
                y:=py;
                x:=px;
                textcolor(cierny);
              end               else
              begin
                if (py = y-2) and (px = x)       {zaciatok vodorovne a zvysle}
                 or ((py = y+2) and (px = x))
                 or ((py = y) and (px = x+2))
                 or ((py = y) and (px = x-2))    {koniec vodorovne a zvysle}
                 or ((py = y-2) and (px = x-2))  {zaciatok krĄ§}
                 or ((py = y-2) and (px = x+2))
                 or ((py = y+2) and (px = x-2))  {koniec krĄ§ + to potom}
                 or ((py = y+2) and (px = x+2)) then
                   begin
                     skuskr:=false;
                   end
                                                else
                   begin
                     skuskr:=true;
                     y:=py;
                     x:=px;
                     textcolor(cierny);
                   end;
              end;
          end          else
          begin
            if (pole[x,y] = 'b') then
              begin
                skuskr:=true;
                y:=py;
                x:=px;
                textcolor(biely);
              end               else
              begin
                if (py = y-2) and (px = x)       {zaciatok vodorovne a zvysle}
                 or ((py = y+2) and (px = x))
                 or ((py = y) and (px = x+2))
                 or ((py = y) and (px = x-2))    {koniec vodorovne a zvysle}
                 or ((py = y-2) and (px = x-2))  {zaciatok krĄ§}
                 or ((py = y-2) and (px = x+2))
                 or ((py = y+2) and (px = x-2)