'===========================================================================
' Subject: QBASIC MINED OUT                  Date: 02-07-99 (00:18)       
' Author:  Mr Whisper                        Code: QB, QBasic, PDS        
' Origin:  mrwhisper@odos.freeserve.co.uk  Packet: GAMES.ABC
'===========================================================================
'
'                    Q B a s i c   M i n e d  O u t
'
'                       Copyright (C) Mr Whisper 1993
'
' A QBASIC re-write o a BASIC gemmie...ah must be gettin disperate...
'
' To run this game, press Shift+F5.
'
' To exit QBasic, press Alt, F, X.
'
' To get help on a BASIC keyword, move the cursor to the keyword and press
' F1 or click the right mouse button.
'

'Set default data type to integer for faster game play
DEFINT A-Z

'User-defined TYPEs

'Sub Declarations
DECLARE SUB SpacePause (text$)
DECLARE SUB Intro ()
DECLARE SUB Set (row, col, acolor)
DECLARE SUB Center (row, text$)
DECLARE SUB Initialize ()
DECLARE SUB SparklePause ()
DECLARE FUNCTION StillWantsToPlay ()

'Constants
CONST TRUE = -1

CONST FALSE = NOT TRUE
CONST STARTOVER = 1             ' Parameters to 'Level' SUB
CONST SAMELEVEL = 2
CONST NEXTLEVEL = 3

'Graphix Variables

DIM SHARED Mine&(63)
DIM SHARED Man&(63)
DIM SHARED Bomb&(50)
DIM SHARED Safe&(60)
DIM SHARED Mines&(200, 1)
DIM SHARED Moves&(1000, 1)


'Do ra Bizzo

    highscore = 0
    RANDOMIZE TIMER
    GOSUB ClearKeyLocks
    Intro
    GOSUB SetColors
    GOSUB initvars
    GOSUB getgraphics

    DO WHILE lives > 0
	 GOSUB playmines
    LOOP
    
    GOSUB RestoreKeyLocks
    COLOR 15, 0
    CLS

    IF StillWantsToPlay THEN
	 RUN
    END IF
END

ClearKeyLocks:
    DEF SEG = 0                     ' Turn off CapLock, NumLock and ScrollLock
    KeyFlags = PEEK(1047)
    POKE 1047, &H0
    DEF SEG
    RETURN

RestoreKeyLocks:
    DEF SEG = 0                     ' Restore CapLock, NumLock and ScrollLock states
    POKE 1047, KeyFlags
    DEF SEG
    RETURN

SetColors:

    COLOR 0, 15
    SCREEN 7
    CLS

RETURN

initvars:

    deadind = 0
    score = 0
    Mines = 50
    level = 1
    lives = 3
   
RETURN

getgraphics:


   CLS 0

'Draw yerweeman

   PSET (2, 1), 15
   PSET (2, 2), 15
   PSET (3, 1), 15
   PSET (4, 1), 15
   PSET (3, 2), 15
   PSET (4, 2), 15
   PSET (3, 3), 15
   PSET (4, 3), 15
   LINE (1, 4)-(6, 4), 15
   PSET (0, 5), 15
   PSET (7, 5), 15
   LINE (3, 4)-(4, 6), 15, BF
   PSET (2, 7), 15
   PSET (1, 8), 15
   PSET (1, 9), 15
   PSET (5, 7), 15
   PSET (6, 8), 15
   PSET (6, 9), 15

   GET (0, 0)-(8, 9), Man&

   CLS 0

   PUT (1, 0), Man&, OR
   GET (0, 0)-(9, 9), Man&
   CLS 0


'Draw Mine

   LINE (0, 0)-(10, 10), 14, BF
   LINE (2, 2)-(8, 8), 0, BF
   FOR c = 0 TO 5
     CIRCLE (5, 5), c, 0
   NEXT c

   CIRCLE (5, 5), 5, 3

   LINE (4, 4)-(6, 6), 3, B
 
  
   GET (0, 0)-(10, 10), Bomb&

   CLS 0

   LINE (0, 0)-(10, 10), 14, BF
   LINE (1, 4)-(9, 6), 7, BF
   LINE (10, 5)-(5, 0), 7
   LINE (10, 5)-(5, 10), 7
  
   GET (0, 0)-(10, 10), Safe&

   CLS
RETURN

playmines:

  
   GOSUB setupscreen
   GOSUB laymines

   DO WHILE yman > 10 AND deadind = 0 AND time > 0

   Move$ = INKEY$

   GOSUB moveman
   GOSUB detectmines
   time = time - 1
   COLOR 15, 0
   LOCATE 1, 1
   PRINT "LEVEL"; level; "LIVES"; lives; "TIME LEFT"; time;

  LOOP

  FOR a = 1 TO 100
       FOR B = 1 TO 1000
       NEXT B
  NEXT a

  IF deadind = 1 OR time = 0 THEN
       LOCATE 1, 1
       PRINT "BOOM!                         "
       FOR d1 = 1 TO 100
	 FOR d2 = 1 TO 1000
	 NEXT d2
       NEXT d1
       lives = lives - 1
