program minefield;

uses Crt,Dos;

var
  done,none,ok  : Boolean;
  mine_ct,score : word;
  ch,flag : char;
  field  : array[1..10,1..15] of char;
  guess  : array[1..10,1..15] of byte;
  k0,m0,xx,yy : byte;
  choice : string[5];
  ud,lr  : word;
  fg     : integer;
  dosrec : Registers;

function keyin:integer;
var key:byte;
begin
  dosrec.ax:=$0700;msdos(dosrec);key:=dosrec.al;
  if key=0 then keyin:=keyin*256 else keyin:=key
end;

procedure chkey;
var stg:integer;
begin
  stg:=keyin;
  m0:=hi(stg);k0:=lo(stg);
end;

procedure neighbors;
var pp,qq,ii,jj,ct:byte;
begin
  for pp:=1 to 10 do begin
    for qq:=1 to 15 do begin
      if field[pp,qq]<>chr(15) then begin
        ii:=pp-1;ct:=0;
        repeat
          if(ii>0)and(ii<11) then begin
            jj:=qq-1;
            repeat
              if(jj>0)and(jj<16)and(field[ii,jj]=char(15)) then inc(ct);
              inc(jj)
            until jj=qq+2;
          end;
          inc(ii)
        until ii=pp+2;
        if ct=0 then field[pp,qq]:='Û'
        else field[pp,qq]:=chr(48+ct)
      end
    end
  end
end;

procedure draw_board;     (* 179 ³ 180 ´ 191 ¿ 192 À 193 Á 194 Â *)
var ii,jj : byte;
  procedure draw_posn;
  var ii,jj:byte;
  begin
    for ii:=1 to 10 do begin
      for jj:=1 to 15 do begin
        if guess[ii,jj]<>0 then begin
          gotoxy(jj*4+1,ii*2+2);
          TextColor(guess[ii,jj]);
          write(field[ii,jj]);
        end
      end
    end
  end;
begin                     (* 195 Ã 196 ÄÄÄ 197 Å 217 Ù 218 Ú *)
  clrscr;
  writeln('     There are ',mine_ct,' mines.     SCORE : ',score,' [Max. 150]');
  writeln('    1   2   3   4   5   6   7   8   9  10  11  12  13  14  15');
  writeln('  ÚÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄ¿');
  for ii:=1 to 9 do begin
    writeln(chr(64+ii),' ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³');
    writeln('  ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´');
  end;
  writeln(chr(74),' ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³   ³');
  writeln('  ÀÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÙ');
  draw_posn;
  TextColor(7);
  neighbors
end;

procedure seed_mines;
var ii,jj:byte;
begin
  for ii:=1 to 10 do for jj:=1 to 15 do field[ii,jj]:=' ';
  for ii:=1 to 10 do for jj:=1 to 15 do guess[ii,jj]:=0;
  for ii:=1 to mine_ct do begin
    repeat
      xx:=1+Random(10);yy:=1+Random(15);
    until field[xx,yy]=' ';
    field[xx,yy]:=chr(15)
  end;

end;


procedure check_empty(du,rl:byte);
begin
  if(du>0)and(du<11)and(rl>0)and(rl<16) then begin
    inc(score);
    repeat
      guess[du,rl]:=3;none:=true;
      if field[du,rl]='Û' then begin
        none:=false;
        if guess[du-1,rl+1]=0 then check_empty(du-1,rl+1);
        if guess[du-1,rl]=0 then check_empty(du-1,rl);
        if guess[du-1,rl-1]=0 then check_empty(du-1,rl-1);
        if guess[du,rl+1]=0 then check_empty(du,rl+1);
        if guess[du,rl-1]=0 then check_empty(du,rl-1);
        if guess[du+1,rl-1]=0 then check_empty(du+1,rl-1);
        if guess[du+1,rl]=0 then check_empty(du+1,rl);
        if guess[du+1,rl+1]=0 then check_empty(du+1,rl+1);
        none:=(none=false);
      end
    until none
  end
end;

procedure show_board;
var ii,jj:byte;
begin
  for ii:=1 to 10 do for jj:=1 to 15 do
              if guess[ii,jj]=0 then guess[ii,jj]:=15
end;

procedure get_guess;
begin
  gotoxy(65,9);write('Move (eg A10X)?');
  repeat
    gotoxy(66,10);clreol;readln(choice);flag:=' ';
    ch:=Upcase(choice[1]);ud:=100;lr:=100;
    choice:=copy(choice,2,length(choice)-1);
    if choice[length(choice)] in ['0'..'9'] then begin end
    else begin
      flag:=upcase(choice[length(choice)]);
      choice:=copy(choice,1,(length(choice)-1))
    end;
    Val(choice,lr,fg);if fg<>0 then lr:=100;
    if ord(ch)>63 then ud:=(ord(ch)-64) else ud:=100;
    ok:=(flag in [' ','?','M'])and(guess[ud,lr]=0)and
                         (ud>0)and(ud<11)and(lr>0)and(lr<16);
    if not ok then begin sound(220);delay(200);nosound end;
  until ok;
(*  gotoxy(66,10);clreol;write(ch,' ',ud,'/',lr,' ',flag,'?'); *)
  guess[ud,lr]:=3;
  case flag of
    ' ' : if field[ud,lr]=chr(15) then begin
            done:=true;show_board;
          end else check_empty(ud,lr);
    '?' : field[ud,lr]:='?';
    'M' : if field[ud,lr]<>chr(15) then begin
            done:=true;show_board
          end else begin inc(score);guess[ud,lr]:=4 end;
  end;
  if not done then done:=(score=150)
end;

procedure run;
begin
  score:=0;seed_mines;
  repeat
    draw_board;
    get_guess;
  until done;
  draw_board;
end;


procedure instructions;
begin
  clrscr;
  gotoxy(30,3);write('M I N E F I E L D');
  gotoxy(1,5);
  writeln('     The display shows a minefield with ',mine_ct,' hidden mines.  You choose areas to');
  writeln('examine by typing the coordinates, as "D7".  If a mine is at that position, you');
  writeln('lose!  If not, you are shown the number of mines in the neighboring squares.');
  writeln;
  writeln('If the square you choose is empty, all adjacent squares will be shown');
  writeln('immediately, and all their neighbors if any of them are also empty.');
  writeln;
  writeln('If you think a mine is present, add "M" (or "m") to the end of the address, as');
  writeln('"D7M", or "f11m", for example.  If you are right, the mine will be shown ; if');
  writeln('not, you lose again!.  If you cannot tell at all, you can append a query, "?",');
  writeln('as in "h10?".  Each correct guess (and empty display) scores you one point.');
  writeln('Query entries do not score.  The maximum possible is 150, if you guess all');
  writeln('squares correctly.');
  writeln;
  writeln('  Press <ENTER> to continue.  Good luck!');
  ch:=ReadKey;
end;

BEGIN
  done:=false;mine_ct:=25;score:=0;done:=false;
  clrscr;randomize;
  instructions;
  repeat
    run;
    if score=150 then begin
    gotoxy(65,9);clreol;write('WELL DONE!')
    end;
    gotoxy(65,13);write('Play again? ');
    repeat ch:=ReadKey;ch:=upcase(ch) until ch in ['Y','N'];
    write(ch);done:=(ch='N')
  until done;
  clrscr;gotoxy(5,10);
  write('Thanks for the game.  See you again soon....')
end.