The one 30 years ago never had random dice location or any sound...
Wrote it for a Mainframe system that used dumb terminals.....
I still welcome anyone to jump in with better Sound Effects...
I'm thinking in 1 to 2 weeks I'm calling this done and moving on to another project...
I'm pretty happy with the game actually.. Spent about 2 hrs tonight just playing
it and seeing if anything would break....
Only 1 TODO left.
2, 3 and 6 dice look different depending what side they fall on..
Got to make that visual enhancement.
Code: Select all
REM THIS IS THE CRAPS PROGRAM
REM THESE ARE THE TEMPORARY DICE VALUES
10 DIM DI(2)
15 TL$=""
16 FOR I = 1 TO 70:TL$=TL$+" ":NEXT I
REM GAME MESSAGES.
20 DIM MSG$(18)
REM STRINGS TO DISPLAY THE DICE
22 DIM D$(10)
23 D$(1) = CHR$($D5):FOR I = 1 TO 5:D$(1)=D$(1)+CHR$($60):NEXT I
24 D$(1) = D$(1) + + CHR$($C9)
25 D$(7) = CHR$($6A):FOR I = 1 TO 5:D$(7)=D$(7)+CHR$($60):NEXT I
26 D$(7) = D$(7) + CHR$($6B)
REM FLAG IS GENERAL PURPOSE VALUE TO COMMUNICATE BETWEEN GOSUBS AND CALLING CODE
30 FLAG = 0: DI(1) = RND(-TI):MP=0
REM SET MESSAGES TO BLANK STRING
31 GOSUB 6000
35 FMINIT:FMINST 3, 56:FMINST 7, 52: REM 127 INITIALIZE THE FM CHIP
40 PT = 5000: REM THIS IS THE USERS POT OF MONEY
45 GOSUB 5000:GOSUB 7500:REM BORDER SUB THEN SHOW THE POT
70 MSG$(2) = CHR$($9E)+"LETS PLAY A GAME OF CRAPS !"
75 MSG$(5) = CHR$($1E)+"PRESS ANY KEY TO START THE GAME"
80 GOSUB 7000: REM SHOW THE MESSAGES
82 GOSUB 8000: REM WAIT FOR KEYPRESS
83 GOTO 100
90 LOCATE 5,6:COLOR 5,0
91 PRINT " **";
92 COLOR 7,0:PRINT " LETS CONTINUE ";
93 COLOR 5,0:PRINT "**";
94 COLOR 1,0
100 REM GAME LOGIC STARTS HERE
310 GOSUB 2000: REM GET THE BET
315 GOSUB 6000: REM BLANK THE MESSAGES
316 GOSUB 7000: REM CLEAR MESSAGE AREA
320 IF B < PT THEN MSG$(2) = "YOUR BET IS "+CHR$($9E)++"$"+STR$(B)+".00"
325 IF B = PT THEN MSG$(2) = CHR$($9E)+"YOU BET IT ALL !!!!!!!!!!!"
326 IF B = 666 THEN MSG$(2)=MSG$(2)+CHR$($81)+ " (THAT BET IS FULL OF SIN)"
330 MSG$(4) = CHR$($1E) + "PRESS ANY KEY TO ROLL YOUR POINT"
335 GOSUB 7000: REM SHOW MESSAGES
340 GOSUB 8000: REM WAIT FOR KEYPRESS
350 GOSUB 3000: REM LOAD THE DICE
370 MP = 1
375 IF R = 7 OR R = 11 THEN MP = 0
380 IF R = 7 OR R = 11 THEN GOSUB 1500
390 IF R = 2 OR R = 3 OR R = 12 THEN LM$ = "YOU CRAPPED OUT !!! "
400 IF R = 2 OR R = 3 OR R = 12 THEN GOSUB 1700
420 IF R = 2 OR R = 3 OR R = 12 THEN MP = 0
470 P=R: REM POINT TO MAKE R IS THE VALUE OF THE DICE ROLL
480 IF PT = 0 THEN GOTO 1000
700 LOCATE 21, 10:COLOR 5, 0
710 IF MP=0 THEN PRINT "***";
715 IF MP=0 THEN COLOR 7,0
720 IF MP=0 THEN PRINT " PRESS ANY KEY TO CONTINUE ";
725 IF MP=0 THEN COLOR 5,0
730 IF MP=0 THEN PRINT "***";
760 IF MP=1 THEN PRINT "POINT TO MAKE IS:";
770 IF MP=1 THEN COLOR 7,0
775 IF MP=1 THEN PRINT P;:COLOR 5,0
780 IF MP=1 THEN PRINT " ANY KEY TO START YOUR ROLL ";
781 IF MP=1 THEN RS=0
785 COLOR 1,0
790 GOSUB 8000:GOSUB 6000:GOSUB 5330
800 IF MP=0 THEN GOTO 90
810 LOCATE 56, 5 : COLOR 5, 0
811 PRINT " ";
812 LOCATE 56, 5
813 PRINT "POINT TO MAKE IS:";
814 COLOR 7,0:PRINT P,
815 COLOR 5,0:PRINT "BET IS: ";
820 COLOR 7,0:PRINT "$";B;".00";
825 GOSUB 7500
830 GOSUB 3000
835 LOCATE 15, 12
840 IF P = R THEN PRINT "YOU MADE YOUR POINT !!!! "
850 IF P = R THEN GOSUB 1500
860 IF R = 7 THEN LM$= "*** YOU MISSED YOUR POINT! ***"
870 IF R = 7 THEN GOSUB 1700
880 IF P<>R AND R<>7 THEN GOTO 810
881 LOCATE 58,5:PRINT " ";
885 LOCATE 21, 12
890 COLOR 5,0
895 PRINT "***";
900 COLOR 7,0
905 PRINT" PRESS ANY KEY TO CONTINUE ";
910 COLOR 5,0:PRINT "***";:COLOR 1,0
940 GOSUB 8000:GOSUB 5330
950 MP=0
980 GOTO 90
1000 SCREEN 0:COLOR 1,0:CLS:PRINT
1005 COLOR 10, 0
1010 IF PT = 0 OR PT < 0 THEN PRINT "YOU LOST IT ALL !!!"
1015 COLOR 5,0
1020 PRINT
1025 IF PT > 0 THEN PRINT "YOU FINISHED WITH ";
1030 IF PT > 0 THEN COLOR 7,0
1040 IF PT > 0 THEN PRINT "$";PT;".00"
1050 COLOR 1, 0:PRINT
1110 PRINT "HOPE YOU ENJOYED PLAYING CRAPS !!"
1120 END
1500 PT = PT + B
1520 GOSUB 7500
1525 COLOR 7, 0:LOCATE 17, 12
1530 PRINT "YOU WON THE ROLL !!";
1540 FMPLAY 3,"T110 O4 ADABDBCA"
1560 COLOR 1,0:RETURN
1700 PT = PT - B
1710 GOSUB 7500
1720 COLOR 10, 0: LOCATE 17, 12
1730 PRINT LM$;
1740 FMPLAY 7, "T75 O2 GGGEDC"
1745 IF PT = 0 OR PT<0 THEN GOTO 1000
1750 COLOR 1,0:RETURN
1999 REM INPUT THE BET
2000 B$ = "":B = 0
2040 GOSUB 7500:LOCATE 56, 5
2060 FOR X = 1 TO 74:PRINT " ";:NEXT X
2070 LOCATE 56,5:COLOR 1, 0
2080 INPUT "ENTER YOUR BET : "; B$
2090 IF LEFT$(B$,1)="Q" THEN GOSUB 10000
2100 B = INT(VAL(B$))
2110 LOCATE 57, 5
2120 COLOR 10, 0
2130 IF B = 0 OR B < 0 THEN PRINT "MUST ENTER A POSITIVE BET !!, TRY AGAIN !! ";
2140 IF B > PT THEN PRINT "YOU CAN'T BET MORE THAN YOU HAVE !! TRY AGAIN !!";
2150 IF B > PT OR B = 0 THEN GOTO 2000
2160 IF B < 0 THEN GOTO 2000
2170 COLOR 1, 0
2180 LOCATE 56, 5:PRINT " ";
2190 LOCATE 57, 5:PRINT " ";
2200 RETURN
2999 REM LOAD THE DICE
3000 FOR I = 1 TO 2
3010 DI(I) = INT(RND(1)* 6) + 1
3020 NEXT I
3025 R = DI(1)+DI(2)
3030 GOSUB 4000
3050 RETURN
3999 REM DISPLAY THE ROLL
4000 GOSUB 9000: REM DRAW THE TABLE
4010 GOSUB 9500: REM SOUND EFFECT
4015 COLOR 0,1
4020 FOR SD = 1 TO 2
4025 FOR X = 2 TO 6:D$(X)=" ":NEXT X
4026 D$(3)= " ":D$(5)=" "
4030 D=DI(SD)
4040 IF D = 1 THEN D$(2) = " "
4050 IF D = 1 THEN D$(4) = " " + CHR$($71)+" "
4060 IF D = 1 THEN D$(6) = " "
4070 IF D = 2 OR D = 3 THEN D$(2)=" "+CHR$($71)
4080 IF D = 2 OR D = 3 THEN D$(6)=CHR$($71)+" "
4090 IF D = 3 OR D = 5 THEN D$(4)=" "+CHR$($71)+" "
4100 IF D = 5 OR D = 6 OR D = 4 THEN D$(2)=CHR$($71)+" "+CHR$($71)
4110 IF D = 5 OR D = 6 OR D = 4 THEN D$(6)=CHR$($71)+" "+CHR$($71)
4120 IF D = 6 THEN D$(4)=CHR$($71)+" "+CHR$($71)
4125 FOR U = 2 TO 6: D$(U)=CHR$($62) + D$(U)+CHR$($62):NEXT U
4130 IF SD = 2 THEN CL = L
4140 IF SD = 2 THEN CC = C
4150 L = INT(RND(0)*13) + 26
4160 C = INT(RND(0)*62) + 7
4170 IF SD = 1 THEN GOTO 4490
4175 IF CL > L+8 OR CL < L-8 THEN GOTO 4490
4190 IF CC > C+8 OR CC < C-8 THEN GOTO 4490
4200 GOTO 4150 : REM IF THEY OVERLAP TRY ANOTHER SET OF COORDINATES
4490 FOR X = 1 TO 7
4500 LOCATE L + X, C
4510 PRINT D$(X);
4520 NEXT X
4530 NEXT SD
4540 LOCATE 11, 12:COLOR 5,0
4545 PRINT " ";:LOCATE 11,12
4550 PRINT "YOU ROLLED :";
4555 COLOR 7,0:PRINT R;" ";
4560 LOCATE 13, 9:PRINT" ";:LOCATE 13, 9
4570 COLOR 5, 0
4580 IF MP=0 AND R=7 THEN PRINT "**";
4590 IF R=2 OR R=11 OR R=12 THEN PRINT "**";
4600 COLOR 7,0
4610 IF R=11 THEN PRINT " A NATURAL !! ";
4620 IF MP=0 AND R=7 THEN PRINT " LUCKY SEVEN !! ";
4630 IF R=2 THEN PRINT " SNAKE EYES !! ";
4640 IF R=12 THEN PRINT " BOXCARS !! ";
4650 COLOR 5,0
4660 IF MP=0 AND R=7 THEN PRINT "**";
4670 IF R=2 OR R=11 OR R=12 THEN PRINT "**";
4680 COLOR 1, 0
4690 GOSUB 9600
4700 RETURN
4990 REM THIS SUB DISPLAYS THE BORDER.
5000 SCREEN 0
5009 REM RED BORDER
5010 COLOR 2, 0 :CLS: REM RED FOREGROUND WHITE BACKGROUND
5020 FOR I = 1 TO 27:PRINT "*";:NEXT I
5021 COLOR 2, 6
5025 FOR I = 1 TO 26:PRINT "-";:NEXT I
5026 COLOR 2, 0
5030 FOR I = 1 TO 27:PRINT "*";:NEXT I
5040 FOR I = 2 TO 52
5045 LOCATE I, 1: PRINT "*";
5050 LOCATE I, 80: PRINT "*";
5060 NEXT I
5080 LOCATE 53, 1
5090 FOR I = 1 TO 80:PRINT "*";:NEXT I
5149 REM NEXT COLOR IS WHITE (RED WHITE & BLUE)
5150 COLOR 1,0
5151 LOCATE 2,2
5155 FOR I = 1 TO 26:PRINT "*";:NEXT I
5156 COLOR 1, 6
5160 PRINT " X16 CRAPS -- PETSCII ";
5161 COLOR 1, 0
5165 FOR I = 1 TO 26:PRINT "*";:NEXT I
5170 FOR I = 3 TO 51
5175 LOCATE I, 2: PRINT "*";
5180 LOCATE I, 79: PRINT "*";
5190 NEXT I
5200 LOCATE 52, 2
5210 FOR I = 1 TO 78: PRINT "*"; :NEXT I
5219 REM NEXT COLOR IS BLUE
5220 COLOR 14, 0
5230 LOCATE 3,3
5240 FOR I = 1 TO 25:PRINT "*";:NEXT I
5245 COLOR 14, 6
5250 FOR I = 1 TO 26:PRINT "-";:NEXT I
5255 COLOR 14, 0
5260 FOR I = 1 TO 25:PRINT "*";:NEXT I
5270 FOR I = 4 TO 50
5290 LOCATE I, 3: PRINT "*";
5300 LOCATE I, 78: PRINT "*";
5310 NEXT I
5320 LOCATE 51,3
5322 FOR I = 1 TO 76:PRINT "*"; :NEXT I
5323 LOCATE 52, 54:COLOR 1, 6:PRINT " USE THE Q KEY TO QUIT ";
5324 COLOR 1,0
5330 FOR I = 4 TO 22 : REM CLEAR THE INNER AREA.
5340 LOCATE I, 4
5375 PRINT TL$;
5380 NEXT I
5385 GOSUB 9000:COLOR 1, 0
5390 RETURN
5999 REM TURN GAME MESSAGE STRINGS TO BLANK
6000 FOR I = 1 TO 18
6010 MSG$(I) = " "
6020 NEXT I
6030 RETURN
6999 REM SHOW MESSAGES
7000 COLOR 5, 0
7005 FOR I = 4 TO 20
7010 LOCATE I, 5
7015 M=INT(I-3)
7020 PRINT MSG$(M);
7030 NEXT I
7040 RETURN
7499 REM UPDATE POT
7500 COLOR 5,0: LOCATE 49, 6
7510 PRINT " ";
7520 LOCATE 49, 6
7540 PRINT "MONEY IN THE POT: ";
7550 COLOR 7,0:PRINT "$";STR$(PT);".00";
7560 RETURN
7999 REM WAIT FOR A KEY TO BE PRESSED, IF Q IS PRESSED ASK IF QUIT
8000 GET I$:IF I$<>"" THEN GOTO 8000 : REM FLUSH KEYBOARD BUFFER
8010 GET I$
8020 IF I$="Q" THEN GOSUB 10000
8025 IF I$="Q" THEN I$=""
8030 IF I$="" THEN GOTO 8010
8100 RETURN
8999 REM DRAW THE CRAPS TABLE
9000 LOCATE 23, 6:COLOR 10, 2
9010 FOR CT = 1 TO 70:PRINT CHR$($B9);:NEXT CT
9015 LOCATE 47, 6
9020 FOR CT = 1 TO 70:PRINT CHR$($B8);:NEXT CT
9045 COLOR 0, 5
9050 FOR CT = 24 TO 46
9075 LOCATE CT, 6
9080 PRINT TL$;
9090 NEXT CT
9150 RETURN
9499 REM ROLL START SOUND EFFECT
9500 FMDRUM 4, 25
9510 SLEEP 6
9520 FOR X = 1 TO 3:FMDRUM 4, 85:SLEEP 4:NEXT X
9550 RETURN
9599 REM ROLL COMPLETE SOUND EFFECT
9600 FOR X = 1 TO 2:FMDRUM 4, 77:SLEEP 3:NEXT X
9610 SLEEP 12
9650 RETURN
10000 LOCATE 56, 5
10005 PRINT " ";
10010 FLAG = 1
10020 LOCATE 56,5:COLOR 1,0
10030 INPUT "DO YOU REALLY WANT TO QUIT ? (ENTER Y OR N):"; B$
10040 AN$=LEFT$(B$,1)
10050 IF AN$="Y" THEN GOTO 1000
10060 IF AN$<> "N" THEN GOTO 10000
10070 LOCATE 56, 5
10075 PRINT " ";
10100 RETURN
