Program pro hru LODĚ. Program by měl umožnit hru dvou protihráčů nebo i hru proti počítači.

{ HRACI.PAS                                Copyright (c) Ales Kucik }
{ Objekty predstavuji jednotlive hrace. Kazdy obekt ma dve hraci    }
{ plochy, stejne jako v realne hre. Jednotlive obekty spolu         }
{ komunikuji metodami:                                              }
{ zasah, prohra (kde se poporade ptaji druheho obektu,jestli        }
{ byla zasazena nejaka lod a jestli nejsou potopeny vsechny lode)   }
{                                                                   }
{ Tato unita je sestavena tak, ze lze relativne jdenoduchym zpusobem}
{ pridavat nove typy hracu. Ovsem byl by nutny drobny zasah i do    }
{ hlavniho programu.                                                }
{                                                                   }
{ Datum:09.04.2002                             http://www.trsek.com }
 
unit hraci;
 
interface
 
uses crt,mcrt01,mouse01;
 
const
  x_max=15;      {maximalni x-ovy rozmer hraciho pole}
  y_max=15;      {maximalni y-ovy rozmer hraciho pole}
 
  x_plocha1=10;  {x-ova souradnice umisteni prvni hraci plochy}
  y_plocha1=10;  {y-ova souradnice umisteni prvni hraci plochy}
 
  x_plocha2=40;  {x-ova souradnice druhe plochy}
  y_plocha2=10;  {y-ova souradnice druhe plochy}
 
  x_nabidka=65;  {souradnice nabidky lodi}
  y_nabidka=30;
 
  x_souradnice=5;  {souradnice vypisu souradnic}
  y_souradnice=30;
 
  plocha_bgr=lightblue; {pozadi hraci plochy}
  lod_col=   yellow;
  vedle_col= lightmagenta;
  zasah_col= lightred;
  souradnice_col= lightgray;
 
 
  obri=2;        {pocet obrich lodi}
  velke=3;       {pocet velkych lodi}
  mensi=4;       {pocet nesich lodi}
  male=5;        {pocet malych lodi}
  {atd.}
 
type
 
  tstav=(nic,vedle,lod,zasah,znacka);         {mozne hodnoty hraci plochy}
  tplocha=array [1..x_max,1..y_max] of tstav; {typ hraci plocha}
  {pole hodnot pro logika}
  tpolehodnot=array [0..x_max+1,0..y_max+1] of integer;
 
  POHrac=^OHrac;
  POClovek=^OClovek;
  POStistko=^OStistko;
  POPodvodnik=^OPodvodnik;
  POLogik=^OLogik;
 
 
 
  OHrac=object                  {objekt hrac}
 
    plocha1,plocha2:tplocha;    {hraci plochy}
    vystup,                     {bude se hraci plocha zobrazovat??}
    zvuk:boolean;               {budou se hrat zvuky??}
 
 
    constructor Init(zvuky,zobr:boolean);
 
    procedure   Rozestaveni;              virtual;
    procedure   ZobrazeniPlochy;
    procedure   Strelba(var x,y:byte);    virtual;
 
    function    Hra(h:POHrac;var konec:boolean):boolean; virtual;
    function    Trefa(x,y:byte):boolean;
    function    Prohral:boolean;
  end;
 
 
  OClovek=object(OHrac)
    zpet:boolean;        {indikuje prredcasny konec hry}
 
    constructor Init(zvuky,zobr:boolean);
    procedure   Rozestaveni;              virtual;
    procedure   Strelba(var x,y:byte);    virtual;
    function    Hra(h:POHrac;var konec:boolean):boolean; virtual;
  end;
 
 
  OStistko=object(OHrac)
 
    policek:word;                       {pocet policek hraciho pole}
 
    constructor Init(zvuky,zobr:boolean);
    procedure Strelba(var x,y:byte);    virtual;
  end;
 
 
  OPodvodnik=object(OHrac)
 
    zacatek:boolean;    {indikuje zda-li jiz byla prectena souperova plocha}
    lode:word;          {pocet policek obsazeych lodi}
    prazdna:word;       {pocet prazdnych policek}
 
    constructor Init(zvuky,zobr:boolean);
    procedure   Strelba(var x,y:byte);                   virtual;
    function    Hra(h:POHrac;var konec:boolean):boolean; virtual;
  end;
 
 
  OLogik=object(OHrac)
    polehodnot:tpolehodnot;
 
    procedure Strelba(var x,y:byte);    virtual;
  end;
 
 
implementation
 
{**************** PROCEDURY A FUNKCE vseobecneho pouziti ***************}
 
{zvuky}
procedure ZvukLet;
var
  i:byte;
 
begin
  for i:=1 to 100 do
    begin
 
      sound(i*20);
      delay(10);
    end;
  for i:=100 downto 1 do
    begin
 
      sound(i*20);
      delay(10);
    end;
  nosound;
end;
 
procedure ZvukZasah;
var
  i:byte;
 
begin
  for i:=1 to 100 do
    begin
      sound((random(10)+1)*100);
      delay(10);
    end;
  nosound;
end;
 
{testy je-li volno pro danou lod na danem miste}
function VolnoObri(plocha:tplocha; i,j:byte):boolean;
begin
  VolnoObri:= (plocha[i-1,  j] in[nic,zasah])and
              (plocha[i  ,  j] in[nic,zasah])and
              (plocha[i+1,  j] in[nic,zasah])and
	      (plocha[i  ,j-1] in[nic,zasah]);
end;
 
function VolnoVelke(plocha:tplocha; i,j:byte):boolean;
begin
  VolnoVelke:= (plocha[i-1,  j] in[nic,zasah])and
               (plocha[i  ,  j] in[nic,zasah])and
	       (plocha[i+1,  j] in[nic,zasah]);
end;
 
function VolnoMensi(plocha:tplocha; i,j:byte):boolean;
begin
  VolnoMensi:=(plocha[i-1,  j] in[nic,zasah])and
	      (plocha[i  ,  j] in[nic,zasah]);
end;
 
function VolnoMale(plocha:tplocha; i,j:byte):boolean;
begin
  VolnoMale:= (plocha[i  ,  j] in[nic,zasah]);
end;
 
{procedury hledajici nahodna mista pro dane lodi}
procedure PostavObri(var plocha:tplocha);
var
  i,j:byte;                 {souradnice sloupce a radku}
 
begin
  repeat
    i:=random(x_max-2)+2;
    j:=random(y_max-1)+2;
  until VolnoObri(plocha,i,j);     {dokud neni volno pro OBRI lod}
 
  {umisteni lodi do hraci plochy}
  plocha[i-1,  j]:=lod;
  plocha[i  ,  j]:=lod;
  plocha[i+1,  j]:=lod;
  plocha[i  ,j-1]:=lod;
end;
 
procedure PostavVelke(var plocha:tplocha);
var
  i,j:byte;                 {souradnice sloupce a radku}
 
begin
  repeat
    i:=random(x_max-2)+2;
    j:=random(y_max  )+1;
  until VolnoVelke(plocha,i,j);    {dokud neni volno pro VELKOU lod}
 
  {umisteni lodi do hraci plochy}
  plocha[i-1,  j]:=lod;
  plocha[i  ,  j]:=lod;
  plocha[i+1,  j]:=lod;
end;
 
procedure PostavMensi(var plocha:tplocha);
var
  i,j:byte;                 {souradnice sloupce a radku}
 
begin
  repeat
    i:=random(x_max-1)+2;
    j:=random(y_max  )+1;
  until VolnoMensi(plocha,i,j);    {dokud neni volno pro MENSI lod}
 
  {umisteni lodi do hraci plochy}
  plocha[i-1,  j]:=lod;
  plocha[i  ,  j]:=lod;
end;
 
procedure PostavMale(var plocha:tplocha);
var
  i,j:byte;                 {souradnice sloupce a radku}
 
begin
  repeat
    i:=random(x_max)+1;
    j:=random(y_max)+1;
  until VolnoMale(plocha,i,j);     {dokud neni volno pro MALOU lod}
 
  {umisteni lodi do hraci plochy}
  plocha[i  ,  j]:=lod;
end;
 
procedure Nuluj(var plocha:tplocha);
{naplni plochu hodnotou nic}
var
  i,j:byte;
 
begin
  for i:=1 to x_max do
    for j:=1 to y_max do
      plocha[i,j]:=nic;
end;
 
procedure CtiSouradnice(var x,y:byte; k,l:byte);
{parametry a,b je nutno predat pozici horniho leveho rohu hraci plochy
 souradnice se zadavaji ve tvaru 12B (nejprve cislo a potom pismeno)
 hodnoty budou vraceny parametry x,y
 je-li hodnota x,y=0 pak bude hra ukoncena (stisk ESC)}
 
  function prevod(s:string; var x,y:byte):boolean;
  var
    kod:integer;  {kod chyby}
 
  begin
    x:=ord(s[1])-ord('A')+1; {vypocet souradnice}
    s:=copy(s,2,2);
    val(s,y,kod);
 
    {kontrola souradnic}
    prevod:= (kod=0) and (x in [1..x_max]) and (y in [1..y_max]);
  end;
 
  function StavMysi(var x,y:byte; k,l:byte):boolean;
  var
    v,h,             {souradnice mysi}
    state,           {nenulova hodnota znamena stisknute tlacitko}
    number:word;     {pocet stisknuti tlacitka}
 
  begin
    StavMysi:=false;
 
    GetPress(0,state,number,h,v); {zjisti stav mysi}
    if (state<>0) then
        begin
          h:=(h+8) div 8;      {prepocet pozice kurzoru mysi}
          v:=(v+8) div 8;
 
          {naleza se kurzor mysi v hracim poli??}
          if (h>=k) and (h<(k+x_max)) and (v>=l) and (v<(l+y_max)) then
            begin
              x:=h-k+1;  {prepocitani a vraceni souradnic}
              y:=v-l+1;
              StavMysi:=true;
            end;
        end;
  end;
 
var
  zvoleno:boolean; {true pokud byla zvolena souradnice}
  pozice:byte;     {pozice v textovem retezci}
  s:string[3];     {text retezec souradnice}
  zn:integer;      {cislo stisknute klavesy}
 
begin
  zvoleno:=false;
  pozice:=0;
  s:='';
  gotoxy(x_souradnice,y_souradnice);
  write('Zadej souradnice:');
  CursorOn;
 
  repeat
    if keypressed then   {vstup klavesnice}
      begin
        zn:=getkey;
        if zn<256 then zn:=ord(upcase(chr(zn))); {prevod na velke pismeno}
          begin
            case zn of
              8 : if pozice>0 then      {stisknut backspace}
                    begin
                      delete(s,pozice,1);
                      dec(pozice);
                    end;
              13: if pozice>1 then
                    zvoleno:=prevod(s,x,y);   {kontrola a prevod souradnic}
              27: begin
                    x:=0;
                    y:=0;
                    zvoleno:=true;
                  end;
              65..64+x_max: if pozice=0  then
                              begin
                                inc(pozice);
                                s:=s+chr(zn);
                              end;
              48..57: if pozice in [1,2] then
                        begin
                          inc(pozice);
                          s:=s+chr(zn);
                        end;
            end;
            gotoxy(x_souradnice+18,y_souradnice);  {pozice vypisu souradnic}
            write(s);
          end;
      end;
 
    {vstup mysi}
    if exmouse and (not zvoleno) then zvoleno:=StavMysi(x,y,k,l);
  until zvoleno;
  CursorOff;
end;
 
procedure ZobrazInformace;
begin
  gotoxy(1,50);
  write('Souradnice zadavej ve tvaru napr.: A11  nebo mysi            ESC=konec');
end;
 
{********************** ZACATEK OBJEKTU OHRAC *****************************}
 
procedure abstract;    {abstraktni metoda - poda jen hlaseni o chybe}
begin
  writeln('Chyba - volas nedefinovanou metodu !!!');
end;
 
 
constructor OHrac.Init(zvuky,zobr:boolean);
begin
  textbackground(black);
  zvuk:=zvuky;         {budou se hrat zvuky??}
  vystup:=zobr;        {bude vystup hraci plochy na obrazovku??}
 
  Nuluj(plocha1);      {vynulovani ploch}
  Nuluj(plocha2);
 
  Rozestaveni;         {rozestaveni lodi v hracim poly}
end;
 
 
procedure OHrac.Rozestaveni;
{rozestaveni lodi}
var
  n:byte;   {pocet rozestavovanych lodi}
 
begin
  for n:=1 to obri  do PostavObri (plocha1);  {rozestaveni obrich lodi}
  for n:=1 to velke do PostavVelke(plocha1);  {rozestaveni velkych lodi}
  for n:=1 to mensi do PostavMensi(plocha1);  {rozestaveni mensich lodi}
  for n:=1 to male  do PostavMale (plocha1);  {rozestaveni malych lodi}
end;
 
 
procedure OHrac.ZobrazeniPlochy;
{zobrazi hraci plochu}
var
  attr:byte;           {uchova stary atribut}
 
  procedure Zobraz(plocha:tplocha; x,y:byte);
  var
    i,j:byte;
 
  begin
    gotoxy(x,y-1);                  {jdi na souradnice plochy}
    textbackground(black);
    textcolor(souradnice_col);
    for i:=1 to x_max do            {vypis horizontalnich souradnic}
      write(chr(ord('A')-1+i));
 
    for j:=1 to y_max do            {postup po radcich plochy}
      begin
        gotoxy(x-2,y+j-1);
        textcolor(souradnice_col);  {barva textu souradnic}
        textbackground(black);      {pozadi textu souradnic}
        write(j:2);                 {vypis vertikalnich souradnic}
 
        textbackground(plocha_bgr); {pozadi hraciho pole}
        for i:=1 to x_max do        {postup po sloupcich plochy}
          begin
            case plocha[i,j] of
 
              lod  : begin
                       textcolor(lod_col);  {barva lode}
                       write('O');          {zobrazeni lode}
                     end;
 
              zasah: begin
                       textcolor(zasah_col);{barva zasahu}
                       write('X');          {zobrazeni zasahu}
                     end;
 
              vedle: begin
                       textcolor(vedle_col);{barva znacky minuti}
                       write('*');          {zobrazeni oznaceni minuti}
                     end;
 
              else
                write(' ');    {zobrazeni prazdneho pole}
            end;
          end;
      end;
  end;       {konec procedury Zobraz}
 
begin
  attr:=textattr;                      {ulozeni puvodniho atributu textu}
  Zobraz(plocha1,x_plocha1,y_plocha1); {zobrazeni prvni plochy}
  Zobraz(plocha2,x_plocha2,y_plocha2); {zobrazeni druhe plochy}
  textattr:=attr;                      {vraceni puvodniho atributu}
end;
 
 
procedure OHrac.Strelba(var x,y:byte);
begin
  abstract;     {abstraktni metoda}
end;
 
 
function OHrac.Hra(h:POHrac;var konec:boolean):boolean;
{obecny postup pri hre u vsech hracu}
var
  x,y:byte;             {souradnice strelby}
 
begin
  konec:=false;         {hra jeste nekonci}
 
  ZobrazInformace;      {zobrazeni informaci}
  if vystup then ZobrazeniPlochy;
  Strelba(x,y);         {zjisteni souradnic strelby}
 
  if h^.Trefa(x,y) then  {byla zasahnuta nejaka lod??}
    begin                   {ano - byla zasahnuta lod}
      plocha2[x,y]:=zasah;  {zapis zasahu}
 
      if zvuk then          {je zapnut zvuk??}
        begin               {ano}
          ZvukLet;          {zvuk letici strely}
          ZvukZasah;        {zvuk zasahu}
        end;
 
      if vystup then ZobrazeniPlochy;
      Hra:=h^.Prohral;       {test jestli protihrac neprohral}
    end
  else
    begin                   {ne - nebyla zasahnuta lod}
      plocha2[x,y]:=vedle;  {zapis minuti}
 
      if zvuk then ZvukLet; {zvuk letu strely}
 
      if vystup then ZobrazeniPlochy;
      Hra:=false;           {protivnik nemohl prohrat}
    end;
  if keypressed then konec:= 27=getkey; {ESC ma cislo 27}
end;
 
 
function OHrac.Trefa(x,y:byte):boolean;
{test na zasah lodi}
begin
  if plocha1[x,y]=lod then     {nachazi se zde nejaka lod??}
    begin                      {ano}
      plocha1[x,y]:=zasah;     {lod je zasazena}
      Trefa:=true;             {ano lod byla trefena}
    end
  else
    begin                      {ne}
      Trefa:=false;            {lod nebyla trefena}
      plocha1[x,y]:=vedle;     {minuti}
    end;
end;
 
 
function OHrac.Prohral:boolean;
{test jsetli byly potopeny vsechny lode}
var
  pozice:word;                {cislo pozice v hracim poly (po radcich)}
  test:boolean;               {indikator - je zde lod??}
 
begin
  pozice:=x_max*y_max;        {vypoccet mnoztvi vsech policek}
  repeat
    dec(pozice);              {sniz pocet neprozkoumanych policek}
 
    {test - je zde lod??}
    test:=plocha1[pozice mod x_max + 1, pozice div x_max +1]=lod;
  until test or (pozice<=0);
  Prohral:=not(test);              {byla/nebyla nalezena nejaka lod}
end;
 
 
{****************** ZACATEK OBJEKTU OCLOVEK ******************************}
constructor OClovek.Init(zvuky,zobr:boolean);
begin
  zpet:=false;
  inherited Init(zvuky,zobr);
end;
 
procedure OClovek.Rozestaveni;
{rozestaveni lodi na hraci plose}
  procedure ZobrazNabidku;
  begin
    gotoxy(x_nabidka,y_nabidka);
    write(obri,' x OBRI lod');
    gotoxy(x_nabidka,y_nabidka+2);
    write('   *');
    gotoxy(x_nabidka,y_nabidka+3);
    write('  ***');
 
    gotoxy(x_nabidka,y_nabidka+5);
    write(velke,' x VEKA lod');
    gotoxy(x_nabidka,y_nabidka+7);
    write('  ***');
 
    gotoxy(x_nabidka,y_nabidka+9);
    write(mensi,' x MENSI lod');
    gotoxy(x_nabidka,y_nabidka+11);
    write('  **');
 
    gotoxy(x_nabidka,y_nabidka+13);
    write(male,' x MALA lod');
    gotoxy(x_nabidka,y_nabidka+15);
    write('  *');
  end;
 
 
  function PostavObri:boolean;
  var
    konec:boolean;       {priznak}
    x,y,                 {souradnice umisteni lodi}
    krok:byte;           {pocet rozestavenych lodi}
 
  begin
    konec:=false;         {pocatecni hodnota}
    krok:=0;             {pocatecni hodnota}
    repeat
      ZobrazeniPlochy;
      repeat
        CtiSouradnice(x,y,x_plocha1,y_plocha1);
        konec:= x=0;                {predcasny konec}
        {kontrola - predcasny konec, rozmezi souradnic a volneho mista}
      until konec or ((x in[2..x_max-1])and (y in[2..y_max])
             and VolnoObri(plocha1,x,y));
 
      if not(konec) then
        begin
          {umisteni lodi do hraci plochy}
          plocha1[x-1,  y]:=lod;
          plocha1[x  ,  y]:=lod;
          plocha1[x+1,  y]:=lod;
          plocha1[x  ,y-1]:=lod;
          inc(krok);
        end;
    until (krok>=obri) or konec;
    PostavObri:=konec;
  end;
 
 
  function PostavVelke:boolean;
  var
    konec:boolean;       {priznak}
    x,y,                 {souradnice umisteni lodi}
    krok:byte;           {pocet rozestavenych lodi}
 
  begin
    konec:=false;         {pocatecni hodnota}
    krok:=0;             {pocatecni hodnota}
    repeat
      ZobrazeniPlochy;
      repeat
        CtiSouradnice(x,y,x_plocha1,y_plocha1);
        konec:= x=0;                {predcasny konec}
        {kontrola - predcasny konec, rozmezi souradnic a volneho mista}
      until konec or ((x in[2..x_max-1])and (y in[1..y_max])
             and VolnoVelke(plocha1,x,y));
 
      if not(konec) then
        begin
          {umisteni lodi do hraci plochy}
          plocha1[x-1,  y]:=lod;
          plocha1[x  ,  y]:=lod;
          plocha1[x+1,  y]:=lod;
          inc(krok);
        end;
    until (krok>=velke) or konec;
    PostavVelke:=konec;
  end;
 
 
  function PostavMensi:boolean;
  var
    konec:boolean;       {priznak}
    x,y,                 {souradnice umisteni lodi}
    krok:byte;           {pocet rozestavenych lodi}
 
  begin
    konec:=false;         {pocatecni hodnota}
    krok:=0;             {pocatecni hodnota}
    repeat
      ZobrazeniPlochy;
      repeat
        CtiSouradnice(x,y,x_plocha1,y_plocha1);
        konec:= x=0;                {predcasny konec}
        {kontrola - predcasny konec, rozmezi souradnic a volneho mista}
      until konec or ((x in[2..x_max])and (y in[1..y_max])
             and VolnoMensi(plocha1,x,y));
 
      if not(konec) then
        begin
          {umisteni lodi do hraci plochy}
          plocha1[x-1,  y]:=lod;
          plocha1[x  ,  y]:=lod;
          inc(krok);
        end;
    until (krok>=mensi) or konec;
    PostavMensi:=konec;
  end;
 
 
  function PostavMale:boolean;
  var
    konec:boolean;       {priznak}
    x,y,                 {souradnice umisteni lodi}
    krok:byte;           {pocet rozestavenych lodi}
 
  begin
    konec:=false;         {pocatecni hodnota}
    krok:=0;             {pocatecni hodnota}
    repeat
      ZobrazeniPlochy;
      repeat
        CtiSouradnice(x,y,x_plocha1,y_plocha1);
        konec:= x=0;                {predcasny konec}
        {kontrola - predcasny konec, rozmezi souradnic a volneho mista}
      until konec or ((x in[1..x_max])and (y in[1..y_max])
             and VolnoMale(plocha1,x,y));
 
      if not(konec) then
        begin
          {umisteni lodi do hraci plochy}
          plocha1[x,y]:=lod;
          inc(krok);
        end;
    until (krok>=male) or konec;
    PostavMale:=konec;
  end;
 
begin
  clrscr;
  if YesNoQ('Chcete automaticky rozestavit lode ??') then
    inherited Rozestaveni      {vola se puvodni automaticke rozestaveni}
  else
    begin
      clrscr;             {vycisteni obrazovky}
      ZobrazInformace;
      ZobrazNabidku;      {zobrazi nabidku lodi}
      if exmouse then CursorEnable;
      zpet:=PostavObri;
      if not zpet then zpet:=PostavVelke;
      if not zpet then zpet:=PostavMensi;
      if not zpet then zpet:=PostavMale;
      if exmouse then CursorDisable;
    end;
end;
 
 
procedure OClovek.Strelba(var x,y:byte);
begin
  if not zpet then
    begin
      if exmouse then CursorEnable;
      repeat
        CtiSouradnice(x,y,x_plocha2,y_plocha2); {zteni souradnic ze vstupu}
        zpet:= x=0;                             {test predcasneho konce}
      until zpet or (plocha2[x,y]=nic);
      if exmouse then CursorDisable;
    end;
end;
 
 
function OClovek.Hra(h:POHrac;var konec:boolean):boolean;
var
  x,y:byte;
 
begin
  if zpet then
    konec:=zpet
  else
    begin
       konec:=false;         {hra jeste nekonci}
 
       ZobrazInformace;      {zobrazeni informaci}
       if vystup then ZobrazeniPlochy;
       Strelba(x,y);         {zjisteni souradnic strelby}
 
       if x<>0 then
         begin
           if h^.Trefa(x,y) then  {byla zasahnuta nejaka lod??}
             begin                   {ano - byla zasahnuta lod}
               plocha2[x,y]:=zasah;  {zapis zasahu}
 
               if zvuk then          {je zapnut zvuk??}
                 begin               {ano}
                   ZvukLet;          {zvuk letici strely}
                   ZvukZasah;        {zvuk zasahu}
                 end;
 
               if vystup then ZobrazeniPlochy;
               Hra:=h^.Prohral;       {test jestli protihrac neprohral}
             end
           else
             begin                   {ne - nebyla zasahnuta lod}
               plocha2[x,y]:=vedle;  {zapis minuti}
 
               if zvuk then ZvukLet; {zvuk letu strely}
 
               if vystup then ZobrazeniPlochy;
                 Hra:=false;           {protivnik nemohl prohrat}
             end;
         end
       else
         konec:=true;
    end;
end;
 
{****************** ZACATEK OBJEKTU OSTISTKO *****************************}
constructor OStistko.Init(zvuky,zobr:boolean);
begin
  inherited Init(zvuky,zobr);
  policek:=x_max*y_max;             {pocet policek hraciho pole}
end;
 
procedure OStistko.Strelba(var x,y:byte);
var
  cislo:integer;                {nahodne n-te policko z prazdnych policek}
  souradnice:word;                         {cislo policka hraci plochy}
 
begin
  cislo:=random(policek);
  souradnice:=0;
  repeat
    repeat                          {hledani nejblizsiho prazdneho policka}
      x:=souradnice mod x_max +1;   {vypocet souradnic hraci plochy}
      y:=souradnice div x_max +1;
      inc(souradnice);
    until plocha2[x,y]=nic;
    dec(cislo);
  until cislo<=0;                   {hledani n-teho prazdneho policka}
  dec(policek);                     {sniz pocet prazdnich policek}
end;
 
{****************** ZACATEK OBJEKTU OPODVODNIK ***************************}
constructor OPodvodnik.Init(zvuky,zobr:boolean);
begin
  inherited Init(zvuky,zobr);   {volani Init predka}
 
  zacatek:=true;                {prednastaveni hodnot}
  lode:=0;
  prazdna:=0;
end;
 
function OPodvodnik.Hra(h:POHrac;var konec:boolean):boolean;
 
  procedure Podvod(h:POHrac;var plocha:tplocha);
  {procedura cte z nepritelova hraciho pole}
  var
    i,j:byte;
 
  begin
    for i:=1 to x_max do
      for j:=1 to y_max do
        if h^.plocha1[i,j]=lod then
          begin
            inc(lode);          {zvys poctet lodi}
            plocha[i,j]:=znacka;{oznac misto s nepritelovou lodi}
          end
        else
          inc(prazdna);         {zvys pocet prazdnych mist}
  end;
 
begin
  if zacatek then
    begin
      Podvod(h,plocha2);    {cteni z nepritelova hraciho pole}
      zacatek:=false;       {uz nebudu chtit cist nepritelovo pole}
    end;
 
  Hra:=inherited Hra(h,konec);   {volani predkovy hry}
end;
 
procedure OPodvodnik.Strelba(var x,y:byte);
{je nastavena 25% sance se trefit}
  procedure Zasah(var x,y:byte);
  {hleda oznacene misto aby se trefil}
  var
    n:integer;                   {nahodne cislo - n-ta lod}
    souradnice:word;             {poradi nejake souradnice}
 
  begin
    n:=random(lode);
    souradnice:=0;
    repeat
      repeat                          {hledani nejblizsiho policka s lodi}
        x:=souradnice mod x_max +1;   {vypocet souradnic hraci plochy}
        y:=souradnice div x_max +1;
        inc(souradnice);
      until plocha2[x,y]=znacka;
      dec(n);
    until n<=0;                   {hledani n-teho policka s lodi}
    dec(lode);                    {sniz pocet nepritelovych lodi}
  end;
 
  procedure Minout(var x,y:byte);
  {hleda prazdne misto aby minul}
  var
    n:integer;                       {nahodne cislo - n-te prazdne misto}
    souradnice:word;              {poradi nejake souradnice}
 
  begin
    n:=random(prazdna);
    souradnice:=0;
    repeat
      repeat                         {hledani nejblizsiho prazdneho policka}
        x:=souradnice mod x_max +1;  {vypocet souradnic hraci plochy}
        y:=souradnice div x_max +1;
        inc(souradnice);
      until plocha2[x,y]=nic;
      dec(n);
    until n<=0;                   {hledani n-teho prazdneho policka}
    dec(prazdna);                 {zniz pocet prazdnych policek}
  end;
 
 
begin
  {pokud padne ze 4 cisel cislo 0 pak bude zasah jinak mine}
  if (random(4)<1) or (prazdna<=0) then Zasah(x,y)
  else Minout(x,y);
end;
 
{****************** ZACATEK OBJEKTU OLOGIK *******************************}
procedure OLogik.Strelba(var x,y:byte);
  procedure NulujPoleHodnot;
  var
    i,j:byte;
 
  begin
    for i:=0 to x_max+1 do
      for j:=0 to y_max+1 do
        polehodnot[i,j]:=0;
  end;
 
  procedure PridejObri;
  var
    i,j:byte;
 
  begin
    for i:=2 to x_max-1 do
      for j:=2 to y_max do
        if VolnoObri(plocha2,i,j) then
          begin
            inc(polehodnot[i-1,  j]);
            inc(polehodnot[i  ,  j]);
            inc(polehodnot[i+1,  j]);
            inc(polehodnot[i  ,j-1]);
          end;
  end;
 
  procedure PridejVelke;
  var
    i,j:byte;
 
  begin
    for i:=2 to x_max-1 do
      for j:=1 to y_max do
        if VolnoVelke(plocha2,i,j) then
          begin
            inc(polehodnot[i-1,  j]);
            inc(polehodnot[i  ,  j]);
            inc(polehodnot[i+1,  j]);
          end;
  end;
 
  procedure PridejMensi;
  var
    i,j:byte;
 
  begin
    for i:=2 to x_max do
      for j:=1 to y_max do
        if VolnoMensi(plocha2,i,j) then
          begin
            inc(polehodnot[i-1,  j]);
            inc(polehodnot[i  ,  j]);
          end;
  end;
 
  procedure VyhodnoceniTref;
  var
    i,j:byte;
 
  begin
    for i:=1 to x_max do
      for j:=1 to y_max do
        if plocha2[i,j]=zasah then
          begin
            inc(polehodnot[i-1,  j],6);
            inc(polehodnot[i+1,  j],6);
            inc(polehodnot[i  ,j-1],5);
            inc(polehodnot[i  ,j+1],5);
          end;
  end;
 
  procedure Maska;
  var
    i,j:byte;
 
  begin
    for i:=1 to x_max do
      for j:=1 to y_max do
        if plocha2[i,j] in [vedle,zasah] then
          polehodnot[i,j]:=-1;
  end;
 
  procedure MaxHodnota (var hodnota,pocet:integer);
  var
    i,j:byte;
 
  begin
    hodnota:=0;
    pocet:=0;
 
    for i:=1 to x_max do
      for j:=1 to y_max do
        if hodnota<polehodnot[i,j] then
          begin
            hodnota:=polehodnot[i,j];
            pocet:=1;
          end
        else
          if hodnota=polehodnot[i,j] then inc(pocet);
  end;
 
var
  hodnota,pocet,n:integer;
  souradnice:word;
 
begin                              {metoda strelba}
  NulujPoleHodnot;
  PridejObri;
  PridejVelke;
  PridejMensi;
  VyhodnoceniTref;
  Maska;
  MaxHodnota(hodnota,pocet);
 
  n:=random(pocet);
  souradnice:=0;
  repeat
    repeat                         {hledani nejblizsiho prazdneho policka}
      x:=souradnice mod x_max +1;  {vypocet souradnic hraci plochy}
      y:=souradnice div x_max +1;
      inc(souradnice);
    until polehodnot[x,y]=hodnota;
    dec(n);
  until n<=0;                   {hledani n-teho prazdneho policka}
end;
 
end.