'===========================================================================
' Subject: MINESWEEPER FOR QBASIC             Date: 04-30-97 (01:22)       
'  Author: Lennaert van den Linden            Code: QB, QBasic, PDS        
'  Origin: luckyone@xs4all.nl               Packet: GAMES.ABC
'===========================================================================
' MineSweeper for QBasic 1.1

' I wrote this a couple of months ago in a version for QB4.5 and even
' modified it for QBasic, but accidentally deleted it :(
' But it's better off this way. Since the interrupt routine I used back then
' only supported registers ax, bx, cx en dx. Now there's a cool mouse cursor
' included!

' Anyway, it is terribly slow, even on a P100 and if anyone has any ideas on
' speeding it up, please let me know. I also didn't bother writing a routine
' to save highscores. Maybe if there's demand for it (although I seriously
' doubt it) I may implement it in a future release.

' It requires a VGA-card and a mouse.

' Please E-Mail any comments to : L.L.vanderLinden@st.hhs.nl

' This program, and the source code in it, is free for you to use, as long
' as you mention the author and you won't sell it for profit.

' Lennaert van der Linden.


' Assembly routine for calling interrupts in QBasic by Rick Elbers.
' Quake routine by William Yu. Modified to support monochrome as well,
' although it has not been tested yet.
' Text printing routine by Douglas H. Lusher.

' $STATIC

DEFINT A-Z

DECLARE SUB int86X ()
DECLARE SUB quake ()
DECLARE SUB ExitProgram ()
DECLARE SUB Menu ()
DECLARE SUB WaitForKeyOrClick ()
DECLARE SUB ClearBoard ()
DECLARE SUB ShowMines ()
DECLARE SUB SetNewMouseCursor ()
DECLARE FUNCTION rightmousebutton ()
DECLARE SUB ToggleFlag ()
DECLARE SUB UpdateClock ()
DECLARE SUB StartClock ()
DECLARE FUNCTION CheckButton (a$)
DECLARE SUB OpenSurrounding (sx, sy)
DECLARE SUB RevealButton (x, y)
DECLARE SUB CreateField ()
DECLARE SUB mouse (t)
DECLARE FUNCTION leftmousebutton ()
DECLARE FUNCTION Twilight$ ()
DECLARE FUNCTION IniMouse ()
DECLARE SUB nprint (n, digits)
DECLARE SUB DrawField ()
DECLARE SUB glocate (y, x)
DECLARE SUB gprint (Text$, Culler)
DECLARE SUB CreateItems ()
DECLARE SUB AllBlack ()
DECLARE SUB DrawData ()

' buttons
DIM SHARED Button.Blank(65) AS INTEGER, Button.Unsure(65) AS INTEGER
DIM SHARED button.flag(65) AS INTEGER, button.surr(65, 8) AS INTEGER
DIM SHARED Button.Mine(65) AS INTEGER, Button.Wrongmine(65) AS INTEGER
DIM SHARED button.mineboom(65) AS INTEGER

DIM SHARED gpos(1) AS INTEGER   ' For Use with printing routines
DIM SHARED xsize AS INTEGER     '
DIM SHARED ysize AS INTEGER     '
DIM SHARED xst AS INTEGER       ' upperleft position of field on
DIM SHARED yst AS INTEGER       ' the screen.
DIM SHARED MineField(-1 TO 40, -1 TO 28) AS INTEGER  ' Contains nums & mines
DIM SHARED MineTags(-1 TO 40, -1 TO 28) AS INTEGER   ' Contains Tags (Flags,?)
DIM SHARED mines AS INTEGER                          ' Total # of mines
DIM SHARED MinesLeft AS INTEGER                      ' Number of Tiles w flags
DIM SHARED mousethings(2) AS INTEGER                 ' for mouse routines
DIM SHARED StartingTime AS LONG                      ' Time when started
DIM SHARED PassedSeconds AS INTEGER                  ' Time Passed Away
DIM SHARED YetToReveal AS INTEGER                    ' Buttons to reveal

DIM SHARED Intx(60) AS INTEGER                       ' These two are for
DIM SHARED regs(10) AS INTEGER                       ' the interrupt calling
							' routine.


' This is the default configuration
xsize = 8          ' Number of buttons/tiles horizontally
ysize = 8          '    "    "    "          vertically
mines = 10         ' duh

RANDOMIZE TIMER ' make sure you get a different field each time

' These 3 lines are for the routine to call interrupts in QBasic
CALL int86X
CONST IntNr = 0, ax = 1, bx = 2, cx = 3, dx = 4, bp = 5, si = 6, ds = 7
CONST di = 8, es = 9, flags = 10

IF IniMouse = 0 THEN   ' No mouse, no play!
	SCREEN 0, , 0, 0: CLS
	PRINT " Mouse not detected."
	PRINT " Sorry, this program does not work if a mouse can not be"
	PRINT " detected."
	END
END IF

SCREEN 12: CLS  ' VGA 640x480 16 colors
AllBlack
CreateItems     ' Secretly create items in the dark...
PALETTE         ' Restore Colors

LINE (0, 0)-(639, 479), 1, BF           ' Setup Screen
LINE (0, 0)-(639, 15), 15, BF
LINE (0, 464)-(639, 479), 15, BF
glocate 1, 2: gprint "Mine Sweeper not for Windows version 0.10 -", 0
glocate 1, 46: gprint "Written by Lennaert van der Linden", 0
glocate 30, 2: gprint "Mines :       Time :", 0


SetNewMouseCursor                  ' Define the odd mousepointer

Continue = -1

DO

Menu

ClearBoard ' Clear the menu
mouse 1         ' mouse on

'Starting Game... Setting a few variables...
MinesLeft = mines                       ' Numbers of mines left
YetToReveal = (xsize * ysize) - mines   ' Calculate number of buttons to
					' reveal
glocate 30, 10: nprint MinesLeft, 4     ' Print the number of mines left.

CreateField                   ' Create the minefield
mouse 0
DrawField                     ' Draw The MineField
mouse 1
ClockHasStarted = 0          ' Stop the 'clock'
PassedSeconds = 0

glocate 30, 23
nprint 0, 3

' In-Game Routine
WHILE INKEY$ <> CHR$(27) AND (YetToReveal > 0)
IF leftmousebutton THEN        ' See if left mousebutton was pressed
	a$ = Twilight$
	IF LEFT$(a$, 1) = "Y" THEN
		e = CheckButton(a$)
		IF e = -1 THEN YetToReveal = -1  ' Pressed a Mine
		IF ClockHasStarted = 0 THEN
			StartClock                ' 1st move, start the
			ClockHasStarted = -1     ' clock!
		END IF
	END IF
END IF
IF rightmousebutton THEN       ' See if right mousebutton was pressed
	ToggleFlag
	WHILE rightmousebutton
	WEND
END IF

IF ClockHasStarted THEN
	UpdateClock             ' Update the timer
END IF

IF YetToReveal = 0 THEN         ' Game over : All non-mines have been cleared
	ShowMines               '             Player has won
ELSEIF YetToReveal = -1 THEN    ' Game over : Player stepped on a mine
	quake                   '             Short EarthQuake-Thing
	ShowMines               '             Player has lost
END IF

WEND

' The Game has ended now
mouse 0

IF YetToReveal = -1 THEN
	glocate 30, 29
	gprint "GAME OVER... Press a key or click mouse to continue", 0
	mouse 1
	WaitForKeyOrClick
	mouse 0
	glocate 30, 29
	gprint "GAME OVER... Press a key or click mouse to continue", 15
ELSEIF YetToReveal = 0 THEN
	glocate 30, 29
	gprint "You Won!     Press a key or click mouse to continue", 0
	mouse 1
	WaitForKeyOrClick
	mouse 0
	glocate 30, 29
	gprint "You Won!     Press a key or click mouse to continue", 15
END IF

ClearBoard

LOOP WHILE Continue

END
' Below follows the data for the buttons of the minefield
' The format is 14x14 16 colors and it's in hexadecimal (f=15).
' The border of the buttons are pre-set (as in defined elsewhere)
DATA fffffffffffff7
DATA f7777777777777
DATA f7770000007777
DATA f7700777700777
DATA f7700777770077
DATA f7770077700777
DATA f7777777007777
DATA f7777700077777
DATA f7777007777777
DATA f7777700777777
DATA f7777777777777
DATA f7777770077777
DATA f7777777777777
DATA 77777777777777

DATA fffffffffffff7
DATA f7777777777777
DATA f7777774407777
DATA f7777444407777
DATA f7444444407777
DATA f7777444407777
DATA f7777774407777
DATA f7777777707777
DATA f7777777707777
DATA f7777777707777
DATA f7777777007777
DATA f7707000000077
DATA f7777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77777711777777
DATA 77777111777777
DATA 77771711777777
DATA 77777711777777
DATA 77777711777777
DATA 77777711777777
DATA 77777711777777
DATA 77777711777777
DATA 77711111111777
DATA 77777777777777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77772222227777
DATA 77222777722277
DATA 77227777772277
DATA 77777777722777
DATA 77777777227777
DATA 77777722277777
DATA 77777227777777
DATA 77772277777777
DATA 77722777777777
DATA 77222222222277
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77700000007777
DATA 77007777700777
DATA 77007777770077
DATA 77777777700777
DATA 77777770007777
DATA 77777777700777
DATA 77777777770077
DATA 77007777770077
DATA 77007777700777
DATA 77700000007777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77777744744777
DATA 77777447744777
DATA 77774477744777
DATA 77744777744777
DATA 77447777744777
DATA 77447777744777
DATA 77444444444477
DATA 77777777744777
DATA 77777777744777
DATA 77777777744777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77555555555577
DATA 77557777777777
DATA 77557777777777
DATA 77557555557777
DATA 77555577755777
DATA 77577777775577
DATA 77777777775577
DATA 77777777775577
DATA 77557777755777
DATA 77755555557777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77776666666777
DATA 77766777776677
DATA 77667777777777
DATA 77667777777777
DATA 77667666666777
DATA 77666677776677
DATA 77667777776677
DATA 77667777776677
DATA 77766777766777
DATA 77776666667777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77888888888877
DATA 77887777778877
DATA 77777777788777
DATA 77777777887777
DATA 77777778877777
DATA 77777788777777
DATA 77777788777777
DATA 77777788777777
DATA 77777788777777
DATA 77777788777777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77711111111777
DATA 77117777771177
DATA 77117777771177
DATA 77117777771177
DATA 77711111111777
DATA 77117777771177
DATA 77117777771177
DATA 77117777771177
DATA 77117777771177
DATA 77711111111777
DATA 77777777777777
DATA 77777777777777

DATA 77777777777777
DATA 77777777777777
DATA 77777707777777
DATA 77707707707777
DATA 77770080077777
DATA 77770880077777
DATA 77000800000777
DATA 77770000077777
DATA 77770000077777
DATA 77707707707777
DATA 77777707777777
DATA 77777777777777
DATA 77777777777777
DATA 77777777777777

DATA ccc7777777ccc7
DATA cccc77777cccc7
DATA ccccc707ccccc7
DATA 7cc0cc0cc0cc77
DATA 77cc00800cc777
DATA 777c08800c7777
DATA 77000800000777
DATA 777c00000c7777
DATA 77cc00000cc777
DATA 7cc0cc0cc0cc77
DATA ccccc707ccccc7
DATA cccc77777cccc7
DATA ccc7777777ccc7
DATA 77777777777777

DATA 77747747777777
DATA 774c44c4474777
DATA 74ceccecc4c477
DATA 74ceeeeeecec47
DATA 74cceeeeeec477
DATA 4ceeefefeec477
DATA 74ceeefecc4777
DATA 74ceefefec4777
DATA 74ceeceeeec477
DATA 74cecceecec477
DATA 774c44ceccc477
DATA 7774774c444777
DATA 77777774777777
DATA 77777777777777

DEFSNG A-Z
SUB AllBlack
' Set all color palette values to 0 (black)
FOR n = 0 TO 15
PALETTE n, 0
NEXT
END SUB

DEFINT A-Z
FUNCTION CheckButton (a$)

x = ASC(MID$(a$, 2, 1))
y = ASC(RIGHT$(a$, 1))

IF MineTags(x, y) = 0 THEN

RevealButton x, y

IF MineField(x, y) = -1 THEN
	MineField(x, y) = 15
	e = -1
ELSE
	MineField(x, y) = MineField(x, y) + 16
	IF MineField(x, y) = 16 THEN OpenSurrounding x, y
	e = 0
END IF

CheckButton = e

END IF

END FUNCTION

' This Sub clears the playing field when game is finished by making the tiles
' disappear 'at random'
SUB ClearBoard

REDIM dis(1119)                        ' Create Random Dissapearing buffer

FOR n = 0 TO 1119                      ' Set up tiles
dis(n) = n
NEXT

FOR n = 0 TO 1118                      ' Shuffle Disappearing tiles
p = n + (INT(RND * 40 * 28) - n)     ' So it looks if tiles are
SWAP dis(n), dis(p)                 ' disappearing at random
NEXT

FOR n = 0 TO 1119                      ' Clear the board
x = dis(n) MOD 40
y = dis(n) \ 40
LINE (x * 16, 16 + y * 16)-(x * 16 + 15, 16 + y * 16 + 15), 1, BF
NEXT

ERASE dis                              ' dump the disappearing buffer

END SUB

SUB CreateField

' wipe the MineField Array AND Minetags Array clean, to make sure there are
' no mines or (invisible) tags left from a previous game.  <- BUG FIX!!
ERASE MineField
ERASE MineTags

' define positions for mines
REDIM r(0 TO xsize * ysize - 1) AS INTEGER      ' Create a dynamic array
FOR n = 0 TO xsize * ysize - 1
r(n) = n
NEXT

' Pick mine positions at random
FOR n = 0 TO mines - 1
p = n + (INT(RND * xsize * ysize) - n)
SWAP r(n), r(p)
NEXT

' Create Field(array) and put the mines in it
FOR n = 0 TO mines - 1
y = r(n) \ xsize
x = r(n) MOD xsize
MineField(x, y) = -1
NEXT n

' Dump the array to randomize the mines
ERASE r

' put in the numbers surrounding the mines
FOR x = 0 TO xsize - 1
FOR y = 0 TO ysize - 1
IF NOT MineField(x, y) = -1 THEN
	acc = 0
	IF MineField(x - 1, y) = -1 THEN acc = acc + 1
	IF MineField(x - 1, y - 1) = -1 THEN acc = acc + 1
	IF MineField(x - 1, y + 1) = -1 THEN acc = acc + 1
	IF MineField(x, y + 1) = -1 THEN acc = acc + 1
	IF MineField(x, y - 1) = -1 THEN acc = acc + 1
	IF MineField(x + 1, y - 1) = -1 THEN acc = acc + 1
	IF MineField(x + 1, y) = -1 THEN acc = acc + 1
	IF MineField(x + 1, y + 1) = -1 THEN acc = acc + 1
	MineField(x, y) = acc
END IF
NEXT y, x
	 
xst = 320 - (xsize * 8)
yst = 240 - (ysize * 8)

END SUB

DEFSNG A-Z
SUB CreateItems
LINE (0, 0)-(15, 15), 7, BF
LINE (0, 0)-(15, 15), 15, B
LINE (1, 15)-(15, 15), 8
LINE -(15, 1), 8
LINE (1, 1)-(14, 1), 15
LINE (1, 1)-(1, 14), 15
GET (0, 0)-(15, 15), Button.Blank
DrawData
GET (0, 0)-(15, 15), Button.Unsure
PUT (0, 0), Button.Blank, PSET
DrawData
GET (0, 0)-(15, 15), button.flag
LINE (0, 0)-(15, 15), 8, B
LINE (0, 0)-(14, 14), 7, BF
GET (0, 0)-(15, 15), button.surr(0, 0)
FOR n = 1 TO 8
DrawData
GET (0, 0)-(15, 15), button.surr(0, n)
NEXT
DrawData
GET (0, 0)-(15, 15), Button.Mine
DrawData
GET (0, 0)-(15, 15), Button.Wrongmine
DrawData
GET (0, 0)-(15, 15), button.mineboom
CLS
END SUB

SUB DrawData
FOR y = 1 TO 14
READ x$
FOR x = 1 TO 14
a = VAL("&H" + MID$(x$, x, 1))
PSET (x, y), a
NEXT x, y

END SUB

SUB DrawField
FOR x = 0 TO xsize - 1
FOR y = 0 TO ysize - 1

a = MineField(x, y)

IF a < 16 THEN
	PUT (xst + x * 16, yst + y * 16), Button.Blank, PSET
ELSE
	a = a - 16
	PUT (xst + x * 16, yst + y * 16), button.surr(0, a), PSET
END IF

NEXT y
NEXT x

END SUB

DEFINT A-Z
SUB ExitProgram

SCREEN 0, , 0, 0: WIDTH 80, 25: COLOR 7, 0
PRINT " MineSweeper for QBasic - Lennaert van der Linden 1996-97"
END

END SUB

SUB glocate (y, x)

gpos(0) = (y - 1) * 16
gpos(1) = (x - 1) * 8

END SUB

SUB gprint (Text$, Culler)

x = gpos(1)
y = gpos(0)

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

 DEF SEG = VARSEG(Intx(0))
 regs(IntNr) = &H10
 regs(ax) = &H1130
 regs(bx) = &H600
 CALL absolute(0)
 CharSegment = regs(es): CharOffset = regs(bp)
 CharWid = 8: CharHgt = 16

 DEF SEG = CharSegment
 XX = x
 FOR Char = 1 TO LEN(Text$)
   Ptr = CharHgt * ASC(MID$(Text$, Char, 1)) + CharOffset
   FOR Ln = 0 TO CharHgt - 1
	 BitPattern& = PEEK(Ptr + Ln) * 256&
	 LineFormat = (BitPattern& - 32768) XOR -32768
	 LINE (XX, y + Ln)-STEP(CharWid - 1, 0), Culler, , LineFormat
   NEXT
   XX = XX + CharWid
 NEXT
 DEF SEG

END SUB

DEFSNG A-Z
FUNCTION IniMouse%

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

regs(IntNr) = &H33
regs(ax) = 0
DEF SEG = VARSEG(Intx(0))
CALL absolute(0)
IniMouse = regs(ax)
END FUNCTION

DEFINT A-Z
SUB int86X
'-------------------------------------------------------
'This routine gives credit and thanks to Rusty Angel!
'-------------------------------------------------------
'Pass: regs()1   2   3   4   5   6   7   8   9    10
'Array intnr, ax, bx, cx, dx, bp, si, ds, di, es, flag

'adress: 0    2   4   6   8   a   c       10       14
'displc:      0   2   4   6   8   a       e        12
'-------------------------------------------------------
regseg = VARSEG(regs(0))                                         'clocks bytes

asm$ = ""

'Save ES( no trick available)  
'----------------------------
asm$ = asm$ + CHR$(&H6)                            'push Es          3     01

'Load DS[SI] with regs() and interruptnr to CS:[&h25]
'---------------------------------------------------
asm$ = asm$ + CHR$(&HB8) + MKI$(regseg)            'mov ax,regseg    1     04
asm$ = asm$ + CHR$(&H8E) + CHR$(&HD8)              'mov ds,ax        3     06
asm$ = asm$ + CHR$(&HA1) + MKI$(0)                 'mov ax,[0] intnr 1+5   09
asm$ = asm$ + CHR$(&H2E) + CHR$(&HA2) + MKI$(&H25) 'mov CS[&h25],al  2+9+1 13
asm$ = asm$ + CHR$(&HBE) + CHR$(&H2) + CHR$(0)     'mov si,2         1     16

'Load the registers.                                                    26
'-------------------
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4)              'mov ax,[si]       1+5   18
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5C) + CHR$(&H2) 'mov bx,[si+2]     1+9   21
asm$ = asm$ + CHR$(&H8B) + CHR$(&H4C) + CHR$(&H4) 'mov cx,[si+4]     1+9   24
asm$ = asm$ + CHR$(&H8B) + CHR$(&H54) + CHR$(&H6) 'mov dx,[si+6]     1+9   27
asm$ = asm$ + CHR$(&H87) + CHR$(&H6C) + CHR$(&H8) 'xchg bp,mov [si+8]3+9   30
asm$ = asm$ + CHR$(&HC4) + CHR$(&H7C) + CHR$(&HE) 'les di,[si+E]     6+9   33
asm$ = asm$ + CHR$(&HC5) + CHR$(&H74) + CHR$(&HA) 'lds si,[si+A]     6+9   36

