!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                              !
! 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.       !
!                                                                              !
! Derived from the Pascal version.                                             !
!                                                                              !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! helper defines

false% = 0
true% = -1

! colors

black%   = 0
white%   = 1
red%     = 2
green%   = 3
blue%    = 4
cyan%    = 5
yellow%  = 6
magenta% = 7

! events

etchar%    = 0  ! ANSI character returned
etup%      = 1  ! cursor up one line
etdown%    = 2  ! down one line
etleft%    = 3  ! left one character
etright%   = 4  ! right one character
etleftw%   = 5  ! left one word
etrightw%  = 6  ! right one word
ethome%    = 7  ! home of document
ethomes%   = 8  ! home of screen
ethomel%   = 9  ! home of line
etend%     = 10 ! end of document
etends%    = 11 ! end of screen
etendl%    = 12 ! end of line
etscrl%    = 13 ! scroll left one character
etscrr%    = 14 ! scroll right one character
etscru%    = 15 ! scroll up one line
etscrd%    = 16 ! scroll down one line
etpagd%    = 17 ! page down
etpagu%    = 18 ! page up
ettab%     = 19 ! tab
etenter%   = 20 ! enter line
etinsert%  = 21 ! insert block
etinsertl% = 22 ! insert line
etinsertt% = 23 ! insert toggle
etdel%     = 24 ! delete block
etdell%    = 25 ! delete line
etdelcf%   = 26 ! delete character forward
etdelcb%   = 27 ! delete character backward
etcopy%    = 28 ! copy block
etcopyl%   = 29 ! copy line
etcan%     = 30 ! cancel current operation
etstop%    = 31 ! stop current operation
etcont%    = 32 ! continue current operation
etprint%   = 33 ! print document
etprintb%  = 34 ! print block
etprints%  = 35 ! print screen
etfun%     = 36 ! function key
etmenu%    = 46 ! display menu
etmouba%   = 47 ! mouse button assertion
etmoubd%   = 51 ! mouse button deassertion
etmoumov%  = 55 ! mouse move
ettim%     = 56 ! timer matures
etjoyba%   = 57 ! joystick button assertion
etjoybd%   = 58 ! joystick button deassertion
etjoymov%  = 59 ! joystick move
etterm%    = 60 ! terminate program

! program defines

maxxs%   = 8 ! size of grid
maxys%   = 8
maxmine% = 10 ! number of mines to place

dim mine%(maxxs%, maxys%) ! mine exists map
dim vis%(maxxs%, maxys%)  ! square is uncovered map
dim flag%(maxxs%, maxys%) ! square is flagged map

! Contruct table to calculate adjacent squares

dim xoff%(8) ! x offset table
dim yoff%(8) ! y offset table

xoff%(1) =  0: yoff%(1) = -1 ! up
xoff%(2) = +1: yoff%(2) = -1 ! upper right
xoff%(3) = +1: yoff%(3) =  0 ! right
xoff%(4) = +1: yoff%(4) = +1 ! lower right
xoff%(5) =  0: yoff%(5) = +1 ! down
xoff%(6) = -1: yoff%(6) = +1 ! lower left
xoff%(7) = -1: yoff%(7) =  0 ! left
xoff%(8) = -1: yoff%(8) = -1 ! upper left

! declares, not required but nice

dim x%, y%    ! user move coordinates
dim done%     ! game over
dim centerx%  ! center of screen position x
dim centery%  ! center of screen position y
dim cursorx%  ! cursor location x
dim cursory%  ! cursor location y
dim badguess% ! bad guess display flag
dim mousex%   ! mouse position x
dim mousey%   ! mouse position y

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
! Find adjacent mines
!
! Finds the number of mines adjacent to a given square.
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

function adjacent%(x%, y%)

dim mines%   ! number of mines
dim xn%, yn% ! neighbor coordinates }
dim i%       ! index for move array }
 
