dietetyk wrocław AAAA

Strefa czasowa: UTC + 2





Utwórz nowy temat Odpowiedz w temacie  [ Posty: 3 ] 
  Drukuj | Powiadom znajomego

Pascal - statki
Autor Wiadomość
PostNapisane: 2006-09-28, 17:45 
Adept
Avatar użytkownika
Offline

Dołączył(a):2006-07-29, 15:33
Posty:35
Lokalizacja: Ciechanów
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.


Zgłoś post
Góra
 Zobacz profil  
Cytuj  

PostNapisane: 2008-03-31, 15:56 
Wszechmogący/a
Offline

Dołączył(a):2007-07-09, 22:47
Posty:2006
Tyle ze trzeba mieć kompilator, a nie każdy ma :-P Skompiluj i wtedy wrzuć.

PS:

Dłuuuuuugi ten kod.... nawet mi sie czytać nie chce :mrgreen:


Zgłoś post
Góra
 Zobacz profil  
Cytuj  

PostNapisane: 2008-06-15, 00:10 
Adept
Offline

Dołączył(a):2008-05-18, 19:05
Posty:12
Mozna to optymalniej i krocej napisac.... pisalam kiedys statki w c/c++ i w javie ;) swietna zabawa;)


Zgłoś post
Góra
 Zobacz profil  
Cytuj  

DrukujPowiadom znajomego 

Wyświetl posty nie starsze niż:  Sortuj wg  
Utwórz nowy temat Odpowiedz w temacie  [ Posty: 3 ] 

Strefa czasowa: UTC + 2


  Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 2 gości


Możesz rozpoczynać nowe tematy
Możesz odpowiadać w tematach
Nie możesz edytować swoich postów
Nie możesz usuwać swoich postów
Nie możesz dodawać załączników

Szukaj:
7CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCviewtopic
Powered by phpBB® Forum Software © phpBB Group

Przyjazne użytkownikom polskie wsparcie phpBB3 - phpBB3.PL
phpBB SEO