'Execute interrupt                                                      104
'-----------------
asm$ = asm$ + CHR$(&HCD) + CHR$(&H0)              'int nr           26     38

'Set up DS[SI] again to regs and store DS                               130
'-----------------------------------------
asm$ = asm$ + CHR$(&H1E)                          'push ds          3      39
asm$ = asm$ + CHR$(&H2E) + CHR$(&H8E) + CHR$(&H1E) + MKI$(86)'mov ds,cs[0]2+9+1 44
asm$ = asm$ + CHR$(&H89) + CHR$(&H36) + MKI$(&HC) 'mov [c],si       1+9    48
asm$ = asm$ + CHR$(&HBE) + CHR$(&H2) + CHR$(&H0)  'mov si,2         1      51

'Store it!                                                              156
'---------
asm$ = asm$ + CHR$(&H89) + CHR$(&H4)              'mov [si],ax      1+5    53
asm$ = asm$ + CHR$(&H9F)                          'lahf             1      54
asm$ = asm$ + CHR$(&H88) + CHR$(&H64) + CHR$(&H12)'mov [si+12],ah   1+9    57
asm$ = asm$ + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'mov [si+2],bx    1+9    60
asm$ = asm$ + CHR$(&H89) + CHR$(&H4C) + CHR$(&H4) 'mov [si+4],cx    1+9    63
asm$ = asm$ + CHR$(&H89) + CHR$(&H54) + CHR$(&H6) 'mov [si+6],dx    1+9    66
asm$ = asm$ + CHR$(&H87) + CHR$(&H6C) + CHR$(&H8) 'xchg [si+8],bp   3+9    69
asm$ = asm$ + CHR$(&H89) + CHR$(&H7C) + CHR$(&HE) 'mov [si+e],di    1+9    72
asm$ = asm$ + CHR$(&H8C) + CHR$(&H44) + CHR$(&H10)'mov [si+10],es   3+9    75
asm$ = asm$ + CHR$(&H58)                          'pop ax  get ds   4      76
asm$ = asm$ + CHR$(&H89) + CHR$(&H44) + CHR$(&HC) 'mov [si+c] ,ax   1+9    79
'                                                                      251
asm$ = asm$ + CHR$(&H7)                           'pop es           3      80
asm$ = asm$ + CHR$(&HB8) + MKI$(VARSEG(asm$))     'mov ax,stringseg 1      83
asm$ = asm$ + CHR$(&H8E) + CHR$(&HD8)             'mov ds,ax        3      85
asm$ = asm$ + CHR$(&HCB)                          'retf             13     86
'TEMP Storage arrea:
'-------------
asm$ = asm$ + MKI$(regseg)     'segment regs storage         271 clocks   88 bytes

