{******************************************************************************

MINE

Mine is the classic game where a field of hidden mines is presented, and the
user tries to find the mines based on mine counts in adjacent squares. 
 
******************************************************************************}

program minet(input, output);

uses trmlib;

const

   maxxs = 16 {8};  { size of grid }
   maxys = 16 {8};
   maxmine = 40 {10}; { number of mines to place }

type

   string = packed array of char; { standard string }
   square = record { individual square }

      mine: boolean; { mine exists at square }
      vis:  boolean; { square is uncovered }
      flag: boolean  { square is flagged }
      
   end; 
   point = record x, y: integer end;

fixed offset: array [1..8] of point = array

   record  0, -1 end, { up }
   record +1, -1 end, { upper right }
   record +1,  0 end, { right }
   record +1, +1 end, { lower right }
   record  0, +1 end, { down }
   record -1, +1 end, { lower left }
   record -1,  0 end, { left }
   record -1, -1 end  { upper left }

end;

var

   { playing board }
   board:    array [1..maxxs, 1..maxys] of square;
   rndseq:   integer; { randomizer }
   x, y:     integer; { user move coordinates }
   done:     boolean; { game over }
   centerx:  integer; { center of screen position x }
   centery:  integer; { center of screen position y }
   cursorx:  integer; { cursor location x }
   cursory:  integer; { cursor location y }
   er:       evtrec;  { event record }
   badguess: boolean; { bad guess display flag }
   mousex:   integer; { mouse position x }
   mousey:   integer; { mouse position y }

{******************************************************************************
 
Find random number
 
Finds a random number between the given top and 1.
 
******************************************************************************}
 
function rand(top: integer): integer;

const a = 16807;
      m = 2147483647;

var gamma: integer;

begin

   gamma := a*(rndseq mod (m div a))-(m mod a)*(rndseq div (m div a));
   if gamma > 0 then rndseq := gamma else rndseq := gamma+m;
   rand := rndseq div (m div top)+1

end;

{******************************************************************************
 
Find adjacent mines

Finds the number of mines adjacent to a given square.
 
******************************************************************************}

function adjacent(x, y: integer): integer;

var mines:  0..8;    { number of mines }
    xn, yn: integer; { neighbor coordinates }
    i:      1..8;    { index for move array }
 
begin

   mines := 0; { clear mine count }
   for i := 1 to 8 do begin { process points of the compass }

      xn := x+offset[i].x; { find neighbor locations }
      yn := y+offset[i].y;
      if (xn >= 1) and (xn <= maxxs) and (yn >= 1) and (yn <= maxys) then
         { valid location }
         if board[xn, yn].mine then mines := mines+1 { count mines }

   end;
   adjacent := mines { return the number of mines }

end;

{******************************************************************************
 
Set adjacent squares visable

Sets all of the valid adjacent squares visable. If any of those squares are
not adjacent to a mine, then the neighbors of that square are set visable, etc.
(recursively).
This is done to "rip" grids of obviously empty neighbors off the board.
 
******************************************************************************}

procedure visadj(x, y: integer);

var xn, yn: integer; { neighbor coordinates }
    i:      1..8;    { index for move array }
 
begin

   for i := 1 to 8 do begin { process points of the compass }

      xn := x+offset[i].x; { find neighbor locations }
      yn := y+offset[i].y;
      if (xn >= 1) and (xn <= maxxs) and (yn >= 1) and (yn <= maxys) then
         if not board[xn, yn].vis then begin { not already visable }

         { valid location }
         board[xn, yn].vis := true; { set visable }
         if adjacent(xn, yn) = 0 then visadj(xn, yn) { perform recursively }

      end

   end

end;

{******************************************************************************
 
Display board
 
Displays the playing board.
 
******************************************************************************}
 
procedure display;
 
var x:   integer;
    y:   integer;
    cnt: 0..8; { count of adjacent mines }
 
