Game of CRAPS. Written in BASIC.

Post Reply
User avatar
ahenry3068
Posts: 1139
Joined: Tue Apr 04, 2023 9:57 pm

File Download Game of CRAPS. Written in BASIC.

Post by ahenry3068 »

CRAPS GAME I'VE BEEN WORKING ON
EMULATOR R42

Unrestricted License... Do what you want with it. :)

VERSION 1.0

Code: Select all

10 REM THIS IS THE CRAPS PROGRAM
20 DIM DI(2): REM THESE ARE THE TEMPORARY DICE VALUES
21 DIM MSG$(18):  REM GAME MESSAGES.
22 GOSUB 6000 :  REM SET MESSAGES TO BLANK STRING
REM GENERAL PURPOSE VALUE TO COMMUNICATE BETWEEN GOSUBS AND CALLING CODE
23 FLAG = 0
24 DI(1) = RND(-TI):MP=0
25 FMINIT:FMINST 6,45: REM 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

50 MSG$(2) = CHR$($9E)+"LETS PLAY A GAME OF CRAPS !"
60 MSG$(5) = CHR$($1E)+"PRESS ANY KEY TO START THE GAME"
70 GOSUB 7000: REM SHOW THE MESSAGES
80 GOSUB 8000: REM WAIT FOR KEYPRESS
85 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 !!!!!!!!!!!"
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 26, 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 "POINT TO MAKE IS:";
812 COLOR 7,0:PRINT P,
813 COLOR 5,0:PRINT "BET IS: ";
815 COLOR 7,0:PRINT "$";B;".00";
820 RS=RS+1

825 GOSUB 7500
830 GOSUB 3000
835 LOCATE 18, 5
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 26, 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 20,5
1530 PRINT "YOU WON THE ROLL !!";
1540 FMPLAY 4,"TADATADA"
1560 COLOR 1,0:RETURN 

1700 PT = PT - B
1710 GOSUB 7500
1720 COLOR 10, 0: LOCATE 20,5 
1730 PRINT LM$;
1740 FMPLAY 3, "BBBGGCCB"
1745 IF PT = 0 OR PT<0 THEN GOTO 1000
1750 COLOR 1,0:RETURN


1999 REM INPUT THE BET
2000 B$ = "":B = 0
2001 GOSUB 7500
2003 COLOR 1,0:LOCATE 56, 5
2004 LOCATE 56, 5:PRINT "                                                    ";
2005 LOCATE 56,5
2006 INPUT "ENTER YOUR BET : "; B$
2007 IF LEFT$(B$,1)="Q" THEN GOSUB 10000
2008 B = INT(VAL(B$))
2010 LOCATE 57, 5
2015 COLOR 10, 0
2020 IF B = 0 OR B < 0 THEN PRINT "MUST ENTER A POSITIVE BET !!,    TRY AGAIN !!       ";
2060 IF B > PT THEN PRINT "YOU CAN'T BET MORE THAN YOU HAVE !!   TRY AGAIN !!";
2080 IF B > PT OR B = 0 THEN GOTO 2000
2085 IF B < 0 THEN GOTO 2000
2090 COLOR 1, 0
2100 LOCATE 56, 5:PRINT "                                                  ";
2110 LOCATE 57, 5:PRINT "                                                  ";
2120 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.  JUST PRINT UNTIL GAME LOGIC IS DONE
4000 GOSUB 7000: REM CLEAR THE SCREEN AREA
4001 FMPLAY 0, "G"
4005 LOCATE 14, 5
4006 M$ = CHR$($1E)+"DICE 1: "+CHR$($9E)+STR$(DI(1))+CHR$($1E)
4007 M$ = M$ + "      DICE 2: "+CHR$($9E)+STR$(DI(2))
4008 PRINT M$;
4010 COLOR 5,0:M$ = CHR$($9E) + STR$(R)
4015 LOCATE 16, 5:PRINT "YOU ROLLED: ";M$;
4020 LOCATE 18, 5
4025 COLOR 5, 0
4030 IF MP=0 AND R=7  THEN PRINT "**";
4040 IF R=2 OR R=11 OR R=12 THEN PRINT "**";
4045 COLOR 7,0
4050 IF R=11 THEN PRINT "  A NATURAL   !!  ";
4055 IF MP=0 AND R=7 THEN PRINT "  LUCKY SEVEN !!  ";
4060 IF R=2 THEN PRINT "  SNAKE EYES  !!  ";
4065 IF R=12 THEN PRINT "   BOXCARS    !!  ";
4070 COLOR 5,0
4075 IF MP=0 AND R=7 THEN PRINT "**";
4076 IF R=2 OR R=11 OR R=12 THEN PRINT "**";
4080 COLOR 1, 0
4090 FMPLAY 6,"B"
4100 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 -- TEXT MODE  ";
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 49 : REM CLEAR THE INNER AREA. 
5340     LOCATE I, 4
5350     FOR C = 4 TO 77
5360         PRINT " ";        
5370     NEXT C
5380 NEXT I 
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 21
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 "MONEY IN THE POT: ";
7520 COLOR 7,0:PRINT "$";STR$(PT);".00";
7530 RETURN

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

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 
TOKENIZED FILE
CRAPS1.PRG
(5.66 KiB) Downloaded 351 times
VERSION 2.0

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 
TOKENIZED FILE:
CRAPS2.PRG
(7.08 KiB) Downloaded 334 times
Last edited by ahenry3068 on Wed May 03, 2023 6:34 pm, edited 2 times in total.
voidstar
Posts: 494
Joined: Thu Apr 15, 2021 8:05 am

Re: Game of CRAPS. Written in BASIC.

Post by voidstar »

Play testing on hardware.

Anyone else get this lucky after betting all their money on the first roll? :D Won three rounds after that, was up to $80K !! At least verified no 32,767 or even 65,535 limit! :lol:
Attachments
IMG_1923a.jpg
IMG_1923a.jpg (255.25 KiB) Viewed 3830 times
User avatar
ahenry3068
Posts: 1139
Joined: Tue Apr 04, 2023 9:57 pm

Re: Game of CRAPS. Written in BASIC.

Post by ahenry3068 »

No practical limit. I'm using a Float so

from the C64 Wiki

"to handle real numbers in the range ±2.93873588·10−39 to ±1.70141183·1038."
User avatar
ahenry3068
Posts: 1139
Joined: Tue Apr 04, 2023 9:57 pm

Game of CRAPS. BASLOAD

Post by ahenry3068 »

This is a direct port of my Craps 2.0 to BASLOAD style source code.

I deliberately avoided making any logic changes at all, So when it "compiles" it is essentially the identical program to the original. The source is MUCH more readable in BASLOAD format.

HERES THE SOURCE
CRAPSWORKB.BAS
(10.01 KiB) Downloaded 200 times
Post Reply