DEF SEG = VARSEG(Intx(0)): FOR i = 0 TO LEN(asm$) - 1:
POKE i, ASC(MID$(asm$, i + 1, 1)): NEXT
DEF SEG

END SUB

FUNCTION leftmousebutton

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

DEF SEG = VARSEG(Intx(0))
regs(IntNr) = &H33
regs(ax) = 3
CALL absolute(0)

IF regs(bx) = 1 THEN leftmousebutton = -1
mousethings(1) = regs(cx)
mousethings(2) = regs(dx)

END FUNCTION

SUB Menu
' This is not the menusystem of the future, but then again, it wasn't
' intended to be.


'Draw The Menu
LINE (150, 145)-(493, 319), 7, BF

LINE (148, 145)-(497, 321), 0, B
LINE (163, 145)-(496, 321), 0, B
LINE (149, 145)-(162, 321), 0, B

LINE (146, 144)-(495, 320), 15, B
LINE (147, 144)-(495, 320), 15, B
LINE (160, 144)-(495, 320), 15, B
LINE (161, 144)-(494, 320), 15, B

glocate 11, 24: gprint "start the game", 0
glocate 13, 24: gprint "tiles horizontal   <<  <        >  >>", 0
glocate 15, 24: gprint "tiles vertical     <<  <        >  >>", 0
glocate 17, 24: gprint "mines              <<  <        >  >>", 0
glocate 19, 24: gprint "exit minesweeper", 0

