Compucolor.org – Virtual Media

Listing of file='CRAG.BAS;01' on disk='vmedia/chip_12-sector.ccvf'

100 REM  CRAG DICE GAME
110 OUT 8,255:OUT 8,247
120 PLOT 6,2,12,27,24,15
130 GOSUB 2750
140 CLEAR 1000
145 A= PEEK (33209):FOR B= 0TO 10* A:C= RND (1):NEXT B
150 DIM G(4,13),H(3)
155 DD= 250
160 GOSUB 1100
170 PLOT 6,1,14,3,0,31
180 OUT 8,255
185 CQ= 0
190 INPUT "HOW MANY PLAYERS (1-4) ? ";Q
200 OUT 8,247
210 PLOT 3,0,31,11
220 IF Q< 1OR Q> 4THEN 170
230 PLOT 3,0,22,15,11
232 IF Q< 4THEN 4000
240 PL= Q
250 PLOT 15:GOSUB 1830
260 J$= "A"
270 PP= ASC (J$)- 64
280 PLOT 6,6,14,3,0,31,11
290 PLOT 3,0,31
295 IF CQ= 1AND PP= PLTHEN 4100
300 PRINT "PLAYER ";J$;" ";
310 PLOT 6,1:PRINT " HIT RETURN TO THROW THE DICE !"
320 OUT 8,255
330 POKE 33278,0
340 K= RND (1)
350 IF PEEK (33278)= 0THEN 340
360 OUT 8,247
370 PLOT 14,3,0,31,11
380 GOSUB 1580
390 PLOT 14,6,6,3,0,31
400 PRINT "PLAYER ";J$;" ";
410 PLOT 6,1
420 OUT 8,255
430 INPUT "SELECT COMPARTMENT (M-Y) OR HIT RETURN !";Q$
440 OUT 8,247
450 Q$= LEFT$ (Q$,1)
460 PLOT 14,3,0,31,11
470 IF Q$< "Z"AND Q$> "L"THEN 3040
480 GOSUB 2670
490 PLOT 6,3,15,3,17,27
500 IF Q$= "@"THEN 2550
510 OUT 8,255
520 INPUT "KEEP(Y/N)?";Q$
530 OUT 8,247
540 PLOT 3,0,27,11
550 IF LEFT$ (Q$,1)= "Y"THEN 740
560 E= 0:GOSUB 570:GOTO 740
570 B= PEEK (33209):FOR I= 0TO B:C= FN R(0):NEXT
580 FOR I= 0TO C
590 D(E)= FN R(0)
600 XX= 21+ E* 8
610 PLOT 3,XX,23
620 ON D(E)GOSUB 1780,1790,1800,1810,1810,1810
630 PLOT 3,XX,24
640 ON D(E)GOSUB 1820,1780,1820,1780,1820,1810
650 PLOT 3,XX,25
660 ON D(E)GOSUB 1780,1800,1790,1810,1810,1810
670 NEXT I
680 H(E)= D(E)
690 I= H(0)+ H(1)+ H(2)
700 GOSUB 1930
710 RETURN
720 REM
730 REM
740 GOSUB 2670
750 PLOT 6,3,3,25,27
760 OUT 8,255
770 INPUT "KEEP(Y/N)?";Q$
780 OUT 8,247
790 PLOT 3,0,27,11
800 IF LEFT$ (Q$,1)= "Y"THEN 880
810 E= 1
820 GOSUB 570
830 GOTO 880
840 REM
850 REM
860 REM
870 REM
880 GOSUB 2670
890 PLOT 6,3,3,33,27
900 OUT 8,255
910 INPUT "KEEP(Y/N)?";Q$
920 OUT 8,247
930 PLOT 3,0,27,11
940 IF LEFT$ (Q$,1)= "Y"THEN 970
950 E= 2
960 GOSUB 570
970 PLOT 14,6,6,3,0,31
980 PRINT "PLAYER ";J$;" ";
990 PLOT 6,1
1000 OUT 8,255
1010 INPUT "LAST CHANCE...SELECT COMPARTMENT (M-Y) ? ";Q$
1020 OUT 8,247
1030 PLOT 14,3,0,31,11
1040 Q$= LEFT$ (Q$,1)
1050 IF Q$= "@"THEN 2550
1060 IF Q$< "Z"AND Q$> "L"THEN SW= 1:GOTO 3040
1070 GOTO 970
1080 REM
1090 REM
1100 REM  DRAW SCREEN
1110 A$= "gggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg"
1120 RC= 13
1130 RD= 1
1140 PLOT 6,7,15,3,55,29
1150 PRINT "ROUND";RD
1160 B$= "n+nnn+n+n+n+n+n"
1170 PLOT 6,7,15,3,8,1
1180 PRINT ""
1190 PLOT 6,56,14,3,8,3
1200 PRINT "  C R A G      D I C E     S C O R E B O A R D  "
1210 PLOT 6,6,3,15,22,15
1220 PRINT "COPYRIGHT 1980 BY DONALD R MILLER"
1230 Y= 5:PLOT 15,6,1,3,2,Y+ 1
1240 PRINT "M  N  O  P  Q  R   S     T     U     V     W     X     Y"
1250 PLOT 6,3,3,2,Y+ 4
1260 PRINT "1  2  3  4  5  6 1-2-3 4-5-6 1-3-5 2-4-6             5-5-3"
1270 PLOT 3,43,Y+ 3:PRINT "THREE 3-4-6 4-4-5"
1280 PLOT 3,43,Y+ 5:PRINT "ALIKE 2-5-6 6-6-1"
1290 PLOT 6,7,3,1,Y+ 7
1300 PRINT "1X 2X 3X 4X 5X 6X   20    20    20    20    25    26    50"
1310 PLOT 6,4,15
1320 PLOT 3,0,Y:PRINT A$
1330 PLOT 3,0,Y+ 2:PRINT A$
1340 FOR YY= 6TO 16STEP 2
1350 PLOT 3,0,Y+ YY
1360 PRINT A$
1370 NEXT YY
1380 PLOT 27,10
1390 FOR XX= 0TO 18STEP 3
1400 PLOT 3,XX,Y+ 1
1410 PRINT B$
1420 NEXT XX
1430 FOR XX= 24TO 60STEP 6
1440 PLOT 3,XX,Y+ 1
1450 PRINT B$
1460 NEXT XX
1470 PLOT 3,63,Y+ 1:PRINT B$
1480 PLOT 6,1,3,62,Y+ 1:PRINT "TOTAL "
1490 PLOT 3,61,Y+ 1:PRINT "      "
1500 PLOT 27,24
1510 C$(0)= "   "
1520 C$(1)= "  d"
1530 C$(2)= "d  "
1540 C$(3)= "d d"
1550 C$(4)= " d "
1560 DEF FN R(X)= INT (6* RND (1)+ 1)
1570 RETURN
1580 REM  ROLL THE DICE
1590 PLOT 15
1600 B= PEEK (33209):FOR I= 0TO B:C= FN R(0):NEXT
1610 FOR I= 0TO C
1620 D(0)= FN R(0):D(1)= FN R(0):D(2)= FN R(0)
1630 E= 0
1640 FOR XX= 21TO 37STEP 8
1650 PLOT 3,XX,23
1660 ON D(E)GOSUB 1780,1790,1800,1810,1810,1810
1670 PLOT 3,XX,24
1680 ON D(E)GOSUB 1820,1780,1820,1780,1820,1810
1690 PLOT 3,XX,25
1700 ON D(E)GOSUB 1780,1800,1790,1810,1810,1810
1710 E= E+ 1
1720 NEXT XX
1730 NEXT I
1740 H(0)= D(0):H(1)= D(1):H(2)= D(2)
1750 I= H(0)+ H(1)+ H(2)
1760 GOSUB 1930
1770 RETURN
1780 PRINT C$(0):RETURN
1790 PRINT C$(1):RETURN
1800 PRINT C$(2):RETURN
1810 PRINT C$(3):RETURN
1820 PRINT C$(4):RETURN
1830 REM  POST ACTIVE PLAYERS
1840 PLOT 6,6
1850 IF Q= 1THEN 1910
1860 IF Q= 2THEN 1900
1870 IF Q= 3THEN 1890
1880 PLOT 3,0,Y+ 15:PRINT "D"
1890 PLOT 3,0,Y+ 13:PRINT "C"
1900 PLOT 3,0,Y+ 11:PRINT "B"
1910 PLOT 3,0,Y+ 9:PRINT "A"
1912 IF CQ= 0THEN 1920
1914 PLOT 6,5,3,0,Y+ 7+ (2* Q)
1916 PRINT CHR$ (Q+ 64)
1920 RETURN
1930 REM  TURN ON INDICATORS FOR COMPARTMENTS THIS ROLL
1940 FOR F= 0TO 13:G(0,F)= 0:NEXT F
1950 FOR F= 0TO 2
1960 IF H(F)= 1THEN G(0,0)= G(0,0)+ 1
1970 IF H(F)= 2THEN G(0,1)= G(0,1)+ 2
1980 IF H(F)= 3THEN G(0,2)= G(0,2)+ 3
1990 IF H(F)= 4THEN G(0,3)= G(0,3)+ 4
2000 IF H(F)= 5THEN G(0,4)= G(0,4)+ 5
2010 IF H(F)= 6THEN G(0,5)= G(0,5)+ 6
2020 NEXT F
2030 IF H(0)= H(1)AND H(1)= H(2)THEN G(0,10)= 25
2040 IF I= 13THEN 2170
2050 IF I= 6THEN 2100
2060 IF I= 9THEN 2400
2070 IF I= 12THEN 2470
2080 IF I= 15THEN 2330
2090 GOTO 2540
2100 IF H(0)= 1AND H(1)= 2AND H(2)= 3THEN 2250
2110 IF H(0)= 3AND H(1)= 1AND H(2)= 2THEN 2250
2120 IF H(0)= 2AND H(1)= 3AND H(2)= 1THEN 2250
2130 IF H(0)= 1AND H(2)= 2AND H(1)= 3THEN 2250
2140 IF H(0)= 3AND H(2)= 1AND H(1)= 2THEN 2250
2150 IF H(0)= 2AND H(1)= 1AND H(2)= 3THEN 2250
2160 GOTO 2540
2170 REM  13
2180 IF H(0)= H(1)THEN 2230
2190 IF H(0)= H(2)THEN 2230
2200 IF H(1)= H(2)THEN 2230
2210 G(0,11)= 26
2220 GOTO 2540
2230 G(0,12)= 50
2240 GOTO 2540
2250 G(0,6)= 20
2260 GOTO 2540
2270 G(0,7)= 20
2280 GOTO 2540
2290 G(0,8)= 20
2300 GOTO 2540
2310 G(0,9)= 20
2320 GOTO 2540
2330 IF H(0)= 4AND H(1)= 5AND H(2)= 6THEN 2270
2340 IF H(0)= 4AND H(2)= 5AND H(1)= 6THEN 2270
2350 IF H(0)= 5AND H(1)= 6AND H(2)= 4THEN 2270
2360 IF H(0)= 5AND H(2)= 6AND H(1)= 4THEN 2270
2370 IF H(0)= 6AND H(1)= 4AND H(2)= 5THEN 2270
2380 IF H(0)= 6AND H(2)= 4AND H(1)= 5THEN 2270
2390 GOTO 2540
2400 IF H(0)= 1AND H(1)= 3AND H(2)= 5THEN 2290
2410 IF H(0)= 1AND H(2)= 3AND H(1)= 5THEN 2290
2420 IF H(0)= 3AND H(1)= 5AND H(2)= 1THEN 2290
2430 IF H(0)= 3AND H(2)= 5AND H(1)= 1THEN 2290
2440 IF H(0)= 5AND H(1)= 1AND H(2)= 3THEN 2290
2450 IF H(0)= 5AND H(2)= 1AND H(1)= 3THEN 2290
2460 GOTO 2540
2470 IF H(0)= 2AND H(1)= 4AND H(2)= 6THEN 2310
2480 IF H(0)= 2AND H(2)= 4AND H(1)= 6THEN 2310
2490 IF H(0)= 4AND H(1)= 6AND H(2)= 2THEN 2310
2500 IF H(0)= 4AND H(2)= 6AND H(1)= 2THEN 2310
2510 IF H(0)= 6AND H(1)= 2AND H(2)= 4THEN 2310
2520 IF H(0)= 6AND H(2)= 2AND H(1)= 4THEN 2310
2530 GOTO 2540
2540 RETURN
2550 REM  END OF GAME
2560 PLOT 14,6,5,3,0,31
2570 OUT 8,255
2580 INPUT "DO YOU WANT TO PLAY ANOTHER GAME (Y/N) ? ";Q$
2590 OUT 8,247
2600 IF LEFT$ (Q$,1)< > "Y"THEN 2710
2610 FOR I= 0TO 13
2620 FOR II= 0TO 4
2630 G(II,I)= 0
2640 NEXT II,I
2650 PLOT 6,2,12,27,11,15
2660 GOTO 160
2670 REM  POST PLAYER NAME WHILE 'KEEP(Y/N)?'
2680 PLOT 6,7,15,3,0,27
2685 IF CQ= 1AND PP= PLTHEN PRINT "COMPUTER":GOTO 2700
2690 PRINT "PLAYER ";J$
2700 RETURN
2710 PLOT 6,2,27,11,15
2720 LOAD "MENU":RUN
2730 OUT 8,255
2740 END
2750 REM  PRINT INSTRUCTIONS
2760 PLOT 6,56,14,3,25,3
2770 PRINT "CRAG DICE GAME"
2780 PLOT 6,7,15,3,25,1:PRINT ""
2790 PLOT 6,3,15,3,0,9
2800 PRINT "FROM ONE TO FOUR PLAYERS. 13 ROUNDS. 13 COMPARTMENTS."
2810 PLOT 3,0,11
2820 PRINT "AT EACH ROUND, EACH PLAYER CASTS THE DICE. THREE ARE CAST."
2830 PLOT 3,0,13
2840 PRINT "THE PLAYER MAY RECAST ONE, TWO OR ALL THREE OF THEM."
2850 PLOT 3,0,15
2860 PRINT "SELECT A COMPARTMENT ON THE SCOREBOARD CORRESPONDING TO THE"
2870 PLOT 3,0,17
2880 PRINT "DICE CAST. THE OBJECT IS TO ACCUMULATE, AT THE END OF 13"
2890 PLOT 3,0,19
2900 PRINT "ROUNDS, THE HIGHEST SCORE. HINT: COMPARTMENTS S-Y ARE HARD"
2910 PLOT 3,0,21
2920 PRINT "TO CAST, TRY FOR THEM FIRST.  ENTER AN '@' TO QUIT."
2922 PLOT 3,0,23
2924 PRINT "YOU MUST SELECT A COMPARTMENT, EVEN IF IT RESULTS IN A SCORE"
2926 PLOT 3,0,25
2928 PRINT "OF 0.  1X THRU 6X MEAN 2 6'S SCORE 12, 2 5'S SCORE 10, ETC."
2930 PLOT 6,1,3,0,28
2940 PRINT "A 'CRAG' IS A THROW OF 13 WITH DOUBLE 4'S, 5'S OR 6'S."
2950 PLOT 6,7,14,3,19,31
2960 PRINT "HIT RETURN TO BEGIN THE GAME"
2970 OUT 8,255
2980 POKE 33278,0
2990 K= RND (1)
3000 IF PEEK (33278)= 0THEN 2990
3010 OUT 8,247
3020 PLOT 6,2,12
3030 RETURN
3040 REM  SELECT COMPARTMENT
3050 CC= ASC (Q$)- 77
3060 IF G(PP,CC)< > 0THEN 3260
3070 IF G(0,CC)= 0THEN 3320
3080 G(PP,CC)= G(0,CC)
3090 G(PP,13)= G(PP,13)+ G(0,CC)
3100 PLOT 6,3,15
3110 IF CC> 5THEN XX= 21+ 6* (CC- 6):GOTO 3130
3120 XX= 1+ CC* 3
3130 YY= 12+ PP* 2
3140 PLOT 3,XX,YY
3150 PRINT RIGHT$ ((STR$ (G(0,CC))),2)
3160 PLOT 3,60,YY,6,1
3170 PRINT RIGHT$ ((STR$ (G(PP,13))),3)
3180 PP= PP+ 1
3190 IF PP> PLTHEN PP= 1:RD= RD+ 1:IF RD> RCTHEN 3440
3200 PLOT 6,7,15,3,55,29
3210 PRINT "ROUND";RD
3220 J$= CHR$ (PP+ 64)
3230 PLOT 15,3,0,23,11,3,0,24,11,3,0,25,11
3240 SW= 0
3250 GOTO 280
3260 PLOT 14,3,0,31
3270 PRINT "TRY AGAIN.  COMPARTMENT ";Q$;" NOT OPEN."
3280 FOR I= 0TO 1000:NEXT I
3290 PLOT 14,3,0,31,11
3300 IF SW= 0THEN 390
3310 SW= 0:GOTO 970
3320 PLOT 14,3,0,31
3330 PRINT "COMPARTMENT ";Q$;" NOT APPROPRIATE, SCORE WOULD BE 0."
3340 FOR I= 0TO 1000:NEXT I
3350 PLOT 14,3,0,31,11
3355 IF CQ= 1AND PP= PLTHEN G(PP,CC)= - 1:GOTO 3100
3360 PLOT 6,1,3,0,31
3370 OUT 8,255
3380 INPUT "ENTER NEW COMPARTMENT LETTER (M-Y) OR HIT RETURN TO GET 0";Q$
3390 OUT 8,247
3400 Q$= LEFT$ (Q$,1)
3410 PLOT 14,3,0,31,11
3420 IF Q$< "Z"AND Q$> "L"THEN 3040
3430 G(PP,CC)= - 1:GOTO 3100
3440 REM  13 ROUNDS COMPLETED
3450 PLOT 14,3,0,31,11
3460 RF= 0
3470 FOR I= 1TO 4
3480 IF G(I,13)> RFTHEN 3590
3490 IF G(I,13)= RFAND RF< > 0THEN 3570
3500 NEXT I
3510 IF SX= 1THEN 3620
3520 PLOT 6,6,14,3,0,31
3530 PRINT "PLAYER ";K$;" WINS THE CRAG DICE CHAMPIONSHIP !!!"
3540 FOR I= 0TO 2500:NEXT I
3550 PLOT 14,3,0,31,11
3560 GOTO 2550
3570 SX= 1
3580 GOTO 3500
3590 K$= CHR$ (I+ 64)
3600 RF= G(I,13)
3610 GOTO 3500
3620 SX= 0
3630 PLOT 6,3,14,3,0,31
3640 PRINT "WE HAVE A TIE IN THE CRAG DICE CHAMPIONSHIP !!!"
3650 GOTO 3540
3660 END
4000 REM  OK IF COMPUTER PLAYS?
4010 PLOT 6,3,14,3,0,31
4015 OUT 8,255
4020 INPUT "OK IF COMPUTER PLAYS ALONG (Y/N) ? ";P$
4022 OUT 8,247
4025 PLOT 3,0,31,14,11
4030 IF LEFT$ (P$,1)< > "Y"THEN 240
4040 Q= Q+ 1
4050 CQ= 1
4060 GOTO 240
4100 PRINT "COMPUTER ";
4110 PLOT 6,1:PRINT " HIT RETURN TO THROW THE DICE !"
4120 FOR I= 0TO DD:NEXT I
4130 PLOT 14,3,0,31,11
4140 GOSUB 1580
4150 PLOT 14,6,6,3,0,31
4160 PRINT "COMPUTER ";
4170 PLOT 6,1:PRINT "SELECT COMPARTMENT (M-Y) OR HIT RETURN !"
4180 FOR I= 0TO DD:NEXT I
4190 PLOT 14,3,0,31,11
4200 FOR I= 12TO 0STEP - 1
4210 IF G(0,I)< > 0THEN 4300
4220 NEXT I
4230 FOR I= 5TO 0STEP - 1
4240 IF G(0,I)> 4THEN 4275
4250 NEXT I
4252 FOR I= 0TO 12
4254 IF G(PP,I)= 0THEN 4410
4256 NEXT I
4260 PLOT 8,6,65:PRINT "THE IMPOSSIBLE HAPPENED AT 4260"
4270 END
4275 IF G(PP,I)< > 0THEN 4250
4280 GOTO 4410
4300 IF I> 5THEN 4400
4310 IF G(0,I)> 9THEN 4400
4320 GOTO 4500
4400 IF G(PP,I)< > 0THEN 4220
4410 Q$= CHR$ (I+ 77)
4420 GOTO 3040
4500 GOSUB 2670
4530 PLOT 6,3,15,3,17,27
4540 PRINT "KEEP(Y/N)?"
4550 FOR I= 0TO DD:NEXT I
4560 GOSUB 2670
4565 E= 0:GOSUB 570
4570 PLOT 3,0,27,11
4580 FOR I= 12TO 0STEP - 1
4590 IF G(0,I)< > 0THEN 4700
4600 NEXT I
4610 GOTO 4900
4700 IF I> 5THEN 4800
4710 IF G(0,I)> 9THEN 4800
4720 GOTO 4600
4800 IF G(PP,I)< > 0THEN 4600
4810 GOTO 6000
4900 REM  TRY SECOND DI
4910 PLOT 6,3,3,25,27
4920 PRINT "KEEP(Y/N)?"
4930 FOR I= 0TO DD:NEXT I
4940 GOSUB 2670
4950 E= 1:GOSUB 570
4960 PLOT 3,0,27,11
4970 FOR I= 12TO 0STEP - 1
4980 IF G(0,I)< > 0THEN 5050
4990 NEXT I
5000 GOTO 5200
5050 IF I> 5THEN 5100
5060 IF G(0,I)> 9THEN 5100
5070 GOTO 4990
5100 IF G(PP,I)< > 0THEN 4990
5110 GOTO 6000
5200 REM  TRY THIRD DI
5210 PLOT 6,3,3,33,27
5220 PRINT "KEEP(Y/N)?"
5230 FOR I= 0TO DD:NEXT I
5240 GOSUB 2670
5250 E= 2:GOSUB 570
5260 PLOT 3,0,27,11
5270 FOR I= 12TO 0STEP - 1
5280 IF G(0,I)< > 0THEN 5400
5290 NEXT I
5300 GOTO 4230
5400 IF I> 5THEN 5500
5410 IF G(0,I)> 9THEN 5500
5420 GOTO 5290
5500 IF G(PP,I)< > 0THEN 5290
5510 GOTO 6000
6000 REM  CHOOSE COMPARTMENT
6010 PLOT 14,6,6,3,0,31
6020 PRINT "COMPUTER ";
6030 PLOT 6,1
6040 PRINT "LAST CHANCE...SELECT COMPARTMENT (M-Y) ? "
6050 FOR II= 0TO DD:NEXT II
6060 PLOT 14,3,0,31,11
6070 GOTO 4410
9000 END