{ 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}