FOR n = 0 TO 2
LINE (392, 192 + n * 32)-(424, 208 + n * 32), 15, BF
NEXT

glocate 13, 52: nprint xsize, -2
glocate 15, 52: nprint ysize, -2
glocate 17, 50: nprint mines, -4

FOR n = 0 TO 1
LINE (320, 156 + n * 128)-(176, 156 + n * 128), 15
LINE -(176, 179 + n * 128), 15
LINE (177, 179 + n * 128)-(320, 179 + n * 128), 8
LINE -(320, 157 + n * 128), 8
NEXT

FOR o = 0 TO 1
FOR n = 0 TO 2
LINE (380 + o * 72, 188 + n * 32)-(364 + o * 72, 188 + n * 32), 15
LINE -(364 + o * 72, 212 + n * 32), 15
LINE (365 + o * 72, 212 + n * 32)-(380 + o * 72, 212 + n * 32), 8
LINE -(380 + o * 72, 189 + n * 32), 8

LINE (356 + o * 128, 188 + n * 32)-(332 + o * 128, 188 + n * 32), 15
LINE -(332 + o * 128, 212 + n * 32), 15
LINE (333 + o * 128, 212 + n * 32)-(356 + o * 128, 212 + n * 32), 8
LINE -(356 + o * 128, 189 + n * 32), 8