begin

   { scan screen }
   bcolor(output, yellow); { set background color }
   for y := 1 to maxys do
      for x := 1 to maxxs do with board[x, y] do begin
      
         cursor(output, centerx+x-1, centery+y-1); { set start of next line }
         if vis then begin

            if mine then write('*') else begin

               cnt := adjacent(x, y); { find adjacent mine count }
               if cnt = 0 then write('.') { no adjacent }
               else write(chr(cnt+ord('0'))) { place the number }

            end

         end else if flag then begin { display flagged location }

            if badguess then write('X') else write('M')

         end else write('=')

      end;
   writeln

end;

{******************************************************************************
 
Initalize board

Clears all board squares to no mines, invisible and not flagged.
Then, the specified number of mines are layed on the board at random.
 
******************************************************************************}
 
procedure clear;
 
var x: integer;
    y: integer;
    n: integer;
 
begin

   for x := 1 to maxxs do { clear minefield }
      for y := 1 to maxys do with board[x, y] do begin

      mine := false; { set no mine }
      vis := false; { set not visible }
      flag := false { set not flagged }

   end;
   for n := 1 to maxmine do begin { place mines }

      repeat

         x := rand(maxxs);
         y := rand(maxys)

      until not board[x, y].mine; { no mine exists at square }
      board[x, y].mine := true { place mine }

   end

end;

{******************************************************************************

Clear line

Clears the specified line to spaces in the specified color.

******************************************************************************}

procedure clrlin(y:   integer; { line to clear }
                 clr: color);  { color to clear to }

var i: integer;

begin

   cursor(output, 1, y); { position to specified line }
   bcolor(output, clr); { set color }
   for i := 1 to maxx(output) do write(' ') { clear line }

end;

{******************************************************************************

Print centered string

Prints the given string centered on the given line.

******************************************************************************}

procedure prtmid(     y: integer; { line to print on }
                 view s: string); { string to print }

begin

   cursor(output, maxx(output) div 2-max(s) div 2, y); { position to start }
   write(s) { output the string }

end;

{******************************************************************************

Draw character box

Draws a box of the given color and character to the location.
The colors are not saved or restored.

******************************************************************************}

procedure tbox(sx, sy: integer; { coordinates of box upper left }
               ex, ey: integer; { coordinates of box lower left }
               c:      char;    { character to draw }
               bclr:   color;   { background color of character }
               fclr:   color);  { foreground color of character }

var x, y: integer; { coordinates }

begin

   bcolor(output, bclr);
   fcolor(output, fclr);
   cursor(output, sx, sy); { position at box top left }
   for x := sx to ex do write(c); { draw box top }
   cursor(output, sx, ey); { position at box lower left }
   for x := sx to ex do write(c); { draw box bottom }
   for y := sy+1 to ey-1 do begin { draw box left side }

      cursor(output, sx, y); { place cursor }
      write(c) { place character }

   end;
   for y := sy+1 to ey-1 do begin { draw box left side }

      cursor(output, ex, y); { place cursor }
      write(c) { place character }

   end

end;

{******************************************************************************

Check replay

Asks the user if a replay is desired, then either cancels the game, or
sets up a new game as requested.

******************************************************************************}

procedure replay;

begin

   { ask user for replay }
   bcolor(output, cyan);
   prtmid(maxy(output), 'PLAY AGAIN (Y/N) ?');
   repeat { wait for response }

      { wait till a character is pressed }
      repeat event(output, er) until er.etype in [etchar, etterm];
      if er.etype = etterm then { force a quit }
         begin er.etype := etchar; er.char := 'n' end

   until er.char in ['y', 'Y', 'n', 'N'];
   if er.char in ['n', 'N'] then done := true { set game over }
   else begin

      { clear old messages }
      clrlin(maxy(output)-2, cyan);
      clrlin(maxy(output), cyan);
      { start new game }
      clear; { set up board }
      cursorx := centerx; { set inital cursor position }
      cursory := centery;
      badguess := false { set bad guesses invisible }

   end

end;

{******************************************************************************

Process square "hit"

Processes a "hit" on a square, which means revealing that square, and possibly
triggering a mine.

******************************************************************************}

procedure hit(x, y: integer);

