Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  memor
Language: PASCAL
Code:
program memory;

uses crt;

const
N=10;                                                                           // Maksymalny rozmiar planszy
M=4;                                                                            // Maksymalna ilość graczy

var
pl                  :array[1..N,1..N] of byte;                                  // Plansza (wartości)
zg                  :array[1..N,1..N] of boolean;                               // Zgadnięte pola na planszy (true)
gracze              :byte;                                                      // Ilość graczy
punkty              :array[1..M] of byte;                                       // Punkty Graczy
imie                :array[1..m] of string[12];                                 // Imiona Graczy
//tura                :byte;                                                      // Tura gracza nr. (nieużywane)
s,w                 :byte;                                                      // Szerokość i wysokość planszy
wyb                 :byte;                                                      // Wybór użytkownika
i,j,k,l             :byte;                                                      // Przeznaczone do pętli for
st                  :string;                                                    // Pomocniczy string
rx,ry               :byte;                                                      // Randomowe współrzędne do wypełniania tabeli
koniec              :boolean;                                                   // Czy rozgrywka się zakończyła?
max                 :byte;                                                      // Ilosc odgadniętych pól na planszy
x,y                 :array[1..2] of byte;                                       // Zgadywane współrzędne
zgadl               :boolean;                                                   // True jeżeli gracz zgadł ostatnią kombinację
wyg                 :byte;                                                      // Sprawdza który gracz wygrał
remis               :boolean;                                                   // True jeżeli jest remis
pierwszy            :boolean;                                                   // Sprawdza czy logo wyświetlane jest po raz 1

procedure napisz(st:string);                                                    // Procedura pisząca literkę po literce
begin
   for i:=1 to length(st) do
   begin
   write(st[i]);
   delay(5);
   end;
writeln();
end;

procedure logo;                                                                 //Tworzy logo Memory
begin
textcolor(white);
clrscr;
if pierwszy=false then                                                          // Jeżeli za pierwszym razem używa procedury napisz
begin
napisz('||| ||| |||||| ||| ||| |||||| |||||| ||  ||');
napisz('||| ||| ||     ||| ||| ||  || ||  ||  |||| ');
napisz('|| | || |||||  || | || ||  || ||||||   ||  ');
napisz('||   || ||     ||   || ||  || ||||     ||  ');
napisz('||   || |||||| ||   || |||||| ||  ||   ||  ');
napisz('          Autor: Michal Sozanski           ');
pierwszy:=true;
end
else
begin                                                                           // Za każdym następnym jedzie normalnie
writeln('||| ||| |||||| ||| ||| |||||| |||||| ||  ||');
writeln('||| ||| ||     ||| ||| ||  || ||  ||  |||| ');
writeln('|| | || |||||  || | || ||  || ||||||   ||  ');
writeln('||   || ||     ||   || ||  || ||||     ||  ');
writeln('||   || |||||| ||   || |||||| ||  ||   ||  ');
writeln('          Autor: Michal Sozanski           ');
end;
textcolor(lightgray);
writeln();
end;

procedure defgraczy;                                                            // Ilość graczy, imiona graczy itp.
begin
   repeat
   write('Wpisz ilosc graczy (od 2 do ',M,'): ');                               // Deklaracja ilości graczy
   readln(gracze);
   until (gracze >= 2) and (gracze <= M);
   for l:=1 to gracze do                                                        // Deklaracja imion graczy
   begin
   write('Wpisz imie gracza ',l,': ');
   readln(imie[l]);
      if imie[l] = '' then                                                      // Jeśli imię nie zostało zadeklarowane, zwraca Gracz #
      begin
      str(l,st);
      imie[l]:= 'Gracz ' + st;
      end;
   end;
end;                                                                            // Koniec defgraczy

procedure nplansza;                                                             // Tworzenie nowej planszy - Trzeba będzie poprawić
begin
   repeat
   writeln();
   writeln('Wybierz rozmiar planszy (szerokosc i wysokosc (max ',N,' na ',N,')');
      repeat
      write('Szerokosc: ');
      readln(s);
      until (s>=2)and(s<=N);
      repeat
      write('Wysokosc: ');
      readln(w);
      until (w>=2)and(w<=N);
   until (s*w)mod 2 = 0;
   for i:= 1 to s do                                                            // Zerowanie tablicy planszy
   begin
      for j:=1 to w do
      begin
      pl[i,j]:=0;
      zg[i,j]:=false;
      end;
   end;
   for i:= 1 to (s*w) div 2 do                                                  // Wpisanie wartosci na tablice (2 x kazda wartosc)
   begin
   j:=0;
      repeat
         repeat
         randomize;
         rx:=random(s)+1;                                                       // Losowanie współrzędnych na których będzie wartość
         ry:=random(w)+1;
         until pl[rx,ry]=0;
      pl[rx,ry]:=i;
      j:=j+1;
      until j=2;
   end;