NEXT
NEXT
' Menu is now set up fully
' Now wait for mouseclick & react...


doorgaan = -1
mouse 1


WHILE doorgaan = -1
  
  IF leftmousebutton THEN
	 x = mousethings(1)
	 y = mousethings(2)
	 IF (y > 156) AND (y < 179) THEN        ' Start button
	IF (x > 176) AND (x < 320) THEN
	   doorgaan = 1
	END IF
	 END IF

	 IF y > 285 AND y < 307 THEN        ' Exit button
	IF (x > 176) AND (x < 320) THEN
	   doorgaan = 0
	END IF
	 END IF

	 IF (y > 188) AND (y < 212) THEN        ' one of xsize buttons?
	IF NOT x < 333 THEN
	  IF NOT x > 483 THEN           ' between << and >>?
		IF x < 356 THEN             ' << button
		IF NOT xsize = 8 THEN
		  mouse 0
		  xsize = xsize - 10
		  IF xsize < 8 THEN xsize = 8
		  glocate 13, 52: nprint xsize, -2
			IF mines > (xsize - 1) * (ysize - 1) THEN ' See if there
			  mines = (xsize - 1) * (ysize - 1)    ' are not too many
			  glocate 17, 50: nprint mines, -4     ' mines. update
			END IF                               ' mines if needed
		  mouse 1
		  WHILE leftmousebutton: WEND
		END IF
		ELSE                ' not <<
		  IF x > 460 THEN   ' it's >>
		  IF NOT xsize = 40 THEN
			mouse 0
			xsize = xsize + 10
			IF xsize > 40 THEN xsize = 40
			glocate 13, 52: nprint xsize, -2
			mouse 1
			WHILE leftmousebutton: WEND
		  END IF
		
		  ELSE    ' not << or >>
		IF (x > 364) AND (x < 452) THEN     ' between < and >?
		  IF x < 380 THEN               ' it's the < button
			IF NOT xsize = 8 THEN
			  mouse 0
			  xsize = xsize - 1
			  glocate 13, 52: nprint xsize, -2
			  IF mines > (xsize - 1) * (ysize - 1) THEN ' See if there
			   mines = (xsize - 1) * (ysize - 1)    ' are not too many
			   glocate 17, 50: nprint mines, -4     ' mines. update
			  END IF                               ' mines if needed
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  ELSEIF x > 436 THEN             ' it's the > button.
			IF NOT xsize = 40 THEN
			  mouse 0
			  xsize = xsize + 1
			  glocate 13, 52: nprint xsize, -2
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  END IF
		END IF
		  END IF
		END IF
	  END IF
	END IF
	 END IF


	 IF (y > 221) AND (y < 244) THEN        ' one of ysize buttons?
	IF NOT x < 333 THEN
	  IF NOT x > 483 THEN           ' between << and >>?
		IF x < 356 THEN             ' << button
		IF NOT ysize = 8 THEN
		  mouse 0
		  ysize = ysize - 10
		  IF ysize < 8 THEN ysize = 8
		  glocate 15, 52: nprint ysize, -2
		  IF mines > (xsize - 1) * (ysize - 1) THEN ' See if there are
			mines = (xsize - 1) * (ysize - 1)       ' not too many mines
			glocate 17, 50: nprint mines, -4        ' update mines if
		  END IF                                    ' needed
		  mouse 1
		  WHILE leftmousebutton: WEND
		END IF
		ELSE                ' not <<
		  IF x > 460 THEN   ' it's >>
		  IF NOT ysize = 28 THEN
			mouse 0
			ysize = ysize + 10
			IF ysize > 28 THEN ysize = 28
			glocate 15, 52: nprint ysize, -2
			mouse 1
			WHILE leftmousebutton: WEND
		  END IF
		   
		  ELSE    ' not << or >>
		IF (x > 364) AND (x < 452) THEN     ' between < and >?
		  IF x < 380 THEN               ' it's the < button
			IF NOT ysize = 8 THEN
			  mouse 0
			  ysize = ysize - 1
			  glocate 15, 52: nprint ysize, -2
			  IF mines > (xsize - 1) * (ysize - 1) THEN ' See if there
			mines = (xsize - 1) * (ysize - 1) ' are not too many
			glocate 17, 50: nprint mines, -4  ' mines, update mines if
			  END IF                              ' neccesary
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  ELSEIF x > 436 THEN             ' it's the > button.
			IF NOT ysize = 28 THEN
			  mouse 0
			  ysize = ysize + 1
			  glocate 15, 52: nprint ysize, -2
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  END IF
		END IF
		  END IF
		END IF
	  END IF
	END IF
	 END IF

	
	 IF (y > 253) AND (y < 276) THEN        ' one of mines buttons?
	IF NOT x < 333 THEN
	  IF NOT x > 483 THEN           ' between << and >>?
		IF x < 356 THEN             ' << button
		IF NOT mines = 10 THEN
		  mouse 0
		  mines = mines - 20
		  IF mines < 10 THEN mines = 10
		  glocate 17, 50: nprint mines, -4
		  mouse 1
		  WHILE leftmousebutton: WEND
		END IF
		ELSE                ' not <<
		  IF x > 460 THEN   ' it's >>
		  IF NOT mines = (xsize - 1) * (ysize - 1) THEN
			mouse 0
			mines = mines + 20
			IF mines > (xsize - 1) * (ysize - 1) THEN mines = (xsize - 1) * (ysize - 1)
			glocate 17, 50: nprint mines, -4
			mouse 1
			WHILE leftmousebutton: WEND
		  END IF
		  
		  ELSE    ' not << or >>
		IF (x > 364) AND (x < 452) THEN     ' between < and >?
		  IF x < 380 THEN               ' it's the < button
			IF NOT mines = 10 THEN
			  mouse 0
			  mines = mines - 1
			  glocate 17, 50: nprint mines, -4
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  ELSEIF x > 436 THEN             ' it's the > button.
			IF NOT mines = (xsize - 1) * (ysize - 1) THEN
			  mouse 0
			  mines = mines + 1
			  glocate 17, 50: nprint mines, -4
			  mouse 1
			  WHILE leftmousebutton: WEND
			END IF
		  END IF
		END IF
		  END IF
		END IF
	  END IF
	END IF
	 END IF


  END IF