mines% = 0 ! clear mine count
for i% = 1 to 8 ! process points of the compass

   xn% = x%+xoff%(i%) ! find neighbor locations
   yn% = y%+yoff%(i%)
   if xn% >= 1 and xn% <= maxxs% and yn% >= 1 and yn% <= maxys% then

      ! valid location
      if mine%(xn%, yn%) then mines% = mines%+1 ! count mines

   endif

next i%

endfunc mines% ! return the number of mines

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
! 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%)

dim xn%, yn% ! neighbor coordinates
dim i%       ! index for move array
 
for i% = 1 to 8 ! process points of the compass

   xn% = x%+xoff%(i%) ! find neighbor locations
   yn% = y%+yoff%(i%)
   if xn% >= 1 and xn% <= maxxs% and yn% >= 1 and yn% <= maxys% then

      if not vis%(xn%, yn%) then ! not already visable

         ! valid location
         vis%(xn%, yn%) = true% ! set visable
         if adjacent%(xn%, yn%) = 0 then visadj(xn%, yn%) ! perform recursively

      endif

   endif

next i%

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
! Display board
! 
! Displays the playing board.
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
procedure display

dim x%
dim y%
dim cnt% ! count of adjacent mines
 
! scan screen
bcolor(yellow%) ! set background color
for y% = 1 to maxys%

   for x% = 1 to maxxs%
   
      cursor(centerx%+x%-1, centery%+y%-1) ! set start of next line
      if vis%(x%, y%) then

         if mine%(x%, y%) then print "*"; else

            cnt% = adjacent%(x%, y%) ! find adjacent mine count
            if cnt% = 0 then
               print "." ! no adjacent
            else
               print chr$(cnt%+asc("0")); ! place the number
            endif

         endif

      else if flag%(x%, y%) then ! display flagged location

         if badguess% then print "X"; else print "M";

      else print "=";
      endif

   next x%

next y%
print

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
! 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 clrbrd
 
dim x%
dim y%
dim n%
 
for x% = 1 to maxxs% ! clear minefield

   for y% = 1 to maxys%

      mine%(x%, y%) = false ! set no mine
      vis%(x%, y%) = false ! set not visible
      flag%(x%, y%) = false ! set not flagged

   next y%

next x%
for n% = 1 to maxmine ! place mine

   repeat

      x% = rnd(0)*maxxs%
      y% = rnd(0)*maxys%

   until not mine%(x%, y%) ! no mine exists at square
   mine%(x%, y%) = true ! place mine

next n%

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Clear line
!
! Clears the specified line to spaces in the specified color.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

procedure clrlin(y%, clr%)

dim i%

cursor(1, y%) ! position to specified line
bcolor(clr%) ! set color
for i% = 1 to maxx% do print " "; ! clear line

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Print centered string
!
! Prints the given string centered on the given line.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

procedure prtmid(y%, s$)

cursor(maxx% div 2-len(s$) div 2, y%) ! position to start
print s$; ! output the string

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! 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%, ex%, ey%, c$, bclr%, fclr%)

dim x%, y% ! coordinates

bcolor(bclr%)
fcolor(fclr%)
cursor(sx%, sy%) ! position at box top left
for x% = sx% to ex%: print c$;: next x% ! draw box top
cursor(sx%, ey%) ! position at box lower left
for x% = sx% to ex%: print c$;: next x% ! draw box bottom
for y% = sy%+1 to ey%-1 ! draw box left side

   cursor(sx%, y%) ! place cursor
   print c$; ! place character

next y%
for y% = sy%+1 to ey%-1 ! draw box left side

   cursor(ex%, y%) ! place cursor
   print c$; ! place character

next y%

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Check coordinates on board
!
! Checks if the given x, y coordinates are in the valid playing area..
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

function insquare%(x%, y%)

dim inx% ! inside x
dim iny% ! inside y

inx% = mousex% >= centerx% and mousex% <= centerx%+maxxs%-1 ! find x
iny% = mousey% >= centery% and mousey% <= centery%+maxys%-1 ! find y

endfunc inx% and iny%

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! 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

