Kurs Turbo Pascala

program MasterMind;

uses
 Crt;

{ -------------------------------------------------------------- }
{ ------------------- Zmienne, typy i stale -------------------- }
{ -------------------------------------------------------------- }

type
 TPole = record
   id : Byte;
   active : Boolean;
   found : Boolean;
 end;

 TPoint = record
   x : Byte;
   y : Byte;
 end;

const
 MAX_PICTURES = 10;
 MAX_ROWS = 10;
 MAX_COLUMNS = 10;

 KEY_LEFT = 'A';
 KEY_RIGHT     = 'D';
 KEY_UP        = 'W';
 KEY_DOWN = 'S';
 KEY_CHOOSE = ' ';
 KEY_NEW_GAME = 'N';
 KEY_ESCAPE = #27;

 { rodzaje obrazkow }
 pictures : array[1..MAX_PICTURES] of Char =
 ('*', '&', '^', '%', '#', '@', '!', '+', '-', '~');

var
 { plansza }
 lvl : array[1..MAX_ROWS, 1..MAX_COLUMNS] of TPole;

 { wspolrzedne poczatkowe planszy pomniejszone o 1 }
 sx, sy : Byte;

 { wspolrzedne aktualnego pola }
 px, py : Byte;

 { wymiary planszy }
 rows, columns : Byte;

 { poprzednio wybrane pole }
 wybPole : TPoint;

 { ilosc zaznaczonych pol }
 wybIle : Byte;

 { ilosc pol nieodgadnietych }
 ile : Byte;

 { czy to juz koniec gry }
 koniec : Boolean;

 { czy wyjsc z programu }
 quit : Boolean;

 { ilosc podejsc }
 ilePodejsc : Word;

{ -------------------------------------------------------------- }
{ ------------------- Procedury i funkcje ---------------------- }
{ -------------------------------------------------------------- }

function Min(a, b : Integer) : Integer;
begin
 if (a > b) then
   Min := b
 else
   Min := a;
end;

function Max(a, b : Integer) : Integer;
begin
 if (a < b) then
   Max := b
 else
   Max := a;
end;

procedure WriteXY(x, y, fg, bg : Byte; const txt : string);
begin
 GotoXY(x, y);
 TextColor(fg);
 TextBackground(bg);
 Write(txt);
end;

procedure CreateLevel(r, c : Integer);
var
 i, j : Byte;
 mp : Word; { maksymalna liczba obrazkow }
 rx, ry : Byte; { losowe wspolrzedne pol }
 cp : Byte; { biezacy obrazek }
begin
 rows := Max(Min(r, MAX_ROWS), 2);
 columns := Max(Min(c, MAX_COLUMNS), 2);
 if (rows and 1<>0) and (columns and 1<>0) then
   Dec(rows);
 for i:=1 to rows do
   for j:=1 to columns do
   begin
     lvl[i, j].id := 0;
     lvl[i, j].active := FALSE;
     lvl[i, j].found := FALSE;
   end;
 mp := rows*columns;
 ile := mp div 2;
 cp := 0;
 while (mp > 0) do
 begin
   Inc(cp);
   if (cp > MAX_PICTURES) then
     cp := 1;
   for i:=1 to 2 do
   begin
     repeat
rx := Random(columns)+1;
ry := Random(rows)+1;
     until (lvl[ry, rx].id = 0);
     lvl[ry, rx].id := cp;
   end;
   Dec(mp, 2);
 end;
 sx := 40-(columns div 2);
 sy := 13-(rows div 2);
 px := 1;
 py := 1;
 wybIle := 0;
 koniec := FALSE;
 ilePodejsc := 0;
end;

procedure Show;
var
 i, j : Byte;
 s : string;
begin
 TextBackground(BLACK);
 ClrScr;
 for i:=1 to rows do
   for j:=1 to columns do
     if (lvl[i, j].found) then
WriteXY(sx+j-1, sy+i-1, YELLOW, BLACK, pictures[lvl[i, j].id])
     else if (lvl[i, j].active) then
WriteXY(sx+j-1, sy+i-1, RED, BLACK, pictures[lvl[i, j].id])
     else
WriteXY(sx+j-1, sy+i-1, DARKGRAY, BLACK, '?');
 Str(ilePodejsc:5, s);
 WriteXY(80-5, 1, WHITE, BLUE, s);
 GotoXY(sx+px-1, sy+py-1);
end;

procedure Choose;
begin
 if (lvl[py, px].found) or (lvl[py, px].active) then
   Exit;
 Inc(ilePodejsc);
 lvl[py, px].active := TRUE;
 if (wybIle = 1) then
 begin
   if (lvl[wybPole.y, wybPole.x].id = lvl[py, px].id) then
   begin
     lvl[wybPole.y, wybPole.x].found := TRUE;
     lvl[py, px].found := TRUE;
     lvl[wybPole.y, wybPole.x].active := FALSE;
     lvl[py, px].active := FALSE;
     Dec(ile);
     if (ile = 0) then
koniec := TRUE;
   end
   else begin
     Show;
     lvl[wybPole.y, wybPole.x].active := FALSE;
     lvl[py, px].active := FALSE;
     Delay(500);
     Show;
   end;
   wybIle := 0;
 end
 else begin
   Inc(wybIle);
   wybPole.x := px;
   wybPole.y := py;
 end;
end;

procedure Init; forward;

procedure KeyHandle(c : Char);
begin
 case (c) of
   KEY_LEFT:
px := Max(px-1, 1);
   KEY_RIGHT:
px := Min(px+1, columns);
   KEY_UP:
py := Max(py-1, 1);
   KEY_DOWN:
py := Min(py+1, rows);
   KEY_CHOOSE:
     Choose;
   KEY_NEW_GAME:
     Init;
   KEY_ESCAPE:
     quit := TRUE;
 else
   Exit;
 end;
 Show;
end;

procedure Init;
begin
 CreateLevel(Random(MAX_ROWS)+2, Random(MAX_COLUMNS)+2);
 Show;
end;

procedure Done;
begin
 TextColor(LIGHTGRAY);
 TextBackground(BLACK);
 ClrScr;
 WriteLn('Master Mind 2005 - by Silent (text mode rulez !!!)');
 Delay(3000);
end;

procedure Play;
var
 c : Char;
begin
 quit := FALSE;
 while (not quit) do
 begin
   if (KeyPressed) then
     KeyHandle(UpCase(ReadKey));
   if (koniec) then
   begin
     WriteXY(1, 1, LIGHTGRAY, BLACK,
'Czy chcesz zagrac jeszcze raz ? [T/N] ');
     repeat
c := UpCase(ReadKey);
     until (c = 'T') or (c = 'N');
     if (c = 'N') then
Break;
     Init;
   end;
 end;
end;

procedure Run;
begin
 Play;
end;

{ -------------------------------------------------------------- }
{ --------------------- Program glowny ------------------------- }
{ -------------------------------------------------------------- }

begin
 Randomize;
 TextMode(CO80);
 Init;
 Run;
 Done;
end.