DECLARE SUB highscore ()
DECLARE SUB GameWon (time#, mode$)
DECLARE SUB GameOver ()

' Mine sweeper
' by Olle Bergkvist
'
' licensed under the GNU GPL license


' Mouse routines

' I found these mouse routines in ChetOS

' The guy who wrote ChetOS found them somewhere else...
' Thanks to anyone who wrote them :-D
'
' This mouse script uses "CALL ABSOLUTE" and that means you have to load
' QuickBasic with the file QB.QLB. Start QB from the command line in example:
'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ C:\QuickBasic\QB.EXE QB.QLB MOUSE.BAS ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'                        www.olle.tk

DECLARE FUNCTION mouseInit% ()
DECLARE SUB MouseRange (X1%, Y1%, X2%, Y2%)
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB mousePut (mousex%, mousey%)
DECLARE SUB MouseStatus (lb%, rb%, mousex%, mousey%)

COMMON SHARED Mouse$
'ON ERROR GOTO errorhandle  ' error handling. good to use in compiled.

' Puts HEX info into Mouse$
Mouse$ = SPACE$(57)
FOR i% = 1 TO 57
  READ a$
  h$ = CHR$(VAL("&H" + a$))
  MID$(Mouse$, i%, 1) = h$
NEXT i%
  DEF SEG = VARSEG(Mouse$)
mouesadr% = SADD(Mouse$)


' Sets inital varibles for mouse. Detects mouse
ax% = 3
MouseDriver ax%, bx%, cx%, dx%
lb% = ((bx% AND 1) <> 0)
rb% = ((bx% AND 2) <> 0)
mousex% = cx%
mousey% = dx%
'mouseInit

MouseDriver 0, 0, 0, 0
MouseRange 0, 0, 636, 477

'mouseShow  ' This shows the mouse cursor. Only use it in fullscreen programs.
' It HIDES the cursor in compiled window program! (With this computer...)
'MouseDriver 1, 0, 0, 0

'MouseHide ' Hides the cursor. Not sure how it works compiled.
'MouseDriver 2, 0, 0, 0


' Mouse HEX Assemble Code
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00


' Border characters

'176 °    192 À    208 Ð
'177 ±    193 Á    209 Ñ
'178 ²    194 Â    210 Ò
'179 ³    195 Ã    211 Ó
'180 ´    196 Ä    212 Ô
'181 µ    197 Å    213 Õ
'182 ¶    198 Æ    214 Ö
'183 ·    199 Ç    215 ×
'184 ¸    200 È    216 Ø
'185 ¹    201 É    217 Ù
'186 º    202 Ê    218 Ú
'187 »    203 Ë    219 Û
'188 ¼    204 Ì    220 Ü
'189 ½    205 Í    221 Ý
'190 ¾    206 Î    222 Þ
'191 ¿    207 Ï    223 ß


'############################## Start game #########################
DEFINT A-Z
RANDOMIZE TIMER

'Colors of the numbers
DIM colors(8)
colors(1) = 9
colors(2) = 10
colors(3) = 12
colors(4) = 14
colors(5) = 4
colors(6) = 3
colors(7) = 15
colors(8) = 8

CLS

LOCATE 1, 1

COLOR 0, 15


PRINT "  º Easy (1)º  º Medium (2)º  º Hard (3)º  º Highscore (4)º    º Exit (Esc)º    "

'                ^10       ^20       ^30       ^40       ^50       ^60       ^70
COLOR 14, 0

LOCATE 3, 15
PRINT "Welcome to Mine!"
PRINT

COLOR 15
PRINT "Use the MOUSE 
. Press one of the buttons above to start."
PRINT
PRINT "Made by Olle Bergkvist.                        Version 1.00.00"
PRINT
PRINT
COLOR 12
PRINT "IMPORTANT! If you cant see the mouse cursor, press Backspace."
PRINT "If you have a slow computer you may press F1 to set the delay."
COLOR 15

'----------------------- Re-Menu
remenu:

DO

   DO
      CALL MouseStatus(lbutton, rbutton, mousex, mousey)
      keyn = INP(96)
   LOOP UNTIL lbutton OR rbutton OR (keyn < 129 AND keyn > 0)

   DO
      CALL MouseStatus(lbutton, rbutton, mousex, mousey)
      tempkeyn = INP(96)
      IF NOT (lbutton OR rbutton OR (tempkeyn < 129 AND tempkeyn > 0)) THEN EXIT DO
      leftclick = lbutton
      rightclick = rbutton
      keyn = tempkeyn
   LOOP

   x = INT(mousex / 8)
   y = INT(mousey / 8) - 3


   IF (x > 1 AND x < 13 AND y = -3 AND leftclick) OR keyn = 2 THEN
      xsize = 9
      ysize = 9
      minenum = 10
   END IF

   IF (x > 14 AND x < 28 AND y = -3 AND leftclick) OR keyn = 3 THEN
      xsize = 16
      ysize = 16
      minenum = 40
   END IF

   IF (x > 29 AND x < 41 AND y = -3 AND leftclick) OR keyn = 4 THEN
      xsize = 78
      ysize = 20
      minenum = 200
   END IF
                               
   IF (x > 42 AND x < 59 AND y = -3 AND leftclick) OR keyn = 5 THEN highscore


   IF (x > 62 AND x < 76 AND y = -3 AND leftclick) OR keyn = 1 THEN END

   IF keyn = 14 THEN PRINT "Wait...": MouseDriver 1, 0, 0, 0: PRINT "Mouse status changed!"

   IF keyn = 59 THEN INPUT "Number of loops between timer is printed:", delay

LOOP UNTIL minenum
                   

'----------------------- End beginning -----------------------
restart:
REDIM place(xsize, ysize)
REDIM mines(minenum, 2)
'REDIM spacex(xsize * ysize / 8, xsize * ysize)
'REDIM spacey(xsize * ysize / 8, xsize * ysize)
REDIM space(minenum, xsize * ysize, 2) 'REDIM space(xsize * ysize / 8, xsize * ysize, 2)
REDIM border(minenum, xsize * ysize, 2) 'REDIM border(xsize * ysize / 8, xsize * ysize, 2)
REDIM spacenum(minenum) 'REDIM spacenum(xsize * ysize / 8)
REDIM bordernum(minenum) 'REDIM bordernum(xsize * ysize / 8)
REDIM opened(xsize, ysize)
REDIM marked(xsize, ysize)

LOCATE 1, 1

COLOR 0, 15


PRINT "  º Easy (1)º  º Medium (2)º  º Hard (3)º  º Highscore (4)º    º Exit (Esc)º    "

' Clear screen
    
COLOR 14, 0

FOR a = 2 TO 25
   LOCATE a, 1
   PRINT STRING$(80, 32);
NEXT a

' Print borders

LOCATE 2, 1
PRINT CHR$(186) + SPACE$(xsize) + CHR$(186);
LOCATE 3, 1
PRINT CHR$(186) + SPACE$(xsize) + CHR$(186);
LOCATE 4, 1
PRINT CHR$(204) + STRING$(xsize, 205) + CHR$(185);

FOR n = 5 TO ysize + 4
   LOCATE n, 1
   PRINT CHR$(186) + SPACE$(xsize) + CHR$(186);
NEXT n

LOCATE ysize + 5, 1
PRINT CHR$(200) + STRING$(xsize, 205) + CHR$(188);

LOCATE 2, 2
PRINT LTRIM$(STR$(minenum)); " mines"


' locate mines

FOR n = 1 TO minenum

   DO
      x = INT(xsize * RND) + 1
      y = INT(ysize * RND) + 1
   LOOP WHILE place(x, y)

   mines(n, 1) = x
   mines(n, 2) = y

   place(x, y) = 9

NEXT n

' locate numbers

FOR x = 1 TO xsize
FOR y = 1 TO ysize

   IF place(x, y) = 0 THEN

      num = 0

      FOR xp = x - 1 TO x + 1
      FOR yp = y - 1 TO y + 1

         IF xp > 0 AND yp > 0 AND xp <= xsize AND yp <= ysize THEN
            IF place(xp, yp) = 9 THEN num = num + 1
         END IF

      NEXT yp, xp

      place(x, y) = num
   END IF


NEXT y, x

' ------------------------------------------------------
' Find empty fields, and group them in array space(,)
 
spacen = 0
DO '------------------------------------'|
spacen = spacen + 1                     '|
                                        '|
' Find a new zero
FOR x = 1 TO xsize
FOR y = 1 TO ysize

   IF place(x, y) = 0 THEN
      GOTO foundazero
   ELSEIF x = xsize AND y = ysize THEN GOTO nozero
   END IF

NEXT y, x

foundazero:
sqrn = 1
place(x, y) = -spacen
space(spacen, sqrn, 1) = x
space(spacen, sqrn, 2) = y


' Find surrounding zeros
DO
   found = 0
   FOR xt = 1 TO xsize
   FOR yt = 1 TO ysize
      
      IF place(xt, yt) = 0 THEN
         num = 0

         FOR xp = xt - 1 TO xt + 1
         FOR yp = yt - 1 TO yt + 1

            IF xp > 0 AND yp > 0 AND xp <= xsize AND yp <= ysize THEN
               IF place(xp, yp) = -spacen THEN num = 1
            END IF

         NEXT yp, xp

         IF num THEN
            found = 1
            sqrn = sqrn + 1
            place(xt, yt) = -spacen
            space(spacen, sqrn, 1) = xt
            space(spacen, sqrn, 2) = yt
         END IF

      END IF


   NEXT yt, xt

LOOP WHILE found

spacenum(spacen) = sqrn


' Find the surrounding numbers

sqrn = 0

FOR xt = 1 TO xsize
FOR yt = 1 TO ysize

   IF place(xt, yt) > 0 THEN
      num = 0

      FOR xp = xt - 1 TO xt + 1
      FOR yp = yt - 1 TO yt + 1

         IF (xp - xt OR yp - yt) AND xp > 0 AND yp > 0 AND xp <= xsize AND yp <= ysize THEN
            IF place(xp, yp) = -spacen THEN num = 1
         END IF

      NEXT yp, xp

      IF num THEN
         sqrn = sqrn + 1
         border(spacen, sqrn, 1) = xt
         border(spacen, sqrn, 2) = yt
      END IF

   END IF

NEXT yt, xt

bordernum(spacen) = sqrn
                                        '|
                                        '|
LOOP '-----------------------------------|

nozero: '----------------- start game
opened = 0
minesleft = minenum
IF delay = 0 THEN delay = 1

DO
   CALL MouseStatus(lbutton, rbutton, mousex, mousey)
   keyn = INP(96)
LOOP UNTIL lbutton OR rbutton OR (keyn < 129 AND keyn > 0)

DO
   CALL MouseStatus(lbutton, rbutton, mousex, mousey)
   IF NOT (lbutton OR rbutton OR (INP(96) < 129 AND INP(96) > 0)) THEN EXIT DO
   leftclick = lbutton
   rightclick = rbutton
   keyn = INP(96)
LOOP

startat# = TIMER
GOTO jumpingame

' -----------------------------------------------------------------
' start main loop


DO '------------------------------------'|
                                        '|
                                        '|

COLOR 14

DO
   r = r + 1
   IF r = delay THEN
      r = 0
      LOCATE 3, xsize - 8
      time# = TIMER - startat#
      PRINT LTRIM$(STR$(time#))
   END IF
   CALL MouseStatus(lbutton, rbutton, mousex, mousey)
   keyn = INP(96)
LOOP UNTIL lbutton OR rbutton OR (keyn < 129 AND keyn > 0)

DO
   r = r + 1
   IF r = delay THEN
      r = 0
      LOCATE 3, xsize - 8
      time# = TIMER - startat#
      PRINT LTRIM$(STR$(time#))
   END IF
   CALL MouseStatus(lbutton, rbutton, mousex, mousey)
   IF NOT (lbutton OR rbutton OR (INP(96) < 129 AND INP(96) > 0)) THEN EXIT DO
   leftclick = lbutton
   rightclick = rbutton
   keyn = INP(96)
LOOP

jumpingame:
x = INT(mousex / 8)
y = INT(mousey / 8) - 3


IF (x > 1 AND x < 13 AND y = -3 AND leftclick) OR keyn = 2 THEN
   xsize = 9
   ysize = 9
   minenum = 10
   GOTO restart
END IF

IF (x > 14 AND x < 28 AND y = -3 AND leftclick) OR keyn = 3 THEN
   xsize = 16
   ysize = 16
   minenum = 40
   GOTO restart
END IF

IF (x > 29 AND x < 41 AND y = -3 AND leftclick) OR keyn = 4 THEN
   xsize = 78
   ysize = 20
   minenum = 200
   GOTO restart
END IF

IF (x > 42 AND x < 59 AND y = -3 AND leftclick) OR keyn = 5 THEN highscore

IF (x > 62 AND x < 76 AND y = -3 AND leftclick) OR keyn = 1 THEN END





IF x > 0 AND x <= xsize AND y > 0 AND y <= ysize THEN '------ click in field
num = place(x, y)

IF leftclick THEN '/////////////// left-click
   IF num = 9 THEN GameOver: GOTO remenu ' ##### Game Over

   IF num > 0 AND opened(x, y) = 0 THEN   ' show number
      LOCATE y + 4, x + 1
      COLOR colors(num)
      PRINT CHR$(num + 48);
      opened(x, y) = 1
      opened = opened + 1
      IF marked(x, y) THEN minesleft = minesleft + 1: marked(x, y) = 0
   END IF

   IF num < 0 AND opened(x, y) = 0 THEN
      spacen = -num
      zeros = spacenum(spacen)

      FOR n = 1 TO zeros           ' open field
         xl = space(spacen, n, 1)
         yl = space(spacen, n, 2)
         LOCATE yl + 4, xl + 1
         COLOR 15
         PRINT CHR$(178);
         opened(xl, yl) = 1
         opened = opened + 1
      NEXT
      bordern = bordernum(spacen)
      FOR n = 1 TO bordern         ' show surrounding numbers
         xl = border(spacen, n, 1)
         yl = border(spacen, n, 2)
         IF opened(xl, yl) = 0 THEN    ' if not already opened
            bordersqr = place(xl, yl)
            LOCATE yl + 4, xl + 1
            COLOR colors(bordersqr)
            PRINT CHR$(bordersqr + 48);
            opened(xl, yl) = 1
            opened = opened + 1
            IF marked(x, y) THEN minesleft = minesleft + 1: marked(x, y) = 0
         END IF
      NEXT

   END IF

END IF '\\\\\\\\\\\\\\\\\\\\\\\\\\\


IF rightclick AND opened(x, y) = 0 THEN '////////////////  right-click

   COLOR 15, 0
   LOCATE y + 4, x + 1

   IF marked(x, y) THEN
      marked(x, y) = 0
      PRINT " "
      minesleft = minesleft + 1
   ELSE
      marked(x, y) = 1
      PRINT CHR$(20)
      minesleft = minesleft - 1
   END IF

   LOCATE 2, 2
   COLOR 14
   PRINT LTRIM$(STR$(minesleft)); " mines"

END IF '\\\\\\\\\\\\\\\\\\\\\\\


IF opened = xsize * ysize - minenum THEN CALL GameWon(time#, LTRIM$(STR$(minenum))): GOTO remenu' ###### Game Won

IF opened > xsize * ysize - minenum THEN PRINT "Theres a bug in the game! Please tell the programmer this: overflow in 'opened'"

ELSE '---------- end click in field

   'GOTO remenu:  '------- click outside field

END IF


                                        '|
                                        '|
LOOP '-----------------------------------|


errorhandle:

errn = ERR
PRINT "An error has occured. The error code is:"; errn

ERROR errn

SUB GameOver

SHARED mines()
SHARED minenum

FOR n = 1 TO minenum
  mx = mines(n, 1)
  my = mines(n, 2)

  COLOR 12
  LOCATE my + 4, mx + 1
  PRINT CHR$(178);

NEXT

FOR a = 10 TO 20
  LOCATE a, 20
  PRINT SPACE$(20)
NEXT

COLOR 15

LOCATE 15, 25

PRINT "Game over!"


END SUB

SUB GameWon (time#, mode$)

SHARED mines()
SHARED minenum

FOR n = 1 TO minenum
  mx = mines(n, 1)
  my = mines(n, 2)

  COLOR 15
  LOCATE my + 4, mx + 1
  PRINT CHR$(244);

NEXT



path$ = ENVIRON$("APPDATA")  '--- for windows 2000 or xp

'--- for older windows:
IF path$ = "" THEN path$ = ENVIRON$("windir")

IF path$ <> "" THEN CHDIR path$

file$ = "mine" + mode$ + ".dat"
 
OPEN file$ FOR APPEND AS #1
PRINT #1, "0"
CLOSE
       
OPEN file$ FOR INPUT AS #1
INPUT #1, high#
CLOSE

IF high# > time# THEN high# = time#
OPEN file$ FOR OUTPUT AS #1
PRINT #1, high#
CLOSE
 

FOR a = 10 TO 20
  LOCATE a, 20
  PRINT SPACE$(30)
NEXT

COLOR 15

LOCATE 12, 25
PRINT "You won!"

LOCATE 14, 25
PRINT "Highscore:"; high#

                                                            
END SUB

SUB highscore

COLOR 15

FOR a = 10 TO 20
LOCATE a, 20
PRINT SPACE$(30)
NEXT


path$ = ENVIRON$("APPDATA")  '--- for windows 2000 or xp

'--- for older windows:
IF path$ = "" THEN path$ = ENVIRON$("windir")

IF path$ <> "" THEN CHDIR path$


FOR lev = 1 TO 3


SELECT CASE lev
CASE 1
  ext$ = "10"
CASE 2
  ext$ = "40"
CASE 3
  ext$ = "200"
END SELECT


file$ = "mine" + ext$ + ".dat"

OPEN file$ FOR APPEND AS #1
PRINT #1, "0"
CLOSE
      
OPEN file$ FOR INPUT AS #1
INPUT #1, high#
CLOSE

OPEN file$ FOR OUTPUT AS #1
PRINT #1, high#
CLOSE




LOCATE 10 + 2 * lev, 25
PRINT ext$; " mines:  "; high#


NEXT


END SUB

DEFSNG A-Z
SUB MouseDriver (ax%, bx%, cx%, dx%)
CALL Absolute(ax%, bx%, cx%, dx%, SADD(Mouse$))
END SUB

DEFINT A-Z
SUB mousePut (mousex%, mousey%)
ax% = 4
cx% = mousex%
dx% = mousey
MouseDriver ax%, 0, cx%, dx%


END SUB

DEFLNG A-Z
SUB MouseRange (X1%, Y1%, X2%, Y2%)
MRLeft% = X1%
MRRight% = X2%
MRTop% = Y1%
MRBot% = Y2%
       
ax% = 7
cx% = X1%
dx% = X2%
MouseDriver ax%, 0, cx%, dx%
ax% = 8
cx% = Y1%
dx% = Y2%
MouseDriver ax%, 0, cx%, dx%

END SUB

DEFSNG A-Z
 SUB MouseStatus (lb%, rb%, mousex%, mousey%)
' Mouse code that I didn't write, It gets the coord's for the mouse.
MouseDriver 3, bx%, cx%, dx%
lb% = ((bx% AND 1) <> 0)
rb% = ((bx% AND 2) <> 0)
mousex% = cx%
mousey% = dx%
         
END SUB