! ask user for replay
bcolor(cyan%)
prtmid(maxy%, "PLAY AGAIN (Y/N) ?")
repeat ! wait for response

   ! wait till a character is pressed
   repeat

      event(nextevent)

   until nextevent.etype = etchar% or nextevent.etype = etterm%
   if nextevent.etype = etterm% then done% = true% ! force a quit

until lcase(nextevent.char$) = "y" or lcase(nextevent.char) = "n" or done%
if lcase(nextevent.char$) = "n" or done% then done% = true% else

   ! clear old messages
   clrlin(maxy%-2, cyan%)
   clrlin(maxy%, cyan%)
   ! start new game
   clrbrd ! set up board
   cursorx% = centerx% ! set inital cursor position
   cursory% = centery%
   badguess% = false% ! set bad guesses invisible

endif

endproc

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

procedure hit(x%, y%)

dim xi%, yi% ! indexes for board
dim viscnt% ! visable squares count

vis%(x%, y%) = true% ! set that location visable
if mine%(x%, y%) then ! mine found

   ! make all mines visable, and bad guesses too.
   for yi% = 1 to maxys%

      for xi = 1 to maxxs%

         if mine%(xi%, yi%) then vis%(xi%, yi%) = true%

      next xi%

   next yi%
   badguess% = true% ! set bad guesses visable
   display ! redisplay board
   ! announce that to the player
   bcolor(red%)
   prtmid(maxy%-2, "*** YOU HIT A MINE ! ***")
   replay ! process replay

else ! valid hit

   if adjacent%(x%, y%) = 0 then 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%

      for xi% = 1 to maxxs%

         if vis%(xi%, yi%) then viscnt% = viscnt%+1 ! count visible

      next xi%

   next yi%
   if maxxs%*maxys%-viscnt% = maxmine% then ! player wins

      display ! redisplay board
      ! announce that to the player
      bcolor(red%)
      prtmid(maxy%-2, "*** YOU WIN ! ***")
      replay ! process replay

   endif

endif
display ! redisplay board

endproc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Main process
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

auto(false%) ! turn off scrolling
bcolor(cyan%) ! color the background
clear ! clear to that
bcolor(magenta%)
prtmid(1, "******* Mine game 1.0 ********") ! output title
! find center board position
centerx% = maxx% div 2-maxxs% div 2
centery% = maxy% div 2-maxys% div 2
! draw a border around that
tbox(centerx%-1, centery%-1, centerx%+maxxs%, centery%+maxys%, " ", blue%, black%)
bcolor(white%) ! restore the background
clrbrd ! 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(cursorx%, cursory%) ! place cursor
   x% = cursorx%-centerx%+1 ! set location on board
   y% = cursory-centery+1
   event(nextevent) ! get the next event
   select nextevent.etype% ! event

      case ettab% ! process flag

         ! reverse flagging on location
         flag(x%, y%) = not flag(x%, y%)
         display ! redisplay board

      case etenter%: hit(x%, y%) ! process hit

      ! move up
      case etup%: if cursory% > centery% then cursory% = cursory%-1

      ! move left
      case etleft%: if cursorx% > centerx% then cursorx% = cursorx%-1

      ! move down
      case etdown%: if cursory% < centery%+maxys%-1 then cursory% = cursory%+1

      ! move right
      case etright%: if cursorx% < centerx%+maxxs%-1 then cursorx% = cursorx%+1

      case etmoumov% ! mouse movement

         mousex% = nextevent.moupx% ! set new mouse position
         mousey% = nextevent.moupy%

      case etmouba ! mouse button 1, hit

         if nextevent.amoubn% = 1 and onboard%(mousex%, mousey%) then

            ! 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
            hit(x%, y%) ! process hit

         else if nextevent.amoubn% = 2 and onboard%(mousex%, mousey%) then

            ! 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
            ! reverse flagging on location
            flag(x%, y%) = flag(x%, y%)
            display ! redisplay board

         endif

   endsel

until done% or nextevent.etype% = etterm% ! game complete
auto(true%) ! turn off scrolling
bcolor(white%) ! restore colors
fcolor(black%)
clear ! clear screen

end