c$ = INKEY$
IF c$ = CHR$(27) THEN doorgaan = 0


WEND


IF doorgaan = 0 THEN ExitProgram
mouse 0


END SUB

SUB mouse (t)
IF t = mousethings(0) THEN EXIT SUB

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

DEF SEG = VARSEG(Intx(0))
regs(IntNr) = &H33
regs(ax) = 2 - t
CALL absolute(0)

mousethings(0) = 1 - mousethings(0)

END SUB

SUB nprint (n, digits)
IF digits > 0 THEN
	IF n < 0 THEN          ' Leading '-' if negative number (only if
				' digits > 0)
		LINE (gpos(1) - 6, gpos(0) + 7)-(gpos(1) - 3, gpos(0) + 7), 0
	ELSE
		LINE (gpos(1) - 6, gpos(0) + 7)-(gpos(1) - 3, gpos(0) + 7), 15
	END IF
ELSE
	digits = -digits
END IF

x = gpos(1)
y = gpos(0)
n$ = RIGHT$(STRING$(digits, "0") + LTRIM$(STR$(ABS(n))), digits)

FOR a = 1 TO LEN(n$)
b = VAL(MID$(n$, a, 1))
c = 0
SELECT CASE b
	CASE 1
	  c = 2 + 4
	CASE 2
	  c = 1 + 2 + 64 + 16 + 8
	CASE 3
	  c = 1 + 2 + 64 + 4 + 8
	CASE 4
	  c = 2 + 4 + 64 + 32
	CASE 5
	  c = 1 + 32 + 64 + 4 + 8
	CASE 6
	  c = 1 + 32 + 64 + 4 + 8 + 16
	CASE 7
	  c = 1 + 2 + 4
	CASE 8
	  c = 1 + 2 + 4 + 8 + 16 + 32 + 64
	CASE 9
	  c = 1 + 2 + 4 + 8 + 64 + 32
	CASE 0
	  c = 1 + 2 + 4 + 8 + 16 + 32

END SELECT
FOR d = 0 TO 6
IF (c AND (2 ^ d)) = 2 ^ d THEN e = 0 ELSE e = 15
	SELECT CASE d
		CASE 0
			LINE (x + 2, y + 2)-(x + 5, y + 2), e
		CASE 3
			LINE (x + 2, y + 12)-(x + 5, y + 12), e
		CASE 1
			LINE (x + 6, y + 3)-(x + 6, y + 6), e
		CASE 5
			LINE (x + 1, y + 3)-(x + 1, y + 6), e
		CASE 2
			LINE (x + 6, y + 8)-(x + 6, y + 11), e
		CASE 4
			LINE (x + 1, y + 8)-(x + 1, y + 11), e
		CASE 6
			LINE (x + 2, y + 7)-(x + 5, y + 7), e
	END SELECT
NEXT
x = x + 8
NEXT

'.000000000000.
'5............1
'5............1
'5............1
'5............1
'5............1
'.666666666666.
'4............2
'4............2
'4............2
'4............2
'4............2
'4............2
'.333333333333.

