Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / yahtzee.bas < prev

Wrap

BASIC Source File | 1991-05-15 | 20.1 KB | 643 lines

0 GOTO 65000 1 ' 1000 ' YATZEE 1010 ' ORIGINAL BY JL HELMS & MF PEZOK FOR CCII 1020 ' CORONADO, CA 1030 ' ADAPTED TO IBM PC BY PATRICK LEABO 1040 ' TUCSON, AZ 1050 ' 1060 DEFINT A-Z 1070 DIM C(5):DIM K(18,7):DIM F(5):DIM A$(7) 1080 DIM S(6,5):DIM M(13),TN(6),DU(6):KEY OFF:COLOR 5,3,1:WIDTH 80 1090 SCREEN 0,1:RESTORE 1150:FOR N= 1 TO 6:READ TN(N):NEXT 1100 COMMON MENU 1110 GOSUB 5090 1120 C1= 39:C2= 63:C3= 33:C4= 56 1130 GOSUB 4660 1140 CLS:GOSUB 4430 1150 DATA 49,51,53,54,56,61 1160 GOSUB 6820:REM draw yatzee board 1165 COLOR 7,0 1170 RANDOMIZE VAL(RIGHT$(TIME$,2)) 1180 LOCATE 25,1 1190 PRINT "HOW MANY PLAYERS? ";:LOCATE ,,1:GOSUB 2090 1200 GOSUB 7100: N=ASC(KB$)-48 1210 IF N< 1 OR N> 5 THEN 1180 1220 IF N< 5 THEN GOSUB 6000 1230 IF CC= 1 THEN GOSUB 5480 1240 LOCATE 25,1:PRINT STRING$(60," ");:FOR A=1 TO N 1250 LOCATE 24,1:PRINT STRING$(60," ");:LOCATE 24,1 1260 PRINT "PLAYER NUMBER "A;" NAME PLEASE "; 1270 GOSUB 2090:LINE INPUT;A$(A):IF A$(A)= "" THEN BEEP:GOTO 1250 1280 A$(A)=LEFT$(A$(A),9) 1290 NEXT A 1295 LOCATE 24,1:PRINT STRING$(60," ");:LOCATE 24,1 1300 IF CC= 1 THEN N= N+ 1:A$(N)= "IBM PC" 1310 LOCATE 23,1 1320 A= 0 1330 REM 1340 REM NEXT ROLL PRESET 1350 REM 1360 A= A+ 1:IF A> N THEN A= 1 1370 H= 0:GOSUB 5340 1380 IF A= 0 THEN 4760 1390 IF K(18,A)= 2 THEN 1360 1400 LOCATE 23,1:PRINT STRING$(70," "); 1410 LOCATE 23,4* (A- 1)+ 14 1420 PRINT A$(A); 1430 REM 1440 REM INITIAL ROLL 1450 REM 1460 H= H+ 1:MR= 0 1470 FOR B= 1 TO 5 1480 J= B- 1:C(B)= INT (6* RND (1)+ 1) 1490 DIE= C(B):F(B)= 0 1500 GOSUB 5250 1510 GOSUB 5530 1520 NEXT B 1530 IF A* CC= N THEN 2140 1540 REM 1550 REM PLAYER SELECTS QTY TO ROLL 1560 REM 1570 GOSUB 7080 1580 IF H> 2 THEN 1940 1590 POKE 106,0:PRINT " HOW MANY DICE TO ROLL AGAIN? ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:F$=KB$:PRINT F$;:F=ASC(F$)-48:LOCATE ,,0 1600 IF F= - 1 THEN GOSUB 35000 1610 IF F< 0 OR F> 5 THEN 1570 1620 IF F= 0 THEN 1940 1630 IF F= 5 THEN 1430 1640 REM 1650 REM PLAYER SELECTS DICE TO ROLL 1660 REM 1670 H= H+ 1 1680 GOSUB 7080 1690 FOR NN= 1 TO 4:F(NN)= 0:NEXT 1700 PRINT " ROLL WHICH";F;"DICE AGAIN ";:LOCATE ,,1 1710 GOSUB 2090:FOR ND= 1 TO F: 1720 GOSUB 7100:F$=KB$::F(ND)= ASC(F$)- 48:GOSUB 2120:IF F(ND)= 0 AND ND= 1 THEN ND= F:GOTO 1740 1730 IF F(ND)< 1 OR F(ND)> 5 THEN 1720 1740 PRINT F(ND);:NEXT 1750 X= 2:XF= 0 1760 FOR J= 1 TO F 1770 IF F= 1 THEN 1790 1780 IF F(J)= F(J+ 1)THEN X= 1 1790 IF F(1)= 0 THEN XF= 1 1800 NEXT J:IF XF= 1 THEN H= H- 1:GOTO 1570 1810 ON X GOTO 1680,1820 1820 REM 1830 REM PLAYER ROLLS DICE AGAIN 1840 REM 1850 FOR B= 1 TO 4 1860 IF F(B)= 0 THEN 1920 1870 C(F(B))= INT (6* RND (1)+ 1) 1880 DIE= C(F(B)):J= F(B)- 1 1890 GOSUB 5250 1900 GOSUB 5530 1910 F(B)= 0 1920 NEXT B 1930 GOTO 1540 1940 REM 1950 REM PLAY BOARD NUMBER 1960 REM 1970 GOSUB 7080 1980 PRINT " PLAY BOARD NUMBER? ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:I$=KB$:I=ASC(I$)- 48:LOCATE ,,0:IF I> 9 THEN I= I- 7 1990 GOSUB 2120:IF I> 9 THEN PRINT CHR$ (I+ 55);:GOTO 2010 2000 PRINT I; 2010 IF I< 1 OR I> 13 THEN 1970 2020 IF I= 12 AND K(12,A)> - 1 THEN 2140 2030 IF K(I,A)= 0 THEN 2140 2040 LOCATE 24,1:BEEP 2050 PRINT "NO - NO - DUMMY - - TRY AGAIN";:FOR ND=1 TO 1500:NEXT:LOCATE 24,1:PRINT STRING$(60," "); 2060 LOCATE 25,1:PRINT STRING$(60," ");:LOCATE 25,1 2070 GOTO 1980 2080 REM HIGH PITCH CLICK 2090 PLAY "L64T200N70":RETURN 2100 REM GLISSANDO SOUND 2110 PLAY "MBt255MLL64O5CC#DD#EFF#GG#AA#B":RETURN 2120 ' LO PITCH CLICK 2130 PLAY "L64T200N46":RETURN 2140 REM 2150 REM DICE LOGIC 2160 REM CLEAR/SET S(M,K) 2170 REM 2180 FOR M= 0 TO 6 2190 FOR K= 0 TO 5 2200 S(M,K)= 0 2210 NEXT K 2220 NEXT M 2230 FOR J= 1 TO 5 2240 X= C(J):S(X,0)= S(X,0)+ 1 2250 P= S(X,0):S(X,P)= J 2260 NEXT J 2270 REM 2280 REM SET S(0,K)=M SEQUENCE BY QTY 2290 REM 2300 X= 0 2310 FOR J= 5 TO 1 STEP - 1 2320 FOR M= 6 TO 1 STEP - 1 2330 IF S(M,0)< > J THEN 2350 2340 S(0,X)= M:X= X+ 1 2350 NEXT M 2360 NEXT J 2370 IF A* CC= N THEN 2740 2380 IF I> 6 THEN 2460 2390 REM 2400 REM CHECK PLAYER BOARD 1-6 2410 REM 2420 GOSUB 6110 2430 IF X= - 1 THEN 2720 2440 K(I,A)= I* S(S(0,X),0) 2450 GOTO 3980 2460 REM 2470 REM CHECK PLAYER BOARD 7-13 2480 REM 2490 ON I- 6 GOTO 2500,2520,2540,2560,2610,2650,2680 2500 IF S(S(0,0),0)< 3 THEN 2720 2510 GOSUB 6190:GOTO 3980 2520 IF S(S(0,0),0)< 4 THEN 2720 2530 GOSUB 6190:GOTO 3980 2540 IF S(S(0,0),0)< > 3 OR S(S(0,1),0)< > 2 THEN 2720 2550 K(9,A)= 25:GOTO 3980 2560 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 2600 2570 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 2600 2580 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 2600 2590 GOTO 2720 2600 K(10,A)= 30:GOTO 3980 2610 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 2640 2620 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 2640 2630 GOTO 2720 2640 K(11,A)= 40:GOTO 3980 2650 IF S(S(0,0),0)< > 5 THEN 2720 2660 IF K(12,A)= 0 THEN K(12,A)= 50:GOTO 3980 2670 K(12,A)= K(12,A)+ 100:GOTO 3980 2680 GOSUB 6190:GOTO 3980 2690 REM 2700 REM SET PLAYER INVALID 2710 REM 2720 K(I,A)= - 1 2730 GOTO 3980 2740 REM 2750 REM COMPUTER CHECKS 2760 REM 2770 I= 12 2780 IF S(S(0,0),0)= 5 AND K(12,A)= 0 THEN K(12,A)= 50:GOTO 3980 2790 IF S(S(0,0),0)= 5 AND K(12,A)> 0 THEN K(12,A)= K(12,A)+ 100:GOTO 3980 2800 I= 8 2810 IF S(S(0,0),0)= 4 AND K(8,A)= 0 THEN GOSUB 6190:GOTO 3980 2820 I= 9 2830 IF S(S(0,0),0)= 3 AND S(S(0,1),0)= 2 AND K(9,A)= 0 THEN K(9,A)= 25:GOTO 3980 2840 IF K(11,A)< > 0 THEN 2900 2850 I= 11 2860 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 2890 2870 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 2890 2880 GOTO 2900 2890 K(11,A)= 40:GOTO 3980 2900 IF K(10,A)< > 0 THEN 2970 2910 I= 10 2920 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 2960 2930 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 2960 2940 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 2960 2950 GOTO 2970 2960 K(10,A)= 30:GOTO 3980 2970 IF H< 3 THEN 3140 2980 I= 6 2990 IF S(6,0)> 2 AND K(6,A)= 0 THEN K(6,A)= 6* S(6,0):GOTO 3980 3000 I= 5 3010 IF S(5,0)> 2 AND K(5,A)= 0 THEN K(5,A)= 5* S(5,0):GOTO 3980 3020 I= 4 3030 IF S(4,0)> 2 AND K(4,A)= 0 THEN K(4,A)= 4* S(4,0):GOTO 3980 3040 I= 3 3050 IF S(3,0)> 2 AND K(3,A)= 0 THEN K(3,A)= 3* S(3,0):GOTO 3980 3060 I= 7 3070 IF S(S(0,0),0)> 2 AND K(7,A)= 0 THEN GOSUB 6190:GOTO 3980 3080 I= 2 3090 IF S(2,0)> 2 AND K(2,A)= 0 THEN K(2,A)= 2* S(2,0):GOTO 3980 3100 I= 1 3110 IF S(1,0)> 2 AND K(1,A)= 0 THEN K(1,A)= S(1,0):GOTO 3980 3120 I= 13:IF K(13,A)< > 0 THEN 3140 3130 IF C(1)+ C(2)+ C(3)+ C(4)+ C(5)> 19 THEN GOSUB 6190:GOTO 3980 3140 REM 3150 REM CLEAR DICE NUMBER F(B) 3160 REM COMPUTER 3170 REM 3180 FOR B= 1 TO 5 3190 F(B)= 0 3200 NEXT B 3210 REM 3220 REM GET DICE CONTROL 3230 REM COMPUTER 3240 REM 3250 H= H+ 1:IF H> 3 THEN 3840 3260 I= M(MR):IF I< > 0 THEN 3290 3270 MR= MR+ 1:IF MR> 13 THEN MR= 1 3280 GOTO 3260 3290 IF I= 12 AND K(12,A)> - 1 THEN 3330 3300 IF K(I,A)< > 0 THEN 3270 3310 IF I= 9 THEN 3440 3320 IF I= 10 OR I= 11 THEN 3560 3330 REM 3340 REM GET DICE 1,2,3,4 3350 REM COMPUTER 3360 REM 3370 M= 0:J= 1 3380 M= M+ 1:IF M> 4 THEN 3720 3390 K= S(0,M):IF K= 0 THEN 3720 3400 FOR L= 1 TO S(K,0) 3410 F(J)= S(K,L):J= J+ 1 3420 NEXT L 3430 GOTO 3380 3440 REM 3450 REM GET DICE FH 3460 REM COMPUTER 3470 REM 3480 M= 0:J= 1 3490 M= M+ 1:IF M> 4 THEN 3720 3500 K= S(0,M):IF K= 0 THEN 3720 3510 IF K> 1 THEN 3490 3520 FOR L= 1 TO S(K,0) 3530 F(J)= S(K,L):J= J+ 1 3540 NEXT L 3550 GOTO 3490 3560 REM 3570 REM GET DICE LG/SM ST 3580 REM COMPUTER 3590 REM 3600 M= 0:J= 1 3610 M= M+ 1:IF M> 4 THEN 3680 3620 K= S(0,M):IF K= 0 THEN 3680 3630 IF S(K,0)= 1 THEN 3610 3640 FOR L= 1 TO S(K,0) 3650 F(J)= S(K,L):J= J+ 1 3660 NEXT L 3670 GOTO 3610 3680 IF F(1)< > 0 THEN 3720 3690 L= INT (2* RND (1)+ 1) 3700 F(1)= 5 3710 IF L= 1 THEN F(1)= 1 3720 REM 3730 REM COMPUTER ROLL AGAIN 3740 REM 3750 FOR B= 1 TO 4 3760 IF F(B)< 1 THEN 3810 3770 C(F(B))= INT (6* RND (1)+ 1) 3780 DIE= C(F(B)):J= F(B)- 1 3790 GOSUB 5250 3800 GOSUB 5530 3810 F(B)= 0 3820 NEXT B 3830 GOTO 2140 3840 REM 3850 REM COMPUTER MUST SCORE 3860 REM 3870 MR= MR+ 1:IF MR> 13 THEN MR= 1 3880 I= M(MR):IF I= 0 THEN 3870 3890 IF K(I,A)< > 0 THEN 3870 3900 IF I> 6 THEN 3960 3910 GOSUB 6110 3920 IF X= - 1 THEN 3970 3930 IF K(I,A)< > 0 THEN 3870 3940 K(I,A)= S(I,0)* I 3950 IF K(I,A)< > 0 THEN 3980 3960 IF I= 13 AND K(13,A)= 0 THEN GOSUB 6190 3970 IF K(I,A)= 0 THEN K(I,A)= - 1 3980 REM 3990 REM GET SCOREBOARD TOTALS 4000 REM 4010 FOR J= 14 TO 17 4020 K(J,A)= 0 4030 NEXT J 4040 FOR J= 1 TO 6 4050 IF K(J,A)< 0 THEN 4070 4060 K(15,A)= K(15,A)+ K(J,A) 4070 NEXT J 4080 IF K(15,A)> 62 THEN K(14,A)= 35 4090 FOR J= 7 TO 13 4100 IF K(J,A)< 0 THEN 4120 4110 K(16,A)= K(16,A)+ K(J,A) 4120 NEXT J 4130 K(17,A)= K(14,A)+ K(15,A)+ K(16,A) 4140 REM 4150 REM PRINT SCORE 4160 REM 4170 GOSUB 2110 4180 COLOR 15,0 4190 FOR J= 1 TO 6 4200 IF K(J,A)< 0 THEN LOCATE J+1,4* (A- 1)+ 15:PRINT " 0";:GOTO 4230 4210 IF K(J,A)< 1 THEN 4230 4220 LOCATE J+1,4* (A- 1)+ 15:PRINT USING"###";K(J,A); 4230 NEXT J 4240 FOR J= 7 TO 13 4250 IF K(J,A)< 0 THEN LOCATE J+4,4* (A- 1)+ 15:PRINT " 0":GOTO 4280 4260 IF K(J,A)< 1 THEN 4280 4270 LOCATE J+4,4* (A- 1)+ 15:PRINT USING "###";K(J,A) 4280 NEXT J 4290 LOCATE 9,4* (A- 1)+ 15:PRINT USING "###";K(15,A) 4300 LOCATE 19,4* (A- 1)+ 15:PRINT USING "###";K(16,A) 4310 LOCATE 20,4* (A- 1)+ 15:PRINT USING "###";K(14,A) 4320 LOCATE 21,4* (A- 1)+ 15:PRINT USING "###";K(17,A) 4330 COLOR 7,0 4340 IF A* CC< > N THEN 1330 4350 REM 4360 REM RESET M(I) COMPUTER PRIORITIES 4370 REM 4380 FOR B= 1 TO 13 4390 IF M(B)= 12 THEN 4410 4400 IF M(B)= I THEN M(B)= 0 4410 NEXT B 4420 GOTO 1330 4430 REM 4440 REM INSTRUCTIONS 4450 REM 4460 PRINT " Y A H T Z E E " 4470 PRINT "THIS IS THE GAME OF YAHTZEE - " 4480 PRINT "FROM 1 TO 7 PLAYERS MAY PLAY AT THE SAME TIME" 4490 PRINT "WITH EACH PLAYERS CURRENT STATUS SHOWN ON THE" 4500 PRINT "PLAYING BOARD, INCLUDING TOTAL SCORES" 4510 PRINT 4520 PRINT "THE ONLY DIFFERENCE BETWEEN THIS GAME AND THE" 4530 PRINT "POPULAR HOME GAME IS THAT YOU MAY GET MULTIPLE" 4540 PRINT "YAHTZEES HERE ..... THE FIRST YAHTZEE SCORES" 4550 PRINT "50 POINTS, AND EACH ADDITIONAL ONE WILL YIELD" 4560 PRINT "A BONUS OF 100 POINTS (IF THE YAHTZEE IS PUT" 4570 PRINT "INTO THE YAHTZEE BLOCK)..... IN ADDITION YOU" 4580 PRINT "WILL BE GIVEN AN EXTRA TURN AT THE END OF" 4590 PRINT "THE GAME":PRINT :PRINT 4600 PRINT "THE WINNER WILL BE ANNOUNCED AT THE END OF" 4610 PRINT "THE GAME - - BUT I WOULDNT ADVISE ANYONE" 4620 PRINT "TO BE LAST......." 4630 PRINT:PRINT 4640 GOSUB 2090:INPUT "HIT RETURN TO CONTINUE ";Y$:BEEP 4650 RETURN 4660 RETURN 4670 LOCATE 10,10:PRINT "YATZEE.BAS VER 3.2" 4680 LOCATE 12,10:PRINT "27 JUN 79" 4690 LOCATE 14,10:PRINT "DEVELOPED BY" 4700 LOCATE 15,13:PRINT "J.L. HELMS & M.F. PEZOK" 4710 LOCATE,16,13:PRINT "1009 LEYTE RD / 1321 SAIPAN RD" 4720 LOCATE 17,17:PRINT "CORONADO, CA. 92118" 4730 LOCATE 18,15:PRINT "(714) 435-6992 / 437-4659" 4740 PRINT CHR$(11) 4750 RETURN 4760 REM 4770 REM END - SORT WINNER 4780 REM 4790 X= 2:IF N= 1 THEN 4870 4800 FOR J= 1 TO N- 1 4810 IF K(17,J)> K(17,J+ 1)THEN 4850 4820 K= K(17,J):K(17,J)= K(17,J+ 1):K(17,J+ 1)= K 4830 A$= A$(J):A$(J)= A$(J+ 1):A$(J+ 1)= A$ 4840 X= 1 4850 NEXT J 4860 ON X GOTO 4760,4870 4870 REM 4880 REM PRINT WINNERS STANDINGS 4890 REM 4900 RESTORE 5200 4910 FOR J= 1 TO N 4920 LOCATE 25,1:PRINT STRING$(60," "); 4930 IF J> 1 AND J= N THEN RESTORE 5240 4940 LOCATE 25,1:READ A$ 4950 PRINT A$;" ";A$(J);" "; 4960 TT= 500* (N- J+ 1):IF TT< 1500 THEN TT= 1500 4970 FOR T= 1 TO TT:NEXT T 4980 NEXT J 4990 LOCATE 25,1:PRINT STRING$(60," "); 5000 LOCATE 24,1:PRINT "+++ END OF GAME +++"; 5010 FOR T= 1 TO 2000:NEXT T 5020 ' 5030 GOSUB 2090:LOCATE 25,1:INPUT "PLAY AGAIN? Y/N ";Y$ 5040 IF LEFT$ (Y$,1)= "Y"THEN GOSUB 5090:GOTO 1110 5050 IF LEFT$ (Y$,1)= CHR$(27) THEN BEEP:GOTO 5070 5060 IF LEFT$ (Y$,1)< > "N"THEN BEEP:GOTO 5030 5070 GOTO 65200 5080 END 5090 REM 5100 REM CLEAR MATRICES 5110 REM 5120 FOR K= 1 TO 7 5130 FOR J= 1 TO 18 5140 K(J,K)= 0 5150 NEXT J 5160 A$(K)= "" 5170 NEXT K 5180 CLS 5190 RETURN 5200 DATA "+++ THE WINNER +++" 5210 DATA " SECOND PLACE"," THIRD PLACE " 5220 DATA " FOURTH PLACE "," FIFTH PLACE " 5230 DATA " SIXTH PLACE " 5240 DATA " DEAD LAST " 5250 REM 5260 REM ERASE DIE 5270 REM 5280 COLOR 0,7:PRINT"";: 5290 LOCATE 4* J+ 1,50:PRINT" "; 5300 LOCATE 4* J+ 2,50:PRINT" "; 5310 LOCATE 4* J+ 3,50:PRINT" "; 5320 COLOR 7,0 5330 RETURN 5340 REM 5350 REM CHECK IF DONE 5360 REM 5370 X= 0 5380 FOR J= 1 TO N 5390 Y= 2 5400 FOR K= 1 TO 13 5410 IF K(K,J)= 0 THEN Y= 1 5420 NEXT K 5430 K(18,J)= Y 5440 IF Y= 2 THEN X= X+ 1 5450 NEXT J 5460 IF X= > N THEN A= 0 5470 RETURN 5480 REM 5490 REM COMPUTER PRIORITIES INFO 5500 REM 5510 GOSUB 6780 5520 RETURN 5530 REM 5540 REM PRINT DIE 5550 REM 5560 COLOR 0,7:LOCATE ,,0 5570 REM 5580 PLAY "L32T200N=TN(DIE);" 5590 ON DIE GOTO 5930,5870,5810,5750,5690,5630 5600 ' 5610 ' SIX 5620 ' 5630 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32); 5640 LOCATE 4*J+2,50:PRINT CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32); 5650 LOCATE 4*J+3,50:PRINT CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);:GOTO 5960 5660 ' 5670 ' FIVE 5680 ' 5690 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);" ";CHR$(32);CHR$(2);" "; 5700 LOCATE 4*J+2,50:PRINT " ";CHR$(32);" ";CHR$(2);" ";CHR$(32);" "; 5710 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);" ";CHR$(2);" ";:GOTO 5960 5720 ' 5730 ' FOUR 5740 ' 5750 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" ";CHR$(32);CHR$(2);" "; 5760 LOCATE 4*J+2,50:PRINT " ";CHR$(32);CHR$(32);CHR$(32); 5770 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);CHR$(2);" ";:GOTO 5960 5780 ' 5790 ' THREE 5800 ' 5810 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 5820 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 5830 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5960 5840 ' 5850 ' TWO 5860 ' 5870 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 5880 LOCATE 4*J+2,50:PRINT " "; 5890 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5960 5900 ' 5910 ' ONE 5920 ' 5930 LOCATE 4*J+1,50:PRINT "";" "; 5940 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 5950 LOCATE 4*J+3,50:PRINT " ";:GOTO 5960 5960 REM GET OUT 5970 COLOR 7,0 5980 LOCATE 1,1 5990 RETURN 6000 REM 6010 REM COMPUTER OPTION 6020 REM 6030 CC= 0 6040 LOCATE 25,1 6050 PRINT "DO YOU WISH TO PLAY AGAINST ME? Y/N ";:GOSUB 2090 6060 Y$=INKEY$:IF Y$="" THEN 6060 ELSE BEEP 6070 IF Y$= "N"THEN RETURN 6080 IF Y$< > "Y"THEN 6040 6090 CC= 1 6100 RETURN 6110 REM 6120 REM CHECK FOR ACES-SIXES ANY POSITION 6130 REM 6140 X= - 1 6150 FOR J= 0 TO 4 6160 IF S(0,J)= I THEN X= J 6170 NEXT J 6180 RETURN 6190 REM 6200 REM TOTAL DICE VALUE 6210 REM 6220 FOR J= 1 TO 5 6230 K(I,A)= K(I,A)+ C(J) 6240 NEXT J 6250 RETURN 6260 REM 6270 REM MATRIX INFORMATION 6280 REM 6290 REM C(5) CURRENT DICE 6300 REM K(18,7) SCOREBOARD 6310 REM COLUMNS 1-13 BOARD NUMBER 6320 REM COLUMN 14 BONUS UPPER 6330 REM COLUMN 15 TOTAL UPPER 6340 REM COLUMN 16 TOTAL LOWER 6350 REM COLUMN 17 GRAND TOTAL 6360 REM COLUMN 18 DONE/NOT DONE STATUS 6370 REM ROW 1- 7 PLAYERS SCORE 6380 REM ROW N COMPUTERS SCORE (<7 PLAYERS) 6390 REM 6400 REM F(5) DICE NUMBER TO ROLL AGAIN 6410 REM A$(7) PLAYERS NAMES 6420 REM S(6,5) COMPUTERS DICE LOGIC 6430 REM COLUMN 0 DICE NUMBER BY QTY SEQUENCE 6440 REM COLUMN 1 QTY/POSITION FOR ACES 6450 REM COLUMN 2 QTY/POSITION FOR TWOS 6460 REM COLUMN 3 QTY/POSITION FOR THREES 6470 REM COLUMN 4 QTY/POSITION FOR FOURS 6480 REM COLUMN 5 QTY/POSITION FOR FIVES 6490 REM COLUMN 6 QTY/POSITION FOR SIXES 6500 REM ROW 0 QUANTITY OF DICE 6510 REM ROW 1- 5 POSITION OF DICE IN C(5) 6520 REM 6530 REM SAMPLE S(Y,X) FOR DICE OF 5,2,4,6,4 6540 REM 6550 REM Y/X 0 1 2 3 4 5 6560 REM 0 4 6 5 2 IN QTY/VALUE SEQUENCE 6570 REM 1 NO DIE=1 6580 REM 2 1 2 1 TWO POSITION 2 6590 REM 3 NO DIE=3 6600 REM 4 2 3 5 2 FOURS POSITIONS 3 AND 5 6610 REM 5 1 1 1 FIVE POSITION 1 6620 REM 6 1 4 1 SIX POSITION 4 6630 REM + + 6640 REM + + ++++++++++++++++ SECTION FOR POSITION DATA 6650 REM + +------------------ COLUMN INDICATES QTY 6660 REM +------------------------ INDEX EQUATES TO DIE VALUE 6670 REM 6680 REM M(13) PRIORITY NUMBERS FOR MUST SCORE WHERE VALUE 6690 REM REFERS TO PLAY BOARD NUMBER 6700 REM 6710 REM TO RUN INTERNAL CHECKS SECTION - ENTER A -1 FOR 6720 REM PLAYING BOARD NUMBER OR QTY OF DICE TO ROLL 6730 REM AGAIN - - DATA WILL NOT BE LOST AND SCREEN 6740 REM WILL BE RESET WITH CURRENT DICE SHOWN - - 6750 REM PLAYERS/COMPUTERS SCORE WILL NOT SHOW UNTIL 6760 REM AFTER THEIR TURN 6770 REM 6780 REM COMPUTER PRIORIRIES 6790 RESTORE 6800 6800 DATA 11,9,12,8,1,2,3,4,5,6,10,7,13 6810 FOR Y= 1 TO 13:READ M(Y):NEXT :RETURN :RETURN 6820 REM player's board 6830 LOCATE 25,1,0:COLOR 7,0:CLS:COLOR 5,3:LOCATE 1,1:FOR Y=1 TO 22:PRINT STRING$(80," ");:NEXT:LOCATE 1,1 6840 PRINT" ╒═══╤═══╤═══╤═══╤═══╤═══╕ 6850 PRINT"ACES........1│...│...│...│...│...│...│1" 6860 PRINT"TWOS........2│...│...│...│...│...│...│2" 6870 PRINT"THREES......3│...│...│...│...│...│...│3" 6880 PRINT"FOURS.......4│...│...│...│...│...│...│4" 6890 PRINT"FIVES.......5│...│...│...│...│...│...│5" 6900 PRINT"SIXES.......6│...│...│...│...│...│...│6" 6910 PRINT" ╞═══╪═══╪═══╪═══╪═══╪═══╡" 6920 PRINT"TOTAL UPPER..│...│...│...│...│...│...│" 6930 PRINT" ╞═══╪═══╪═══╪═══╪═══╪═══╡" 6940 PRINT"3 OF A KIND.7│...│...│...│...│...│...│7" 6950 PRINT"4 OF A KIND.8│...│...│...│...│...│...│8" 6960 PRINT"FULL HOUSE..9│...│...│...│...│...│...│9" 6970 PRINT"SM STRAIGHT.A│...│...│...│...│...│...│A" 6980 PRINT"LG STRAIGHT.B│...│...│...│...│...│...│B" 6990 PRINT"YATZEE......C│...│...│...│...│...│...│C" 7000 PRINT"CHANCE......D│...│...│...│...│...│...│D" 7010 PRINT" ╞═══╪═══╪═══╪═══╪═══╪═══╡" 7020 PRINT"TOTAL LOWER..│...│...│...│...│...│...│" 7030 PRINT"TOP BONUS....│...│...│...│...│...│...│" 7040 PRINT"GRAND TOTAL..│...│...│...│...│...│...│" 7050 PRINT" ╘═══╧═══╧═══╧═══╧═══╧═══╛" 7060 FOR N=1 TO 5:LOCATE N*4-2,46:PRINT N;:NEXT 7070 RETURN 7080 LOCATE 25,1:PRINT STRING$(70," ");:LOCATE 25,1:RETURN 7090 ' KB INPUT AND ESCAPE 7100 KB$="":WHILE KB$="":KB$=INKEY$:WEND 7110 IF KB$=CHR$(27) THEN 5070 ELSE RETURN 65000 REM -*- program name -*- 65010 REM Version 1.00 65020 KEY(2) ON:ON KEY(2) GOSUB 65200 65030 KEY OFF:SCREEN 0,1:COLOR 15,3,1:WIDTH 40:CLS:LOCATE 5,18:PRINT " IBM " 65040 LOCATE 7,12,0:PRINT "Personal Computer" 65050 COLOR 10,0:LOCATE 10,9,0:PRINT CHR$(213)+STRING$(21,205)+CHR$(184) 65060 LOCATE 11,9,0:PRINT CHR$(179)+" -*- YAHTZEE -*- "+CHR$(179) 65070 LOCATE 12,9,0:PRINT CHR$(179)+STRING$(21,32)+CHR$(179) 65080 LOCATE 13,9,0:PRINT CHR$(179)+"By: J Helms & M Pezok"+CHR$(179) 65085 LOCATE 14,9,0:PRINT CHR$(179)+"PC vsn: Patrick Leabo"+CHR$(179) 65090 LOCATE 15,9,0:PRINT CHR$(212)+STRING$(21,205)+CHR$(190) 65100 COLOR 15,0:LOCATE 19,5,0:PRINT " Original written for CCII " 65110 COLOR 14,0:LOCATE 23,7,0:PRINT "Press space bar to continue";CHR$(7); 65120 COLOR 30:LOCATE 23,5,0:PRINT CHR$(15);:LOCATE 23,35,0:PRINT CHR$(15); 65130 COLOR 14 65140 POKE 106,0 'CLEAR KYBD BUFFER 65150 CMD$ = INKEY$ 65160 IF CMD$="" THEN GOTO 65150 65170 IF CMD$ = CHR$(27) THEN GOTO 65200 65180 IF CMD$ = " " THEN GOTO 1 65190 GOTO 65140 65200 ON ERROR GOTO 65240:RUN"BASMENU 65210 IF E<>71 THEN RUN"control 65220 RUN"A:TRANSFER 65230 SYSTEM 65240 E=ERR:RESUME NEXT