end;                                                                            // Koniec nplansza

procedure wyswietl;                                                             // Wyświetla plansze i wyniki graczy
begin
logo;
   for k:=1 to w do
   begin
      for l:=1 to s do
      begin
         if zg[l,k] = true then                                                 // Jezeli pole zostalo juz odsloniete/zgadniete
         begin
            if pl[l,k] < 10 then                                                // Pokazuje jego wartość
            begin
            write('0',pl[l,k]);
            end
            else
            begin
            write(pl[l,k]);
            end;
         end
         else                                                                   // Jezeli nie zostalo odsloniete/zgadniete wyswietl ##
         begin
         write('##');
         end;
      write(' ');
      end;
      writeln();
   end;
   writeln();
   for l:=1 to gracze do                                                        // Pokazuje wynik i imona graczy
   begin
   writeln(imie[l],' :',punkty[l]);
   end;
writeln();
end;                                                                            // Koniec wyswietl

procedure sprawdz;                                                              // Sprawdza czy rozgrywka powinna sie zakonczyc... Da się prościej!
begin
   if max >= s*w then
   begin                                                                        // Jezeli ilosc zganietych pol = ilosc pol w ogle to koniec
   koniec:=true;
   end;
end;                                                                            // Koniec sprawdz

procedure zgadywanie;                                                           // Rozpoczenie zgadywanie
begin
                                                                                // Tury graczy
   for i:=1 to gracze do
   begin
   zgadl:=true;
      repeat
      while (zgadl=true) and (koniec <> true) do
      begin
         for j:= 1 to 2 do                                                      // Wskazanie punktów przez graczy
         begin
            repeat
            write('Tura: ');
            writeln(imie[i]);
            writeln('Wprowadz ',j,' punkt:');
               repeat
               write('x (od 1 do ',s,'): ');
               readln(x[j]);
               until (x[j] >= 1) and (x[j] <= s);

               repeat
               write('y (od 1 do ',w,'): ');
               readln(y[j]);
               until (y[j] >= 1) and (y[j] <= w);
            until zg[x[j],y[j]] <> true;
            zg[x[j],y[j]]:= true;                                               // Podświetla pole
            wyswietl;
         end;

         if pl[x[1],y[1]] = pl[x[2],y[2]] then                                  // Jeżeli trafione to zostawia tak jak jest, tylko punkty + 1
         begin
         punkty[i]:=punkty[i]+1;
         max:=max+2;
         sprawdz;
         end
         else                                                                   // Jeżeli nietrafione to usuwa podświetlenie (zgadnięcie) pól
         begin
         zg[x[1],y[1]]:=false;
         zg[x[2],y[2]]:=false;
         zgadl:=false;
         delay(1000);
         end;
      wyswietl;
      end;
      until (zgadl=false) or (koniec=true);
   end;
end;

procedure wybor;
begin
   repeat
   logo;
   writeln('1 - Start');
   writeln('2 - Instrukcja');
   writeln('3 - Koniec');
   readln(wyb);
      case wyb of
      2: begin
         writeln('Gra polega na szukaniu par w zakrytych liczbach.');
         writeln('Za kazda odgadnieta pare gracz zdobywa jeden punkt.');
         writeln('Gracze zgaduja po kolei - od pierwszego do ostatniego.');
         writeln('Wygrywa gracz ktory zdobyl najwiecej punktow.');
         writeln('W przypadku znalezienia pary, gracz ma prawo do ponownego zgadywania, az do nieznalezienia pary');
         readln();
         end;
      end;
   until (wyb <>2) and (wyb >= 1) and (wyb <= 3);
end;

begin                                                                           // Początek programu
koniec:=false;                                                                  // Inicjalizacja zmiennych
max:=0;

wybor;
defgraczy;
   for i:=1 to gracze do
   punkty[i]:=0;                                                                // Tworzenie planszy
nplansza;
wyswietl;
   repeat
   zgadywanie;                                                                  // Zgadywanie
   until koniec=true;
writeln('Koniec!');                                                             // Koniec i wyniki
writeln('Wyniki: ');
writeln();
   for i:=1 to gracze do
   writeln(imie[i],': ',punkty[i]);
wyg:=1;
   for i:=2 to gracze do
   begin
      if punkty[wyg] < punkty[i] then
      begin
      wyg:=1;
      remis:=false;
      end
      else
      begin
         if punkty[wyg]=punkty[i] then
         begin
         remis:=true;
         end;
      end;
   end;
   if remis=true then
   begin
   writeln('REMIS');
   end
   else
   begin
   writeln('Wygral ',imie[wyg]);
   end;
readln();
end.
Comments: