The Easiest Way to Save and Share Code Snippets on the web

fff

pascal

posted: Apr, 24th 2012 | jump to bottom

program msweeperx;
 
uses newdelay,crt;
 
const
  NUM_ROWS=9;
  NUM_COLS=9;
  NUM_MINES=9;
 
type
 
  TField=record
    a:integer;
    h:boolean;
  end;
 
  TPos=record
    x,y:integer;
  end;
 
var
  field:array[1..NUM_COLS,1..NUM_ROWS] of TField;
  pos:TPos;
  i,j:integer;
  c:char;
 
function isValid(x,y:integer):boolean;
begin
  if (x>=1) and (x<=NUM_COLS) and (y>=1) and (y<=NUM_ROWS)
  then isValid:=true else isValid:=false;
end;
 
procedure discover(x,y:integer);
begin
  for i:=x-1 to x+1 do
    for j:=y-1 to y+1 do
      if isValid(i,j) and (field[i,j].a=0) and (not field[i,j].h) then begin
        gotoxy(i*3,j*3);
        textBackground(9);
        write('2');
        delay(3000);
        field[i,j].a:=2;
        field[i,j].h:=true;
        discover(i,j);
      end;
end;
 
function getArounded(m,n:integer):byte;
var mines:byte;k,l:integer;
begin
  mines:=0;
  for k:=m-1 to m+1 do
    for l:=n-1 to n+1 do
      if isValid(k,l) and (field[k,l].a=13) then inc(mines);
  getArounded:=mines;
end;
 
procedure onSpace;
begin
  discover(pos.x,pos.y);
end;
 
procedure drawGrid;
begin
  clrscr;
  for i:=1 to NUM_COLS do
    for j:=1 to NUM_ROWS do begin
      if (i=pos.x) and (j=pos.y) then textBackground(red) else textBackground(black);
      if field[i,j].a=13 then textColor(green) else textColor(white);
      if field[i,j].a=0 then textColor(yellow) else textColor(white);
	  gotoxy(i*3,j*3);
	  write(field[i,j].a);
    end;
end;
 
procedure newGame;
begin
 
  pos.x:=NUM_COLS div 2;
  pos.y:=NUM_ROWS div 2;
 
  for i:=1 to NUM_COLS do
    for j:=1 to NUM_ROWS do begin
      field[i,j].a:=0;
      field[i,j].h:=false;
    end;
 
  for i:=1 to NUM_MINES do
    field[random(NUM_COLS)+1,random(NUM_ROWS)+1].a:=13;
 
  for i:=1 to NUM_COLS do
    for j:=1 to NUM_ROWS do begin
      if field[i,j].a<>13 then
        field[i,j].a:=getArounded(i,j);
    end;
 
  drawGrid;
end;
 
begin
  randomize;
 
  newGame;
 
  repeat
    c:=readkey;
    case c of
      'w':if pos.y>1 then dec(pos.y);
      'd':if pos.x<NUM_COLS then inc(pos.x);
      's':if pos.y<NUM_ROWS then inc(pos.y);
      'a':if pos.x>1 then dec(pos.x);
      ' ':onSpace;
      'r':newGame;
    end;
    drawGrid;
  until c=#27;
end.
59 views