Dze je subor www.TrSek.com/cover/ales/lode.pas

{ LODE.PAS                                 Copyright (c) Ales Kucik }
{ PROGRAM PRO KLASICKOU HRU LODE                                    }
{                                                                   }
{ pozadavky na program:                                             }
{ -vytvorit interaktivni prostredi pro hru lode                     }
{ -umozneni hry pro clovek-clovek                                   }
{                   clovek-PC                                       }
{                   PC-PC                                           }
{ -obtiznost ma tri urovne - PC nahodne hada pozice                 }
{                          - PC pouzije daneho postupu pri strelbe  }
{                          - PC "zneuzije" data o souperovi         }
{                                                                   }
{ pouzite znaky:                                                    }
{         O - nezasazena lod                                          }
{         X - zasazena lod                                            }
{         * - vedle                                                   }
{            ' '- prazdno                                             }
{                                                                   }
{ Datum:09.04.2002                             http://www.trsek.com }

program LODE;

uses
  crt,mcrt01,tmenu01,hraci;

const
  newtextmode=3+256;  {50 radku}
  menu_x=20;          {souradnice menu}
  menu_y=20;

type
  thrac=(clovek,stistko,logik,podvodnik); {typy hracu}

const
  hrac1:thrac = logik;            {prednastaveni prvniho hrace}
  hrac2:thrac = logik;            {prednastaveni druheho hrace}
  PC=[stistko,logik,podvodnik];   {hodnoty predstavujici hrace pocitac}
  cekej:word = 100;
  zvuk:boolean = false;
  konec_prog:boolean = false;

var
  oldtextmode:integer;    {uchovani puvodniho nastaveni text. modu}
  oldattr:byte;           {uchovani puvodniho atributu textu}

procedure Init;
{neco co budu inicializovat}
begin
  CursorOff;                  {vypnuti zobrazeni kurzoru}
  Clrscr;                     {vycisteni obrazovky}
  Randomize;                  {zapnuti generatoru nahodnych cisel}
  oldtextmode:=lastmode;      {ulozeni textoveho modu}
  oldattr:=textattr;          {ulozeni atrubutu textu}
end;

procedure Finish;
begin
  CursorOn;                   {zapnuti zobrazeni kurzoru}
  textattr:=oldattr;          {obnova atributu textu}
  TextMode(oldtextmode);      {obnova textoveho modu}
end;

procedure ZobrazNapis;        {zobrazi napis}
var
  attr:byte;

begin
  attr:=textattr;            {ulozeni puvodniho atributu}
  textcolor(lightcyan);
  writeln('                                       __   __      ');
  writeln('                                       \ \_/ /      ');
  writeln('                                        \___/       ');
  writeln('    __           ___      ______      _________     ');
  writeln('   /  \         /   \    |      \    |         |    ');
  writeln('   |  |        /     \   |       \   |   ______|    ');
  writeln('   |  |       /       \  |   __   \  |  |           ');
  writeln('   |  |       |   _   |  |  |  \  |  |  |____       ');
  writeln('   |  |       |  / \  |  |  |  |  |  |       |      ');
  writeln('   |  |       |  | |  |  |  |  |  |  |   ____|      ');
  writeln('   |  |       |  | |  |  |  |  |  |  |  |           ');
  writeln('   |  |       |  \_/  |  |  |__/  |  |  |_____      ');
  writeln('   |  |____   \       /  |        /  |        |     ');
  writeln('   |       \   \     /   |       /   |        |     ');
  writeln('   \_______/    \___/    |______/    |________|    Autor:Ales Kucik  ');
  textattr:=attr;           {obnova puvodniho atributu}
end;

procedure ZobrazHrace(h:thrac);
{na dane pozici napise na obrazovku nazev hrace}
begin
  case h of
    clovek   :write('CLOVEK');
    stistko  :write('STISTKO');
    podvodnik:write('PODVODNIK');
    logik    :write('LOGIK');
  end;
end;

procedure VolbaHrac(var hracx:thrac);
{zvoleni typu hrace}
begin
  if hracx < podvodnik then hracx:=succ(hracx)
  else hracx:=clovek;
end;

procedure ZobrazHodnoty(h1,h2:thrac; zvuky:boolean; cas:word);
{zobrazi hodnoty u nekterych polozek menu}
begin
  gotoxy(20,18);              {souradnice polozky menu 'Zvuky'}
  if zvuky then write('ANO')
  else write('NE');

  gotoxy(20,19);              {souradnice polozky menu 'Cas'}
  write(cas:5,' ms');

  gotoxy(20,20);              {souradnice polozky menu 'Hrac1'}
  ZobrazHrace(h1);

  gotoxy(20,21);              {souradnice polozky menu 'Hrac2'}
  ZobrazHrace(h2);
end;

function CtiCas(cas:word):word;
{precteni noveho casu - pro spomaleni hry}
var
  attr:byte;
  s:string;
  cislo:word;
  chyba:integer;

begin
  attr:=textattr;                      {ulozeni puvodniho atributu}
  textbackground(lightblue);           {svetle modre pozadi}
  textcolor(lightgreen);               {svetle zelene pismo}
  window(20,19,25,19);                 {okno v radku nabidky menu 'Cas'}
  clrscr;                              {samzani okna danou barvou}

  cursoron;                            {zobrazeni kurzoru}
  readln(s);                           {vstup textoveho retezce}
  cursoroff;                           {schovani kurzoru}

  if ord(s[1])>ord('5') then
    chyba:=1                     {test jestli zadane cislo neni moc velke}
  else
    val(s,cislo,chyba);          {prevod retezce na cislo}

  if chyba = 0 then CtiCas:=cislo      {navrat hodnoty funkce}
  else CtiCas:=cas;                    {pokud nastala chyba nech puvodni cas}
  textattr:=attr;                      {obnova atributu textu}
  window(1,1,80,25);                   {vrat okno pres celou obrazovku}
end;

procedure Hraj (hraca,hracb:thrac; zvuk:boolean; cekani:word);
{procedura zvoli podle typu hracu typ hry}

  procedure InitHrace(typhrace:thrac; var h:POHrac;zvuk,vystup:boolean);
  {prirazeny ukazatele na spravny typ obektu hrace podle typu hrace}
  begin
    case typhrace of
      clovek   :h:=new(POClovek,Init(zvuk,vystup));
      stistko  :h:=new(POStistko,Init(zvuk,vystup));
      podvodnik:h:=new(POPodvodnik,Init(zvuk,vystup));
      logik    :h:=new(POLogik,Init(zvuk,vystup));
    end;
  end;

  procedure PCvsPC(pocitac1,pocitac2:thrac; zvuk:boolean;cekani:word);
  {typ hry pocitac proti pocitaci}
  var
    h1,h2:POHrac;                      {hraci}
    konec,                             {je predcasny konec??}
    stavhry:boolean;                   {vyhral posledni hrac??}

  begin
    InitHrace(pocitac1,h1,zvuk,true);  {inicializace hracu}
    InitHrace(pocitac2,h2,zvuk,true);
    repeat
      gotoxy(1,1);
      write('PRVNI hrac');
      stavhry:=h1^.Hra(h2,konec);      {jaky je stav hry??}
      delay(cekani);                   {spomaleni hry}

      if not(konec) then
        if stavhry then
          ErrorMes('Vyhral PRVNI hrac!!!')
        else
          begin
            gotoxy(1,1);
            write('DRUHY hrac');
            stavhry:=h2^.Hra(h1,konec);{jaky je stav hry}
            delay(cekani);
            if stavhry then ErrorMes('Zvitezil DRUHY hrac!!!');
          end;
    until stavhry or konec;
    dispose(h1);                       {uvolneni pameti}
    dispose(h2);
  end;

  procedure CLOVEKvsPC(pocitac:thrac);
  {typ hry clovek proti pocitaci (clovek bude vzdy zacinat)}
  var
    h1,h2:POHrac;
    konec,                              {je predcasny konec??}
    stavhry:boolean;                    {vyhral posledni hrac??}

  begin
    InitHrace(clovek,h1,zvuk,true);      {inicializace hracu}
    InitHrace(pocitac,h2,zvuk,false);

    clrscr;
    repeat
      gotoxy(1,1);
      write('PRVNI hrac');
      stavhry:=h1^.Hra(h2,konec);        {stav hry}
      delay(cekani);                     {spomaleni hry}

      if not(konec) then
        if stavhry then                  {vyhral PRVNI hrac??}
          ErrorMes('CLOVECE VYHRAL JSI!!!')
        else
          begin
            gotoxy(1,1);
            write('DRUHY hrac');
            stavhry:=h2^.Hra(h1,konec);   {stav hry}
            delay(cekani);                {spomaleni hry}
            if stavhry then ErrorMes('VYHRAL JSEM HA HA!!!');
          end;
    until stavhry or konec;
    dispose(h1);                          {uvolneni pamenti}
    dispose(h2);
  end;

  procedure CLOVEKvsCLOVEK;
  {typ hry clovek proti cloveku (je nutne hrace nejak oddelit)}
  var
    h1,h2:POHrac;
    konec,                                 {je predcasny konec??}
    stavhry:boolean;                       {vyhral posledni hrac??}

  begin
    ErrorMes('Ted si rozestavi lode PRVNI hrac!');
    InitHrace(clovek,h1,zvuk,true);        {inicializace hracu}

    clrscr;
    ErrorMes('Nyni rozestavi lode DRUHY hrac!');
    InitHrace(clovek,h2,zvuk,true);

    ErrorMes('!!! POZOR !!! - nyni se NESMI DRUHY hrac KOUKAT !!!');
    repeat
      clrscr;
      write('PRVNI hrac');
      stavhry:=h1^.Hra(h2,konec);
      delay(cekani);

      if not(konec) then
        if stavhry then
          ErrorMes('Vyhral PRVNI hrac!!!')
        else
          begin
            clrscr;                              {oddelovaci obrazovka}
            ErrorMes('!!! POZOR !!! - Vymente se s DRUHYM hracem!!!');

            clrscr;
            write('DRUHY hrac');
            stavhry:=h2^.Hra(h1,konec);
            delay(cekani);

            if stavhry then ErrorMes('Zvitezil DRUHY hrac!!!')
            else
              begin
                clrscr;                         {oddelovaci obrazovka}
                ErrorMes('!!! POZOR !!! - Vymente se s PRVNIM hracem!!!');
              end;
          end;
    until stavhry or konec;
    dispose(h1);                            {uvolneni pameti}
    dispose(h2);
  end;

begin
  textmode(newtextmode);
  cursoroff;

  if (hraca in PC) and (hracb in PC) then PCvsPC(hraca,hracb,zvuk,cekej)
  else
    if (hraca in PC) and not(hracb in PC) then CLOVEKvsPC(hraca)
    else
      if not(hraca in PC) and (hracb in PC) then CLOVEKvsPC(hracb)
    else CLOVEKvsCLOVEK;
  textmode(oldtextmode);
  cursoroff;
end;

var
  m:^tmenu;                     {ukazatel na menu}

begin                           {zacatek hlavniho programu}
  init;                         {inicializace programu}

  {inicializace hlavniho menu}
  new(m,init(10,18));
  m^.NewItem('Zvuk');
  m^.NewItem('Cekej');
  m^.NewItem('Hrac1');
  m^.NewItem('Hrac2');
  m^.NewItem('Zacatek');
  m^.NewItem('Konec');

  repeat                       {cyklus hlavniho menu}
    clrscr;
    ZobrazNapis;               {zobrazeni napisu "LODE"}
    ZobrazHodnoty(hrac1,hrac2,zvuk,cekej);
    case m^.Choice of          {volba polozky}
      1: zvuk:=not(zvuk);
      2: cekej:=CtiCas(cekej);
      3: VolbaHrac(hrac1);     {vyber prvniho hrace}
      4: VolbaHrac(hrac2);     {vyber druheho hrace}
      5: Hraj(hrac1,hrac2,zvuk,cekej);    {zahajeni hry}
      6: konec_prog:=true;     {ukonceni programu}
    end;
  until konec_prog;            {konec cyklu hlavniho menu}
  dispose(m);                  {uvolneni hlavniho menu z pameti}
  finish;                      {navrat pocitace do puvodniho stavu}
end.                           {konec hlavniho programu}

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com