10 ! ADAPTED and 1/2 rewritten YAHTZEE J. E. STEITZ 6/27/83 !************************************************************************* !** YAHTZEE BY : W HARTGERS / OMEGON COMPUTERSYSTEMS * !** and : J E STEITZ * !** HOLLAND * !** * !** This is a game of YAHTZEE for 1-6 players (Great fun with XFORCE!) * !** with XFORCE!.) * !** The routines used within this program are PACMAN.SBR and VERIFY.SBR * !** (Both on the network) * !** * !** Ofcause the normal rules are here also: Let the author message in * !** the program and my employer has NOTHING to do with this program * !** It's for free... * !** * !** * !************************************************************************* STRSIZ 256 RANDOMIZE OT=TIME MAP1 DATUM,B,3 MAP1 DATUM2,@DATUM MAP2 MAAND,B,1 MAP2 DAG,B,1 MAP2 JAAR,B,1 DATUM=DATE:DIM STAT(7) XCALL VERIFY,"PACMAN.SBR" XCALL PACMAN 20 GOSUB 6000:PRINT TAB(1,24);:PRINT"YAHTZEE By W Hartgers/JE Steitz" :PRINT TAB(2,34);:PRINT"27/8/87" 70 PRINT:PRINT"During play, instructions are given at the very bottom of the screen to" 80 PRINT"let you know what to do at each step. You may use the ARROW keys or the" 90 PRINT"SPACE BAR to move the cursor from place to place on the screen. The cursor" 100 PRINT"looks like this: ";:PRINT "X"; 110 PRINT" " :PRINT"When you have decided what you want to do, you must remember to hit the" 120 PRINT"RETURN ";:PRINT" key to inform the computer that you have made some choice or" 130 PRINT"taken some action." 140 PRINT " ":PRINT"Hit the ";:PRINT"RETURN";:PRINT" KEY TO CONTINUE." 150 XCALL PACMAN,A$:IF LEN(A$)=0 THEN 150 GOSUB 7000 160 IF ASC(A$)<>13 THEN 150 170 !DEFINT I-O 180 !DEFSTR A-H 190 !OPTION BASE 1 195 DIM NAM$(11),DT$(11),SCORE(11),SSTOP(11),SBOT(11) 197 DIM SCORE$(11),UPPER$(11),LOWER$(11) 200 DIM DIE(5),J1(5,2),NNAME$(6,6),OSCORE(6,14) 210 NNAME$(1,1)="test":CRS$="+" 220 !DEF FNUP$(A$)=CHR$(ASC(LEFT$(A$,1)) AND 223) 230 A$="00:00:00" 240 ! A$= RIGHT$(A,2)+MID$(A,3,2)+LEFT$(A,2) 250 TEST=RND(TIME) 260 OCOL=70 DIM FACE$(10,10) 270 FACE$(1,1)=" " 280 FACE$(1,2)=" "+"0"+" " 290 FACE$(1,3)=" " 300 FACE$(2,1)=" "+"0"+" " 310 FACE$(2,2)=" " 320 FACE$(2,3)=" "+"0"+" " 330 FACE$(3,1)=" "+"0"+" " 340 FACE$(3,2)=" "+"0"+" " 350 FACE$(3,3)=" "+"0"+" " 360 FACE$(4,1)=" "+"0"+" "+"0"+" " 370 FACE$(4,2)=" " 380 FACE$(4,3)=" "+"0"+" "+"0"+" " 390 FACE$(5,1)=" "+"0"+" "+"0"+" " 400 FACE$(5,2)=" "+"0"+" " 410 FACE$(5,3)=" "+"0"+" "+"0"+" " 420 FACE$(6,1)=" "+"0"+" "+"0"+" " 430 FACE$(6,2)=" "+"0"+" "+"0"+" " 440 FACE$(6,3)=" "+"0"+" "+"0"+" " 450 GOSUB 6000 455 GOSUB 3000 458 GOSUB 4000 460 PRINT TAB(23,1);:PRINT "HOW MANY PLAYERS (1-6) ";:GOSUB 61000:NP=VAL(INP$) IF NP=0 THEN NP=1 470 IF NP=>1 AND NP<=6 THEN 500 480 PRINT CHR$(7); 490 GOTO 460 500 !ERASE OSCORE,ANAME$ 510 !DIM ANAME$(6),OSCORE(6,14) 520 FOR I=1 TO NP 530 PRINT TAB(23,1);:PRINT"Enter the name for player number ";I;" "; 540 GOSUB 61000 : IF INP$[1;1]=" " THEN INP$="WILLEM" INP$=UCS(INP$):ANAME$(I)=INP$ 550 ANAME$(I)=LEFT$(ANAME$(I),6) 555 ANAME2$(I)=ANAME$(I) 560 ANAME$(I)=UCS(ANAME$(I))+MID$(ANAME$(I),2) 570 FOR J=1 TO 13 580 OSCORE(I,J)=-1 590 NEXT J 600 OSCORE(I,14)=0 610 NEXT I 620 ! DISPLAY THE SCORING TABLE 630 GOSUB 6000 :PRINT TAB(01,01);TAB(-1,11); 640 PRINT" | | | | | | |" 650 PRINT" | | | | | | |" 660 PRINT" | | | | | | |" 670 PRINT" | | | | | | |" 680 PRINT" | | | | | | |" 690 PRINT" | | | | | | |" 700 PRINT" | | | | | | |" 710 PRINT" |------+------+------+------+------+------|" 720 PRINT" | | | | | | |" 730 PRINT" | | | | | | |" 740 PRINT" |------+------+------+------+------+------|" 750 PRINT" | | | | | | |" 760 PRINT" | | | | | | |" 770 PRINT" | | | | | | |" 780 PRINT" | | | | | | |" 790 PRINT" | | | | | | |" 800 PRINT" | | | | | | |" 810 PRINT" | | | | | | |" 820 PRINT" | | | | | | |" 830 PRINT" |------+------+------+------+------+------|" 840 PRINT" | | | | | | |" 850 PRINT" | | | | | | |" 860 PRINT" | | | | | | |" 870 PRINT" -------------------------------------------"; 875 PRINT TAB(-1,11); PRINT TAB(02,02);"One's "; PRINT TAB(03,02);"Two's "; PRINT TAB(04,02);"Three's"; PRINT TAB(05,02);"Four's "; PRINT TAB(06,02);"Five's "; PRINT TAB(07,02);"Six's "; PRINT TAB(09,02);"Total upper "; PRINT TAB(10,02);"BONUS (63) "; PRINT TAB(12,02);"Three/kind "; PRINT TAB(13,02);"Four/kind "; PRINT TAB(14,02);"Full house "; PRINT TAB(15,02);"Small str. "; PRINT TAB(16,02);"Large str. "; PRINT TAB(17,02);"YAHTZEE "; PRINT TAB(18,02);"Chance "; PRINT TAB(19,02);"YAH. BONUS "; PRINT TAB(21,02);"Total lower "; PRINT TAB(22,02);"Total upper "; PRINT TAB(23,02);"T O T A L ";TAB(-1,12); SWSCR=0 880 FOR NROUND=1 TO 13 890 FOR NPLAYER = 1 TO NP 900 FOR I=1 TO NP 910 IF I=NPLAYER THEN PRINT TAB(1,17+(I-1)*7);TAB(-1,12);:PRINT ANAME$(I);TAB(-1,12); IF I<>NPLAYER THEN PRINT TAB(1,17+(I-1)*7);TAB(-1,11);:PRINT ANAME$(I);TAB(-1,12); 940 NEXT I 950 FOR NROLL=1 TO 2 960 GOSUB 2850 !Roll and Display the Dice 970 ! DICE SELECTION ROUTINE 980 OPOS = 1 990 CCRS$=CRS$ 1000 PRINT TAB(24,1);SPACE(79);:PRINT TAB(24,1); PRINT TAB(-1,11);" Press X for holding this dice. ";TAB(-1,12); 1010 PRINT TAB(5+4*(OPOS-1),OCOL-2);:PRINT CCRS$ ;: 1020 A$="":XCALL PACMAN,A$ : IF LEN(A$)=0 GOTO 1020 GOSUB 7000 A$=UCS(A$) 1030 IF A$= CHR$(13) THEN 1290 !accept input IF A$= "0" THEN A$=" " 1040 IF A$= " " THEN 1270 !Space bar IF A$= "." THEN A$="X" 1050 IF A$="X" THEN 1250 !die selected 1080 IF A$=CHR$(11) THEN 1220 !cursor up 1090 IF A$<>CHR$(10) THEN 1020 1100 OPOS = OPOS + 1 !cursor down 1110 IF OPOS>5 THEN OPOS=1 1120 CCRS$=CRS$ 1130 PRINT TAB(5,OCOL-2); 1140 FOR I=1 TO 5 1150 APRT$=" " 1160 IF J1(I,1)=0 THEN 1190 1170 APRT$="X" 1180 IF I=OPOS THEN CCRS$="*" 1190 PRINT TAB(5+4*(I-1),OCOL-2);:PRINT APRT$; 1200 NEXT I 1210 GOTO 1010 1220 OPOS=OPOS-1 ! cursor up 1230 IF OPOS<1 THEN OPOS=5 1240 GOTO 1120 1250 J1(OPOS,1)=1 ! select the die 1260 GOTO 1100 !move to next position 1270 J1(OPOS,1)=0 !unselect the die (Space bar was hit) 1280 GOTO 1100 1290 FOR I=1 TO 5 1300 PRINT TAB(5+4*(I-1),OCOL-2);:PRINT" "; 1310 NEXT I 1320 NSAVE=J1(1,1) 1330 FOR I=2 TO 5 1340 NSAVE=NSAVE+J1(I,1) 1350 NEXT I 1360 IF NSAVE=5 THEN 1390 1370 NEXT NROLL 1380 GOSUB 2850 !Roll and display the dice for the third time 1390 ! SELECT SCORING ROUTINE 1400 FOR K=1 TO 5:J1(K,1)=0:NEXT K PRINT TAB(24,1);SPACE(79); 1410 PRINT TAB(24,1); PRINT TAB(-1,11);" Move cursor to the item you want to score and hit the return key ";TAB(-1,12); 1420 FOR I=1 TO 13 1430 IF OSCORE(NPLAYER,I)=-1 THEN 1460 1440 NEXT I 1450 PRINT"game over?" 1460 IF I<7 THEN ILINE=I+1 ELSE ILINE=I+5 1470 PRINT TAB(ILINE,1);:PRINT CRS$; 1480 A$="": XCALL PACMAN,A$:IF LEN(A$)=0 THEN 1480 GOSUB 7000 1490 IF A$=" " THEN 1550 1500 IF A$=CHR$(13) THEN 1670 1520 INKY=ASC(A$) 1530 IF INKY=11 THEN 1610 1540 IF INKY <> 10 THEN 1480 1550 PRINT TAB(ILINE,1);:PRINT" "; ! Cursor down 1560 ILINE=ILINE+1 1570 IF ILINE=8 THEN ILINE=12:GOTO 1590 1580 IF ILINE=19 THEN ILINE = 2 1590 IF ILINE<8 THEN I=ILINE-1 ELSE I=ILINE-5 1600 IF OSCORE(NPLAYER,I)=-1 GOTO 1470 ELSE GOTO 1560 1610 PRINT TAB(ILINE,1);:PRINT" "; 1620 ILINE=ILINE-1 1630 IF ILINE=11 THEN ILINE=7:GOTO 1650 1640 IF ILINE=1 THEN ILINE=18 1650 IF ILINE<8 THEN I=ILINE-1 ELSE I=ILINE-5 1660 IF OSCORE(NPLAYER,I)=-1 GOTO 1470 ELSE GOTO 1620 1670 ALL5$="NO" !Assume no yahtzee 1680 FOR L=2 TO 5 1690 IF J1(L,2)<>J1(1,2) THEN 1720 1700 NEXT L 1710 ALL5$="YES" 1720 IF I>6 THEN 1840 1730 NTOT=0 1740 FOR ND=1 TO 5 1750 IF J1(ND,2)=I THEN NTOT=NTOT+I 1760 J1(ND,1)=0 1770 NEXT ND 1780 NTOP=NTOT 1790 FOR L=1 TO 6 1800 IF OSCORE(NPLAYER,L)<>-1 THEN NTOP=NTOP+OSCORE(NPLAYER,L) 1810 NEXT L 1820 PRINT TAB(9,17+(NPLAYER-1)*7);:PRINT USING "######";NTOP; 1830 GOTO 2410 1840 ! VALIDATE AND SCORE LOWER HALF 1850 NDTOT=J1(1,2) !Get the total of all dice 1860 FOR L=2 TO 5 1870 NDTOT=NDTOT+J1(L,2) 1880 NEXT L 1890 IF I=13 THEN NTOT=NDTOT:GOTO 2410 !Go score chance line 1900 IF I<> 12 THEN 1930 !Not Yahtzee 1910 IF ALL5$="YES" THEN NTOT=50 ELSE NTOT=0 1920 GOTO 2420 !Go score the YAHTZEE line 1930 ! Distribute pips for analysis 1940 FOR L=1 TO 6:NPIP(L)=0:NEXT L 1950 FOR L=1 TO 5 1960 NPIP(J1(L,2))=NPIP(J1(L,2))+1 1970 NEXT L 1980 IF I<>7 THEN 2050 !Not 3 of a kind 1990 NTOT=NDTOT 2000 FOR L=1 TO 6 2010 IF NPIP(L)=>3 THEN 2410 !Qualifies for 3 of a kind 2020 NEXT L 2030 NTOT=0 2040 GOTO 2410 2050 IF I<>8 THEN 2120 !Not 4 of a kind 2060 NTOT=NDTOT 2070 FOR L=1 TO 6 2080 IF NPIP(L)=>4 THEN 2410 !Qualifies for 4 of a kind 2090 NEXT L 2100 NTOT=0 2110 GOTO 2410 2120 ! May only be full house, sm or lg straight 2130 IF ALL5$="YES" AND OSCORE(NPLAYER,J1(1,2))<>-1 THEN JOKER$="yes" ELSE JOKER$="NO" 2140 IF I<>9 THEN 2210 2150 NTOT=25 !Assume a good full house 2160 IF JOKER$="YES" THEN 2410 2170 FOR K=1 TO 6 2180 IF NPIP(K)=1 OR NPIP(K)>3 THEN NTOT=0 2190 NEXT K 2200 GOTO 2410 2210 ! Only the sm and lg straights are left 2220 IF I<>10 THEN 2320 2230 NTOT=30 !Assume a good small straight 2240 IF JOKER$="YES" THEN 2410 2250 OBIT=0 2260 FOR K=1 TO 6 2270 IF NPIP(K)=0 THEN OBIT=0 ELSE OBIT=OBIT+1 2280 IF OBIT=4 THEN 2410 !qualifies as a small straight 2290 NEXT K 2300 NTOT=0 ! fails as a small straight 2310 GOTO 2410 2320 NTOT=40 !Must be trying for a large straight 2330 IF JOKER$="YES" THEN 2410 2340 OBIT=0 2350 FOR K=1 TO 6 2360 IF NPIP(K)=0 THEN OBIT=0 ELSE OBIT=OBIT+1 2370 IF OBIT=5 THEN 2410 2380 NEXT K 2390 NTOT=0 2400 ! ADD 100 IF THIS IS SECOND OR LATER YAHTZEE 2410 IF ALL5$="YES" AND OSCORE(NPLAYER,12)>0 THEN OSCORE(NPLAYER,14)=OSCORE(NPLAYER,14)+100 !Score 100 point bonus for extra yahtzees 2420 OSCORE(NPLAYER,I)= NTOT 2430 PRINT TAB(ILINE,1);:PRINT" "; 2440 PRINT TAB(ILINE,17+(NPLAYER-1)*7);:PRINT USING "######";NTOT; 2450 NEXT NPLAYER 2460 NEXT NROUND 2470 PRINT TAB(24,1);:PRINT SPACE(77); 2480 ! PRINT FINAL TOTALS 2490 LSCORE=0 2500 FOR N=1 TO NP 2510 NTOP=OSCORE(N,1) 2520 FOR M=2 TO 6 2530 NTOP=NTOP+OSCORE(N,M) 2540 NEXT M 2550 IF NTOP =>63 THEN NB63=35 ELSE NB63=0 2560 PRINT TAB(10,17+(N-1)*7);:PRINT USING "######";NB63; 2570 NTUPPER=NTOP+NB63 2580 PRINT TAB(19,17+(N-1)*7);:PRINT USING "######";OSCORE(N,14) 2590 NBOT=OSCORE(N,7) 2600 FOR M=8 TO 14 2610 NBOT=NBOT+OSCORE(N,M) 2620 NEXT M 2630 PRINT TAB(21,17+(N-1)*7);:PRINT USING "######";NBOT; 2640 PRINT TAB(22,17+(N-1)*7);:PRINT USING "######";NTUPPER; 2650 PRINT TAB(23,17+(N-1)*7);:PRINT USING "######";NTUPPER+NBOT; 2655 SB(N)=NBOT:SU(N)=NTUPPER:ST(N)=NBOT+NTUPPER 2660 IF NTUPPER+NBOT>LSCORE THEN LSCORE=NTUPPER+NBOT:NNNAME=N 2670 NEXT N 2680 PRINT TAB(24,17+(NNNAME-1)*7);:PRINT"WINNER";: 2685 GOSUB 5000 2690 PRINT TAB(24,1);:PRINT"Do you want to play another (Y,N) "; GOSUB 61000 : A$=INP$ 2700 IF LEN(A$)=0 THEN 2690 2710 IF UCS(A$)="N" THEN PRINT TAB(-1,0): GOTO 62000 2720 IF UCS(A$)<>"Y" THEN 2690 2730 PRINT TAB(24,1);:PRINT SPACE(77); 2740 PRINT TAB(24,1);:PRINT"Same players (Y,N) "; GOSUB 61000 : A$=INP$ 2750 IF LEN(A$)=0 THEN 2730 2760 IF UCS(A$)="N" THEN 450 2770 IF UCS(A$)<>"Y" THEN 2730 2780 FOR I=1 TO NP 2790 FOR J=1 TO 13 2800 OSCORE(I,J)=-1 2810 NEXT J 2820 OSCORE(I,14)=0 2830 NEXT I 2840 GOTO 630 2850 ! ROUTINE TO ROLL AND DISPLAY UP TO FIVE DICE FOR ZZZ=1 TO 6 2860 FOR I=1 TO 5 2870 IF J1(I,1)=0 THEN J1(I,2)=INT(RND(1)*6) + 1 ! Roll only unlocked dice IF J1(I,1)<>0 STAT(J1(I,2))=STAT(J1(I,2))+1 IF ZZZ=6 THEN J1(I,1)=0 ! Reset dice locking flag !2890 NEXT I !2900 !2910 FOR I=1 TO 5 IF SWSCR=1 GOTO 2905 PRINT TAB(2+4*(I-1),OCOL-1);TAB(-1,11); IF I<>1 THEN PRINT "---------";& ELSE PRINT "---------"; PRINT TAB(3+4*(I-1),OCOL-1); PRINT "| |"; PRINT TAB(4+4*(I-1),OCOL-1); PRINT "| |"; PRINT TAB(5+4*(I-1),OCOL-1); PRINT "| |"; PRINT TAB(6+4*(I-1),OCOL-1); IF I<>5 THEN PRINT "---------";TAB(-1,12); & ELSE & PRINT "---------";TAB(-1,12); 2905 IF J1(I,1)<>0 GOTO 2965 2920 FOR J=1 TO 3 2930 PRINT TAB(2+4*(I-1)+J,OCOL);:PRINT FACE$(J1(I,2),J); 2940 NEXT J 2965 NEXT I SWSCR=1 NEXT ZZZ 2970 RETURN 3000 ! GET THE TOP TEN SCORE LIST 3010 LOOKUP "YA.OVR",SW 3020 IF SW=0 GOSUB 8000 3030 OPEN #1,"YA.OVR",INPUT INPUT #1,SECONDS INPUT #1,GAMES 3040 FOR I=1 TO 10 INPUT #1,NAM$(I) INPUT #1,SCORE(I) INPUT #1,SSTOP(I) INPUT #1,SBOT(I) INPUT #1,DT$(I) NEXT I 3050 CLOSE #1 RETURN 4000 ! DRAW THE HISCORE MATRIX TOP$=" NAME DATE HI-SCORE UPPER LOWER " INN$="| | | | | |" 4030 BOT$="------------------------------------------------" 4035 PRINT TAB(1,13);TAB(-1,11);:PRINT" TOP - SCORE LIJST WINNAARS YANTZEE "; 4040 PRINT TAB(2,13);TAB(-1,11);:PRINT TOP$; PRINT TAB(-1,11); PRINT TAB(2,13);"|";TAB(2,22);"|";TAB(2,33);"|";TAB(2,44);"|";TAB(2,52);"|"; PRINT TAB(2,60);"|"; 4050 FOR I=3 TO 21:PRINT TAB(I,13);:PRINT INN$:NEXT 4060 PRINT TAB(22,13);:PRINT BOT$;TAB(-1,12); FOR I=1 TO 10 IF SCORE(I)=0 GOTO 4070 PRINT TAB(I*2+1,15);:PRINT LEFT$(NAM$(I),6);: PRINT TAB(I*2+1,24);:PRINT DT$(I); PRINT TAB(I*2+1,37);:PRINT USING "####";SCORE(I); PRINT TAB(I*2+1,47);:PRINT USING "####";SSTOP(I); PRINT TAB(I*2+1,55);:PRINT USING "####";SBOT(I); 4070 NEXT I FOR I=1 TO 6 PRINT TAB(3+I,70);:PRINT I;" = ";:PRINT USING "####";STAT(I) NEXT I HH=0:SS=0:MM=0 HSEC=SECONDS 4071 IF HSEC>3599 THEN HH=HH+1 : HSEC=HSEC-3600 : GOTO 4071 4072 IF HSEC>59 THEN MM=MM+1 : HSEC=HSEC-60 : GOTO 4072 SS=HSEC 4120 RETURN 5000 ! UPDATE TOP TEN SCORES 5002 PRINT TAB(24,32);:PRINT"PRESS ANY KEY TO CONTINUE"; 5004 A$="":XCALL PACMAN,A$ :IF LEN(A$)=0 THEN 5004 GOSUB 7000 5006 GOSUB 3000 DAT$=DAG USING "#Z": WW$=MAAND USING "#Z" : DAT$=DAT$+"-"+WW$ WW$=JAAR USING "#Z": DAT$=DAT$+"-"+WW$ 5010 NAM$(11)=ANAME2$(NNNAME):DT$(11)=DAT$ 5020 SSTOP(11)=SU(NNNAME) 5050 SBOT(11)=SB(NNNAME) 5080 SCORE(11)=SSTOP(11)+SBOT(11) 5100 FOR I=1 TO 10 5110 FOR J=I+1 TO 11 5120 IF SCORE(I)CHR$(127) GOTO 61010 61050 INP$=INP$+POS$ : PRINT POS$; 61060 GOTO 61010 61090 PRINT TAB(-1,29):RETURN 62000 END