'       GOSUB zappydeath
       GOSUB replay
  ELSE
       LOCATE 1, 1
       PRINT "YOU DID IT!                   "
       level = level + 1
       Mines = Mines + 5
       score = score + (level * 10)
       score = score + (time / 10)
       FOR d1 = 1 TO 100
	 FOR d2 = 1 TO 1000
	 NEXT d2
       NEXT d1
       GOSUB replay
  END IF
 
RETURN

setupscreen:

  CLS
  LINE (0, 16)-(320, 200), 3, BF
  LINE (1, 17)-(319, 199), 3, BF
  LINE (2, 18)-(318, 198), 3, BF
  LINE (3, 19)-(317, 197), 3, BF
  LINE (4, 20)-(315, 196), 3, BF
  LINE (10, 20)-(310, 190), 14, BF
  deadind = 0
  movesmade = 0
  xman = 160
  yman = 190
  Moves&(0, 0) = xman
  Moves&(0, 1) = yman
  LINE (160, 10)-(170, 19), 0, BF
  LINE (xman, yman)-(xman + 10, yman + 10), 0, BF
  PUT (xman, yman), Man&, OR
  LOCATE 1, 1
  PRINT "LEVEL"; level; "LIVES"; lives; "SCORE"; score
  time = 10000
 
RETURN

laymines:

  LOCATE 1, 1
  PRINT "LAYING"; Mines; " MINES...            "
  FOR lay = 1 TO Mines
    FOR d = 1 TO 3000
    NEXT d
    layitind = 0
    DO WHILE layitind = 0
      xmine = (INT(RND * 30) * 10) + 10
      ymine = (INT(RND * 17) * 10) + 20
      layitind = 1
      FOR checklay = 1 TO lay
	  xminecheck = Mines&(checklay, 0)
	  yminecheck = Mines&(checklay, 1)
	  IF xmine = (xminecheck AND ymine = yminecheck) OR (xmine = 160 AND ymine = 20) THEN
	     layitind = 0
	  ELSE
'            layitind = 1
	  END IF
      NEXT checklay
    LOOP
    Mines&(lay, 0) = xmine
    Mines&(lay, 1) = ymine
'    LINE (xmine, ymine)-(xmine + 10, ymine + 10), 5, B
  NEXT lay
  IF level = 1 THEN
    LOCATE 2, 1
    PRINT "FIRST AND LAST  LINES ARE SAFE"
    clearline = 20
    GOSUB clearmine
    clearline = 180
    GOSUB clearmine
  ELSEIF level = 2 THEN
    LOCATE 2, 1
    PRINT "FIRST LINE ONLY IS SAFE"
    clearline = 180
    GOSUB clearmine
  ELSEIF level > 2 THEN
    PRINT "FIRST LINE AND ONE OTHER SAFE"
    clearline = 180
    GOSUB clearmine
    clearline = (INT(RND * 16) * 10) + 20
    GOSUB clearmine
  END IF

  LOCATE 2, 1
  PRINT "                                       ";

RETURN

clearmine:

   FOR clearacil = 1 TO Mines
	IF Mines&(clearacil, 1) = clearline THEN
	   Mines&(clearacil, 0) = 0
	   Mines&(clearacil, 1) = 0
	END IF
   NEXT clearacil
   FOR clint = 10 TO 300 STEP 10
       PUT (clint, clearline), Safe&, AND
       IF clint > 10 THEN
	   LINE (clint - 10, clearline)-(clint, clearline + 10), 0, BF
       END IF
       FOR z = 1 TO 15000
       NEXT z
   NEXT clint
   LINE (300, clearline)-(310, clearline + 10), 0, BF

RETURN

replay:

    LOCATE 1, 1
    PRINT "ACTION REPLAY...PRESS S TO SPEED UP"
    LINE (10, 20)-(310, 190), 14, BF
    FOR show = 1 TO Mines
	 xmine = Mines&(show, 0)
	 ymine = Mines&(show, 1)
	 IF xmine > 0 AND ymine > 9 THEN
	  PUT (xmine, ymine), Bomb&, AND
	  FOR d = 1 TO 1000
	  NEXT d
	 END IF
    NEXT show

    xman = 160
    yman = 190
    FOR manshow = 1 TO movesmade
	LINE (xman, yman)-(xman + 10, yman + 10), 0, BF
	xman = Moves&(manshow, 0)
	yman = Moves&(manshow, 1)
	LINE (xman, yman)-(xman + 10, yman + 10), 0, BF
	PUT (xman, yman), Man&, OR
	GOSUB detectmines
	FOR d = 1 TO 30000
	NEXT d
	IF INKEY$ <> "s" THEN
	  FOR d = 1 TO 30000
	  NEXT d
	END IF
    NEXT manshow
'    GOSUB zappydeath
    FOR d1 = 1 TO 100
      FOR d2 = 1 TO 1000
      NEXT d2
    NEXT d1

     
RETURN

