Może na początek gra w statki
Kod:
program STATKI;
uses crt,dos;
const tlo=black; {tlo - tlo calej gry}
pozx_pl=27;{pozycje planszy}
pozy_pl=12;
rozx_pl=10;{rozmiar planszy}
rozy_pl=10;
pozx_pl2=pozx_pl+rozx_pl+5;
pozy_pl2=pozy_pl;
tlo_pl1=red;{tlo i kolor planszy}
tlo_pl2=green;
tek_pl=white;
k_zatop=black;{kolor statku zatopionego prze gracza}
kurs_kol=yellow;
stat_kol=blue;{kol statku}
maszt4=1;{ilosc statkow}
maszt3=2;
maszt2=3;
type tab=array[0..rozx_pl+1,0..rozy_pl+1] of char;
tab2=array[0..rozx_pl*rozy_pl] of string;
tab3=array[1..5] of byte;
var anim_logo:integer;
ktory_logo,licznik,pozycja:byte;{ktory_logo-to numer obrazu logo,licznik-dotyczy szybkosci scrolla,pozycja dotyczy scrolla}
plan1:tab;{pamiec planszy komputera}
plan2:tab;{gracza}
etapy_gry:tab3;{przechowuje kolejnosc etapow gry}
pamiec:tab;{tutaj komputer zapamietuje sobie pozycje zatopionych statkow}
pamiec_gracz:tab;{tutaj pamietane sa statki zatopione przez gracza}
pola_wol:tab2;{tutaj komputer przechowuje wolne pola do strzalu}
nr_pola:integer;{przechowuje numer wybranego pola}
ilosc_pol:integer;{przechowuje ilosc wolnych pol}
koniec_gry,aktywny:boolean;{aktywny-czy scroll ma leciec czy nie}
suma_komp,suma_gracz,maszt4_komp,maszt3_komp,maszt2_komp,
maszt4_gracz,maszt3_gracz,maszt2_gracz:byte;
tekst_scroll:string;
kursor_p,kursor_k:byte;{uzywane w procedurze ukryj kursor}
pkur_x,pkur_y:byte;{pamieta pozycje kursora gracza w proc ruch_gracza}
etap_gry,pozx_strz,pozy_strz,x_strz,y_strz:byte;{z tych zmiennych korzysta MOZG komputera}
ktory_etap:byte;{okresla ktory z etapow w etapy_gry[] jest teraz}
komp_trafil:boolean;
{==================================================}
procedure ukryj_kursor(var kp,kk:byte);
var rejestry:registers;
begin
rejestry.AH:=3;
intr($10,rejestry);
with rejestry do
begin
kp:=CH;
kk:=cl;
AH:=1;
CH:=16;
CL:=0;
end;
intr($10,rejestry);
end;
{==================================================}
procedure pokaz_kursor(var kp,kk:byte);
var rejestry:registers;
begin
with rejestry do
begin
AH:=1;
CH:=kp;
CL:=kk;
end;
intr($10,rejestry);
end;
{==================================================}
{-------------------------------------------------------------------}
procedure czysc_plan;
var x,y:byte;
begin
for y:=0 to rozy_pl+1 do
begin
for x:=0 to rozx_pl+1 do
begin
plan1[x,y]:=chr(9);
plan2[x,y]:=chr(9);
pamiec[x,y]:=chr(9);
pamiec_gracz[x,y]:=chr(9);
end;
end;
end;
{-------------------------------------------------------------------}
procedure scroll(var aktywny:boolean;rozmiar,px,py:byte;ped:word;text:string);
var l:word;
{potrzebna jest jedna zmienna globalna licznik,
ped oznacza szybkosc srolla}
begin
if aktywny=true then
begin
inc(licznik);{co ktore wywolanie procedury ma wy?wietli? tekst}
if licznik=ped then
begin
licznik:=0;
l:=0;repeat;inc (l);text:=' '+text;until l=rozmiar+2;text:=text+' ';
inc(pozycja);if pozycja>=length(text) then pozycja:=1;
gotoxy(px,py);textbackground(black);
write(copy(text,pozycja,rozmiar));
end;
end;
end;
{-------------------------------------------------------------------}
procedure logo(k_tek,k_tlo,x,y:byte);
begin
inc(anim_logo);
delay(1);
if anim_logo=200 then begin
anim_logo:=0;inc(ktory_logo);if ktory_logo>5 then ktory_logo:=1;
textbackground(tlo);
gotoxy(x-1,y); write(' ');
gotoxy(x-1,y+1);write(' ');
gotoxy(x-1,y+2);write(' ');
gotoxy(x-1,y+3);write(' ');
gotoxy(x-1,y+4);write(' ');
gotoxy(x-1,y+5);write(' ');
textcolor(k_tek);textbackground(k_tlo);
if (ktory_logo=1) then begin
gotoxy(x,y); write(' **-- ***** *** ***** * * * ');
gotoxy(x,y+1);write(' * * * * * * * * ');
gotoxy(x,y+2);write(' --** * ***** * ** * ');
gotoxy(x,y+3);write(' * * * * * * * * ');
gotoxy(x,y+4);write(' -**** * * * * * * * ');
end;
if (ktory_logo=2) then begin
gotoxy(x,y); write(' **** *--** *** ***** * * * ');
gotoxy(x,y+1);write(' * * * * * * * * ');
gotoxy(x,y+2);write(' ***- * ***** * ** * ');
gotoxy(x,y+3);write(' - * * * * * * * ');
gotoxy(x,y+4);write(' **--* * * * * * * * ');
end;
if ktory_logo=3 then begin
gotoxy(x,y); write(' **** ***** *-- ***** * * * ');
gotoxy(x,y+1);write(' * * - * * * * * ');
gotoxy(x,y+2);write(' **** * -**** * ** * ');
gotoxy(x,y+3);write(' * - * * * * * * ');
gotoxy(x,y+4);write(' ***** - * * * * * * ');
end;
if (ktory_logo=4) then begin
gotoxy(x,y); write(' **** ***** *** **--* * * * ');
gotoxy(x,y+1);write(' * * * - * * * * ');
gotoxy(x,y+2);write(' **** * ***-- * ** * ');
gotoxy(x,y+3);write(' * * - * * * * * ');
gotoxy(x,y+4);write(' ***** * - * * * * * ');
end;
if (ktory_logo=5) then begin
gotoxy(x,y); write(' **** ***** *** ***** * - * ');
gotoxy(x,y+1);write(' * * * * * * - * ');
gotoxy(x,y+2);write(' **** * ***** * *- * ');
gotoxy(x,y+3);write(' * * * * * - * * ');
gotoxy(x,y+4);write(' ***** * * * - * * * ');
end;
end;
end;
{---------------------------------------------------------------------}
procedure start;
var petla,petla2:integer;
a:byte;
muzyka:boolean;
kl:char;
begin
petla:=0;petla2:=0;a:=0;muzyka:=true;
repeat
inc(petla);inc(petla2);
logo(lightred,black,24,1);
textcolor(lightblue);
scroll(aktywny,30,25,8,200,'--==*** S T A T K I ***==-- Wcisnij !SPACJE! by zaczac gre M - muzyka wl/wyl Q-koniec');
case petla of
1:begin textcolor(lightgray);gotoxy(20,10);write('Gr© zrobil');end;
3000:begin textcolor(white);gotoxy(30,12);write('Tomasz Str©kowski');end;
5000:begin textcolor(green);gotoxy(20,14);write('gametesterzy:');end;
6000:begin textcolor(lightgreen);gotoxy(30,15);write('Grzegoz Wolak');end;
6300:begin textcolor(lightgreen);gotoxy(30,16);write('Maciek,Wojtek Zaucha');end;
6600:begin textcolor(lightgreen);gotoxy(30,17);write('Krzysztof,Mieczyslaw Strekowscy');end;
6900:begin textcolor(lightgreen);gotoxy(30,18);write('dr.mgr.hab. Maciek Gawron');end;
13000:begin textbackground(tlo);a:=0;
repeat gotoxy(20,10+a);write(' ');
inc(a);until a=10;
end;
13000:begin petla:=0;end;
end;
if muzyka=true then
begin
case petla2 of
1:sound(100);
300:nosound;
301:sound(20);
600:nosound;
601:sound(40);
800:nosound;
801:sound(70);
900:nosound;
901:sound(120);
950:nosound;
1151:sound(200);
1400:nosound;
1600:sound(100);
1800:nosound;
2000:sound(50);
2420:nosound;
3000:petla2:=0;
end;
end;
if keypressed then
begin
kl:=readkey;
if kl='m' then
begin
nosound;if muzyka=true then muzyka:=false else muzyka:=true;
end;
if kl='q' then
begin
nosound;koniec_gry:=true;kl:=' ';
end;
end;
until (kl=' ');
nosound;
delay(100);
textbackground(tlo);clrscr;
end;
{---------------------------------------------------------------------}
procedure rys_plansze;
var x,y:byte;
begin
x:=0;y:=0;
textcolor(tek_pl);
for y:=0 to rozy_pl-1 do {rysowanie planszy}
begin
for x:=0 to rozx_pl-1 do
begin
textbackground(tlo_pl1);
gotoxy(pozx_pl+x,pozy_pl+y);
if plan1[x+1,y+1]<>chr(177) then
begin
write(plan1[x+1,y+1]);
end
else
begin
write(chr(9));
end;
if pamiec_gracz[x+1,y+1]='X' then {wyswietlenie statkowzatopionych przez komputer}
begin
textcolor(k_zatop);
gotoxy(pozx_pl+x,pozy_pl+y);
write(pamiec_gracz[x+1,y+1]);
textcolor(tek_pl);
end;
textbackground(tlo_pl2);
gotoxy(pozx_pl2+x,pozy_pl2+y);write(plan2[x+1,y+1]);
if pamiec[x+1,y+1]='#' then {wyswietlenie statkowzatopionych przez komputer}
begin
textcolor(k_zatop);
gotoxy(pozx_pl2+x,pozy_pl2+y);
write('X');
textcolor(tek_pl);
end;
end;
end;
x:=0;y:=0;
for x:=0 to rozx_pl-1 do {rysowanie gornych lini}
begin
textbackground(tlo_pl1);
gotoxy(pozx_pl+x,pozy_pl-1);write(chr(205));
gotoxy(pozx_pl+x,pozy_pl+rozy_pl);write(chr(205));
textbackground(tlo_pl2);
gotoxy(pozx_pl2+x,pozy_pl2-1);write(chr(205));
gotoxy(pozx_pl2+x,pozy_pl2+rozy_pl);write(chr(205));
end;
for y:=0 to rozy_pl-1 do {rysowanie bocznych}
begin
textbackground(tlo_pl1);
gotoxy(pozx_pl-1,pozy_pl+y);write(chr(186));
gotoxy(pozx_pl+rozx_pl,pozy_pl+y);write(chr(186));
textbackground(tlo_pl2);
gotoxy(pozx_pl2-1,pozy_pl2+y);write(chr(186));
gotoxy(pozx_pl2+rozx_pl,pozy_pl2+y);write(chr(186));
end;
{rysowanie katow}
textbackground(tlo_pl1);
gotoxy(pozx_pl-1,pozy_pl-1);write(chr(201));{lewy gorny}
gotoxy(pozx_pl+rozx_pl,pozy_pl-1);write(chr(187));{prawy gorny}
gotoxy(pozx_pl-1,pozy_pl+rozy_pl);write(chr(200));{lewy dolny}
gotoxy(pozx_pl+rozx_pl,pozy_pl+rozy_pl);write(chr(188));{prawy dolny}
textbackground(tlo_pl2);
gotoxy(pozx_pl2-1,pozy_pl2-1);write(chr(201));{lewy gorny}
gotoxy(pozx_pl2+rozx_pl,pozy_pl2-1);write(chr(187));{prawy gorny}
gotoxy(pozx_pl2-1,pozy_pl2+rozy_pl);write(chr(200));{lewy dolny}
gotoxy(pozx_pl2+rozx_pl,pozy_pl2+rozy_pl);write(chr(188));{prawy dolny}
end;
{------------------------------------------------------------------------}
procedure rys_statki(x,y,rodzaj:byte);
{ta procedura przechowuje dane statkow wyglad ktore pozniej sa wyswietlane}
begin
textcolor(stat_kol);
textbackground(tlo_pl2);
if rodzaj=1 then
begin
gotoxy(x,y);write(chr(177),chr(177),chr(177),chr(177));
end;
if rodzaj=2 then
begin
gotoxy(x,y);write(chr(177));
gotoxy(x,y+1);write(chr(177));
gotoxy(x,y+2);write(chr(177));
gotoxy(x,y+3);write(chr(177));
end;
if rodzaj=3 then
begin
gotoxy(x,y);write(chr(177),chr(177),chr(177));
end;
if rodzaj=4 then
begin
gotoxy(x,y);write(chr(177));
gotoxy(x,y+1);write(chr(177));
gotoxy(x,y+2);write(chr(177));
end;
if rodzaj=5 then
begin
gotoxy(x,y);write(chr(177),chr(177));
end;
if rodzaj=6 then
begin
gotoxy(x,y);write(chr(177));
gotoxy(x,y+1);write(chr(177));
end;
end;
{-----------------------------------------------------------------------}
procedure wstaw(x,y,dlgx,dlgy:byte;kto:char);
{procedura wstawia statki do tablicy}
var a,b:integer;
begin
a:=0;b:=0;
repeat
inc(a);b:=0;
repeat
inc(b);
if kto='g' then plan2[x+b,y+a]:=chr(177);
if kto='k' then plan1[x+b,y+a]:=chr(177);
until b=dlgx;
until a=dlgy;
end;
{----------------------------------------------------------------------}
procedure spr_sasiedz(x,y,dlgx,dlgy:byte;kto:char;var wstawiony:boolean);
{procedura sprawdza czy statki nie beda sie stykac}
var a,b:byte;
koniec:boolean;
begin
koniec:=true;a:=0;b:=0;
repeat
inc(a);b:=0;
repeat
inc(b);
if kto='g' then
begin
if plan2[x+b-1,y+a]=chr(177) then koniec:=false; {z lewej}
if plan2[x+b+1,y+a]=chr(177) then koniec:=false; {z prawej}
if plan2[x+b,y+a-1]=chr(177) then koniec:=false; {z gory}
if plan2[x+b,y+a+1]=chr(177) then koniec:=false; {z dolu}
if plan2[x+b-1,y+a-1]=chr(177) then koniec:=false; {z lewej gory}
if plan2[x+b+1,y+a-1]=chr(177) then koniec:=false; {z prawej gory}
if plan2[x+b-1,y+a+1]=chr(177) then koniec:=false; {z lewego dolu}
if plan2[x+b+1,y+a+1]=chr(177) then koniec:=false; {z prawego dolu}
end;
if kto='k' then
begin
if plan1[x+b-1,y+a]=chr(177) then koniec:=false; {z lewej}
if plan1[x+b+1,y+a]=chr(177) then koniec:=false; {z prawej}
if plan1[x+b,y+a-1]=chr(177) then koniec:=false; {z gory}
if plan1[x+b,y+a+1]=chr(177) then koniec:=false; {z dolu}
if plan1[x+b-1,y+a-1]=chr(177) then koniec:=false; {z lewej gory}
if plan1[x+b+1,y+a-1]=chr(177) then koniec:=false; {z prawej gory}
if plan1[x+b-1,y+a+1]=chr(177) then koniec:=false; {z lewego dolu}
if plan1[x+b+1,y+a+1]=chr(177) then koniec:=false; {z prawego dolu}
end;
until b=dlgx;
until a=dlgy;
if koniec=true then begin wstaw(x,y,dlgx,dlgy,kto);wstawiony:=true;end;
end;
{------------------------------------------------------------------------}
{-----------------------------------------------------------------------}
procedure ustawianie_gracz;
{ta procedura pozwala na ustawienie przez gracza swoich statkow
korzysta z procedury rysujacej statki[rys_statki],sprawdzjacej ich
wzajemne sasiedztwo[spr_sasiedz] i tam tez wpisuje polozenie do tablicy]
zmiana - pokazuje czy zmieniono ulozenie statku pion/poziom
koniec - gdy wszystkie statki zostana ustawione
pozk_x/y - pozycja kursora na planszy}
var zmiana,koniec,wstawiony:boolean;
kl:char;
rodzaj,dlgx,dlgy:byte;
pozk_x,pozk_y:byte;
maszt4_tym,maszt3_tym,maszt2_tym:shortint;
begin
koniec:=false;rodzaj:=1;
dlgx:=4;dlgy:=1;pozk_x:=0;pozk_y:=0;
rys_statki(pozx_pl2+pozk_x,pozy_pl+pozk_y,rodzaj);
maszt4_tym:=0;maszt3_tym:=-1 ;maszt2_tym:=-1;
repeat
logo(white,blue,24,1);
scroll(aktywny,30,25,8,200,' Teraz rozstaw swoje statki SPACJA-obrot ENTER-wstawianie');
if keypressed then
begin
kl:=readkey;
if kl=#0 then
begin
kl:=readkey;
case kl of
#72:if pozk_y>0 then dec(pozk_y);{do gory}
#75:if pozk_x>0 then dec(pozk_x);{lewo}
#77:if pozk_x<(rozx_pl-dlgx) then inc(pozk_x);{prawo}
#80:if pozk_y<(rozy_pl-dlgy) then inc(pozk_y);{dol}
end;
rys_plansze;
rys_statki(pozx_pl2+pozk_x,pozy_pl2+pozk_y,rodzaj);
end
else
if kl=#13 then
begin
wstawiony:=false;spr_sasiedz(pozk_x,pozk_y,dlgx,dlgy,'g',wstawiony);
if wstawiony=true then
begin
sound(100);delay(50);nosound;
inc(maszt4_tym);
if maszt4_tym>=maszt4 then
begin
inc(maszt3_tym);rodzaj:=3;pozk_x:=0;pozk_y:=0;dlgx:=3;dlgy:=1;
if maszt3_tym>=maszt3 then
begin
inc(maszt2_tym);rodzaj:=5;pozk_x:=0;pozk_y:=0;dlgx:=2;dlgy:=1;
if maszt2_tym>=maszt2 then koniec:=true;
end;
end;
end;
end;{enter}
if kl=#32 then {spacja - obroc}
begin
zmiana:=false;
if (rodzaj=1)and(zmiana=false)and(pozk_y<=rozy_pl-4) then begin zmiana:=true;rodzaj:=2;dlgx:=1;dlgy:=4;end;
if (rodzaj=2)and(zmiana=false)and(pozk_x<=rozx_pl-4) then begin zmiana:=true;rodzaj:=1;dlgx:=4;dlgy:=1;end;
if (rodzaj=3)and(zmiana=false)and(pozk_y<=rozy_pl-3) then begin zmiana:=true;rodzaj:=4;dlgx:=1;dlgy:=3;end;
if (rodzaj=4)and(zmiana=false)and(pozk_x<=rozx_pl-3) then begin zmiana:=true;rodzaj:=3;dlgx:=3;dlgy:=1;end;
if (rodzaj=5)and(zmiana=false)and(pozk_y<=rozy_pl-2) then begin zmiana:=true;rodzaj:=6;dlgx:=1;dlgy:=2;end;
if (rodzaj=6)and(zmiana=false)and(pozk_x<=rozx_pl-2) then begin zmiana:=true;rodzaj:=5;dlgx:=2;dlgy:=1;end;
rys_statki(pozx_pl2+pozk_x,pozy_pl2+pozk_y,rodzaj);
end;
if kl=#27 then koniec:=true;
begin
end;
rys_plansze;rys_statki(pozx_pl2+pozk_x,pozy_pl2+pozk_y,rodzaj);
end;
until koniec=true;
end;
{----------------------------------------------------------------------------------}
procedure ustawianie_komp;
var rodzaj,dlgx,dlgy,obrot:byte;
maszt4_tym,maszt3_tym,maszt2_tym:shortint;
pozk_x,pozk_y:byte;
wstawiony,koniec,zmiana:boolean;
begin
koniec:=false;rodzaj:=1;dlgx:=4;dlgy:=1;
maszt4_tym:=0;maszt3_tym:=-1;maszt2_tym:=-1;
repeat
pozk_x:=random(rozx_pl-1)+1;pozk_y:=random(rozy_pl-1)+1;obrot:=random(1);
zmiana:=false;
if (rodzaj=1)and(zmiana=false)and(pozk_y<=rozy_pl-4) then begin zmiana:=true;rodzaj:=2;dlgx:=1;dlgy:=4;end;
if (rodzaj=2)and(zmiana=false)and(pozk_x<=rozx_pl-4) then begin zmiana:=true;rodzaj:=1;dlgx:=4;dlgy:=1;end;
if (rodzaj=3)and(zmiana=false)and(pozk_y<=rozy_pl-3) then begin zmiana:=true;rodzaj:=4;dlgx:=1;dlgy:=3;end;
if (rodzaj=4)and(zmiana=false)and(pozk_x<=rozx_pl-3) then begin zmiana:=true;rodzaj:=3;dlgx:=3;dlgy:=1;end;
if (rodzaj=5)and(zmiana=false)and(pozk_y<=rozy_pl-2) then begin zmiana:=true;rodzaj:=6;dlgx:=1;dlgy:=2;end;
if (rodzaj=6)and(zmiana=false)and(pozk_x<=rozx_pl-2) then begin zmiana:=true;rodzaj:=5;dlgx:=2;dlgy:=1;end;
wstawiony:=false;
if (pozk_x+dlgx<=rozx_pl)and(pozk_x-dlgx>=1)and(pozk_y+dlgy<=rozy_pl)and(pozk_y-dlgy>=1) then
begin
spr_sasiedz(pozk_x,pozk_y,dlgx,dlgy,'k',wstawiony);
end;
if wstawiony=true then
begin
inc(maszt4_tym);
if maszt4_tym>=maszt4 then
begin
inc(maszt3_tym);rodzaj:=3;pozk_x:=0;pozk_y:=0;dlgx:=3;dlgy:=1;
if maszt3_tym>=maszt3 then
begin
inc(maszt2_tym);rodzaj:=5;pozk_x:=0;pozk_y:=0;dlgx:=2;dlgy:=1;
if maszt2_tym>=maszt2 then koniec:=true;
end;
end;
end;
rys_plansze;
until koniec=true;
end;
{-----------------------------------------------------------------------------}
procedure czy_zatopiony(x,y:byte;kto:char);
var a,b,c:byte;
trafionych,rozmiar:byte;
begin
if kto='g' then {jesli ruch gracza}
begin
for a:=1 to rozy_pl+1 do
begin
rozmiar:=0;trafionych:=0;
for b:=1 to rozx_pl+1 do
begin
if plan1[b,a]='#' then begin inc(trafionych);inc(rozmiar);end;
if plan1[b,a]=chr(177) then inc(rozmiar);
if (plan1[b,a]<>chr(177))and(plan1[b,a]<>'#') then
begin
if rozmiar>1 then
begin
if trafionych=rozmiar then
begin
sound(100);delay(200);nosound;
if rozmiar=4 then dec(maszt4_komp);
if rozmiar=3 then dec(maszt3_komp);
if rozmiar=2 then dec(maszt2_komp);
for c:=rozmiar downto 1 do begin plan1[b-c,a]:='X';pamiec_gracz[b-c,a]:='X';;end;
a:=rozy_pl;
end;
end;
trafionych:=0;rozmiar:=0;
end;
end;
end;
a:=0;b:=0;
for a:=1 to rozx_pl+1 do
begin
rozmiar:=0;trafionych:=0;
for b:=1 to rozy_pl+1 do
begin
if plan1[a,b]='#' then begin inc(trafionych);inc(rozmiar);end;
if plan1[a,b]=chr(177) then inc(rozmiar);
if (plan1[a,b]<>chr(177))and(plan1[a,b]<>'#') then
begin
if rozmiar>1 then
begin
if trafionych=rozmiar then
begin
sound(100);delay(200);nosound;
if rozmiar=4 then dec(maszt4_komp);
if rozmiar=3 then dec(maszt3_komp);
if rozmiar=2 then dec(maszt2_komp);
for c:=rozmiar downto 1 do begin plan1[a,b-c]:='X';pamiec_gracz[a,b-c]:='X';end;
a:=rozx_pl;
end;
end;
trafionych:=0;rozmiar:=0;
end;
end;
end;
end;
if kto='k' then {jesli ruch komputera}
begin
for a:=1 to rozy_pl+1 do
begin
rozmiar:=0;trafionych:=0;
for b:=1 to rozx_pl+1 do
begin
if plan2[b,a]='#' then begin inc(trafionych);inc(rozmiar);end;
if plan2[b,a]=chr(177) then inc(rozmiar);
if (plan2[b,a]<>chr(177))and(plan2[b,a]<>'#') then
begin
if rozmiar>1 then
begin
if trafionych=rozmiar then
begin
sound(100);delay(200);nosound;
if rozmiar=4 then dec(maszt4_gracz);
if rozmiar=3 then dec(maszt3_gracz);
if rozmiar=2 then dec(maszt2_gracz);
etap_gry:=0;ktory_etap:=0;
for c:=rozmiar downto 1 do begin plan2[b-c,a]:='X';pamiec[b-c,a]:='#';end;
a:=rozy_pl;
end;
end;
trafionych:=0;rozmiar:=0;
end;
end;
end;
a:=0;b:=0;
for a:=1 to rozx_pl+1 do
begin
rozmiar:=0;trafionych:=0;
for b:=1 to rozy_pl+1 do
begin
if plan2[a,b]='#' then begin inc(trafionych);inc(rozmiar);end;
if plan2[a,b]=chr(177) then inc(rozmiar);
if (plan2[a,b]<>chr(177))and(plan2[a,b]<>'#') then
begin
if rozmiar>1 then
begin
if trafionych=rozmiar then
begin
sound(100);delay(200);nosound;
if rozmiar=4 then dec(maszt4_gracz);
if rozmiar=3 then dec(maszt3_gracz);
if rozmiar=2 then dec(maszt2_gracz);
etap_gry:=0;ktory_etap:=0;
for c:=rozmiar downto 1 do begin plan2[a,b-c]:='X';pamiec[a,b-c]:='#';end;
a:=rozx_pl;
end;
end;
trafionych:=0;rozmiar:=0;
end;
end;
end;
end;
end;
{-----------------------------------------------------------------------------}
procedure strzal(x,y:byte;kto:char;var koniec:boolean);
begin
if kto='g' then {jesli ruch gracza}
begin
if (plan1[x,y]<>'X')and(plan1[x,y]<>chr(177))and(plan1[x,y]<>'#') then
begin
plan1[x,y]:='X';koniec:=true;
end;
if (plan1[x,y]=chr(177)) then
begin
plan1[x,y]:='#';koniec:=true;
czy_zatopiony(x,y,kto);
end;
end;
if kto='k' then {jesli ruch komputera}
begin
if (plan2[x,y]<>'X')and(plan2[x,y]<>chr(177))and(plan2[x,y]<>'#') then
begin
plan2[x,y]:='X';koniec:=true;
end;
if (plan2[x,y]=chr(177)) then
begin
plan2[x,y]:='#';koniec:=true;komp_trafil:=true;
czy_zatopiony(x,y,kto);
end;
end;
end;
{-----------------------------------------------------------------------------}
procedure wolne_pola(Z_O:char;var x,y:byte);
{zapis jednego pola wyglada tak: pozx:pozy}
{tutaj komputer wpisuje oddane strzaly i je odczytuje
co zmniejsza liczbe mozliwych do oddania strzalow}
var a,b:byte;
l_x,l_y:string;
blad,c:integer;
begin
if Z_O='O' then {jesli chcemy odzczytac jakies wolne pole}
begin
val(copy(pola_wol[nr_pola],0,pos(':',pola_wol[nr_pola])-1),x,blad); {odczyt pozy}
val(copy(pola_wol[nr_pola],pos(':',pola_wol[nr_pola])+1,length(pola_wol[nr_pola])),y,blad){odczyt pozx};
end;
if Z_O='Z' then {zapisujemy cala tablice}
begin
a:=0;b:=0;c:=0;
repeat
inc(a);b:=0;
repeat
inc(b);inc(c);
str(b,l_x);str(a,l_y); {wpisujemy pozx i pozy_}
pola_wol[c]:=l_x+':'+l_y;
until b=rozx_pl;
until a=rozy_pl;
end;
if Z_O='K' then {jesli kasujemy jakies pole}
begin
if nr_pola<>ilosc_pol then
begin
pola_wol[nr_pola]:=pola_wol[ilosc_pol];
dec(ilosc_pol);
end
else
dec(ilosc_pol);
end;
end;
{-----------------------------------------------------------------------------}
procedure ruch_gracza;
var kl:char;
pozk_x,pozk_y:byte;
koniec:boolean;
begin
koniec:=false;pozk_x:=pkur_x;pozk_y:=pkur_y;
repeat
logo(white,blue,24,1);
scroll(aktywny,30,25,8,200,tekst_scroll);
if keypressed then
begin
kl:=readkey;
if kl=#0 then
begin
kl:=readkey;
case kl of
#72:if pozk_y>0 then dec(pozk_y);{do gory}
#75:if pozk_x>0 then dec(pozk_x);{lewo}
#77:if pozk_x<rozx_pl-1 then inc(pozk_x);{prawo}
#80:if pozk_y<rozy_pl-1 then inc(pozk_y);{dol}
end;
rys_plansze;
textbackground(tlo_pl1);textcolor(kurs_kol);
gotoxy(pozx_pl+pozk_x,pozy_pl+pozk_y);write('+');
end;
if kl=#13 then strzal(pozk_x+1,pozk_y+1,'g',koniec);
if kl=#27 then koniec_gry:=true;
end;
until (koniec=true)or(koniec_gry=true);
pkur_x:=pozk_x;pkur_y:=pozk_y;
end;
{-----------------------------------------------------------------------------}
procedure ruch_komp;
var x,y,a:byte;
powtorz,moze_strz,koniec,zgoda:boolean;
begin
koniec:=false;komp_trafil:=false;moze_strz:=true;a:=0;
if ktory_etap>4 then ktory_etap:=0;
if (etap_gry=0)and(moze_strz=true)then {szukanie statku przez strzelanie}
begin
repeat
zgoda:=false;
nr_pola:=random(ilosc_pol-1)+1;
wolne_pola('O',x,y);
{faza I malo zaznaczonych pol,strzela tak aby wokol nie bylo strzalow}
logo(white,blue,24,1);
scroll(aktywny,30,25,8,200,tekst_scroll);
if (plan2[x-1,y]='X')and(plan2[x+1,y]='X')and(plan2[x,y-1]='X')and(plan2[x,y+1]='X') then
begin
zgoda:=false;
end
else
begin
zgoda:=true;
end;
if zgoda=true then {sprwadza czy z polem strzalu nie sasiaduje statek}
begin
if (pamiec[x-1,y-1]='#')or(pamiec[x+1,y-1]='#')or(pamiec[x-1,y-1]='#')or(pamiec[x+1,y-1]='#') then
begin
if (pamiec[x+1,y]='#')or(pamiec[x-1,y]='#')or(pamiec[x,y+1]='#')or(pamiec[x,y-1]='#') then
begin
zgoda:=false;wolne_pola('K',x,y);
end
else
begin
zgoda:=true;
end;
end;
end;
if zgoda=true then
begin
strzal(x,y,'k',koniec);
wolne_pola('K',x,y);
moze_strz:=false;
if komp_trafil=true then {jesli trafiony statek}
begin
etapy_gry[1]:=random(3)+1;
if etapy_gry[1]=1 then etapy_gry[2]:=2;
if etapy_gry[1]=2 then etapy_gry[2]:=1;
if etapy_gry[1]=3 then etapy_gry[2]:=4;
if etapy_gry[1]=4 then etapy_gry[2]:=3;
if (etapy_gry[1]=1)or(etapy_gry[1]=2) then
begin
etapy_gry[3]:=random(1)+3;
if etapy_gry[3]=3 then etapy_gry[4]:=4;
if etapy_gry[3]=4 then etapy_gry[4]:=3;
end
else
begin
etapy_gry[3]:=random(1)+1;
if etapy_gry[3]=1 then etapy_gry[4]:=2;
if etapy_gry[3]=2 then etapy_gry[4]:=1;
end;
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];pozx_strz:=x;pozy_strz:=y;
x_strz:=x;y_strz:=y;
end;
end
else
begin
wolne_pola('K',x,y);
end;
until koniec=true;
end;
if (etap_gry>=1)and(moze_strz=true)then {jesli komputer trafil w statek}
begin
repeat
a:=0;
if (etap_gry=1)and(moze_strz=true)then {strzaly z lewej strony}
begin
powtorz:=false;
repeat
inc(a);
{sprawdza czy nie strzeli w pole sasiadujece z statkiem}
if (pamiec[pozx_strz-1-a,pozy_strz]='#')or(pamiec[pozx_strz-1-a,pozy_strz+1]='#')then
begin
if (pamiec[pozx_strz-1-a,pozy_strz-1]='#')then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
end;
if pozx_strz-a=0 then {sprawdza czy nie przekroczono planszy}
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if plan2[pozx_strz-a,pozy_strz]='X' then {sprawdza czy nie przekroczono planszy}
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if (plan2[pozx_strz-a,pozy_strz]='#') then
begin
inc(a);
end;
if ((plan2[pozx_strz-a,pozy_strz]=chr(9))or(plan2[pozx_strz-a,pozy_strz]=chr(177)))and(etap_gry=1)then
begin
pozx_strz:=pozx_strz-a;
strzal(pozx_strz,pozy_strz,'k',koniec);
wolne_pola('K',x,y);
if komp_trafil=false then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
moze_strz:=false;
end;
end;
until (etap_gry<>1)or(koniec=true);
end;
a:=0;
if (etap_gry=2)and(moze_strz=true) then {strzaly z prawej strony}
begin
powtorz:=false;
repeat
inc(a);
{sprawdza czy nie strzeli w pole sasiadujece z statkiem}
if (pamiec[pozx_strz+1+a,pozy_strz]='#')or(pamiec[pozx_strz+1+a,pozy_strz+1]='#')then
begin
if (pamiec[pozx_strz+1+a,pozy_strz-1]='#')then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
end;
if pozx_strz+a>rozx_pl then {sprwdaz czy nie przekroczono planszy}
begin;
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if plan2[pozx_strz+a,pozy_strz]='X'then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if (plan2[pozx_strz+a,pozy_strz]='#') then
begin
inc(a);
end;
if (plan2[pozx_strz+a,pozy_strz]=chr(9))or(plan2[pozx_strz+a,pozy_strz]=chr(177))and(etap_gry=2)then
begin
pozx_strz:=pozx_strz+a;
strzal(pozx_strz,pozy_strz,'k',koniec);
wolne_pola('K',x,y);
if komp_trafil=false then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
moze_strz:=false;
pozx_strz:=x_strz;pozy_strz:=y_strz;
end;
end;
until (etap_gry<>2)or(koniec=true);
end;
a:=0;
if (etap_gry=3)and(moze_strz=true) then {strzaly do gory}
begin
powtorz:=false;
repeat
inc(a);
{sprawdza czy nie strzeli w pole sasiadujece z statkiem}
if (pamiec[pozx_strz+1,pozy_strz-1-a]='#')or(pamiec[pozx_strz,pozy_strz-1-a]='#')then
begin
if (pamiec[pozx_strz-1,pozy_strz-1-a]='#')then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
end;
if pozy_strz-a=0 then {sprawdza czy nie przekroczono planszy}
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if plan2[pozx_strz,pozy_strz-a]='X' then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
powtorz:=true;break;
end;
if (plan2[pozx_strz,pozy_strz-a]='#') then
begin
inc(a);
end;
if ((plan2[pozx_strz,pozy_strz-a]=chr(9))or(plan2[pozx_strz,pozy_strz-a]=chr(177)))and(etap_gry=3)then
begin
pozy_strz:=pozy_strz-a;
strzal(pozx_strz,pozy_strz,'k',koniec);
wolne_pola('K',x,y);
if komp_trafil=false then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;
moze_strz:=false;
end;
end;
until (etap_gry<>3)or(koniec=true);
end;
a:=0;
if (etap_gry=4)and(moze_strz=true) then {strzaly w dol}
begin
powtorz:=false;
repeat
inc(a);
{sprawdza czy nie strzeli w pole sasiadujece z statkiem}
if (pamiec[pozx_strz+1,pozy_strz+1+a]='#')or(pamiec[pozx_strz-1,pozy_strz+1+a]='#')then
begin
if (pamiec[pozx_strz,pozy_strz+1+a]='#')then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
end;
if pozy_strz+a>rozy_pl then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];;
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
if plan2[pozx_strz,pozy_strz+a]='X' then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];;
pozx_strz:=x_strz;pozy_strz:=y_strz;wolne_pola('K',x,y);
powtorz:=true;break;
end;
if (plan2[pozx_strz,pozy_strz+a]='#') then
begin
inc(a);
end;
if ((plan2[pozx_strz,pozy_strz+a]=chr(9))or(plan2[pozx_strz,pozy_strz+a]=chr(177)))and(etap_gry=4)then
begin
pozy_strz:=pozy_strz+a;
strzal(pozx_strz,pozy_strz,'k',koniec);
wolne_pola('K',x,y);
if komp_trafil=false then
begin
inc(ktory_etap);
etap_gry:=etapy_gry[ktory_etap];
moze_strz:=false;
pozx_strz:=x_strz;pozy_strz:=y_strz;
end;
end;
until (etap_gry<>4)or(koniec=true);
end;
until powtorz=false;
end;
rys_plansze;
end;
{-----------------------------------------------------------------------------}
procedure informacje;
begin
suma_komp:=maszt4_komp+maszt3_komp+maszt2_komp;
suma_gracz:=maszt4_gracz+maszt3_gracz+maszt2_gracz;
textcolor(white);textbackground(tlo_pl1);
gotoxy(6,12);write('Komputer:');
textcolor(yellow);textbackground(black);
gotoxy(6,14);write('4 maszt=',maszt4_komp);
gotoxy(6,15);write('3 maszt=',maszt3_komp);
gotoxy(6,16);write('2 maszt=',maszt2_komp);
textcolor(white);
gotoxy(6,18);write('konwoj =',suma_komp);
textcolor(white);textbackground(tlo_pl2);
gotoxy(60,12);write('Gracz:');
textcolor(yellow);textbackground(black);
gotoxy(60,14);write('4 maszt=',maszt4_gracz);
gotoxy(60,15);write('3 maszt=',maszt3_gracz);
gotoxy(60,16);write('2 maszt=',maszt2_gracz);
textcolor(white);
gotoxy(60,18);write('konwoj =',suma_gracz);
end;
{------------------------------------------------------------------------------}
BEGIN
repeat {petla konczaca program}
{ustawianie zmiennych}
randomize;
textbackground(tlo);
clrscr;
anim_logo:=0;ktory_logo:=0;aktywny:=true;licznik:=0;
koniec_gry:=false;pkur_x:=0;pkur_y:=0;
maszt4_komp:=maszt4;maszt3_komp:=maszt3;
maszt2_komp:=maszt2;maszt4_gracz:=maszt4;
maszt3_gracz:=maszt3;maszt2_gracz:=maszt2;
suma_komp:=maszt4+maszt3+maszt2;
suma_gracz:=suma_komp;
tekst_scroll:='Tomasz Strekowski przedstawia gre -=* STATKI *=- Jest to program zaliczeniowy z Pascala --.XII.2000';
ukryj_kursor(kursor_p,kursor_k);
etap_gry:=0;x_strz:=0;y_strz:=0;komp_trafil:=false;
ktory_etap:=0;etapy_gry[5]:=255;
ilosc_pol:=rozx_pl*rozy_pl;nr_pola:=0;
start;
if koniec_gry=false then
begin
{program}
wolne_pola('Z',pkur_x,pkur_x);{wstawione zmienne nie maja tu zanego znaczenie}
czysc_plan;
rys_plansze;
ustawianie_gracz;
ustawianie_komp;
rys_plansze;
informacje;
{petla glowna}
repeat
ruch_gracza;
informacje;
if suma_komp>0 then
begin
ruch_komp;
end;
informacje;
until (suma_komp=0)or(suma_gracz=0)or(koniec_gry=true);
koniec_gry:=false;
gotoxy(26,10);sound(100);delay(200);sound(200);delay(200);sound(250);delay(200);nosound;
if suma_komp=0 then write(' WYGRALES!!!!');
if suma_gracz=0 then write('Ja WYGRALEM!!! HAHAHAH!');
repeat
logo(white,blue,24,1);
scroll(aktywny,30,25,8,200,'* Wcisnij dowolny klawisz * ');
until keypressed;
readkey;
end;
until koniec_gry=true;
pokaz_kursor(kursor_p,kursor_k);
END.