END SUB

SUB OpenSurrounding (sx, sy)
' Needs optimizing!

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

IF MineField(x, y) = 16 THEN
	IF MineField(x - 1, y - 1) < 16 THEN
		IF x > 0 AND y > 0 THEN
			RevealButton x - 1, y - 1
			MineField(x - 1, y - 1) = MineField(x - 1, y - 1) + 16
			a = -1
		END IF
	END IF
	IF MineField(x, y - 1) < 16 THEN
		IF y > 0 THEN
			RevealButton x, y - 1
			MineField(x, y - 1) = MineField(x, y - 1) + 16
			a = -1
		END IF
	END IF
	IF MineField(x + 1, y - 1) < 16 THEN
		IF y > 0 AND x < xsize - 1 THEN
			RevealButton x + 1, y - 1
			MineField(x + 1, y - 1) = MineField(x + 1, y - 1) + 16
			a = -1
		END IF
	END IF
	IF MineField(x - 1, y) < 16 THEN
		IF x > 0 THEN
			RevealButton x - 1, y
			MineField(x - 1, y) = MineField(x - 1, y) + 16
			a = -1
		END IF
	END IF
	IF MineField(x + 1, y) < 16 THEN
		IF x < xsize - 1 THEN
			RevealButton x + 1, y
			MineField(x + 1, y) = MineField(x + 1, y) + 16
			a = -1
		END IF
	END IF
	IF MineField(x - 1, y + 1) < 16 THEN
		IF x > 0 AND y < ysize - 1 THEN
			RevealButton x - 1, y + 1
			MineField(x - 1, y + 1) = MineField(x - 1, y + 1) + 16
			a = -1
		END IF
	END IF
	IF MineField(x, y + 1) < 16 THEN
		IF y < ysize - 1 THEN
			RevealButton x, y + 1
			MineField(x, y + 1) = MineField(x, y + 1) + 16
			a = -1
		END IF
	END IF
	IF MineField(x + 1, y + 1) < 16 THEN
		IF x < xsize - 1 AND y < ysize - 1 THEN
			RevealButton x + 1, y + 1
			MineField(x + 1, y + 1) = MineField(x + 1, y + 1) + 16
			a = -1
		END IF
	END IF
END IF
	IF a THEN
		x = x - 2: IF x < 0 THEN x = -1
		y = y - 2: IF y < 0 THEN y = -1
		a = NOT a
	END IF

NEXT
NEXT

END SUB

SUB quake

DEF SEG = 0                             ' Determine the adress of the crt
crtc = PEEK(1123) + 256 * PEEK(1124)    ' controller port. It's &H3D4 for
					' color and &H3B4 for monochrome
					' monitors.

n = 0
StartClock
a& = StartingTime + 9 ' about half a second of shaking...
WHILE StartingTime < a&
OUT crtc, 8
OUT (crtc + 1), n
n = (n + 1) MOD 256
StartClock
WEND
OUT crtc, 8: OUT (crtc + 1), 0
END SUB

SUB RevealButton (x, y)
mouse 0
IF MineField(x, y) < 16 THEN
	IF MineField(x, y) = -1 THEN
	PUT (xst + x * 16, yst + y * 16), button.mineboom, PSET
	ELSE
	PUT (xst + x * 16, yst + y * 16), button.surr(0, MineField(x, y)), PSET
	IF MineTags(x, y) > 0 THEN
		IF MineTags(x, y) = 1 THEN
			MinesLeft = MinesLeft + 1
			glocate 30, 10: nprint MinesLeft, 4
		END IF
		MineTags(x, y) = 0
	END IF
	YetToReveal = YetToReveal - 1
	END IF
END IF
mouse 1
END SUB

FUNCTION rightmousebutton

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

DEF SEG = VARSEG(Intx(0))
regs(IntNr) = &H33
regs(ax) = 3
CALL absolute(0)

mousethings(1) = regs(cx)
mousethings(2) = regs(dx)

IF regs(bx) = 2 THEN rightmousebutton = -1

END FUNCTION

DEFSNG A-Z
SUB SetNewMouseCursor

DIM m(1 TO 32) AS INTEGER

m(1) = &H0
m(2) = &H0
m(3) = &H1
m(4) = &H3
m(5) = &H7
m(6) = &H70F
m(7) = &H707
m(8) = &H783
m(9) = &H1C1
m(10) = &HE0
m(11) = &H41
m(12) = &H3
m(13) = &H407
m(14) = &HE0F
m(15) = &H1F1F
m(16) = &H3FBF
m(17) = &H0
m(18) = &H7FFE
m(19) = &H7FFC
m(20) = &H7FF8
m(21) = &H7030
m(22) = &H7060
m(23) = &H7070
m(24) = &H7038
m(25) = &H701C
m(26) = &H760E
m(27) = &H7F1C
m(28) = &H7BB8
m(29) = &H71F0
m(30) = &H60E0
m(31) = &H4040
m(32) = &H0

DEF SEG = VARSEG(Intx(0))

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

DEF SEG = VARSEG(Intx(0))
regs(IntNr) = &H33
regs(ax) = 9
regs(bx) = 0
regs(cx) = 0
regs(dx) = VARPTR(m(1))
regs(es) = VARSEG(m(1))
CALL absolute(0)

END SUB

SUB ShowComplete
FOR x = 0 TO xsize - 1
FOR y = 0 TO ysize - 1
IF MineField(x, y) = -1 OR MineField(x, y) = 15 THEN
	PUT (xst + x * 16, yst + y * 16), Button.Mine, PSET
ELSE
	PUT (xst + x * 16, yst + y * 16), button.surr(0, MineField(x, y) MOD 16), PSET
END IF
NEXT y, x

END SUB

SUB ShowMines

