1 REM Ins{nd av Lennart Einarsson <6554>    1986-06-01 14.43.57
10 REM *******************************
20 REM *  av    PETER STAHL          *
30 REM *      ABC80 och 40tkn        *
40 REM *******************************
50 IF PEEK(590%)<>40% ; INP(3%)
60 ; CHR$(12) : RESTORE 
70 DIM A(5,17),T$(17)=10,P$(5)=8,S$=8,P$=20,Z1(6),Z(6),U%(5),Q$=4
80 FOR I%=0 TO 17 : READ T$(I%) : NEXT I%
90 ; CHR$(151)STRING$(38,44) : ; CHR$(151)STRING$(13,44)CHR$(135)' Y A T Z Y 'CHR$(151)STRING$(12,44)
100 ; CHR$(151)STRING$(38,44)
110 ; " Vill du ha instruktioner(J/N)?"; : GET Q$ : IF Q$='J' OR Q$='j' THEN 120 ELSE 260
120 ; CUR(4,0);
130 ; ' Detta program till}ter att SEX person-  er spelar YATZY.' : ; 
140 ; ' N{r spelet b|rjat sl}r man in de t{r-   ningar''s POSITION som man vill spara    p}.' : ; 
150 ; ' Man f}r kasta t{rningarna totalt TRE    g}nger.' : ; 
160 ; ' Om man vill spara det man har redan p}  f|rsta eller andra kastet trycker man   in (N).' : ; 
170 ; ' Om man vill kasta om alla t{rningarna   s} tryck in (0=noll).' : GOSUB 1750
180 ; CUR(4,0)SPACE$(750) : ; CUR(4,0)
190 ; ' N{r man kastat TRE ggr m}ste man , om   tvivel kan uppst}, tala om var i'
200 ; ' protokollet man vill spara (1=\vre=     Ettor-Sexor, 2=Nedre delen=Par och'
210 ; ' ned}t.)' : ; 
220 ; ' Jag kollar sj{lv var det g}r in p}      (Absolut fuskfritt) men n{r n}got g}r'
230 ; ' in p} flera st{llen f}r Du v{lja p}     vilket.' : ; 
240 ; ' Ibland n{r det inte finns n}got att     s{tta p} m}ste Du STRYKA n}got.'
250 ; ' Tala d} om detta genom att trycka in    det RAD nummer som den aktuella raden   har.' : GOSUB 1750
260 ; CHR$(12) : ONERRORGOTO 260 : ; ' Hur m}nga skall spela'; : INPUT N : IF N>6 OR N<1 THEN 260
270 N8=N
280 ; : ; ' Sl} in namnen i den ordning som ni ska spela(h|gst 8 bokst{ver)'
290 FOR I%=0 TO N-1 : ; : ; I%+1; : INPUT P$ : IF LEN(P$)>8 THEN P$(I%)=LEFT$(P$,8) ELSE P$(I%)=P$
300 NEXT I%
310 FOR R%=0 TO 14 : FOR I=1 TO 2500 : NEXT I
320 RANDOMIZE : Y=0 : IF N>1 THEN GOSUB 340
330 FOR P=0 TO N8-1 : RANDOMIZE : GOTO 1480
340 M=0 : I=-1 : IF Y=0 THEN ; CHR$(12) : A9=0 : N=N8 ELSE A9=P : N=P+1
350 FOR I%=A9 TO N-1 : I=I+1
360 IF LEN(P$(I%))<3 THEN J$=P$(I%) ELSE J$=LEFT$(P$(I%),3)
370 ; CUR(0,11+I*4)J$ : NEXT I%
380 FOR I%=A9 TO N-1 : A(I%,6)=0 : A(I%,17)=0 : NEXT I%
390 FOR J%=A9 TO N-1 : M=0 : FOR I%=0 TO 5 : M=M+A(J%,I%) : NEXT I%
400 A(J%,6)=FIX(M)
410 IF M>=63 THEN A(J%,7)=50 ELSE IF V(P)=6 THEN A(J%,7)=.1 ELSE A(J%,7)=0
420 NEXT J% : ; CUR(0,1)'Y-A-T-Z-Y'
430 FOR J%=A9 TO N-1 : M1=0 : FOR I%=6 TO 16 : M1=M1+A(J%,I%) : NEXT I% : A(J%,17)=FIX(M1) : NEXT J%
440 I=-1 : FOR I%=0 TO 16 : I=I+1
450 ; CUR(I+1,0)T$(I%)
460 J=-1 : FOR J%=A9 TO N-1 : J=J+1
470 IF A(J%,I%)<>.1 THEN 500
480 ; CUR(I+1,10+J*4)' == '
490 GOTO 510
500 ; CUR(I+1,10+J*4)A(J%,I%)'  '
510 IF A(J%,I%)<>0 THEN 520 ELSE ; CUR(I+1,10+J*4)':.. '
520 NEXT J%
530 NEXT I%
540 J=-1 : FOR J%=A9 TO N-1 : J=J+1 : ; CUR(U%(J%)+1,13+J*4)'<'
550 NEXT J%
560 IF Y<>0 THEN 570 : ; CUR(18,0)CHR$(151)'######################################'CHR$(135) : GOTO 580
570 ; CUR(18,0)CHR$(151)'#############'CHR$(135)
580 ; CUR(19,0)T$(17) : I=-1 : FOR I%=A9 TO N-1 : I=I+1 : ; CUR(19,10+I*4)"    "
590 ; CUR(19,10+I*4)A(I%,17)
600 NEXT I%
610 N=N8 : RETURN 
620 GOTO 650
630 ; CHR$(7) : ; CUR(2,16)'VAR? (1=\VRE,2=NEDRE)'
640 ; CUR(3,16)SPACE$(19);CUR(3,20); : GET S$ : IF S$<'1' OR S$>'2' THEN 640 ELSE RETURN 
650 GOSUB 1040 : IF C5>0 THEN GOSUB 700
660 IF C4>0 THEN GOSUB 710
670 IF C3>0 THEN GOSUB 720
680 IF C2>0 THEN GOSUB 730
690 GOTO 750
700 IF B8=1 AND A(P,C5-1)=0 AND A(P,16)=0 THEN 740 ELSE RETURN 
710 IF B3=1 AND A(P,C4-1)=0 AND A(P,11)=0 THEN 740 ELSE RETURN 
720 IF B2=1 AND B1=0 AND A(P,C3-1)=0 AND A(P,10)=0 THEN 740 ELSE RETURN 
730 IF B1=1 AND B2=0 AND A(P,C2-1)=0 AND A(P,8)=0 THEN 740 ELSE RETURN 
740 GOSUB 630 : IF S$='1' THEN 910
750 S$='0'
760 IF B8<>1 THEN 780 ELSE IF A(P,16)<>0 THEN 780 ELSE A(P,16)=50
770 U%(P)=16 : GOTO 1250
780 IF B6<>1 THEN 800 ELSE IF A(P,14)<>0 THEN 800 ELSE A(P,14)=C6
790 U%(P)=14 : GOTO 1250
800 IF B5<>1 THEN 820 ELSE IF A(P,13)<>0 THEN 820 ELSE A(P,13)=20
810 U%(P)=13 : GOTO 1250
820 IF B4<>1 THEN 840 ELSE IF A(P,12)<>0 THEN 840 ELSE A(P,12)=15
830 U%(P)=12 : GOTO 1250
840 IF B3<>1 THEN 860 ELSE IF A(P,11)<>0 THEN 860 ELSE A(P,11)=C4*4
850 U%(P)=11 : GOTO 1250
860 IF B2=1 AND B1=0 THEN 870 ELSE 880
870 IF A(P,10)<>0 THEN 880 : A(P,10)=C3*3 : U%(P)=10 : GOTO 1250
880 IF B1<>2 OR A(P,9)<>0 THEN 890 : A(P,9)=C2*2+C1*2 : U%(P)=9 : GOTO 1250
890 IF B1=1 AND B2=0 THEN 900 ELSE 910
900 IF A(P,8)<>0 THEN 910 : A(P,8)=C2*2 : U%(P)=8 : GOTO 1250
910 IF B8<>1 THEN 920 : IF A(P,C5-1)<>0 THEN 920 : A(P,C5-1)=C5*5 : U%(P)=C5-1 : GOTO 1250
920 IF B3<>1 THEN 930 : IF A(P,C4-1)<>0 THEN 930 : A(P,C4-1)=4*C4 : U%(P)=C4-1 : V(P)=V(P)+1 : GOTO 1250
930 IF B2=1 AND B1=0 THEN 940 ELSE 950
940 IF A(P,C3-1)<>0 THEN 950 : A(P,C3-1)=C3*3 : U%(P)=C3-1 : V(P)=V(P)+1 : GOTO 1250
950 IF B1=1 AND B2=0 THEN 960 ELSE 970
960 IF A(P,C2-1)<>0 THEN 970 : A(P,C2-1)=C2*2 : U%(P)=C2-1 : V(P)=V(P)+1 : GOTO 1250
970 IF S$='1' THEN 750 ELSE IF A(P,15)<>0 THEN 980 : A(P,15)=C6 : U%(P)=15 : GOTO 1250
980 OUT 6,7 : GOSUB 1740 : OUT 6,0 : ; CHR$(7);
990 ; CUR(2,16)'DU m}ste STRYKA n}got !'
1000 ONERRORGOTO 1000 : ; CUR(3,16)SPACE$(23);CUR(3,16)"Vad ska Du STRYKA"; : INPUT S
1010 IF S>18 OR S<1 THEN 980 : S=S-1 : IF S=6 OR S=7 OR S=17 OR A(P,S)<>0 THEN 980
1020 IF S<7 THEN V(P)=V(P)+1
1030 A(P,S)=.1 : U%(P)=S : GOTO 1250
1040 Z=0 : C6=0 : FOR I%=1 TO 5 : C6=C6+Z(I%) : NEXT I%
1050 B1=0 : B2=0 : B3=0 : B4=0 : B5=0 : B6=0 : B7=0 : B8=0 : B9=0 : C1=0 : C2=0 : C3=0 : C4=0 : C5=0
1060 FOR J%=1 TO 4 : FOR I%=J%+1 TO 5 : IF Z(J%)<=Z(I%) THEN 1070 : Z=Z(J%) : Z(J%)=Z(I%) : Z(I%)=Z
1070 NEXT I% : NEXT J%
1080 FOR I%=1 TO 6 : Z1(I%)=0 : B(I%)=0 : NEXT I%
1090 FOR I%=1 TO 5 : Z1(Z(I%))=Z1(Z(I%))+1 : B(Z(I%))=Z(I%) : NEXT I%
1100 FOR I%=1 TO 6
1110 IF Z1(I%)=2 THEN B1=B1+1 : C2=B(I%) ELSE ]=0
1120 IF Z1(I%)=3 THEN B2=1 : C3=B(I%) ELSE ]=0
1130 IF Z1(I%)=4 THEN B3=1 : C4=B(I%) ELSE ]=0
1140 IF Z1(I%)=5 THEN B8=1 : C5=B(I%) ELSE ]=0
1150 IF B1=1 THEN C1=C2
1160 IF Z1(I%)=1 THEN B9=B9+1
1170 NEXT I%
1180 IF B1=1 AND B2=1 THEN B6=1
1190 IF B9<>5 THEN 1240
1200 FOR I%=1 TO 4 : IF Z(I%)=Z(I%+1)-1 THEN B5=B5+1
1210 NEXT I%
1220 IF B5=4 AND Z(1)=1 THEN B4=1 ELSE B4=0
1230 IF B5=4 AND Z(1)=2 THEN B5=1 ELSE B5=0
1240 RETURN 
1250 GOSUB 340 : NEXT P : NEXT R%
1260 Y=0 : IF N>1 THEN GOSUB 340
1270 FOR I%=0 TO N-1 : Q(I%)=A(I%,17) : NEXT I%
1280 FOR J%=0 TO N-2 : FOR I%=J%+1 TO N-1 : IF Q(J%)>Q(I%) THEN 1290 : Q=Q(J%) : Q(J%)=Q(I%) : Q(I%)=Q
1290 NEXT I% : NEXT J%
1300 IF N<2 THEN 1400 : IF Q(0)<>Q(1) THEN 1400
1310 N1=2 : IF N<3 THEN 1330 : IF Q(0)<>Q(2) THEN 1330
1320 N1=3 : IF N<4 THEN 1330 : IF Q(0)<>Q(3) THEN 1330
1330 FOR J%=1 TO N1 : GOSUB 1370 : M(J%)=Q : NEXT J%
1340 ; CUR(20,0)"Oavgjort mellan:";
1350 FOR J%=1 TO N1 : ; P$(M(J%))" "; : NEXT J%
1360 ; CUR(21,0)"alla p}:";Q(0)" Po{ng G R A T T I S ";CUR(21,0); : END 
1370 FOR I%=0 TO N-1 : IF Q(J%)=A(I%,17) THEN 1390 ELSE NEXT I%
1380 RETURN 
1390 Q=I% : A(I%,17)=-1 : RETURN 
1400 FOR I%=0 TO N8-1
1410 IF Q(0)=A(I%,17) THEN 1430
1420 NEXT I%
1430 ; CUR(20,0)P$(I%)" V A N N !!! med:"A(I%,17)" po{ng.."
1440 ; CUR(21,0)"G R A T T I S  ! "P$(I%);CUR(21,0); : END 
1450 DATA 1-ETTOR...,2-TV]OR...,3-TREOR...,4-FYROR...,5-FEMMOR..,6-SEXOR...
1460 DATA SUMMA.....,-BONUS....,9-1PAR....,10-2PAR...,11-TRETAL.,12-FYRTAL.
1470 DATA 13-L-STEGE,14-S-STEGE,15-K]K....,16-CHANS..,17-YATZY..,S-U-M-M-A.
1480 GOSUB 1750 : ; CHR$(12)
1490 Y=1 : GOSUB 340 : ; CUR(0,20)P$(P)"'s TUR"
1500 FOR I%=5 TO 16 : IF I%=11 OR I%=10 THEN 1510 : ; CUR(I%,15)CHR$(151)
1510 NEXT I%
1520 ; CUR(5,16)'      '
1530 ; CUR(6,16)'         '
1540 ; CUR(7,16)'           '
1550 ; CUR(8,16)'            '
1560 ; CUR(9,16)'          '
1570 RESTORE 1730 : FOR I9%=1 TO 4 : READ A9$(I9%) : NEXT I9%
1580 FOR I=0 TO 4 : GOSUB 1590 : NEXT I : GOTO 1670
1590 RESTORE 1730 : RANDOMIZE : F=FIX(RND*6+1) : Z(I+1)=F : FOR I9%=1 TO 2*(F-1)+4 : READ Q$ : NEXT I9%
1600 FOR I9%=1 TO 2 : READ B9$(I9%) : NEXT I9%
1610 ; CUR(10,16)"T{rning nummer:";CUR(11,17)" 1    2    3    4    5"
1620 FOR I9%=12 TO 15 : ; CUR(I9%,5*I+16)"    " : NEXT I9% : GOSUB 1740
1630 FOR I9%=12 TO 15 : ; CUR(I9%,5*I+16)A9$(I9%-11) : NEXT I9%
1640 FOR I9%=13 TO 14 : ; CUR(I9%,5*I+17)B9$(I9%-12) : NEXT I9%
1650 RETURN 
1660 FOR I=0 TO 4 : GOSUB 1590 : NEXT I
1670 FOR K=2 TO 3
1680 ; CUR(19,16)"(N)=N\JD;(0=NOLL)=ALLA"
1690 ; CUR(17,16)SPACE$(24);CUR(17,16)"Jag beh}ller"; : ONERRORGOTO 1690 : INPUT G$
1700 IF G$="N" OR G$='n' THEN 620 ELSE G%=VAL(G$)
1710 FOR I=0 TO 4 : FOR J=1 TO LEN(G$) : IF I+1=VAL(MID$(G$,J,1)) THEN 1720 : NEXT J : GOSUB 1590 : GOTO 1720
1720 NEXT I : NEXT K : GOTO 620
1730 DATA 'h,,l','j  j','j  j','*,,.','  ',' !',' 0',' $',' $',' 1','((','``','((','`a','((','bb'
1740 FOR V9=1 TO 200 : NEXT V9 : RETURN 
1750 ; : ; " TRYCK n{r du {r klar"; : GET Q$ : RETURN