Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Listing 1
0 REM   
2 GRAPHICS 18:SETCOLOR 4,14,8:SETCOLOR 3,0,0:SETCOLOR 2,6,6
3 ? #6;" ":? #6:? #6;" [USE JOYSTICKS]"
4 ? #6:? #6;" ":? #6;" 1 - 3 ?"
5 OPEN #1,4,0,"K:":GET #1,T:CLOSE #1:IF (T<49)+(T>51) THEN 5
6 P=T-48
10 OPEN #1,4,0,"S:"
14 DIM LINE$(23),C(6),CC(6),SCORE(18),TOTSCORE(P),BONUS(P),BON(P),H(P),BL$(13)
15 POKE 752,1:POKE 82,1
20 SOUN=1000:SOUN1=1040:SOUN2=1080
25 TIME=1100:CLEAR=5000:SOUN3=1090
30 ROLL=2000:BL$=" "
31 EVAL=3000
32 SEARCH=4000
33 STICK=4500
40 FOR X=1 TO P:H(X)=0:NEXT X
100 REM
110 LINE$=""
114 ? " Yatzee"
116 ? " Cat. pts #1 #2 #3"
120 ? LINE$
130 FOR X=1 TO 6:? X;"'S":SO=200:TT=12:GOSUB SOUN:NEXT X
140 ? "BONUS":GOSUB SOUN
150 ? LINE$:GOSUB TIME:FOR X=3 TO 4:? X;" KIND":GOSUB SOUN:NEXT X
160 ? "F.HOUS":GOSUB SOUN:? "SM.STR":GOSUB SOUN:? "LG.STR":GOSUB SOUN:? "":GOSUB SOUN:? "CHANCE":GOSUB SOUN
161 ? LINE$:GOSUB SOUN:? "":GOSUB SOUN:? LINE$:GOSUB SOUN
163 FOR X=12 TO 22 STEP 4:FOR Y=3 TO 21:SO=Y*11:TT=2:GOSUB SOUN:POSITION X,Y:? "---":NEXT Y:NEXT X
170 FOR X=3 TO 21:SO=273-10*X:TT=10:GOSUB SOUN:FOR Y=7 TO 23 STEP 4:POSITION Y,X:? "|":NEXT Y:NEXT X
180 FOR X=7 TO 22 STEP 4:POSITION X,3:? "":SO=100:GOSUB SOUN:NEXT X
190 FOR Y=11 TO 19 STEP 8:GOSUB SOUN:FOR X=7 TO 22 STEP 4:POSITION X,Y:? "":NEXT X:NEXT Y
200 FOR X=7 TO 22 STEP 4:POSITION X,21:? "":GOSUB SOUN:NEXT X
210 ? " "
220 FOR X=4 TO 9
225 SO=X*20:T=20:GOSUB SOUN
230 IF X<7 THEN POSITION 1,X:? "";(X-3)*3:NEXT X
240 POSITION 1,X:? "";(X-3)*3:NEXT X
250 ? "35   ":SO=200:GOSUB SOUN
260 ? "TOT":GOSUB SOUN1:? "TOT":GOSUB SOUN1:? "25":GOSUB SOUN1:? "30":GOSUB SOUN1
265 ? "40":GOSUB SOUN1:? "50"
270 GOSUB SOUN1:? "TOT":GOSUB SOUN1
280 FOR X=50 TO 200:SO=243-X:SOUND 0,SO,10,15:NEXT X:FOR X=50 TO 200:SOUND 0,X,10,15:NEXT X
290 Y=15:FOR X=50 TO 200:SOUND 0,X,8,Y:Y=Y-0.1:POKE 712,X:POKE 710,X:NEXT X:SOUND 0,0,0,0
300 FOR X=24 TO 37:POSITION X,0:? "":NEXT X
310 FOR X=1 TO 10:POSITION 24,X:? " ":NEXT X
320 COL=INT(15/P*RND(0)+3)
399 REM 
400 FOR X=1 TO 6:C(X)=0:CC(X)=0:NEXT X
410 FOR X=1 TO P:TOTSCORE(X)=0:BONUS(X)=0:BON(X)=1:NEXT X
415 FOR X=1 TO 15:SCORE(X)=0:NEXT X
420 FOR TRY=1 TO 13
422 FOR PLAYER=1 TO P:FOR X=1 TO 6:C(X)=0:CC(X)=0:NEXT X:TOT=0:RO=0
424 SETCOLOR 2,COL*PLAYER,3:SETCOLOR 4,COL*PLAYER,0
425 RO=RO+1:N=0
427 POSITION 25,10:? "";CHR$(PLAYER+176);"":POSITION 25,0:? "";CHR$(RO+176);""
430 GOSUB ROLL
433 FOR Y=1 TO 6:FOR X=1 TO 5:IF C(X)=Y THEN FF=FF+1:IF FF=5 THEN POP:GOSUB SOUN3:GOTO 700
434 NEXT X:FF=0:NEXT Y
435 IF RO=3 THEN RO=0:GOTO 700
438 POKE 77,0
440 A=33:B=6:NO=0
450 POSITION A,B:GET #1,NO:IF NO=32 THEN A=A+2:GOTO 490
460 TT=20:GOSUB TIME:POSITION A,B:PUT #1,NO+128:GOSUB TIME:POSITION A,B:PUT #1,NO
470 U=STICK(PLAYER-1)
480 IF U=7 THEN A=A+2:SOUND 0,200,10,15:TT=5:GOSUB TIME:SOUND 0,0,0,0:GOTO 490
485 GOTO 510
490 IF A>37 AND B=6 THEN B=8:A=33
500 IF A>35 AND B=8 THEN B=6:A=33
503 IF N=5 THEN 425
505 GOTO 450
510 IF STRIG(PLAYER-1)=0 THEN C(NO-48)=0:POSITION 2*A-40,2*B-10:? "   ":N=N+1:GOTO 550
520 IF U=14 THEN FOR X=1 TO 10:SOUND 0,100,10,15-X:NEXT X:SOUND 0,0,0,0:GOTO 425
540 GOTO 450
550 POSITION A,B:PUT #1,32:SOUND 0,200,8,15:TT=5:GOSUB TIME:SOUND 0,0,0,0:GOTO 450
700 GOSUB EVAL
740 POSITION 24,12:GET #1,LT:POSITION 24,12:? CHR$(LT):IF LT=32 THEN 900
750 POSITION 26,LINE+2:? ""
755 LINE=12:TT=20
757 POSITION 24,LINE:GET #1,TL
760 POSITION 24,LINE:? CHR$(TL+128):GOSUB TIME:POSITION 24,LINE:? CHR$(TL):GOSUB TIME
770 U=STICK(PLAYER-1)
780 IF U=13 THEN SO=LINE*10:TT=10:GOSUB SOUN:LINE=LINE+1:POSITION 24,LINE:GET #1,TL:IF TL=32 THEN 755
790 IF STRIG(PLAYER-1)=0 THEN GOSUB SOUN2:GOTO 850
800 GOTO 757
850 AB=AA:IF TL>64 AND TL<71 THEN GOSUB 5100
855 IF SCORE(TL-64)>9 THEN AB=AA-1
860 IF SCORE(TL-64)>99 THEN AB=AA-2
870 POSITION AB,TL-61
872 ? SCORE(TL-64):IF TL=78 AND H(PLAYER)>1 THEN POSITION AB,TL-61:? "150"
874 TOTSCORE(PLAYER)=TOTSCORE(PLAYER)+SCORE(TL-64)
880 AB=AA
883 IF TOTSCORE(PLAYER)>9 THEN AB=AA-1
885 IF TOTSCORE(PLAYER)>99 THEN AB=AA-2
890 POSITION AB,20:? TOTSCORE(PLAYER):IF H(PLAYER)>1 THEN H(PLAYER)=1:PLAYER=PLAYER-1
895 GOTO 980
900 BB=4:Z=INT(3*RND(0)+1):ON Z GOTO 910,920,930
910 POSITION 24,12:? "Boy,what luck!":POSITION 24,13:? "Here's the ":POSITION 24,14:? "Brooklyn cheer"
911 POSITION 24,15:? "for that roll"
915 SOUND 0,243,8,15:TT=250:GOSUB TIME:SOUND 0,0,0,0
916 POSITION 24,16:? "Take a zero":GOTO 940
920 POSITION 24,12:? "Too bad-take":POSITION 24,13:? "a fat  ":GOTO 940
925 POSITION 24,25:? "Take a zero":GOTO 940
930 POSITION 24,12:? "It's just not ":POSITION 24,13:? "your day. Take":POSITION 24,14:? "a zero"
940 POSITION AA,BB:GET #1,LT
942 IF LT<>45 THEN POSITION AA,BB:PUT #1,LT:BB=BB+1:GOTO 945
943 GOTO 950
945 IF BB>18 THEN BB=4:GOTO 940
946 GOTO 940
950 POSITION AA,BB:PUT #1,LT+128:TT=20:GOSUB TIME:POSITION AA,BB:PUT #1,LT:GOSUB TIME
960 IF STICK(PLAYER-1)=13 THEN SOUND 0,150,8,15:GOSUB TIME:SOUND 0,0,0,0:BB=BB+1:GOTO 940
965 IF STRIG(PLAYER-1)=0 THEN POSITION AA,BB:PUT #1,48:GOSUB CLEAR:GOTO 980
970 GOTO 940
980 GOSUB CLEAR:FOR X=26 TO 37
985 FOR Y=2 TO 8:POSITION 26,Y:PRINT BL$:NEXT Y
990 NEXT PLAYER:NEXT TRY
995 POSITION 2,22:? ""
996 IF STRIG(0)=0 THEN CLR:CLOSE #1:GOTO 2
997 GOTO 996
999 END
1000 SOUND 0,SO,10,15:GOSUB TIME:SOUND 0,0,0,0:RETURN
1040 REM
1041 SOUND 0,SO,10,15:GOSUB TIME:SOUND 0,0,0,0
1042 SO=SO-30:RETURN
1080 FOR X=100 TO 130:SOUND 1,X,10,15:NEXT X:FOR X=130 TO 100 STEP -5:SOUND 1,X,10,15:NEXT X:SOUND 1,0,0,0:RETURN
1090 FOR Z=1 TO 200:SOUND 0,243-Z,10,15:SOUND 1,200-Z,12,5:NEXT Z:TT=250:GOSUB TIME
1092 FOR Z=43 TO 230:SOUND 0,Z,10,15:SOUND 1,Z-43,8,5:NEXT Z:FOR ZZ=15 TO 0 STEP -1:SOUND 0,Z,10,ZZ:SOUND 1,Z,8,ZZ
1093 NEXT ZZ:RETURN
1100 FOR TI=1 TO TT:NEXT TI:RETURN
2000 A=26:B=2
2010 FOR DICE=1 TO 5
2020 IF C(DICE)<>0 THEN 2070
2040 C(DICE)=INT(6*RND(1)+1):GOTO 2170
2055 POSITION A,B
2060 ON C(DICE) GOSUB 2100,2110,2120,2130,2140,2150
2070 A=A+4
2075 IF A>36 THEN A=26:B=6
2076 NEXT DICE
2080 POSITION 33,6:? "1 2 34 5":RETURN
2100 ? "":RETURN
2110 ? "":RETURN
2120 ? "":RETURN
2130 ? "":RETURN
2140 ? "":RETURN
2150 ? "":RETURN
2170 G=0
2172 POSITION A,B
2175 C=INT(6*RND(0)+1):ON C GOSUB 2100,2110,2120,2130,2140,2150
2178 SOUND 1,100,12,10:SOUND 1,0,0,0
2180 G=G+1:IF G=5 THEN 2055
2190 GOTO 2172
3000 REM 
3005 LINE=12
3010 FOR X=1 TO 5:FOR Y=1 TO 6:IF C(X)=Y THEN CC(Y)=CC(Y)+1
3015 NEXT Y:NEXT X
3020 FOR Y=1 TO 6:AA=4*PLAYER+10:BB=Y+3
3030 GOSUB SEARCH:IF SC<>45 THEN 3045
3040 IF CC(Y)>0 THEN POSITION 24,LINE:? CHR$(64+Y);"-";(Y);"'s=";CC(Y)*Y:LINE=LINE+1:SCORE(Y)=CC(Y)*Y
3045 NEXT Y
3047 FOR X=1 TO 5:TOT=TOT+C(X):NEXT X
3050 BB=12:GOSUB SEARCH:IF SC<>45 THEN 3080
3060 FOR Y=1 TO 6:IF CC(Y)>=3 THEN POSITION 24,LINE:? "I-3 kind=";TOT:LINE=LINE+1:SCORE(BB-3)=TOT
3070 NEXT Y
3080 BB=13:GOSUB SEARCH:IF SC<>45 THEN 3100
3090 FOR Y=1 TO 6:IF CC(Y)>=4 THEN POSITION 24,LINE:? "J-4 kind=";TOT:LINE=LINE+1:SCORE(BB-3)=TOT
3095 NEXT Y
3100 BB=14:GOSUB SEARCH:IF SC<>45 THEN 3130
3110 FOR Y=1 TO 6:IF CC(Y)=3 THEN 3120
3115 NEXT Y
3117 GOTO 3130
3120 FOR Y=1 TO 6:IF CC(Y)=2 THEN POSITION 24,LINE:? "K-Full House=25":LINE=LINE+1:SCORE(BB-3)=25
3125 NEXT Y
3130 BB=15:GOSUB SEARCH:IF SC<>45 THEN 3180
3140 FOR X=1 TO 3:FOR Y=X TO 3+X:IF CC(Y)<3 AND CC(Y)>0 THEN NEXT Y:GOTO 3170
3152 NEXT X
3160 GOTO 3180
3170 POSITION 24,LINE:? "L-Sm.Str=30":LINE=LINE+1:SCORE(BB-3)=30
3180 BB=16:GOSUB SEARCH:IF SC<>45 THEN 3220
3190 FOR X=1 TO 2:FOR Y=X TO 4+X:IF CC(Y)<=2 AND CC(Y)>0 THEN NEXT Y:GOTO 3200
3195 NEXT X
3197 GOTO 3220
3200 POSITION 24,LINE:? "M-Lg.Str=40":LINE=LINE+1:SCORE(BB-3)=40
3220 BB=17
3230 FOR Y=1 TO 6:IF CC(Y)=5 THEN H(PLAYER)=H(PLAYER)+1:POSITION 24,LINE:SCORE(BB-3)=50:GOTO 3250
3240 NEXT Y
3245 GOTO 3260
3250 IF H(PLAYER)>1 THEN SCORE(BB-3)=100
3255 ? "N-=";SCORE(BB-3):LINE=LINE+1
3260 BB=18:GOSUB SEARCH:IF SC<>45 THEN 3299
3270 POSITION 24,LINE:? "O-Chance=";TOT:SCORE(BB-3)=TOT
3299 RETURN
4000 POSITION AA,BB:GET #1,SC:POSITION AA,BB:PUT #1,SC:RETURN
5000 REM 
5010 FOR X=11 TO 22:POSITION 24,X:? " "
5020 NEXT X
5090 RETURN
5100 BONUS(PLAYER)=BONUS(PLAYER)+SCORE(TL-64)
5110 IF BONUS(PLAYER)>=63 AND BON(PLAYER)=1 THEN BON(PLAYER)=2:GOTO 5130
5120 RETURN
5130 POSITION AA,10:? "35":TOTSCORE(PLAYER)=TOTSCORE(PLAYER)+35
5140 FOR X=70 TO 80:FOR Y=150 TO 170
5150 SOUND 0,X,10,15:SOUND 1,243-Y,10,15
5160 NEXT Y:NEXT X:SOUND 0,0,0,0:SOUND 1,0,0,0
5170 RETURN
References
https://archive.org/details/BELLCOMPublicDomainSoftwareAtari8Bit
https://ftp.pigwa.net/stuff/collections/holmes%20cd/Holmes%203/BELLCOM/index.html
Atari 8-bit Source code
