'=========================================================================== ' Subject: MINESWEEPER FOR DOS Date: 08-30-96 (10:20) ' Author: Akarsha Vasant Kumar Code: QB, PDS ' Origin: avkumar@giasbm01.vsnl.net.in Packet: GAMES.ABC '=========================================================================== '########################################################################### '########################### MINESWEEPER FOR DOS ########################### '########################################################################### ' ' --- AKARSHA V. KUMAR ' Bombay , INDIA. 'Viola ! Now here's a real beaut . Took a lot of my time, but it works real 'well ! There might be a few bugs ( tho me not find one ) and I would really 'appreciate it if you point 'em out me so that I could fix 'em . 'I had to steal a few subroutines from previous ABCs and being the Mr.Nice 'that I undoubtably am, I think I'll give these chaps some credit . 'Many thanx to :--- '1) Chris Wagner ( mouse subroutine ; the best I could find ) '2) Erik Olson ( Edit Box subroutine ; real neat function ) 'Keep up the good work guys and I'll always come up with an application ! 'I was going to include a custom setup utility . I had already started making 'a subroutine . That I didn't find it challenging enough to get my grey cells 'ticking is a different story altogether ! . So u programming tyros out there 'vying to get ur names on the ABC, go ahead n' complete it if you want . 'And u programming gurus out there, tell me if you make any changes and do 'ask me before ripping it apart . 'Coming Attraction : 'Watch out for WARSHIP I : A superb(?) space game with real neat ' grafix n' sound ( varooom! varooom!! ) ' Minesweeper 4 Dos : Source Code REM $INCLUDE: 'QBX.BI' DECLARE SUB FANCYPRINT (MSG$, X!, Y!) DECLARE SUB VLINE (Y1!, Y2!, X!) DECLARE SUB HLINE (X1!, X2!, Y!) DECLARE SUB DELAY (D!) DECLARE SUB DBLBOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2) DECLARE SUB BOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2) DECLARE SUB MOUSEON () DECLARE SUB MOUSEOFF () DECLARE SUB MouseSetHor (Min%, Max%) DECLARE SUB MouseSetVert (Min%, Max%) DECLARE SUB MouseLocate (Xpos%, Ypos%) DECLARE SUB MouseStatus (VERT%, HOR%, MBUTTONS$) DECLARE FUNCTION MouseInstalled% () DECLARE SUB AROUNDBOXCLEAR (I, J) DECLARE SUB CLEARAROUNDZERO (I, J) DECLARE SUB SHOWMINES () DECLARE SUB MENU () DECLARE SUB LEVELS () DECLARE SUB HELP () DECLARE SUB START () DECLARE SUB ABOUT () DECLARE SUB HISCORE () DECLARE SUB SHOWHISCORE () DECLARE SUB RESETSCORES () DECLARE SUB CHECKTIME () DECLARE FUNCTION EDITBOX$ (DEFAULT$, X, Y) DECLARE SUB CUSTOMBOX () TYPE INFO FNAME AS STRING * 12 time AS STRING * 10 DATE AS STRING * 10 END TYPE DIM SHARED PLAYER AS INFO DIM SHARED NUMOFBLOCKS AS INTEGER DIM SHARED NEWGAMECANCELLED DIM SHARED NEWGAME DIM SHARED RegX AS RegTypeX DIM SHARED WON DIM SHARED LOST DIM SHARED TIMENOW CALL MouseSetHor(1, 80) CALL MouseSetVert(1, 25) CALL MouseLocate(20, 70) CALL MOUSEON SCREEN , , 1, 1 CLS CALL START CALL MENU NEWGAME = 0: WON = 0: LOST = 0 START: RANDOMIZE TIMER: TIMER ON TYPE PROPERTIES STARTX AS INTEGER STARTY AS INTEGER CONTENT AS STRING * 1 CLEARED AS INTEGER MARKED AS INTEGER QMARKED AS INTEGER ZEROCLEARED AS INTEGER DRAWN AS INTEGER END TYPE 'NUMOFBLOCKS = 25 NUMOFCOLS = 7 NUMOFMARKERS = NUMOFBLOCKS NUMOFMINES = NUMOFBLOCKS REDIM SHARED BLOCK(NUMOFBLOCKS, NUMOFCOLS) AS PROPERTIES WON = 0: LOST = 0 NUMCLEARED = 0 SCREEN , , 1, 1 CLS LOCATE 25, 10: PRINT "Number of markers :" LOCATE 25, 50: PRINT "Time :" COLOR 14, 12: LOCATE 25, 35: PRINT " MENU " FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO NUMOFCOLS BLOCK(I, J).CONTENT = "" BLOCK(I, J).CLEARED = 0 BLOCK(I, J).MARKED = 0 BLOCK(I, J).QMARKED = 0 NEXT J NEXT I TEMP = 0 5 FOR MINE = 1 TO NUMOFBLOCKS 10 I = INT(RND * NUMOFBLOCKS) + 1: J = INT(RND * 6) + 1 IF BLOCK(I, J).CONTENT = CHR$(21) THEN GOTO 10 ELSE BLOCK(I, J).CONTENT = CHR$(21) TEMP = TEMP + 1 END IF NEXT MINE IF TEMP <> NUMOFBLOCKS THEN GOTO 5 FOR X = 1 TO NUMOFBLOCKS FOR Y = 1 TO NUMOFCOLS TEMP = 0 IF BLOCK(X, Y).CONTENT <> CHR$(21) THEN IF X <> 1 AND Y <> 1 THEN IF BLOCK(X - 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF Y <> 1 THEN IF BLOCK(X, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF X <> NUMOFBLOCKS AND Y <> 1 THEN IF BLOCK(X + 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF X <> 1 THEN IF BLOCK(X - 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF X <> NUMOFBLOCKS THEN IF BLOCK(X + 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF X <> 1 AND Y <> NUMOFCOLS THEN IF BLOCK(X - 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF Y <> NUMOFCOLS THEN IF BLOCK(X, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF IF X <> NUMOFBLOCKS AND Y <> NUMOFCOLS THEN IF BLOCK(X + 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1 END IF BLOCK(X, Y).CONTENT = LTRIM$(STR$(TEMP)) END IF NEXT Y NEXT X DRAWX = INT((80 - NUMOFBLOCKS * 3) / 2) CALL DBLBOX(DRAWX - 1, 1, DRAWX + NUMOFBLOCKS * 3 + 2, 23, 11, 1) FOR X = 1 TO NUMOFBLOCKS FOR Y = 0 TO 6 CALL BOX(DRAWX - 2 + X * 3, Y * 3 + 2, DRAWX + X * 3, Y * 3 + 4, 1, 11) BLOCK(X, Y + 1).STARTX = DRAWX - 2 + X * 3: BLOCK(X, Y + 1).STARTY = Y * 3 + 2 'LOCATE Y * 3 + 3, X * 3 + 1: PRINT BLOCK(X, Y + 1).CONTENT NEXT Y NEXT X COLOR 10, 0 LOCATE 4, 50 TIMEST = 0 DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) a$ = UCASE$(INKEY$) IF MBUTTONS$ = "L" THEN IF VERT% = 25 AND HOR% >= 35 AND HOR% <= 43 THEN CALL MENU STARTIME = STARTIME + (TIMER - (STARTIME + TIMENOW)) END IF IF NEWGAME = 1 THEN NEWGAME = 0: GOTO START FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO NUMOFCOLS IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THEN IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THEN IF TIMEST = 0 THEN STARTIME = TIMER: TIMEST = 1 END IF BLOCK(I, J).CLEARED = 1 BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 0 END IF END IF NEXT J NEXT I END IF IF NEWGAME = 1 THEN NEWGAME = 0: GOTO START IF MBUTTONS$ = "LR" THEN FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO NUMOFCOLS IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THEN IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THEN IF TIMEST = 0 THEN STARTIME = TIMER: TIMEST = 1 END IF IF BLOCK(I, J).CLEARED = 1 THEN CALL AROUNDBOXCLEAR(I, J) END IF END IF END IF NEXT J NEXT I END IF IF MBUTTONS$ = "R" THEN FOR I = 1 TO 5000: NEXT I FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO NUMOFCOLS IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THEN IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THEN IF TIMEST = 0 THEN STARTIME = TIMER: TIMEST = 1 END IF IF BLOCK(I, J).CLEARED = 0 THEN IF BLOCK(I, J).MARKED = 1 THEN BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 1: NUMOFMARKERS = NUMOFMARKERS + 1 X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTY CALL DBLBOX(X, Y, X + 2, Y + 2, 14, 5): COLOR 14, 5 LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "?" ELSEIF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).QMARKED = 0 THEN IF NUMOFMARKERS <> 0 THEN BLOCK(I, J).MARKED = 1: : NUMOFMARKERS = NUMOFMARKERS - 1 X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTY COLOR 1, 10: CALL DBLBOX(X, Y, X + 2, Y + 2, 14 + 16, 12): COLOR 14 + 16, 12 LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "M" END IF ELSEIF BLOCK(I, J).QMARKED = 1 THEN BLOCK(I, J).QMARKED = 0: BLOCK(I, J).MARKED = 0 X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTY COLOR 2, 0: CALL BOX(X, Y, X + 2, Y + 2, 1, 11): COLOR 1, 11 LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "" END IF END IF END IF END IF NEXT J NEXT I END IF COLOR 15, 0 LOCATE 25, 30: PRINT LTRIM$(STR$(NUMOFMARKERS)) + " "; IF TIMEST = 1 THEN TIMENOW = TIMER - STARTIME LOCATE 25, 57: PRINT USING "####.##"; TIMENOW; END IF IF a$ = "Q" THEN CALL MOUSEOFF: SYSTEM FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO NUMOFCOLS IF BLOCK(I, J).CLEARED = 1 THEN NUMCLEARED = NUMCLEARED + 1 IF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).DRAWN = 0 THEN X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTY CALL BOX(X, Y, X + 2, Y + 2, 8, 0) IF BLOCK(I, J).CONTENT <> "0" THEN LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT BLOCK(I, J).CONTENT BLOCK(I, J).DRAWN = 1 END IF IF BLOCK(I, J).CONTENT = CHR$(21) AND BLOCK(I, J).MARKED = 0 THEN LOST = 1 CALL SHOWMINES SLEEP (2) CALL BOX(25, NUMOFCOLS, 55, 13, 13, 1) COLOR 2, 1 FOR X = 26 TO 54 FOR Y = 8 TO 12 LOCATE Y, X: PRINT CHR$(21) NEXT Y NEXT X COLOR 13, 1 LOCATE 10, 31: PRINT " Block Has Mine !! " SLEEP (2) CALL MENU END IF IF BLOCK(I, J).CONTENT = "0" AND BLOCK(I, J).ZEROCLEARED = 0 THEN CALL CLEARAROUNDZERO(I, J) BLOCK(I, J).ZEROCLEARED = 1 END IF END IF NEXT J NEXT I IF NUMCLEARED = NUMOFBLOCKS * NUMOFCOLS - NUMOFMINES AND NEWGAMECANCELLED = 0 THEN WON = 1 CALL BOX(25, NUMOFCOLS, 55, 13, 14, 0) COLOR 2, 1 FOR X = 26 TO 54 FOR Y = 8 TO 12 LOCATE Y, X: PRINT CHR$(2) NEXT Y NEXT X COLOR 12, 1 LOCATE 10, 34: PRINT " YOU WIN !! " SLEEP (2) CALL CHECKTIME CALL MENU ELSE NUMCLEARED = 0 END IF LOOP DATA "`MINESWEEPER' is a game involving skill and lotsa luck ." DATA "All ya guys gotta do is to clear a minefield without " DATA "blasting a mine . The number of markers at the start of " DATA "game is = the number of mines in the grid . Click with " DATA "the left mouse button to clear a block . The number that" DATA "a cleared block shows is the number of blocks touching it" DATA "which contain mines . If you are sure that a block has" DATA "a mine then use the right mouse button to mark it . If " DATA "you are doubtful about its contents , another click will" DATA "question mark the block . A third click unmarks the block. DATA "Clickin' both buttons together , clears all blocks around " DATA "a block except those that have been marked previously." DATA "For more help , go play the Windows version (He He He...)" SUB ABOUT CALL MOUSEOFF PCOPY 3, 4 CALL MOUSEON CALL DBLBOX(15, 4, 64, 22, 12, 10) COLOR 8, 8: FOR I = 16 TO 65 a = SCREEN(23, I) LOCATE 23, I: PRINT CHR$(a) NEXT I FOR J = 5 TO 22 a = SCREEN(J, 65) LOCATE J, 65: PRINT CHR$(a) NEXT J FOR I = 23 TO 53 STEP 3 CALL BOX(I, 5, I + 2, 7, 14, 12) NEXT I TITLE$ = "MINESWEEPER" COLOR 14, 12 FOR I = 1 TO 11 a$ = MID$(TITLE$, I, 1) CALL FANCYPRINT(a$, 6, I * 3 + 21) NEXT I CALL BOX(36, 18, 46, 20, 1, 0) CALL BOX(35, 17, 45, 19, 1, 15) COLOR 1, 15: LOCATE 18, 39: PRINT "OK" COLOR 10, 2 CALL FANCYPRINT("For DOS", 8, 35) CALL FANCYPRINT("Version : 1.0 (1996)", 9, 29) CALL FANCYPRINT("By : Akarsha V.Kumar , Bombay ,India .", 10, 21) CALL FANCYPRINT("For comments and bugs e-mail me at :", 11, 21) CALL FANCYPRINT("avkumar@giasbm01.vsnl.net.in", 12, 24) CALL FANCYPRINT("You are free to distribute this game .", 13, 21) CALL FANCYPRINT("You may not expect future versions", 14, 22) CALL FANCYPRINT("'cos this game ain't got no future .", 15, 21) DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% >= 17 AND VERT% <= 19 AND HOR% >= 35 AND HOR% <= 45 THEN EXIT DO END IF END IF LOOP PCOPY 4, 3 SCREEN , , 3, 3 END SUB SUB AROUNDBOXCLEAR (I, J) IF I <> 1 AND J <> 1 THEN IF BLOCK(I - 1, J - 1).MARKED = 0 THEN BLOCK(I - 1, J - 1).CLEARED = 1 END IF IF J <> 1 THEN IF BLOCK(I, J - 1).MARKED = 0 THEN BLOCK(I, J - 1).CLEARED = 1 END IF IF I <> NUMOFBLOCKS AND J <> 1 THEN IF BLOCK(I + 1, J - 1).MARKED = 0 THEN BLOCK(I + 1, J - 1).CLEARED = 1 END IF IF I <> 1 THEN IF BLOCK(I - 1, J).MARKED = 0 THEN BLOCK(I - 1, J).CLEARED = 1 END IF IF I <> NUMOFBLOCKS THEN IF BLOCK(I + 1, J).MARKED = 0 THEN BLOCK(I + 1, J).CLEARED = 1 END IF IF I <> 1 AND J <> 7 THEN IF BLOCK(I - 1, J + 1).MARKED = 0 THEN BLOCK(I - 1, J + 1).CLEARED = 1 END IF IF J <> 7 THEN IF BLOCK(I, J + 1).MARKED = 0 THEN BLOCK(I, J + 1).CLEARED = 1 END IF IF I <> NUMOFBLOCKS AND J <> 7 THEN IF BLOCK(I + 1, J + 1).MARKED = 0 THEN BLOCK(I + 1, J + 1).CLEARED = 1 END IF END SUB SUB BOX (X1, Y1, X2, Y2, COLOR1, COLOR2) 'DRAW HORIZONTAL LINES COLOR COLOR1, COLOR2 IF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATE GREATERX = X1: LESSERX = X2 ELSE GREATERX = X2: LESSERX = X1 END IF FOR I = (LESSERX + 1) TO (GREATERX - 1) LOCATE Y1, I: PRINT CHR$(196); LOCATE Y2, I: PRINT CHR$(196); NEXT I 'DRAW VERTICAL LINES IF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATE GREATERY = Y1: LESSERY = Y2 ELSE GREATERY = Y2: LESSERY = Y1 END IF FOR I = LESSERY + 1 TO GREATERY - 1 LOCATE I, X1: PRINT CHR$(179); LOCATE I, X2: PRINT CHR$(179); NEXT I 'DRAW CORNERS LOCATE LESSERY, LESSERX: PRINT CHR$(218); LOCATE GREATERY, GREATERX: PRINT CHR$(217); LOCATE LESSERY, GREATERX: PRINT CHR$(191); LOCATE GREATERY, LESSERX: PRINT CHR$(192); FOR I = LESSERX + 1 TO GREATERX - 1 FOR J = LESSERY + 1 TO GREATERY - 1 LOCATE J, I: PRINT " "; NEXT J NEXT I COLOR 7, 0 END SUB SUB CHECKTIME OPEN "HISCORE.DAT" FOR RANDOM AS #1 FOR I = 1 TO 4 IF NUMOFBLOCKS = I * 5 + 5 THEN GET #1, I, PLAYER IF TIMENOW < VAL(PLAYER.time) THEN CALL BOX(20, 6, 60, 14, 0, 15) COLOR 2, 1 FOR X = 21 TO 59 FOR Y = 7 TO 13 LOCATE Y, X: PRINT CHR$(2) NEXT Y NEXT X COLOR 0, 15 LOCATE 6, 25: PRINT " HI SCORE :" COLOR 15, 1 LOCATE 8, 25: PRINT " You have made a new record. " LOCATE 9, 25: PRINT " Please enter your name :- " PLAYER.FNAME = EDITBOX$(" ", 34, 11) PLAYER.time = STR$(TIMENOW) PLAYER.DATE = DATE$ PUT #1, I, PLAYER CLOSE #1 CALL SHOWHISCORE EXIT FOR END IF END IF NEXT I CLOSE #1 END SUB SUB CLEARAROUNDZERO (I, J) IF I <> 1 AND J <> 1 THEN IF BLOCK(I - 1, J - 1).MARKED = 0 AND BLOCK(I - 1, J - 1).CONTENT <> "M" THEN BLOCK(I - 1, J - 1).CLEARED = 1 END IF IF J <> 1 THEN IF BLOCK(I, J - 1).MARKED = 0 AND BLOCK(I, J - 1).CONTENT <> "M" THEN BLOCK(I, J - 1).CLEARED = 1 END IF IF I <> NUMOFBLOCKS AND J <> 1 THEN IF BLOCK(I + 1, J - 1).MARKED = 0 AND BLOCK(I + 1, J - 1).CONTENT <> "M" THEN BLOCK(I + 1, J - 1).CLEARED = 1 END IF IF I <> 1 THEN IF BLOCK(I - 1, J).MARKED = 0 AND BLOCK(I - 1, J).CONTENT <> "M" THEN BLOCK(I - 1, J).CLEARED = 1 END IF IF I <> NUMOFBLOCKS THEN IF BLOCK(I + 1, J).MARKED = 0 AND BLOCK(I + 1, J).CONTENT <> "M" THEN BLOCK(I + 1, J).CLEARED = 1 END IF IF I <> 1 AND J <> 7 THEN IF BLOCK(I - 1, J + 1).MARKED = 0 AND BLOCK(I - 1, J + 1).CONTENT <> "M" THEN BLOCK(I - 1, J + 1).CLEARED = 1 END IF IF J <> 7 THEN IF BLOCK(I, J + 1).MARKED = 0 AND BLOCK(I, J + 1).CONTENT <> "M" THEN BLOCK(I, J + 1).CLEARED = 1 END IF IF I <> NUMOFBLOCKS AND J <> 7 THEN IF BLOCK(I + 1, J + 1).MARKED = 0 AND BLOCK(I + 1, J + 1).CONTENT <> "M" THEN BLOCK(I + 1, J + 1).CLEARED = 1 END IF END SUB SUB CUSTOMBOX CALL MOUSEOFF PCOPY 5, 6 CALL MOUSEON CUSTOMROW = 28 CALL DBLBOX(20, 3, 60, 20, 1, 2) COLOR 10, 0 LOCATE 6, 27: PRINT CHR$(17) LOCATE 6, 54: PRINT CHR$(16) COLOR 10, 2 FOR I = 28 TO 53 LOCATE 6, I: PRINT CHR$(176) NEXT I LOCATE 6, CUSTOMROW: PRINT CHR$(219) CALL BOX(36, 16, 46, 18, 1, 0) CALL BOX(35, 15, 45, 17, 1, 15) DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% = 6 THEN IF HOR% = 27 THEN DELAY (2000) IF CUSTOMROW > 28 THEN CUSTOMROW = CUSTOMROW - 1 END IF IF HOR% = 54 THEN DELAY (2000) IF CUSTOMROW < 53 THEN CUSTOMROW = CUSTOMROW + 1 END IF END IF IF VERT% >= 15 AND VERT% <= 17 AND HOR% >= 35 AND HOR% <= 45 THEN EXIT DO END IF COLOR 10, 0 LOCATE 6, 27: PRINT CHR$(17) LOCATE 6, 54: PRINT CHR$(16) COLOR 10, 2 FOR I = 28 TO 53 LOCATE 6, I: PRINT CHR$(176) NEXT I LOCATE 6, CUSTOMROW: PRINT CHR$(219) END IF LOOP DELAY (5000) PCOPY 6, 5 SCREEN , , 5, 5 END SUB SUB DBLBOX (X1, Y1, X2, Y2, COLOR1, COLOR2) 'CHECK FOR VALID CO-ORDINATES IF X1 > 80 OR X1 < 1 OR X2 > 80 OR X2 < 1 OR Y1 > 24 OR Y1 < 1 OR Y2 > 24 OR Y2 < 1 THEN GOTO 100 COLOR COLOR1, COLOR2 IF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATE GREATERX = X1: LESSERX = X2 ELSE GREATERX = X2: LESSERX = X1 END IF 'DRAW HORIZONTAL LINES FOR I = (LESSERX + 1) TO (GREATERX - 1) LOCATE Y1, I: PRINT CHR$(205); LOCATE Y2, I: PRINT CHR$(205); NEXT I 'DRAW VERTICAL LINES IF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATE GREATERY = Y1: LESSERY = Y2 ELSE GREATERY = Y2: LESSERY = Y1 END IF FOR I = LESSERY + 1 TO GREATERY - 1 LOCATE I, X1: PRINT CHR$(186); LOCATE I, X2: PRINT CHR$(186); NEXT I 'DRAW CORNERS LOCATE LESSERY, LESSERX: PRINT CHR$(201); LOCATE GREATERY, GREATERX: PRINT CHR$(188); LOCATE LESSERY, GREATERX: PRINT CHR$(187); LOCATE GREATERY, LESSERX: PRINT CHR$(200); FOR I = LESSERX + 1 TO GREATERX - 1 FOR J = LESSERY + 1 TO GREATERY - 1 LOCATE J, I: PRINT " "; NEXT J NEXT I COLOR 7, 0 100 END SUB SUB DELAY (D) FOR I = 1 TO D NEXT I END SUB FUNCTION EDITBOX$ (DEFAULT$, X, Y) DO LOCATE Y, X: PRINT DEFAULT$' if you want to put the box somewhere LOCATE Y, X + YY: PRINT CHR$(2) ' else, change these locate statements DO: a$ = INKEY$: LOOP WHILE LEN(a$) = 0 IF LEN(a$) THEN SELECT CASE (a$) CASE CHR$(27), CHR$(13) 'END SELECT CASE CHR$(8) IF YY THEN YY = YY - 1 IF YY THEN DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " " ELSE DEFAULT$ = MID$(DEFAULT$, YY + 2) + " " END IF END IF CASE CHR$(0) + CHR$(83) IF YY THEN DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " " ELSE DEFAULT$ = MID$(DEFAULT$, YY + 2) + " " END IF CASE CHR$(0) + CHR$(&H4D) IF YY < LEN(DEFAULT$) THEN YY = YY + 1 CASE CHR$(0) + CHR$(&H4B) IF YY THEN YY = YY - 1 CASE CHR$(0) + CHR$(79)'end YY = LEN(RTRIM$(DEFAULT$)) CASE CHR$(0) + CHR$(71) YY = 0 CASE ELSE IF LEN(a$) = 1 AND YY = 0 THEN DEFAULT$ = SPACE$(LEN(DEFAULT$)) IF LEN(a$) = 1 AND YY < LEN(DEFAULT$) THEN MID$(DEFAULT$, YY + 1, 1) = a$: YY = YY + 1 END SELECT IF a$ = CHR$(27) THEN EDITBOX$ = "": EXIT DO IF a$ = CHR$(13) THEN EDITBOX$ = RTRIM$(DEFAULT$): EXIT DO END IF LOOP END FUNCTION SUB FANCYPRINT (MSG$, X, Y) LOCATE X, Y FOR I = 1 TO LEN(MSG$) M$ = MID$(MSG$, I, 1) PRINT M$; : IF M$ = " " THEN SOUND 500, 1 DELAY (750) NEXT I END SUB SUB HELP CALL MOUSEOFF PCOPY 3, 4 CALL MOUSEON CALL DBLBOX(5, 2, 75, 23, 0, 13) COLOR 14, 13 LOCATE 3, 29: PRINT " MINESWEEPER HELP " COLOR 0, 13 FOR Y = 5 TO 17 READ HLP$ LOCATE Y, 10: PRINT HLP$ NEXT Y CALL BOX(35, 20, 45, 22, 1, 1) CALL BOX(34, 19, 44, 21, 1, 15) COLOR 1, 15 LOCATE 20, 38: PRINT "OK" DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% >= 19 AND VERT% <= 21 AND HOR% >= 34 AND HOR% <= 44 THEN EXIT DO END IF END IF LOOP RESTORE PCOPY 4, 3 SCREEN , , 3, 3 END SUB SUB HISCORE END SUB SUB HLINE (X1, X2, Y) 'DETERMINE GREATER X CO-ORDINATE IF X1 > X2 THEN GREATER = X1: LESSER = X2 ELSE GREATER = X2: LESSER = X1 END IF FOR I = LESSER TO GREATER LOCATE Y, I: PRINT CHR$(196) NEXT I END SUB SUB LEVELS CALL MOUSEOFF PCOPY 3, 4: PCOPY 4, 5 CALL MOUSEON SCREEN , , 5, 5 CALL DBLBOX(10, 5, 70, 20, 0, 12) FOR X = 15 TO 35 STEP 19 FOR Y = 7 TO 14 STEP 7 CALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8) CALL BOX(X, Y, X + 13, Y + 2, 1, 15) NEXT Y NEXT X CALL BOX(53, 12, 67, 14, 8, 8) CALL BOX(52, 11, 66, 13, 1, 15) COLOR 1, 15 LOCATE 8, 18: PRINT "LEVEL 1" LOCATE 8, 37: PRINT "LEVEL 3" 'LOCATE 8, 57: PRINT "CUSTOM" LOCATE 15, 18: PRINT "LEVEL 2" LOCATE 15, 37: PRINT "LEVEL 4" LOCATE 12, 56: PRINT "CANCEL" DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THEN NUMOFBLOCKS = 10: NEWGAMECANCELLED = 0: EXIT DO EXIT DO END IF IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THEN NUMOFBLOCKS = 20: NEWGAMECANCELLED = 0: EXIT DO END IF 'IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THEN 'CALL CUSTOMBOX 'END IF IF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THEN NUMOFBLOCKS = 15: NEWGAMECANCELLED = 0: EXIT DO END IF IF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THEN NUMOFBLOCKS = 25: NEWGAMECANCELLED = 0: EXIT DO END IF IF VERT% >= 11 AND VERT% <= 13 AND HOR% >= 52 AND HOR% <= 66 THEN NEWGAMECANCELLED = 1 EXIT DO END IF END IF LOOP PCOPY 4, 3 SCREEN , , 3, 3 DELAY (10000) END SUB SUB MENU CALL MOUSEOFF PCOPY 1, 2: PCOPY 2, 3 SCREEN , , 3, 2 CALL DBLBOX(10, 5, 70, 20, 2, 15) COLOR 8, 8: FOR I = 11 TO 71 a = SCREEN(21, I) LOCATE 21, I: PRINT CHR$(a) NEXT I FOR J = 6 TO 20 a = SCREEN(J, 71) LOCATE J, 71: PRINT CHR$(a) NEXT J FOR X = 15 TO 58 STEP 19 FOR Y = 7 TO 14 STEP 7 CALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8) CALL BOX(X, Y, X + 13, Y + 2, 1, 14) NEXT Y NEXT X SCREEN , , 3, 3 COLOR 15, 14 LOCATE 8, 18: PRINT "NEW GAME" LOCATE 8, 37: PRINT "CONTINUE" LOCATE 8, 58: PRINT "HELP" LOCATE 15, 19: PRINT "ABOUT" LOCATE 15, 36: PRINT "BEST TIMES" LOCATE 15, 58: PRINT "EXIT" CALL MOUSEON DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THEN CALL LEVELS IF NEWGAMECANCELLED = 0 THEN NEWGAME = 1 EXIT DO END IF END IF IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THEN IF WON = 1 OR LOST = 1 OR NUMOFBLOCKS = 0 THEN BEEP ELSE EXIT DO END IF END IF IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THEN CALL HELP END IF IF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THEN CALL ABOUT END IF IF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THEN CALL SHOWHISCORE END IF IF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 53 AND HOR% <= 66 THEN COLOR 10, 0 CALL MOUSEOFF: CLS : SYSTEM END IF END IF LOOP DELAY (10000) PCOPY 2, 1 SCREEN , , 1, 1 END SUB FUNCTION MouseInstalled% DEF SEG = 0 MouseSeg& = 256& * PEEK(207) + PEEK(206) MouseOfs& = 256& * PEEK(205) + PEEK(204) + 2 DEF SEG = MouseSeg& IF (MouseSeg& = 0 AND MouseOfs& = 0) OR PEEK(MouseOfs&) = 207 THEN MouseInstalled% = 0 EXIT FUNCTION ELSE MouseInstalled% = -1 END IF DEF SEG RegX.ax = 0 CALL INTERRUPTX(&H33, RegX, RegX) IF RegX.ax = -1 THEN MouseInstalled% = -1 ELSE MouseInstalled% = 0 END IF END FUNCTION SUB MouseLocate (Xpos%, Ypos%) RegX.dx = (Xpos% * 8) - 1 RegX.cx = (Ypos% * 8) - 1 RegX.ax = 4 CALL INTERRUPTX(&H33, RegX, RegX) END SUB SUB MOUSEOFF RegX.ax = 2 CALL INTERRUPTX(&H33, RegX, RegX) END SUB SUB MOUSEON RegX.ax = 1 CALL INTERRUPTX(&H33, RegX, RegX) END SUB SUB MouseSetHor (Min%, Max%) RegX.cx = (Min% * 8) - 1 RegX.dx = (Max% * 8) - 1 RegX.ax = 7 CALL INTERRUPTX(&H33, RegX, RegX) END SUB SUB MouseSetVert (Min%, Max%) RegX.cx = (Min% * 8) - 1 RegX.dx = (Max% * 8) - 1 RegX.ax = 8 CALL INTERRUPTX(&H33, RegX, RegX) END SUB SUB MouseStatus (VERT%, HOR%, MBUTTONS$) RegX.ax = 3 CALL INTERRUPTX(&H33, RegX, RegX) VERT% = (RegX.dx / 8) + 1 HOR% = (RegX.cx / 8) + 1 SELECT CASE RegX.bx CASE 0 MBUTTONS$ = " " CASE 1 MBUTTONS$ = "L" CASE 2 MBUTTONS$ = "R" CASE 3 MBUTTONS$ = "LR" CASE 4 MBUTTONS$ = "C" END SELECT END SUB SUB RESETSCORES OPEN "HISCORE.DAT" FOR RANDOM AS #1 PLAYER.FNAME = "Anonymous" PLAYER.time = "9999999999" PLAYER.DATE = "-" FOR I = 1 TO 4 PUT #1, I, PLAYER NEXT I CLOSE #1 END SUB SUB SHOWHISCORE CALL MOUSEOFF PCOPY 3, 4 CALL MOUSEON CALL DBLBOX(1, 1, 80, 24, 8, 15) FOR X = 3 TO 63 STEP 19 FOR Y = 4 TO 17 STEP 4 CALL BOX(X + 1, Y + 1, X + 17, Y + 3, 2, 1) CALL BOX(X, Y, X + 16, Y + 2, 1, 15) NEXT Y NEXT X CALL BOX(21, 21, 31, 23, 2, 1) CALL BOX(20, 20, 30, 22, 1, 15) CALL BOX(36, 21, 56, 23, 2, 1) CALL BOX(35, 20, 55, 22, 1, 15) OPEN "HISCORE.DAT" FOR RANDOM AS #1 IF LOF(1) = 0 THEN CLOSE #1: CALL RESETSCORES OPEN "HISCORE.DAT" FOR RANDOM AS #1 END IF COLOR 0, 15 FOR I = 1 TO 4 GET #1, I, PLAYER LOCATE I * 4 + 1, 8: PRINT "LEVEL :"; I LOCATE I * 4 + 1, INT(31 - .5 * (LEN(RTRIM$(PLAYER.FNAME)))): PRINT RTRIM$(PLAYER.FNAME) LOCATE I * 4 + 1, INT(50 - .5 * (LEN(RTRIM$((PLAYER.time))))): PRINT RTRIM$(PLAYER.time) LOCATE I * 4 + 1, INT(69 - .5 * (LEN(RTRIM$((PLAYER.DATE))))): PRINT RTRIM$(PLAYER.DATE) NEXT I CLOSE #1 LOCATE 21, 24: PRINT "OK" LOCATE 21, 39: PRINT "RESET SCORES" COLOR 8, 15 LOCATE 2, 35: PRINT "BEST TIMES" LOCATE 3, 8: PRINT "LEVEL" LOCATE 3, 29: PRINT "NAME" LOCATE 3, 45: PRINT "TIME (sec)" LOCATE 3, 67: PRINT "DATE" DO CALL MouseStatus(VERT%, HOR%, MBUTTONS$) IF MBUTTONS$ = "L" THEN IF VERT% >= 20 AND VERT% <= 22 THEN IF HOR% >= 20 AND HOR% <= 30 THEN EXIT DO END IF IF HOR% >= 35 AND HOR% <= 55 THEN CALL RESETSCORES EXIT DO END IF END IF END IF LOOP PCOPY 4, 3 SCREEN , , 3, 3 'DELAY (10000) END SUB SUB SHOWMINES BEEP FOR I = 1 TO NUMOFBLOCKS FOR J = 1 TO 7 IF BLOCK(I, J).CONTENT = CHR$(21) THEN COLOR 10, 2 X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTY CALL DBLBOX(X, Y, X + 2, Y + 2, 12, 1) LOCATE Y + 1, X + 1: PRINT BLOCK(I, J).CONTENT END IF NEXT J NEXT I COLOR 10, 0 END SUB SUB START CLS FOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(219); : NEXT J: NEXT I FOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(178); : NEXT J: NEXT I FOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(177); : NEXT J: NEXT I FOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(176); : NEXT J: NEXT I CALL DBLBOX(20, 8, 58, 17, 1, 11) COLOR 8, 0: FOR I = 21 TO 59 a = SCREEN(18, I) LOCATE 18, I: PRINT CHR$(a) NEXT I FOR J = 9 TO 17 a = SCREEN(J, 59) LOCATE J, 59: PRINT CHR$(a) NEXT J FOR I = 23 TO 53 STEP 3 CALL BOX(I, 10, I + 2, 12, 11, 1) NEXT I TITLE$ = "MINESWEEPER" COLOR 9, 1 FOR I = 1 TO 11 a$ = MID$(TITLE$, I, 1) LOCATE 11, I * 3 + 21: PRINT a$ NEXT I COLOR 1, 11 LOCATE 13, 35: PRINT "For DOS" IF NOT MouseInstalled% THEN LOCATE 15, 22: PRINT " Sorry , system must have a mouse !" SLEEP (2) COLOR 1, 0: CLS : SYSTEM ELSE LOCATE 15, 29: PRINT "Mouse found and reset ." CALL MOUSEON END IF END SUB SUB VLINE (Y1, Y2, X) 'DETERMINE GREATER Y CO-ORDINATE IF Y1 > Y2 THEN GREATER = Y1: LESSER = Y2 ELSE GREATER = Y2: LESSER = Y1 END IF FOR I = LESSER TO GREATER LOCATE I, X: PRINT CHR$(179) NEXT I END SUB