var xi, yi: integer; { indexes for board }
    viscnt: integer; { visable squares count }

begin

   board[x, y].vis := true; { set that location visable }
   if board[x, y].mine then begin { mine found }

      { make all mines visable, and bad guesses too. }
      for yi := 1 to maxys do
         for xi := 1 to maxxs do
            if board[xi, yi].mine then board[xi, yi].vis := true;
      badguess := true; { set bad guesses visable }
      display; { redisplay board }
      { announce that to the player }
      bcolor(output, red);
      prtmid(maxy(output)-2, '*** YOU HIT A MINE ! ***');
         replay { process replay }

   end else begin { valid hit }

      if adjacent(x, y) = 0 then { no adjacent mines }
         visadj(x, y); { clean up adjacent spaces }
      { now, the player may have won. we find this out by counting all of the
        visable squares, and seeing if the number of squares left is equal
        to the number of mines }
      viscnt := 0;
      for yi := 1 to maxys do
         for xi := 1 to maxxs do
            if board[xi, yi].vis then viscnt := viscnt+1; { count visible }
      if maxxs*maxys-viscnt = maxmine then begin { player wins }

         display; { redisplay board }
         { announce that to the player }
         bcolor(output, red);
         prtmid(maxy(output)-2, '*** YOU WIN ! ***');
         replay { process replay }

      end

   end;
   display { redisplay board }

end;

{******************************************************************************

Main process

******************************************************************************}

begin

   select(output, 2, 2); { switch screens }
   auto(output, false); { automatic terminal off }
   bcolor(output, cyan); { color the background }
   page; { clear to that }
   bcolor(output, magenta);
   prtmid(1, '******* Mine game 1.0 ********'); { output title }
   { find center board position }
   centerx := maxx(output) div 2-maxxs div 2;
   centery := maxy(output) div 2-maxys div 2;
   { draw a border around that }
   tbox(centerx-1, centery-1, centerx+maxxs, centery+maxys, ' ', blue, black);
   bcolor(output, white); { restore the background }
   rndseq := 1;
   clear; { set up board }
   display; { display board }
   done := false; { set game in progress }
   cursorx := centerx; { set inital cursor position }
   cursory := centery;
   badguess := false; { set bad guesses invisible }
   repeat { enter user moves }

      cursor(output, cursorx, cursory); { place cursor }
      x := cursorx-centerx+1; { set location on board }
      y := cursory-centery+1;
      event(input, er); { get the next event }
      if er.etype in [ettab, etenter, etup, etdown, etleft, etright,
                      etmoumov, etmouba] then
         case er.etype of { event }

         ettab: begin { process flag }

            { reverse flagging on location }
            board[x, y].flag := not board[x, y].flag;
            display { redisplay board }

         end;
         etenter: hit(x, y); { process hit }
         { move up }
         etup: if cursory > centery then cursory := cursory-1;
         { move left }
         etleft: if cursorx > centerx then cursorx := cursorx-1;
         { move down }
         etdown: if cursory < centery+maxys-1 then cursory := cursory+1;
         { move right }
         etright: if cursorx < centerx+maxxs-1 then cursorx := cursorx+1;
         etmoumov: begin { mouse movement }

            mousex := er.moupx; { set new mouse position }
            mousey := er.moupy

         end;
         etmouba: { mouse button 1, hit }
            if (mousex >= centerx) and (mousex <= centerx+maxxs-1) and
               (mousey >= centery) and (mousey <= centery+maxys-1) then begin

               { mouse postion inside valid square }
               cursorx := mousex; { set current position to that }
               cursory := mousey;
               x := cursorx-centerx+1; { set location on board }
               y := cursory-centery+1;
               if er.amoubn = 1 then hit(x, y) { process hit }
               else if er.amoubn = 2 then begin { process flag }

                  { reverse flagging on location }
                  board[x, y].flag := not board[x, y].flag;
                  display { redisplay board }

               end

         end

  

      end

   until done or (er.etype = etterm); { game complete }
   auto(output, true); { automatic terminal off }
   select(output, 1, 1) { restore screen }
   
end.