10 REM Converted to HP85 John Shadbolt May 2002
20 CLEAR
30 DISP TAB(10);"YAHTZEE"
40 DISP TAB(17);"Creative Computing"
50 A=0 @ I0=0
60 ! K(1,2) CONTAINS SCORE #1 FOR PLAYER #2
70 DIM C(5),K(14,7),F(4),H2(6),L2(6),B5(7),B8(7),A$[80]
80 FOR I1=1 TO 14 @ FOR I2=1 TO 7 @ K(I1,I2)=0 @ NEXT I2 @ NEXT I1
90 BEEP @ BEEP
100 DISP "This is the game of Yahtzee;" @ DISP "do you want comments (Y/N)";
110 INPUT B$@ IF UPC$(B$[1,1])="N" THEN 150
120 IF UPC$(B$[1,1])="Y" THEN 140
130 GOSUB 1960 @ GOTO 100
140 GOSUB 2100
150 DISP @ DISP "How many players";@ INPUT N
160 IF N<1 THEN 150
170 IF N<=7 THEN 190
180 DISP "The maximum number of players is 7." @ GOTO 150
190 FOR A0=1 TO N
200 DISP "Enter name of player number ";A0 @ INPUT B$
210 L(A0)=LEN(B$) @ IF L(A0)>10 THEN 200
220 A$[A0*10,A0*10+L(A0)-1]=B$
230 NEXT A0
240 DISP @ DISP "Would you like a printed        scorecard (Y/N)" @ INPUT B$
250 IF UPC$(B$[1,1])="N" THEN 300
260 IF UPC$(B$[1,1])="Y" THEN 1980
270 GOSUB 1960 @ GOTO 240
280 ! Main loop. H count number of dice throws for each player (1 to 3), 
290 ! A current player number (1 to N)
300 H=0 @ DISP @ A=A+1 @ IF A<>N+1 THEN 320
310 A=1
320 FOR B=1 TO 5 @ C(B)=INT(6*RND)+1 @ NEXT B @ DISP
330 DISP @ GOSUB 2300 @ DISP "'s numbers:  " @ H=H+1
340 DISP C(1);C(2);C(3);C(4);C(5) @ IF H=3 THEN 580
350 DISP "How many dice to change - (0 to 5, or 25 for options)";@ INPUT E
360 IF E<>25 THEN 380
370 GOSUB 2180 @ GOTO 350
380 IF E>5 THEN 350
390 IF E<0 THEN 350
400 IF INT(E)<>E THEN 350
410 IF E=0 THEN 580
420 IF E=5 THEN 320
430 FOR F3=1 TO 4 @ F(F3)=0 @ NEXT F3
440 DISP "Which dice to change (eg 2,5)";
450 ON E GOTO 460,470,480,490
460 INPUT F(1)@ GOTO 500
470 INPUT F(1),F(2)@ GOTO 500
480 INPUT F(1),F(2),F(3)@ GOTO 500
490 INPUT F(1),F(2),F(3),F(4)
500 FOR F1=1 TO 4 @ F(F1)=INT(F(F1)) @ IF F(F1)>5 THEN 440
510 IF F(F1)<0 THEN 440
520 NEXT F1
530 FOR F2=1 TO 4 @ IF F(F2)=0 THEN 550
540 C(F(F2))=INT(6*RND+1)
550 NEXT F2
560 GOTO 330
570 ! Player chooses scoreboard to use this turn
580 GOSUB 2300 @ DISP " -- Scoreboard Number" @ DISP "(25 for options)";
590 INPUT I
600 IF I<>25 THEN 620
610 GOSUB 2180 @ GOTO 580
620 IF I<1 THEN 580
630 I=INT(I) @ IF I<14 THEN 680
640 DISP "Confirm (Y/N)";@ INPUT B$
650 IF UPC$(B$[1,1])="N" THEN 580
660 IF UPC$(B$[1,1])="Y" THEN 1580
670 GOSUB 1960 @ GOTO 640
680 IF K(I,A)=0 THEN 700
690 GOSUB 2300 @ DISP ", you have already used row number ";I @ GOTO 580
700 IF I>6 THEN 820
710 ! Categories 1 through 6
720 K=0
730 FOR G=1 TO 5 @ IF C(G)<>I THEN 750
740 K=K+I
750 NEXT G @ IF K=0 THEN 790
760 IF K<>1 THEN 800
770 GOSUB 2300 @ DISP ", you have 1 point in" @ DISP "row #1 (aces)"
780 K(1,A)=1 @ GOTO 1550
790 K(I,A)=.4 @ GOTO 1350
800 K(I,A)=K @ GOTO 1350
810 ! I>6
820 ON I-6 GOTO 840,850,1010,1170,1170,860,1320
830 ! 3 of a kind, 4 of a kind, 5 of a kind (Yahtzee)
840 R=3 @ T=C(1)+C(2)+C(3)+C(4)+C(5) @ GOTO 870
850 R=4 @ T=C(1)+C(2)+C(3)+C(4)+C(5) @ GOTO 870
860 R=5 @ T=50
870 FOR H3=1 TO 6 @ H2(H3)=0 @ NEXT H3
880 FOR H=1 TO 6 @ FOR H1=1 TO 5
890 IF C(H1)<>H THEN 910
900 H2(H)=H2(H)+1
910 NEXT H1 @ NEXT H
920 FOR H4=1 TO 6
930 IF H2(H4)>=R THEN 950
940 NEXT H4 @ K(I,A)=.4 @ GOTO 1350
950 IF K(I,A)=50 THEN 970
960 K(I,A)=T @ IF I<>12 THEN 1000
970 BEEP 400,10 @ BEEP 200,20 @ BEEP 100,50
980 DISP "Congratulations, ";@ GOSUB 2300 @ DISP "," @ DISP "you have a YAHTZEE!!!"
990 BEEP 400,10 @ BEEP 200,20 @ BEEP 100,50
1000 GOTO 1350
1010 ! Full house (I=9)
1020 L4=0 @ L5=0 @ FOR L=1 TO 6 @ L2(L)=0 @ NEXT L
1030 FOR L=1 TO 6 @ FOR L1=1 TO 5
1040 IF C(L1)<>L THEN 1050 ELSE L2(L)=L2(L)+1
1050 NEXT L1 @ NEXT L
1060 FOR L3=1 TO 6
1070 IF L5=1 THEN 1100
1080 IF L2(L3)<>2 THEN 1100
1090 L5=L5+1 @ GOTO 1110
1100 IF L2(L3)<>3 THEN 1120
1110 L4=L4+1
1120 NEXT L3
1130 IF L4=2 THEN 1150
1140 K(9,A)=.4 @ GOTO 1350 ! No score recorded, but scoreboard used
1150 K(9,A)=25 @ GOTO 1350 ! 25 points for full house
1160 DISP "LINE 480" @ STOP @ ! DELETE THIS LINE!
1170 ! PUT NUMBERS IN ORDER, STRAIGHTS (I=10 OR 11)
1180 FOR M2=1 TO 4 @ FOR M1=1 TO 4
1190 IF C(M1+1)>=C(M1) THEN 1210
1200 Z=C(M1) @ C(M1)=C(M1+1) @ C(M1+1)=Z
1210 NEXT M1 @ NEXT M2
1220 G1=1 @ ! Count number of times 2 neihbouring dice have adjancent numbers
1230 FOR X=2 TO 5
1240 IF C(X-1)+1<>C(X) THEN 1250 ELSE G1=G1+1
1250 NEXT X
1260 IF I=11 THEN 1290
1270 IF G1<4 THEN 1310
1280 K(I,A)=30 @ GOTO 1350
1290 IF G1<>5 THEN 1310
1300 K(I,A)=40 @ GOTO 1350
1310 K(I,A)=.4 @ GOTO 1350
1320 ! Chance (I=13)
1330 Y1=C(1)
1340 FOR Y=2 TO 5 @ Y1=C(Y)+Y1 @ NEXT Y @ K(13,A)=Y1
1350 GOSUB 2300 @ DISP ", you now have" @ DISP INT(K(I,A));"points in row #";I;", "
1360 DISP "(";
1370 ON I GOTO 1380,1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500
1380 DISP "(1)aces";@ GOTO 1510
1390 DISP "(2)twos";@ GOTO 1510
1400 DISP "(3)threes";@ GOTO 1510
1410 DISP "(4)fours";@ GOTO 1510
1420 DISP "(5)fives";@ GOTO 1510
1430 DISP "(6)sixes";@ GOTO 1510
1440 DISP "(7)3 of a kind";@ GOTO 1510
1450 DISP "(8)4 of a kind";@ GOTO 1510
1460 DISP "(9)full house";@ GOTO 1510
1470 DISP "(10)small straight";@ GOTO 1510
1480 DISP "(11)large straight";@ GOTO 1510
1490 DISP "(12)YAHTZEE";@ GOTO 1510
1500 DISP "(13)chance";
1510 IF E=25 THEN 2200
1520 IF I0=25 THEN 2200
1530 DISP ")"
1540 ! Check if game has finished
1550 FOR B=1 TO N @ FOR B1=1 TO 13
1560 IF K(B1,B)=0 THEN 300 ! NEXT PLAYER
1570 NEXT B1 @ NEXT B
1580 FOR B3=1 TO N @ B5(B3)=0 @ B8(B3)=0 @ NEXT B3
1590 DISP
1600 FOR B3=1 TO N @ FOR B4=1 TO 6
1610 B5(B3)=B5(B3)+INT(K(B4,B3)) @ ! Ignore any 0.4 scores
1620 NEXT B4 @ NEXT B3
1630 FOR B6=1 TO N @ FOR B7=7 TO 13
1640 B8(B6)=B8(B6)+INT(K(B7,B6)) @ ! Ignore any 0.4 scores
1650 NEXT B7 @ NEXT B6
1660 FOR B3=1 TO N
1670 IF B5(B3)<63 THEN 1680 ELSE K(14,B3)=35
1680 NEXT B3
1690 GOSUB 1970
1700 FOR A9=1 TO N @ ! Print score for player A9
1710 PRINT A$[A9*10,A9*10+L(A9)-1];"'s Totals" @ PRINT "**********************"
1720 PRINT
1730 PRINT "Aces --------";INT(K(1,A9))
1740 PRINT "Twos --------";INT(K(2,A9))
1750 PRINT "Threes ------";INT(K(3,A9))
1760 PRINT "Fours -------";INT(K(4,A9))
1770 PRINT "Fives -------";INT(K(5,A9))
1780 PRINT "Sixes -------";INT(K(6,A9))
1790 PRINT "3 of a kind -";INT(K(7,A9))
1800 PRINT "4 of a kind -";INT(K(8,A9))
1810 PRINT "4 of a kind -";INT(K(9,A9))
1820 PRINT "Small straight";INT(K(10,A9))
1830 PRINT "Large straight";INT(K(11,A9))
1840 PRINT "Yahtzee ------";INT(K(12,A9))
1850 PRINT "Chance -------";INT(K(13,A9))
1860 PRINT @ PRINT @ PRINT "Total of upper half -";B5(A9)
1870 PRINT @ PRINT "Bonus ---------------";K(14,A9)
1880 PRINT @ PRINT "Total of lower half -";B8(A9)
1890 PRINT
1900 B9=B5(A9)+B8(A9)+K(14,A9)
1910 PRINT A$[A9*10,A9*10+L(A9)-1];"'s GRAND TOTAL ----";B9
1920 GOSUB 1970
1930 NEXT A9
1940 IF I>13 THEN 580
1950 GOTO 2240
1960 DISP "Answer Y(es) or N(o)" @ RETURN
1970 FOR E=1 TO 30 @ PRINT "-";@ NEXT E @ PRINT @ RETURN
1980 GOSUB 1970
1990 PRINT "1**ACES" @ GOSUB 1970 @ PRINT "2**TWOS" @ GOSUB 1970
2000 PRINT "3**THREES" @ GOSUB 1970 @ PRINT "4**FOURS" @ GOSUB 1970
2010 PRINT "5**FIVES" @ GOSUB 1970 @ PRINT "6**SIXES" @ GOSUB 1970
2020 PRINT "7**3 OF A KIND" @ GOSUB 1970 @ PRINT "8**FOUR OF A KIND" @ GOSUB 1970
2030 PRINT "9**FULL HOUSE" @ GOSUB 1970 @ PRINT "10**SMALL STRAIGHT" @ GOSUB 1970
2040 PRINT "11**LARGE STRAIGHT" @ GOSUB 1970 @ PRINT "12**YAHTZEE" @ GOSUB 1970
2050 PRINT "13**CHANCE" @ GOSUB 1970
2060 FOR E1=1 TO 6 @ PRINT @ NEXT E1 @ CLEAR @ DISP "Tear off your scorecard."
2070 DISP "and press 'END LINE'"
2080 INPUT B$@ GOTO 300
2090 ! HELP SECTION
2100 DISP "Totals will be displayed if you"
2110 DISP "respond to 'Scoreboard Number?'"
2120 DISP "with a number greater than 13."
2130 DISP "To see what scoreboard options"
2140 DISP "you have not used, respond to"
2150 DISP "'How many?' or 'Scoreboard"
2160 DISP "Number?' with 25."
2170 RETURN
2180 DISP @ GOSUB 2300 @ DISP ", You have the following scoreboard options left:"
2190 I0=25 @ FOR I=1 TO 13 @ IF K(I,A)=0 THEN 1370 ELSE 2220
2200 DISP "  ";
2210 ! CURSCOL is on Advanced Programming ROM, otherwise reprogram
2220 IF CURSCOL>32 THEN DISP
2230 NEXT I @ DISP @ DISP @ I0=0 @ RETURN
2240 CLEAR @ DISP
2250 DISP @ DISP "Another game (Y/N)";@ INPUT B$
2260 IF UPC$(B$[1,1])="Y" THEN 150
2270 IF UPC$(B$[1,1])="N" THEN 2350
2280 GOSUB 1960 @ GOTO 2250
2290 ! Display name A
2300 DISP A$[A*10,A*10+L(A)-1];
2310 RETURN
2320 ! TEST AREA
2330 !
2340 STOP
2350 END
