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.
Może na początek gra w statki
[code]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. [/code]
|