moveman:
  
    IF Move$ = "q" OR Move$ = "a" OR Move$ = "o" OR Move$ = "p" THEN
     LINE (xman, yman)-(xman + 8, yman + 9), 0, BF
     IF Move$ = "q" THEN
	 IF yman > 20 OR xman = 160 THEN
	  yman = yman - 10
	  direction = 1
	  movesmade = movesmade + 1
	  Moves&(movesmade, 0) = xman
	  Moves&(movesmade, 1) = yman
	 END IF
     ELSEIF Move$ = "a" AND yman < 180 THEN
	  yman = yman + 10
	  direction = 2
	  movesmade = movesmade + 1
	  Moves&(movesmade, 0) = xman
	  Moves&(movesmade, 1) = yman
     ELSEIF Move$ = "p" AND yman < 190 AND xman < 300 THEN
	  xman = xman + 10
	  direction = 3
	  movesmade = movesmade + 1
	  Moves&(movesmade, 0) = xman
	  Moves&(movesmade, 1) = yman
     ELSEIF Move$ = "o" AND yman < 190 AND xman > 10 THEN
	  xman = xman - 10
	  direction = 4
	  movesmade = movesmade + 1
	  Moves&(movesmade, 0) = xman
	  Moves&(movesmade, 1) = yman
     END IF
     LINE (xman, yman)-(xman + 10, yman + 10), 0, BF
     PUT (xman, yman), Man&, OR
    END IF
RETURN

detectmines:
   
    minesdet = 0
    FOR detect = 1 TO Mines
       xmine = Mines&(detect, 0)
       ymine = Mines&(detect, 1)
       IF (xmine = xman - 10 OR xmine = xman OR xmine = xman + 10) AND (ymine = yman - 10 OR ymine = yman OR ymine = yman + 10) THEN
	  minesdet = minesdet + 1
       END IF
       IF xmine = xman AND ymine = yman THEN
	  deadind = 1
	  GOSUB zappydeath
       END IF
    NEXT detect
'    IF deadind = 0 THEN
	COLOR minesdet + 1, 0
	IF minesdet = 0 THEN
	  COLOR 15, 0
	END IF
	LOCATE 2, 1
	PRINT minesdet; " MINES DETECTED";
	COLOR 15, 0
'    END IF

RETURN


zappydeath:

     FOR arf = 1 TO 2
       FOR s = 1 TO 15
	 FOR t = 0 TO 2
	    COLOR t, s
	 NEXT t
	NEXT s
     NEXT arf

	
RETURN
     

END

'Center:
'  Centers text on given row
SUB Center (row, text$)
    LOCATE row, 41 - LEN(text$) / 2
    PRINT text$;
END SUB

'Intro:
'  Displays game introduction
SUB Intro
    SCREEN 0
    WIDTH 80, 25
    COLOR 15, 0
    CLS

    Center 4, "Q B a s i c   M i n e d   O u t"
    COLOR 7
    Center 6, "Copyright (C) Mr Whisper 1993"
    Center 8, "Try to cross the rather nasty wee minefield, armed"
    Center 9, "only wi a mine detector, which tells you the nummer"
    Center 10, "o mines in the immediate vicinty an that."
    Center 11, "Watch oot fer yer time limit, and use yer safe zones."
    Center 14, "Use q, a, o, p for movement."
    Center 24, "Press any key to continue"

    
    SparklePause

END SUB

'SpacePause:
'  Pauses game play and waits for space bar to be pressed before continuing
SUB SpacePause (text$)

END SUB

'SparklePause:
'  Creates flashing border for intro screen
SUB SparklePause

    COLOR 4, 0
    a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
    WHILE INKEY$ <> "": WEND 'Clear keyboard buffer

    WHILE INKEY$ = ""
	FOR a = 1 TO 5
	    LOCATE 1, 1                             'print horizontal sparkles
	    PRINT MID$(a$, a, 80);
	    LOCATE 22, 1
	    PRINT MID$(a$, 6 - a, 80);

	    FOR B = 2 TO 21                         'Print Vertical sparkles
		c = (a + B) MOD 5
		IF c = 1 THEN
		    LOCATE B, 80
		    PRINT "*";
		    LOCATE 23 - B, 1
		    PRINT "*";
		ELSE
		    LOCATE B, 80
		    PRINT " ";
		    LOCATE 23 - B, 1
		    PRINT " ";
		END IF
	    NEXT B
	NEXT a
    WEND

END SUB

'StillWantsToPlay:
'  Determines if users want to play game again.
FUNCTION StillWantsToPlay

    COLOR 5, 6
    Center 10, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
    Center 11, "Û       G A M E   O V E R       Û"
    Center 12, "Û                               Û"
    Center 13, "Û       PlayAgain?   (Y/N)      Û"
    Center 14, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
 
    WHILE INKEY$ <> "": WEND
    DO
	kbd$ = UCASE$(INKEY$)
    LOOP UNTIL kbd$ = "Y" OR kbd$ = "N"

    COLOR 15, 4
    Center 10, "                                 "
    Center 11, "                                 "
    Center 12, "                                 "
    Center 13, "                                 "
    Center 14, "                                 "

    IF kbd$ = "Y" THEN
	StillWantsToPlay = TRUE
    ELSE
	StillWantsToPlay = FALSE
	COLOR 7, 0
	CLS
    END IF

END FUNCTION