DIGGER.BAS

'<Digger. The classic Digger game re-created in ASCII>
'Copyright (C) <2001> <Navin>

'This program is free software: you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation, either version 3 of the License, or
'(at your option) any later version.

'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'GNU General Public License for more details.

'You should have received a copy of the GNU General Public License
'along with this program. If not, see <http://www.gnu.org/licenses/>.

10 SCREEN 12: GOSUB 2030: OPEN "O", #1, "LEV.DAT": WRITE #1, 1: WRITE #1, 2: WRITE #1, 3: WRITE #1, 4: CLOSE #1
20 CLS : KEY OFF: SCREEN 0, 0, 0: OPEN "I", #1, "LEV.DAT": INPUT #1, LEVEL: CLOSE #1
30 LOCATE 15, 25: PRINT "LEVEL : "; LEVEL: X$ = INPUT$(1)
40 LOCATE 24, 1: PRINT CHR$(200); STRING$(78, CHR$(205)); CHR$(188): C = 5
50 R = 22: DIM A(24, 80): DIM D(24, 80)
60 LOCATE R, 1: PRINT CHR$(186): LOCATE R, 80: PRINT CHR$(186)
70 IF R = 1 THEN 80 ELSE R = R - 1: GOTO 60
80 LOCATE 1, 1: PRINT CHR$(201); STRING$(78, CHR$(205)); CHR$(187): C = 5
90 R = 2
100 LOCATE R, 2: PRINT STRING$(78, CHR$(178))
110 IF R = 22 THEN 120 ELSE R = R + 1: GOTO 100
120 '--ASSIGNING VALUES
130 FOR i = 1 TO 24
140 FOR J = 1 TO 80
150 A(i, J) = 10
160 NEXT: NEXT
170 IF LEVEL = 1 THEN LEV = 10
180 IF LEVEL = 2 THEN LEV = 20
190 IF LEVEL = 3 THEN LEV = 30
200 RANDOMIZE TIMER
210 FOR i = 1 TO LEV
220 R = INT(RND * 18 + 3): C = INT(RND * 76 + 2)
230 LOCATE R, C: PRINT CHR$(4): D(R, C) = 4: DIA = DIA + 1
240 NEXT i
250 LOCATE 10, 10: PRINT CHR$(19): LOCATE 10, 70: PRINT CHR$(19)
260 LOCATE 20, 10: PRINT CHR$(19): LOCATE 20, 70: PRINT CHR$(19)
270 D(10, 10) = 0: D(10, 70) = 0: D(20, 10) = 0: D(20, 70) = 0
280 '--DIA & SAC DRAWN
290 LOCATE 21, 78: PRINT STRING$(2, CHR$(176))
300 '-DIGGER MOVE FORWARD
310 '-INKEY CHECK
320 DR = 21: DC = 77: FR = 21: FC = 77: SHOOT = 1: NDR = DR: NDC = DC
330 S1R = 11: S1C = 10: S2R = 11: S2C = 70: S3R = 21: S3C = 10: S4R = 21: S4C = 70
340 LOCATE DR, DC: PRINT CHR$(232): SHOT = 0: FSE = 1: FACE = 1
350 D$ = CHR$(232): F$ = CHR$(2): DI$ = CHR$(4): S$ = CHR$(15)
360 X$ = INKEY$
370 IF X$ = CHR$(0) + CHR$(80) THEN NDR = DR + 1: DM$ = "D": GOTO 440
380 IF X$ = CHR$(0) + CHR$(72) THEN NDR = DR - 1: DM$ = "U": GOTO 440
390 IF X$ = CHR$(0) + CHR$(77) THEN NDC = DC + 1: DM$ = "R": GOTO 440
400 IF X$ = CHR$(0) + CHR$(75) THEN NDC = DC - 1: DM$ = "L": GOTO 440
410 IF X$ = CHR$(27) THEN GOTO 1410
420 IF X$ = CHR$(32) THEN SHOT = 1: GOTO 910
430 GOTO 640
440 '--
450 '-DIGGER MOVE
460 '--
470 SP = SP + 1: SOUND 6000, .1
480 IF NDC < 2 OR NDC > 79 THEN GOTO 640
490 IF NDR >= 23 OR NDR < 2 THEN GOTO 640
500 IF SCREEN(NDR, NDC) = 3 OR SCREEN(NDR, NDC) = 1 THEN GOTO 1410
510 IF SCREEN(NDR, NDC) = 178 THEN 520 ELSE 540
520 LOCATE NDR, NDC: PRINT D$: LOCATE DR, DC: PRINT " "
530 A(DR, DC) = FSE: DR = NDR: DC = NDC: GOTO 640
540 IF SCREEN(NDR, NDC) = 32 THEN 550 ELSE 570
550 LOCATE NDR, NDC: PRINT D$: LOCATE DR, DC: PRINT " ": A(DR, DC) = FSE: DR = NDR: DC = NDC: GOTO 570
560 IF SCREEN(DR, DC + 1) = 32 AND SCREEN(DR, DC - 1) = 32 AND SCREEN(DR - 1, DC) = 32 THEN A(DR, DC) = FSE ELSE A(DR, DC) = FL
570 IF SCREEN(NDR, NDC) = 4 THEN LOCATE NDR, NDC: PRINT D$: GOTO 580 ELSE 600
580 LOCATE DR, DC: PRINT " ": DIA = DIA - 1: FOR i = 200 TO 600 STEP 50: SOUND i, .1: NEXT: IF DIA = 0 THEN 1540
590 A(DR, DC) = FSE: DR = NDR: DC = NDC
600 IF SCREEN(NDR, NDC) = 15 THEN LOCATE NDR, NDC: PRINT D$: GOTO 610 ELSE 630
610 LOCATE DR, DC: PRINT " ": SHOOT = SHOOT + 2:
620 DR = NDR: DC = NDC: A(DR, DC) = FSE
630 '--
640 '-FACE
650 '--
660 IF EXTERMINATOR = 1 THEN GOTO 910
670 IF SP > 20 THEN 680 ELSE GOTO 890
680 FOR i = 1 TO 3000: NEXT
690 IF FACE = 0 THEN FACE = 1: FSE = FSE - 1: FL = FL + 1: LOCATE FR, FC: PRINT " ": FR = 21: FC = 77
700 KU = KU + 1: IF INT(KU / 5) <> KU / 5 THEN 930
710 SOUND 1000, .1: IF SCREEN(FR + 1, FC) = 232 OR SCREEN(FR - 1, FC) = 232 THEN GOTO 1410
720 IF SCREEN(FR, FC + 1) = 232 OR SCREEN(FR, FC - 1) = 232 THEN GOTO 1410
730 IF A(FR + 1, FC) = FSE THEN LOCATE FR + 1, FC: PRINT F$: FM$ = "U": GOTO 740 ELSE 750
740 LOCATE FR, FC: PRINT " ": A(FR, FC) = FL: FR = FR + 1: GOTO 810
750 IF A(FR - 1, FC) = FSE THEN LOCATE FR, FC: PRINT " ": GOTO 760 ELSE 770
760 LOCATE FR - 1, FC: PRINT F$: A(FR, FC) = FL: FR = FR - 1: FM$ = "D": GOTO 810
770 IF A(FR, FC + 1) = FSE THEN LOCATE FR, FC + 1: PRINT F$: GOTO 780 ELSE 790
780 LOCATE FR, FC: PRINT " ": A(FR, FC) = FL: FC = FC + 1: FM$ = "R": GOTO 810
790 IF A(FR, FC - 1) = FSE OR A(FR, FC - 1) = FL + 1 THEN LOCATE FR, FC - 1: PRINT F$: GOTO 800 ELSE 810
800 LOCATE FR, FC: PRINT " ": A(FR, FC) = FL: FC = FC - 1: FM$ = "L": GOTO 810
810 IF FM$ = "R" THEN 820 ELSE 830
820 IF SCREEN(FR, FC + 1) <> 32 AND SCREEN(FR - 1, FC) <> 32 AND SCREEN(FR + 1, FC) <> 32 THEN A(FR, FC - 1) = FSE
830 IF FM$ = "L" THEN 840 ELSE 850
840 IF SCREEN(FR, FC - 1) <> 32 AND SCREEN(FR - 1, FC) <> 32 AND SCREEN(FR + 1, FC) <> 32 THEN A(FR, FC + 1) = FSE
850 IF FM$ = "U" THEN 860 ELSE 870
860 IF SCREEN(FR + 1, FC) <> 32 AND SCREEN(FR, FC + 1) <> 32 AND SCREEN(FR, FC - 1) <> 32 THEN A(FR - 1, FC) = FSE
870 IF FM$ = "D" THEN 880 ELSE 890
880 IF SCREEN(FR - 1, FC) <> 32 AND SCREEN(FR, FC + 1) <> 32 AND SCREEN(FR, FC - 1) <> 32 THEN A(FR + 1, FC) = FSE
890 IF SHOT = 1 THEN 910 ELSE 1170
900 '--
910 '-- SHOOTING
920 '--
930 '--- assigining values
940 IF SHOOTING = 1 THEN GOTO 1050
950 IF SHOOT >= 1 THEN 960 ELSE GOTO 1170
960 IF SHOT = 1 THEN SHOOT = SHOOT - 1: GOTO 970 ELSE 1170
970 IF DM$ = "D" THEN SD$ = "U": GOTO 980 ELSE 990
980 SHOOTING = 1: DRC = DR: DCC = DC: SDC$ = "U": GOTO 1050
990 IF DM$ = "U" THEN SD$ = "D": GOTO 1000 ELSE 1010
1000 SHOOTING = 1: DRC = DR: DCC = DC: SDC$ = "D": GOTO 1050
1010 IF DM$ = "R" THEN SD$ = "L": GOTO 1020 ELSE 1030
1020 SHOOTING = 1: DRC = DR: DCC = DC: SDC$ = "L": GOTO 1050
1030 IF DM$ = "L" THEN SD$ = "R": GOTO 1040 ELSE 1050
1040 SHOOTING = 1: DRC = DR: DCC = DC: SDC$ = "R": GOTO 1050
1050 '--the shooting part
1060 IF DRC > 22 OR DRC < 2 OR DCC > 79 OR DCC < 2 THEN SHOOTING = 0: SHOT = 0
1070 IF SCREEN(DRC, DCC) = 1 OR SCREEN(DRC, DCC) = 2 THEN FACE = 0: SHOOTING = 0: SHOT = 0
1080 IF SCREEN(DRC, DCC) = 178 THEN SHOOTING = 0: SHOT = 0
1090 IF SCREEN(DRC, DCC) = 186 OR SCREEN(DRC, DCC) = 205 THEN SHOOTING = 0: SHOT = 0
1100 LOCATE DRC, DCC: PRINT CHR$(237): A(DRC, DCC) = 0: SOUND 100, .1: FOR i = 1 TO 50: NEXT i
1110 IF SDC$ = "D" THEN DRC = DRC + 1: LOCATE DRC - 1, DCC: PRINT " ": GOTO 1150
1120 IF SDC$ = "U" THEN DRC = DRC - 1: LOCATE DRC + 1, DCC: PRINT " ": GOTO 1150
1130 IF SDC$ = "R" THEN DCC = DCC + 1: LOCATE DRC, DCC - 1: PRINT " ": GOTO 1150
1140 IF SDC$ = "L" THEN DCC = DCC - 1: LOCATE DRC, DCC + 1: PRINT " ": GOTO 1150
1150 GOTO 1170
1160 '--
1170 '--SACK
1180 '--
1190 IF SCREEN(S1R, S1C + 1) = 32 OR SCREEN(S1R, S1C - 1) = 32 THEN LOCATE S1R + 1, S1C: PRINT " ": GOTO 1200 ELSE 1220
1200 LOCATE S1R, S1C: PRINT S$: S1R = S1R + 1
1210 IF S1R >= 22 THEN MOVING1 = 0 ELSE MOVING1 = 1
1220 IF SCREEN(S1R, S1C) = 2 THEN FACE = 0: LOCATE S1R - 1, S1C: PRINT " ": LOCATE S1R, S1C: PRINT S$
1230 IF SCREEN(S1R, S1C) = 232 THEN GOTO 1410
1240 IF SCREEN(S2R, S2C + 1) = 32 OR SCREEN(S2R, S2C - 1) = 32 THEN LOCATE S2R + 1, S1C: PRINT " ": GOTO 1250 ELSE 1270
1250 LOCATE S2R, S2C: PRINT S$: S2R = S2R + 1: SOUND 500, .2
1260 IF S2R >= 22 THEN MOVING2 = 0 ELSE MOVING2 = 1
1270 IF SCREEN(S2R, S2C) = 2 THEN FACE = 0: LOCATE S2R - 1, S2C: PRINT " ": LOCATE S2R, S2C: PRINT S$: MOVING2 = 0
1280 IF SCREEN(S2R, S2C) = 232 THEN GOTO 1410
1290 IF SCREEN(S3R, S3C + 1) = 32 OR SCREEN(S3R, S3C - 1) = 32 THEN LOCATE S3R + 1, S3C: PRINT " ": GOTO 1300 ELSE 1320
1300 LOCATE S3R, S3C: PRINT S$: S3R = S3R + 1: SOUND 500, .2
1310 IF S3R >= 22 THEN MOVING3 = 0 ELSE MOVING3 = 1
1320 IF SCREEN(S3R, S3C) = 2 THEN FACE = 0: LOCATE S3R - 1, S3C: PRINT " ": LOCATE S3R, S3C: PRINT S$: MOVING3 = 0
1330 IF SCREEN(S3R, S3C) = 232 THEN GOTO 1410
1340 IF SCREEN(S4R, S4C + 1) = 32 OR SCREEN(S4R, S4C - 1) = 32 THEN LOCATE S4R + 1, S4C: PRINT " ": GOTO 1350 ELSE 1370
1350 LOCATE S4R, S4C: PRINT S$: S4R = S4R + 1: SOUND 500, .2
1360 IF S4R >= 22 THEN MOVING4 = 0 ELSE MOVING4 = 1
1370 IF SCREEN(S4R, S4C) = 2 THEN FACE = 0: LOCATE S4R - 1, S4C: PRINT " ": LOCATE S4R, S4C: PRINT S$: MOVING4 = 0
1380 IF SCREEN(S4R, S4C) = 232 THEN GOTO 1410
1390 IF EXTERMINATOR = 1 THEN 1750
1400 IF SP > 20 THEN 1690 ELSE 360
1410 '--
1420 '-ENDING PROGRAM
1430 '--
1440 OPEN "O", #1, "LEV.DAT"
1450 WRITE #1, 1: WRITE #1, 2: WRITE #1, 3: WRITE #1, 4
1460 CLOSE #1
1470 FOR i = 100 TO 2500 STEP 100: SOUND i, .2: NEXT
1480 LOCATE 12, 35: PRINT "G A M E O V E R"
1490 LOCATE 13, 35: PRINT "G A M E O V E R"
1500 LOCATE 14, 35: PRINT "G A M E O V E R"
1510 X$ = INPUT$(1)
1520 SYSTEM
1530 '-
1540 '-SHIFTING TO NEW LEVEL
1550 '--
1560 OPEN "I", #1, "LEV.DAT"
1570 OPEN "O", #2, "LEVE.DAT"
1580 INPUT #1, LEVEL
1590 IF LEVEL = 4 THEN 1420
1600 IF EOF(1) THEN 1640
1610 INPUT #1, LEVEL
1620 WRITE #2, LEVEL
1630 GOTO 1600
1640 CLOSE #1, #2
1650 KILL "LEV.DAT"
1660 NAME "LEVE.DAT" AS "LEV.DAT"
1670 CLEAR : GOTO 20
1680 '--
1690 'THE EXTERMINATOR
1700 '--
1710 IF CHECKING = 1 THEN 1720 ELSE FST = FR: FST2 = FC
1720 IF FST = FR AND FST2 = FC THEN SAP = SAP + 1 ELSE SAP = 0: CHECKING = 0
1730 IF SAP >= 1 THEN CHECKING = 1
1740 IF SAP >= 50 THEN EXTERMINATOR = 1: GOTO 1750 ELSE GOTO 360
1750 FOR i = 1 TO 3000: NEXT: UK = UK + 1: IF UK / 7 = INT(UK / 7) THEN 1760 ELSE 360
1760 LOCATE FR, FC: PRINT CHR$(1): SOUND 710, .1
1770 IF FACE = 0 THEN GOTO 690
1780 SUBR = FR - DR: SUBC = FC - DC
1790 IF SGN(SUBR) = 1 AND SGN(SUBC) = 1 THEN EM$ = "LU"
1800 IF SGN(SUBR) = 1 AND SGN(SUBC) = -1 THEN EM$ = "RU"
1810 IF SGN(SUBR) = -1 AND SGN(SUBC) = -1 THEN EM$ = "RD"
1820 IF SGN(SUBR) = -1 AND SGN(SUBC) = 1 THEN EM$ = "LD"
1830 IF SGN(SUBR) = 0 AND SGN(SUBC) = 1 THEN EM$ = "L"
1840 IF SGN(SUBR) = 1 AND SGN(SUBC) = 0 THEN EM$ = "U"
1850 IF SGN(SUBR) = 0 AND SGN(SUBC) = -1 THEN EM$ = "R"
1860 IF SGN(SUBR) = -1 AND SGN(SUBC) = 0 THEN EM$ = "D"
1870 IF LEN(EM$) = 2 THEN 1920
1880 IF EM$ = "L" THEN NFC = FC - 1: NFR = FR
1890 IF EM$ = "U" THEN NFR = FR - 1: NFC = FC
1900 IF EM$ = "R" THEN NFC = FC + 1: NFR = FR
1910 IF EM$ = "D" THEN NFR = FR + 1: NFC = FC
1920 IF EM$ = "LU" THEN NFR = FR - 1: NFC = FC - 1
1930 IF EM$ = "RU" THEN NFR = FR - 1: NFC = FC + 1
1940 IF EM$ = "RD" THEN NFR = FR + 1: NFC = FC + 1
1950 IF EM$ = "LD" THEN NFR = FR + 1: NFC = FC - 1
1960 IF SCREEN(NFR, NFC) = 232 THEN 1420
1970 IF SCREEN(NFR, NFC) = 4 THEN DIA = DIA - 1: GOTO 2000
1980 IF SCREEN(NFR, NFC) = 2 OR SCREEN(NFR, NFC) = 32 OR SCREEN(NFR, NFC) = 178 THEN 2000
1990 IF SCREEN(NFR, NFC) = 19 OR SCREEN(NFR, NFC) = 236 THEN 2000 ELSE 2010
2000 LOCATE FR, FC: PRINT " ": LOCATE NFR, NFC: PRINT CHR$(1)
2010 '
2020 FR = NFR: FC = NFC: GOTO 360
2030 '-
2040 '-INTRODUCTION
2050 '--
2060 SCREEN 0, 0, 0: KEY OFF: CLS
2070 PRINT "   D I G G E R": PRINT STRING$(80, "-"): PRINT
2080 PRINT TAB(51); "By Navin.K.Ipe Copyright (C)"
2090 COLOR 20: PRINT "     I N T R O D U C T I O N"
2100 COLOR 14: PRINT "----------------------------------"
2110 COLOR 12: PRINT "   This is a distorted version of"
2120 PRINT "     of a very famous computer game"
2130 PRINT "       DIGGER.In this game,you will be"
2140 PRINT "         required to eat some diamonds"; CHR$(4)
2150 PRINT "           Eating all diamonds ,allows you"
2160 PRINT "             To enter the next level.A face,"
2170 PRINT "               will follow you.You can shoot it"
2180 PRINT "                 by pressing the enter key. Any"
2190 PRINT "                   contact with the face ends the"
2200 PRINT "                     game.An Exterminator face will"
2210 PRINT "                       kill you if you fool around with"
2220 PRINT "                         the non-Exterminator white face."
2230 COLOR 14: PRINT TAB(26); STRING$(35, "-")
2240 COLOR 15: PRINT "     ALL THE BEST THEN !!"
2250 X$ = INPUT$(1)
2260 RETURN