2 ! +++++++++++++++++++++++++++++++++++
3 ! Program ....     YATZY.800
4 ! Utg}va  1.0      1983-05-29
5 ! av (c) Erik ]kesson
8 ! Ins{nt av Erik ]kesson, 2913.
9 ! +++++++++++++++++++++++++++++++++++
10 FLOAT : EXTEND 
20 REM ***   Y A T Z Y   ***
30 REM *********************
40 ; CHR$(12%) TAB(6%);
50 ; YEL "V [ L K O M M E N   T I L L"
60 ; TAB(10%) RED "***" CYA "Y A T Z Y" RED "***" : ; 
70 ; CYA "Yatzy {r ett ";
80 ; CYA "t{rningsspel som spelas "
90 ; CYA "med fem t{rningar. Upp till tre"
100 ; CYA "spelare kan vara med. T{rningar"
110 ; CYA "och protokoll fixar jag." : ; 
120 ; CYA "Spelet g}r ut p} att uppn} s}"
130 ; CYA "m}nga som m|jligt av de";
140 ; " t{rnings-" : ; CYA "kombinationer";
150 ; CYA " som finns angivna p}"
160 ; CYA "yatzy-protokollet.";
170 ; " Segraren {r den"
180 ; CYA "som uppn}tt h|gsta po{ngsumman"
190 ; CYA "sedan protokollet ifyllts f|r"
200 ; CYA "samtliga spelare."
210 ; CYA "Varje g}ng har du r{tt till";
220 ; " tre kast"
230 ; CYA "med t{rningarna. Du beh|ver";
240 ; CYA "inte sl} om"
250 ; CYA "alla t{rningar. Ange d} vilka du vill" : ; CYA "sl} om. Mellanslag sl}r alla t{rningar."
260 ; CYA "Du beh|ver inte utnyttja alla slag."
270 ; CYA "Skriv d} en nolla n{r jag fr}gar efter"
280 ; CYA "vilka t{rningar du vill sl} om." : GOSUB 2010
290 ; CHR$(12%);
300 ; "Vid f|rsta slaget n{r det {r din tur,"
310 ; "sl} mellanslag och d{refter ""return"""
320 ; "s} sl}s alla fem t{rningarna."
330 ; : ; "N{r du slagit f{rdigt ska du ange"
340 ; "bokstaven f|r den protokollrubrik d{r"
350 ; "du vill placera ditt kast. Jag r{knar"
360 ; "ut din delpo{ng, din eventuella bonus"
370 ; "och din totala po{ngsumma."
380 ; : ; "Exempel:  Du har slagit tre sexor,"
390 ; "          en etta och en tv}a. Du"
400 ; "          placerar detta p} rad ""F"""
410 ; '          d{r rubriken {r "Sexor" och'
420 ; "          f}r d{r 18 po{ng."
430 ; "Om du uppn}r 63 po{ng p} f|rsta delen"
440 ; "f}r du 50 bonuspo{ng."
450 ; "P} rubrik ""N  Chans"" r{knas summan av"
460 ; "alla t{rningar."
470 ; "Med YATZY menas alla t{rningar lika,"
480 ; "val|r saknar betydelse. En YATZY {r"
490 ; "v{rd 50 po{ng." : GOSUB 2010
500 ; CHR$(12%) "I |vrigt g{ller pokerregler, och dom {r"
510 ; "v{l bekanta?"
520 ; : ; "\vning ger f{rdighet. K|r s} det ryker." : GOSUB 2010
530 DIM X%(5%),N%(6%),A%(17%,3%),A$(4%)
540 ON ERROR GOTO 540 : ; CHR$(12%) CYA "Hur m}nga spelare {r ni" YEL; : INPUT A%
550 IF A%>3% OR A%<1% THEN 540
560 RANDOMIZE : K%=-1% : FOR I%=0% TO 17% : FOR J%=0% TO A%-1% : A%(I%,J%)=K% : NEXT J% : NEXT I% 
570 A$(0%)=RED+"Y A T Z Y"
580 ; : ; : ; GRN "Ange vad ni kallas med";
590 ; " h|gst" RED "tre" GRN "tecken"
600 FOR I%=1% TO A%
610   ; CYA "Spelare nummer" I% YEL;
620   INPUT LINE A$(I%) : ; 
630   A$(I%)=LEFT$(A$(I%),LEN(A$(I%))-2%)+"   "
640   IF A$(I%)="   " THEN A$(I%)="Nr"+NUM$(I%)
650 A$(I%)=LEFT$(A$(I%),3%) : NEXT I% 
660 ; CHR$(12%) A$(0%) CUR(0%,13%);
670 FOR I%=1% TO A% : ; A$(I%) "   "; : NEXT I% 
680 RESTORE : FOR I%=0% TO 17% : READ T$
685 ; CUR(2%+I%,0%) YEL CHR$(I%+65%-I%/8%*2%+I%/16%*2%) TAB(3%) ' ' T$ : NEXT I% 
690 ; CUR(8%,1%) " " CUR(9%,1%) " " CUR(19%,1%) " "
700 FOR I%=1% TO 20% : ; CUR(I%,10%) GBLU 'n' TAB(5%*A%+14%) GBLU 'n' : NEXT I% : ; CUR(4%,15%+5%*A%) "pp"
710 FOR I%=1% TO 5% : ; CUR((I%-1%)*4%+3%,32%) CHR$(135%) NUM$(I%) CHR$(151%) : NEXT I% 
720 ; CUR(0%,31%) "T[RNINGAR"
730 FOR I%=0% TO 1% : ; CUR(I%*19%+1%,0%) GBLU STRING$(13%+5%*A%,44%) : NEXT I% 
740 FOR I%=1% TO A%-1%
750   ; CUR(1%,11%+I%*6%) '.'
760 FOR J%=2% TO 19% : ; CUR(J%,10%+6%*I%) GBLU "(" : NEXT J% : NEXT I% 
770 FOR T%=1% TO 5% : X%(T%)=0% : GOSUB 1600 : NEXT T% 
780 DATA Ettor,Tv}or,Treor,Fyror,Femmor
790 DATA Sexor,PO[NG,BONUS,"1 par"
800 DATA "2 par",Tretal,Fyrtal
810 DATA "L stege","S stege",K}k
820 DATA Chans,YATZY,SUMMA
830 REM *********** SK[RM KLAR ********
840 FOR J%=1% TO 15% : ; CUR(20%-J%,15%+5%*A%) "("; : FOR P%=1% TO A% : POKE 31880%+6%*P%,172%
850     ; CUR(21%,0%) CYA "Nu ska " A$(P%) " sl}.";
860     FOR T1%=1% TO 3%
870       ON ERROR GOTO 870 : T%=22% : GOSUB 1680 : ; CHR$(7%) : ; CUR(22%,0%); : INPUT LINE T$
880       IF LEN(T$)<3% OR LEN(T$)>7% THEN 870 ELSE T$=LEFT$(T$,LEN(T$)-2%)
890       IF T1%=1% OR ASCII(T$)=32% THEN T$="12345"
900       FOR I%=1% TO LEN(T$) : T%=VAL(MID$(T$,I%,1%)) : N%(I%)=T% : IF T%=0% THEN 1010 ELSE IF T%>5% THEN 870
910       FOR B1%=1% TO I% : FOR B2%=B1%+1% TO I% : IF N%(B1%)=N%(B2%) THEN 870 ELSE NEXT B2% : NEXT B1% : NEXT I% 
920       FOR I%=1% TO LEN(T$) : T%=VAL(MID$(T$,I%,1%)) : X%(T%)=0% : GOSUB 1600 : NEXT I% 
930       FOR I%=1% TO 3000%*SGN(T1%-1%) : NEXT I% 
940       FOR I%=1% TO LEN(T$)
950         T%=VAL(MID$(T$,I%,1%))
960         X%(T%)=INT(6%*RND)+1%
970         IF X%(T%)=7% THEN 960
980       GOSUB 1600 : NEXT I% 
990       ; CUR(21%,0%) CYA "Vilka t{rningar vill";
1000     ; " " A$(P%) " sl} om?" : NEXT T1% 
1010     REM Utv{rdering
1020     GOSUB 2020
1030     ; CUR(21%,0%);RED "Var skall po{ngen r{knas";
1040     FOR B2%=1% TO 500% : NEXT B2% 
1050     ON ERROR GOTO 1050 : ; CHR$(7%); : GET T$
1060     I%=ASCII(T$)-65%-ASCII(T$)/96%*32% : IF I%>5% I%=I%+2%
1070     IF I%<0% OR I%>16% OR I%=6% OR I%=7% THEN 1020
1080     IF A%(I%,P%-1%)<>K% ; CUR(I%+2%,0%) RED CHR$(7%,8%); : GET T$ : ; YEL : GOTO 1060
1090     ; CUR(I%+2%,0%) GRN CHR$(8%); : GET T$ : ; YEL : IF ASCII(T$)<>13% ; YEL : ON ERROR GOTO 1050 : GOTO 1060
1100     A%(I%,P%-1%)=0% : X%(0%)=0% : T%=I%
1110     FOR I%=1% TO 5% : X%(0%)=X%(0%)+X%(I%) : NEXT I% : FOR I%=1% TO 6% : N%(I%)=0% : NEXT I% 
1120     FOR I%=1% TO 5% : N%(X%(I%))=N%(X%(I%))+1% : NEXT I% 
1130     IF T%>5% THEN 1150
1140     A%(T%,P%-1%)=N%(T%+1%)*(T%+1%)
1150     IF T%<>16% THEN 1170
1160     FOR I%=1% TO 6% : IF N%(I%)=5% THEN A%(T%,P%-1%)=50% ELSE NEXT I% 
1170     IF T%<>15% THEN 1190
1180     A%(T%,P%-1%)=X%(0%)
1190     IF T%<>14% THEN 1260
1200     FOR \%=2% TO 3% : FOR I%=1% TO 6%
1210         IF N%(I%)<>\% THEN 1230
1220         A%(T%,P%-1%)=A%(T%,P%-1%)+\%*I%
1230     NEXT I% : NEXT \% 
1240     IF A%(T%,P%-1%)=X%(0%) THEN 1260
1250     A%(T%,P%-1%)=0%
1260     IF T%<>13% THEN 1280
1270     FOR I%=2% TO 6% : IF N%(I%)=1% THEN NEXT I% : A%(T%,P%-1%)=X%(0%)
1280     IF T%<>12% THEN 1300
1290     FOR I%=1% TO 5% : IF N%(I%)=1% THEN NEXT I% : A%(T%,P%-1%)=X%(0%)
1300     IF T%<>11% THEN 1330
1310     FOR I%=1% TO 6% : IF N%(I%)>3% THEN A%(T%,P%-1%)=4%*I%
1320     NEXT I% 
1330     IF T%<>10% THEN 1360
1340     FOR I%=1% TO 6% : IF N%(I%)>2% THEN A%(T%,P%-1%)=3%*I%
1350     NEXT I% 
1360     IF T%<>8% THEN 1390
1370     FOR I%=1% TO 6% : IF N%(I%)>1% THEN A%(T%,P%-1%)=2%*I%
1380     NEXT I% 
1390     IF T%<>9% THEN 1480
1400     \%=0%
1410     FOR I%=1% TO 6%
1420       IF N%(I%)<2% THEN 1450
1430       A%(T%,P%-1%)=A%(T%,P%-1%)+2%*I%
1440       \%=\%+1%
1450     NEXT I% 
1460     IF \%=2% THEN 1480
1470     A%(T%,P%-1%)=0%
1480     GOSUB 1880
1490     GOSUB 1700
1500     FOR T%=1% TO 5% : X%(T%)=0%
1510       GOSUB 1600
1520     NEXT T% 
1530     GOSUB 2020
1540     FOR B2%=1% TO 5000% : NEXT B2% 
1550   POKE 31880%+6%*P%,44% : NEXT P% 
1560 NEXT J% 
1570 GOSUB 2020
1580 ; CUR(21%,1%) GRN "Slut. Ska vi ta ett varv till?"; : INPUT LINE T$
1590 IF LEFT$(T$,1%)="J" OR LEFT$(T$,1%)="j" THEN 540 ELSE ; CUR(21%,0%); : GOTO 2030
1600 REM Visar t{rning T%
1610 REM med v{rde X%(T%)
1620 ON X%(T%)+1% RESTORE 1940,1950,1960,1970,1980,1990,2000
1630 FOR \%=1% TO 3%
1640   READ T0$
1650   ; CUR(\%+1%+(T%-1%)*4%,34%) GCYA T0$
1660 NEXT \% 
1670 RETURN 
1680 REM rensa rad T%
1690 ; CUR(T%,0%) SPACE$(40%); : RETURN 
1700 REM Summera po{ng f|r spelare P%
1710 A%(6%,P%-1%)=0% : A%(17%,P%-1%)=0%
1720 FOR I%=0% TO 5%
1730   IF A%(I%,P%-1%)=K% THEN 1750
1740   A%(6%,P%-1%)=A%(6%,P%-1%)+A%(I%,P%-1%)
1750 NEXT I% 
1760 IF A%(6%,P%-1%)<63% THEN A%(7%,P%-1%)=0% ELSE A%(7%,P%-1%)=50%
1770 FOR I%=6% TO 16%
1780   IF A%(I%,P%-1%)=K% THEN 1800
1790   A%(17%,P%-1%)=A%(17%,P%-1%)+A%(I%,P%-1%)
1800 NEXT I% 
1810 T%=6% : IF A%(T%,P%-1%)=0% THEN 1830
1820 GOSUB 1880
1830 T%=7% : IF A%(T%,P%-1%)=0% THEN 1850
1840 GOSUB 1880
1850 T%=17% : IF A%(T%,P%-1%)=0% THEN 1870
1860 GOSUB 1880
1870 RETURN 
1880 REM Skriv ut po{ng
1890 T$=NUM$(A%(T%,P%-1%))
1900 IF LEN(T$)=3% THEN 1920
1910 T$=YEL+T$ : GOTO 1900
1920 ; CUR(T%+2%,6%+6%*P%) YEL T$
1930 RETURN 
1940 DATA 5,5,5
1950 DATA 5,w5,5
1960 DATA w5,5,w5
1970 DATA w5,w5,w5
1980 DATA ww5,5,ww5
1990 DATA ww5,w5,ww5
2000 DATA ww5,ww5,ww5
2010 ; CUR(23%,10%) GRN "Tryck p}" RED "return"""; : INPUT LINE T$ : RETURN 
2020 T%=21% : GOSUB 1680 : T%=22% : GOSUB 1680 : RETURN 
2030 END