mouse 0
FOR x = 0 TO xsize - 1
FOR y = 0 TO ysize - 1

	IF MineField(x, y) = -1 THEN
	PUT (xst + x * 16, yst + y * 16), Button.Mine, PSET
	ELSE
	IF MineTags(x, y) = 1 THEN
		PUT (xst + x * 16, yst + y * 16), Button.Wrongmine, PSET
	END IF
	END IF

NEXT y
NEXT x

mouse 1

END SUB

SUB StartClock
DEF SEG = 0
StartingTime = 1& * PEEK(&H46D) * 256 + PEEK(&H46C)
END SUB

SUB ToggleFlag

xm = mousethings(1)
ym = mousethings(2)
flag = 0

IF xm >= xst AND xm < xst + xsize * 16 THEN
	IF ym >= yst AND ym < yst + ysize * 16 THEN
		ox = xst + ((xm - xst) \ 16) * 16: oy = yst + ((ym - yst) \ 16) * 16
		IF MineField((ox - xst) \ 16, (oy - yst) \ 16) < 15 THEN
			flag = -1
		END IF
	END IF
END IF

IF NOT flag THEN EXIT SUB ' Did not press an unrevealed button

rx = (ox - xst) \ 16
ry = (oy - yst) \ 16

flag = MineTags(rx, ry)

mouse 0
SELECT CASE flag
	CASE 0
		PUT (ox, oy), button.flag, PSET
		MinesLeft = MinesLeft - 1
		glocate 30, 10: nprint MinesLeft, 4
	CASE 1
		PUT (ox, oy), Button.Unsure, PSET
		MinesLeft = MinesLeft + 1
		glocate 30, 10: nprint MinesLeft, 4
	CASE 2
		PUT (ox, oy), Button.Blank, PSET
END SELECT
mouse 1

MineTags(rx, ry) = (flag + 1) MOD 3

END SUB

FUNCTION Twilight$
xm = mousethings(1)
ym = mousethings(2)
flag = 0
IF xm >= xst AND xm < xst + xsize * 16 THEN
	IF ym >= yst AND ym < yst + ysize * 16 THEN
		ox = xst + ((xm - xst) \ 16) * 16: oy = yst + ((ym - yst) \ 16) * 16
		IF MineField((ox - xst) \ 16, (oy - yst) \ 16) < 15 THEN
		  IF MineTags((ox - xst) \ 16, (oy - yst) \ 16) = 0 THEN
			flag = 1
			mouse 0
			PUT (ox, oy), button.surr(0, 0), PSET
			mouse 1
		  END IF
		END IF
	END IF
END IF

WHILE leftmousebutton
xm = mousethings(1)
ym = mousethings(2)
IF xm >= xst AND xm < xst + xsize * 16 AND ym >= yst AND ym < yst + ysize * 16 THEN
		IF flag = 1 THEN
			nx = xst + ((xm - xst) \ 16) * 16
			ny = yst + ((ym - yst) \ 16) * 16
			IF NOT ((ox = nx) AND (oy = ny)) THEN
				mouse 0
				PUT (ox, oy), Button.Blank, PSET
				flag = 0
				ox = nx
				oy = ny
				IF MineField((ox - xst) \ 16, (oy - yst) \ 16) < 15 THEN
					IF MineTags((ox - xst) \ 16, (oy - yst) \ 16) = 0 THEN
					PUT (ox, oy), button.surr(0, 0), PSET
					flag = 1
					END IF
				END IF
				mouse 1
			END IF
		ELSE
			ox = xst + ((xm - xst) \ 16) * 16
			oy = yst + ((ym - yst) \ 16) * 16
			IF MineField((ox - xst) \ 16, (oy - yst) \ 16) < 15 THEN
				IF MineTags((ox - xst) \ 16, (oy - yst) \ 16) = 0 THEN
				mouse 0
				flag = 1
				PUT (ox, oy), button.surr(0, 0), PSET
				mouse 1
				END IF
			END IF
		END IF
ELSE
	IF flag = 1 THEN
		flag = 0
		IF MineField((ox - xst) \ 16, (oy - yst) \ 16) < 15 THEN
			IF MineTags((ox - xst) \ 16, (oy - yst) \ 16) = 0 THEN
			mouse 0
			PUT (ox, oy), Button.Blank, PSET
			mouse 1
			END IF
		END IF
	END IF
END IF

WEND


a$ = "N  " ' No unrevealed field pressed
IF flag = 1 THEN ' a revealed field is pressed
	mouse 0
	PUT (ox, oy), Button.Blank, PSET
	mouse 1
	a$ = "Y" + CHR$((ox - xst) \ 16) + CHR$((oy - yst) \ 16)
END IF

Twilight$ = a$

END FUNCTION

DEFINT A-Z
SUB UpdateClock
IF NOT PassedSeconds > 998 THEN
	DEF SEG = 0
	t& = 1& * PEEK(&H46D) * 256 + PEEK(&H46C)
	IF t& < StartingTime THEN t& = t& + 65536
	Ticks& = t& - StartingTime
	tim = (Ticks& * 10) \ 182
	IF tim > PassedSeconds THEN
		mouse 0
		glocate 30, 23
		nprint tim, 3
		mouse 1
		PassedSeconds = PassedSeconds + 1
	END IF
END IF
END SUB

' Wait for a mouseclick or a keypress.
SUB WaitForKeyOrClick

b = 0
WHILE INKEY$ = "" AND b = 0    ' Wait until a keypress or a mousclick

 FOR n = 0 TO 10
	regs(n) = 0
 NEXT n

DEF SEG = VARSEG(Intx(0))
regs(IntNr) = &H33
regs(ax) = 3
CALL absolute(0)
b = regs(bx)
WEND

WHILE b > 0 OR INKEY$ <> ""      ' Don't continue, unless there are no
				 ' keys pressed and no mousebuttons
 FOR n = 0 TO 10                 ' pushed
	regs(n) = 0
 NEXT n

	DEF SEG = VARSEG(Intx(0))
	regs(IntNr) = &H33
	regs(ax) = 3
	CALL absolute(0)
	b = regs(bx)
WEND
END SUB