Backgammon

10 REM **************** GAMMON *****************
20 REM
22 REM Converted for Televideo 912 terminal by Bill Soon, August 1981
24 REM Cursor control codes probably OK for ADM-3 & SOROC also.
26 REM * further refinements encouraged *
30 REM originally written for HEATH H-8 OR H-89 WITH H-19
35 REM REQUIRES MICROSOFT
40 REM
50 REM By: R. Wild
55 REM OSO11 Nepil Ave.
60 REM Wheaton, Ill. 60187
70 REM
80 REM Idea by Cursor Magazine
100 CLEAR 1000
200 GOSUB 9000
210 RR=RND(1)
240 DIM B(27),D(4),DA$(3),DI$(6,6),US(4),P(24),PR(6),M$(5)
260 DIM T(6)
280 BK$=SPACE$(38)
300 M$(1)=" HIT YOUR BLOT AT ":M$(2)=" COVERED MY BLOT AT "
310 M$(3)=" MOVED TO "
320 M$(5)="MOVED BLOT TO SAFETY AT ":M$(4)=" CAN'T MAKE MOVE "
340 M$(0)=" BEARING OFF FROM ":FR$=" FROM "
360 A$="":DA$(1)="q":DA$(2)=" ":DA$(3)="*":ER$=A$+""
380 AA$=CHR$(27)+CHR$(61)+CHR$(31+6)+CHR$(33):AL$="XWVUTSRQPONMLKJIHGFEDCBA"
390 A$=CHR$(27)+CHR$(61)+CHR$(31+10)+CHR$(33)
400 FOR I=1 TO 12:READ P(I):NEXT
420 DATA .31,.33,.39,.42,.42,.47,.17,.17,.14,.08,.06,.08
440 FOR I=0 TO 6:READ PR(I):NEXT
460 DATA 0,.03,.11,.25,.44,.69,1
480 GOSUB 8000
640 CM=24:F=6:S=0:HM=24:HB=0:CB=0:XC=0:XH=0
660 PRINT ERAS$;"* BACKGAMMON *"
662 PRINT "Difficulty (1=easy, 10=hard)? ";:LINE INPUT IN$
665 PRINT CO$
680 TT=(VAL(IN$)/10):PRINT GRA$
700 IF TT>1 OR TT<=0 THEN 660
720 PRINT ERAS$:A=TT:IF RND(1)<.5 THEN F=1
740 GOSUB 4220:GOSUB 4460
760 GOSUB 8250:IF D(1)=D(2)THEN 760
780 NP=1: PRINT AA$" MINE YOURS":FOR I=1 TO 500:NEXT
790 GOSUB 8280:FOR I=1 TO 500:NEXT:GOSUB 4580
820 PRINT A$;:IF D(2)>D(1)THEN NP=-1:PRINT"YOU";
840 IF D(2)<D(1)THEN NP=1:PRINT"I";
860 PRINT" GO FIRST!"
880 FOR L=1 TO 2000:NEXT:PRINT AA$;BK$:TU=2:GOTO 980
900 D(1)=0:D(2)=0:GOSUB 4660
920 IF NP=-1 THEN GOSUB 7000
940 TU=2:GOSUB 8250:D(3)=D(1)+D(2)
960 IF D(1)=D(2)THEN D(3)=D(1):D(4)=D(1):TU=4:PY=RND(-100*RND(1))
980 GOSUB 4660:GOSUB 4580
1000 MV=0:Y=0:FOR I=1 TO TU:Y=Y+D(I):US(I)=0:NEXT:IF NP=1 THEN 2620
1020 XH=XH+Y:IN$=""
1040 I=1:GOTO 1080
1060 IN$="":FOR J=1 TO 2000:NEXT J
1080 IF LEN(IN$)>2 THEN IN$=MID$(IN$,2):GOTO 1120
1100 GOSUB 4580:PRINT A$;CN$;" MOVE";I;"? ";:GOSUB 6240:PRINT:PRINT:IF IN$=""THEN 2180
1120 IF LEN(IN$)>1 THEN 1220
1140 IF IN$>="A"AND IN$<="F"THEN IN$="="+IN$
1160 IF IN$>="S"AND IN$<="X"THEN IN$=IN$+"-"
1180 IF LEN(IN$)>1 THEN 1220
1200 PRINT"BAD MOVE.":GOTO 1060
1220 IF LEN(IN$)>3 THEN 1200
1240 IF MID$(IN$,2,1)=","THEN IN$=LEFT$(IN$,1)+MID$(IN$,3):GOTO 1240
1260 F$=LEFT$(IN$,1)
1280 IF F$>="A"AND F$<="X"THEN FM=89-ASC(F$):GOTO 1320
1300 FM=25:IF F$<>"="AND F$<>"-"THEN 1200
1320 T$=MID$(IN$,2,1)
1340 IF T$="="OR T$="-"THEN TM=0:GOTO 1400
1360 IF T$<"A"OR T$>"X"THEN 1200
1380 TM=89-ASC(T$):N=0:M=FM-TM:K=1:L=0
1400 IF FM=25 AND B(25)=0 THEN PRINT"YOU HAVE NO MEN ON THE BAR.":GOTO 1060
1420 IF FM<TM THEN PRINT"WRONG DIRECTION.":GOTO 1060
1440 IF B(25)<0 AND FM<>25 THEN PRINT"YOU HAVE MEN ON THE BAR.":GOTO 1060
1460 IF B(FM)>=0 THEN PRINT"YOU HAVE NO MEN ON ";F$;".":GOTO 1060
1480 IF TM=0 THEN 1920
1500 L=0:FOR J=1 TO TU:IF US(J)THEN K=K+1:GOTO 1560
1520 L=L+1:N=N+D(J):IF N=M THEN 1580
1540 IF D(J)=M THEN K=J:L=1:GOTO 1580
1560 NEXT J:PRINT"YOU CAN'T MOVE";M;".":GOTO 1060
1580 IF B(TM)>1 THEN PRINT"POINT ";T$;" IS BLOCKED.":GOTO 1060
1600 IF L=1 THEN GOSUB 5880:US(K)=1:GOTO 2580
1620 IF B(25)<-1 THEN PRINT"YOU HAVE MEN ON THE BAR.":GOTO 1060
1640 IF TU=4 THEN 1760
1660 IF B(FM-D(1))<=1 THEN M=1:GOTO 1720
1680 IF B(FM-D(2))<=1 THEN M=2:GOTO 1720
1700 PRINT"THE PATH IS BLOCKED.":GOTO 1060
1720 N=TM:TM=FM-D(M):GOSUB 5880:FM=TM:TM=N::GOSUB 5880:I=I+1
1740 GOTO 2580
1760 FOR N=1 TO L
1780 IF B(FM-D(1)*N)>1 THEN 1700
1800 NEXT N
1820 FOR N=K TO J
1840 TM=FM-D(N):US(N)=1:GOSUB 5880
1860 I=I+1:FM=TM:NEXT N
1880 I=I-1:GOTO 2580
1900 NEXT K
1920 FOR J=7 TO 25:IF B(J)<0 THEN PRINT"YOU CAN'T CHEAT!!":GOTO 1060
1940 NEXT J
1960 TM=26:FOR J=1 TO TU:IF US(J)=0 AND FM=D(J)THEN GOSUB 5880:US(J)=1:GOTO 2580
1980 NEXT J
2000 IF FM=6 THEN 2080
2020 FOR J=6 TO FM+1 STEP-1
2040 IF B(J)<0 THEN PRINT"YOU CAN'T BEAR OFF FROM ";F$;".":GOTO 1060
2060 NEXT J
2080 K=0:D(K)=0:FOR J=1 TO TU:IF US(J)=0 AND D(J)>FM AND D(J)>D(K)THEN K=J
2100 NEXT J
2120 IF K=0 THEN PRINT"YOU CAN'T MOVE";FM;".":GOTO 1060
2140 PRINT"ASSUMING USE OF";D(K);".":US(K)=1
2160 GOSUB 5880:GOTO 2580
2180 IF B(25)>=0 THEN 2280
2200 FOR J=1 TO 6
2220 IF J=D(TU)AND US(TU)=0 AND B(25-J)<2 THEN 2560
2240 IF J=D(TU-1)AND US(TU-1)=0 AND B(25-J)<2 THEN 2560
2260 NEXT J:GOTO 2600
2280 FOR J=24 TO 2 STEP-1
2300 IF B(J)>=0 THEN 2360
2320 IF J-D(TU-1)>0 THEN IF US(TU-1)=0 AND B(J-D(TU-1))<2 THEN 2560
2340 IF J-D(TU)>0 THEN IF US(TU)=0 AND B(J-D(TU))<2 THEN 2560
2360 NEXT J
2380 FOR J=24 TO 7 STEP-1:IF B(J)<0 THEN 2600
2400 NEXT J
2420 IF US(TU)=0 AND B(D(TU))<0 THEN 2560
2440 IF US(TU-1)=0 AND B(D(TU-1))<0 THEN 2560
2460 IF US(TU)THEN D=D(TU-1):GOTO 2500
2480 D=D(TU):IF US(TU-1)=0 AND D<D(TU-1)THEN D=D(TU-1)
2500 IF D=6 THEN 2560
2520 FOR J=6 TO D+1:IF B(J)<0 THEN 2560
2540 NEXT J:GOTO 2600
2560 PRINT"YOU CAN TOO MOVE!":GOTO 1060
2580 I=I+1:IF I<=TU THEN 1080
2600 NP=1:GOTO 5460
2620 MO=0:B9=0
2640 XC=XC+Y
2660 K=0
2680 K=K+1:IF B(0)=0 OR K>TU THEN 2800
2700 IF B(D(K))<>-1 THEN 2680
2720 US(K)=1:MO=MO+1
2740 FM=0:TM=D(K):GOSUB 5880
2760 PRINT"OFF BAR AND HIT BLOT AT ";MID$(AL$,TM,1)
2780 GOTO 2680
2800 K=0
2820 K=K+1:IF B(0)=0 OR K>TU THEN 2940
2840 IF B(D(K))<0 OR US(K)>0 THEN 2820
2860 US(K)=1:MO=MO+1
2880 FM=0:TM=D(K):GOSUB 5880
2900 PRINT"OFF BAR TO ";MID$(AL$,TM,1)
2920 GOTO 2820
2940 IF B(0)=0 AND MO<TU THEN 3000
2960 IF MO<TU THEN FOR I=1 TO 500:NEXT:PRINT A$;"CAN'T GET OFF BAR":FOR I=1 TO 500:NEXT
2980 GOTO 4160
3000 IF CM>6 THEN 3380
3020 FOR J=1 TO TU:L=25-D(J):IF B(L)<1 THEN 3060
3040 FM=L:TM=27:GOSUB 5880:PRINT M$(0);MID$(AL$,L,1):MO=MO+1
3150 GOSUB 8500:GOTO 3300
3060 K=6
3080 Y=25-K:IF B(L-K)<1 OR B(Y)<-1 THEN 3160
3100 IF B(Y)=-1 THEN B(Y)=0
3120 FM=L-K:TM=Y:GOSUB 5880
3140 PRINT M$(3);MID$(AL$,Y,1);FR$;MID$(AL$,FM,1)
3150 GOSUB 8500:GOTO 3300
3160 IF K>1 THEN K=K-1:GOTO 3080
3180 K=1
3200 IF L+K>24 THEN 3280
3220 IF B(L+K)<1 THEN 3280
3240 MO=MO+1:FM=L+K:TM=27:GOSUB 5880
3260 PRINT M$(0);MID$(AL$,FM,1);" WITH ROLL OF";D(J)
3270 GOSUB 8500:GOTO 3300
3280 IF K<6 THEN K=K+1:GOTO 3200
3300 IF B(27)=15 THEN 5460
3320 IF TU=MO THEN 4160
3340 NEXT J
3360 GOTO 4160
3380 IF TU=MO THEN 4160
3400 IF TU-MO<2 THEN 3720
3420 IF HB=0 THEN 3720
3440 J=1
3460 IF B(J)<>-1 THEN 3700
3480 J1=J-D(1):J2=J-D(2):IF J1<1 OR J2<1 THEN 3700
3500 IF D(1)=D(2)AND B(J1)=1 THEN 3700
3520 IF B(J1)<1 OR B(J2)<1 THEN 3700
3540 IF TU=4 THEN 3600
3560 IF J1>18 AND B(J1)=2 THEN 3700
3580 IF J2>18 AND B(J2)=2 THEN 3700
3600 MV=MV-1:TM=J:FM=J1:GOSUB 5880:FM=J2:GOSUB 5880
3620 PRINT M$(1);MID$(AL$,J,1);FR$;
3640 PRINT MID$(AL$,J1,1);" AND ";MID$(AL$,J2,1):MO=MO+2:HB=HB-1
3650 GOSUB 8500
3660 IF TU=4 THEN US(3)=1:US(4)=1
3680 GOTO 3380
3700 IF J<24 THEN J=J+1:GOTO 3460
3720 TRY=0:Y=1
3740 IF US(Y)=1 THEN 4120
3760 GOSUB 5120
3780 IF Y<>1 OR MO<>0 OR TU=4 OR BM=4 THEN 3900
3800 S1=BS:F1=FM:M1=BM:Y=2:GOSUB 5120
3820 S2=BS:F2=FM:M2=BM:Y=3:G=1:GOSUB 5120
3840 G=0:IF BS>S1+S2 THEN Y=TM:TM=FM+D(Y):GOTO 3900
3860 IF S2>S1 THEN FM=F2:Y=2:TM=F2+D(Y):BM=M2:GOTO 3900
3880 FM=F1:Y=1:TM=F1+D(Y):BM=M1
3900 IF BM<>4 THEN 4020
3920 IF F<>1 THEN F=1:GOTO 3760
3940 IF TRY<TU+4 THEN 4120
3960 FOR J=1 TO 18:IF B(J)>0 OR B9 THEN PRINT M$(4);:GOSUB 8500:GOTO 4160
3980 NEXT J:B9=1:GOTO 3020
4000 GOTO 4120
4020 IF BM=1 THEN HB=HB-1
4040 MO=MO+1:US(Y)=1:IF HM<24-CM THEN BM=3:A=0
4060 GOSUB 5880
4080 PRINT M$(BM);MID$(AL$,TM,1);FR$;MID$(AL$,FM,1)
4090 GOSUB 8500
4100 IF MO=TU THEN 4160
4120 Y=Y+1:IF Y>TU THEN Y=1
4140 GOTO 3740
4160 NP=-1
4180 GOTO 5460
4200 PRINT M$(MN);MID$(AL$,TM,1);
4210 GOSUB 8500
4220 PRINT ERAS$;:H=8:L$=" 2 ":M$=" 2 ":R$=" 2"
4240 ESC$=CHR$(27):GR$="":LC$="":RV$=ESC$+"j":RVO$=ESC$+"k"
4245 DA$(1)="q"
4250 ERAS$=CHR$(26):PRINT ERAS$
4260 PRINT TAB(39);ESC$;"j";" A B C D E F = G H I J K L "RVO$
4280 FOR I=1 TO 8
4300 PRINT TAB(39);GR$"i ` ` ` iii ` ` ` i":NEXT
4320 FOR I=1 TO 2
4340 PRINT TAB(39);GR$"i iii i"LC$:NEXT
4360 FOR I=1 TO 8
4380 PRINT TAB(39);GR$; "i ` ` ` iii ` ` ` i"LC$:NEXT
4400 PRINT TAB(39);ESC$"j X W V U T S R Q P O N M "RVO$
4420 GOTO 8320
4440 PRINT RIGHT$(" "+STR$(13-I),2);"&";TAB(21);"&";MID$(STR$(I+12),2):RETURN
4460 FOR I=0 TO 25:B(I)=0:NEXT I:B(26)=-15:B(27)=15
4480 B(1)=2:B(6)=-5:B(8)=-3:B(12)=5
4500 B(13)=-5:B(17)=3:B(19)=5:B(24)=-2
4520 FOR I=1 TO 24:N=B(I):TM=I:FM=27+(N<0)
4540 B(I)=0:IF N<>0 THEN FOR J=1 TO ABS(N):GOSUB 5880:NEXT J
4560 NEXT I
4580 PRINT A$;
4600 FOR L=1 TO 3:PRINT BK$:NEXT L
4640 RETURN
4660 PRINT ESC$"=";CHR$(31+6);CHR$(33+9);" ";:PRINT TEMP$;MID$("YOUR MY ",3+NP+NP,4);:PRINT" ROLL ";
4670 PRINT RO$
4680 GOSUB 8280
4700 RETURN
4720 PP=0:J6=24:IF K<13 THEN J6=K+12
4740 FOR I=K TO J6:IF B(I)<0 THEN PP=PP+P(I-K)
4760 NEXT I:IF K>14 THEN PP=PP+P(25-K)*2
4780 RETURN
4800 MS=3:CS=0
4820 Q4=8*PR(BH)*(1+PR(BH))
4840 Q5=8*PR(BC)*(1+PR(BC))
4860 K=P5:GOSUB 4720:CZ=PP*(P5+Q4)*A
4880 K=P5+RL:GOSUB 4720:PZ=PP
4900 CW=PZ*(P5+RL+Q4)*A
4920 IF B(P5)=2 THEN CS=CS-CZ
4940 IF B(P5)=1 AND B(K)>0 THEN CS=CS+CZ:MS=5
4960 IF B(K)=-1 THEN CS=CS+25-K+Q5:MS=1:IF K>18 THEN CS=CS-4
4980 IF B(K)<>1 THEN 5040
5000 CS=CS+CW:IF B(P5)>2 THEN MS=2
5020 GOTO 5100
5040 SM=0:J=20:NN=K+R1:IF NN<20 THEN J=NN
5060 FOR I=K TO J:IF B(I)=-1 THEN SM=SM+P(I-K)*(25-I)
5080 NEXT I:CS=CS-CW+(1-PZ)*SM
5100 RETURN
5120 BS=-999:BM=4:FM=0:TM=0:TRY=TRY+1
5140 FOR L=24 TO 1 STEP-1:IF B(L)<1 THEN 5440
5160 RL=D(Y):R=L+RL:IF R>24 THEN 5440
5180 IF R<F AND B(R)<>-1 THEN 5440
5200 IF B(R)<-1 THEN 5440
5220 IF G<>1 THEN 5300
5240 Q=0:L1=L+D(1):L2=L+D(2):IF B(L1)>-2 THEN Q=1
5260 IF B(L2)>-2 THEN Q=2
5280 IF Q=0 THEN 5440
5300 P5=L:GOSUB 4800
5320 IF G<>1 THEN 5400
5340 MS=3:IF B(L1)=-1 THEN Q=1:CS=CS+25-L1:MS=1
5360 IF B(L2)=-1 THEN Q=2:CS=CS+25-L2:MS=1
5380 K=Q
5400 IF CS<BS THEN 5440
5420 BS=CS:FM=L:TM=K:BM=MS
5440 NEXT L:GOSUB 4580:RETURN
5460 IF B(26)=-15 THEN X$="YOU":X=CP:GOTO 5800
5480 IF B(27)=15 THEN X$="I":X=HP:GOTO 5800
5500 HM=0:CM=0:JM=0:HP=0:CP=0:HB=0:CB=0:BC=0:BH=0
5520 FOR I=0 TO 25
5540 IF B(I)<0 THEN HP=HP-B(I)*I:HM=I
5560 IF B(I)>0 THEN CP=CP+B(I)*(25-I):JM=25-I
5580 IF JM>CM THEN CM=JM
5600 IF B(I)=-1 THEN HB=HB+1
5620 IF B(I)=+1 THEN CB=CB+1
5640 IF I<7 AND B(I)<-1 THEN BH=BH+1
5660 IF I>18 AND B(I)>1 THEN BC=BC+1
5680 NEXT
5700 XX=CP:IF HP<XX THEN XX=HP
5720 Y=(CP-HP)/XX:IF Y>.2 THEN S=1:F=6:A=.1
5740 IF Y<-.1 THEN S=0:F=1:A=TT
5760 IF S=1 AND HM<6 THEN F=HM
5780 GOTO 900
5800 PRINT ER$A$;X$;" WON BY";X;"POINTS."
5810 PRINT CN$
5820 PRINT"TOTAL POINTS ROLLED";XH;DA$(1);XC;DA$(3):PRINT:INPUT"WANT TO PLAY AGAIN";X$
5840 IF LEFT$(X$,1)="Y"THEN 640
5860 PRINT CN$:END
5880 PT=FM:GOSUB 6060:P=SGN(B(FM)):GOSUB 6060:B(FM)=B(FM)-P
5900 IF FM=25 OR FM=0 THEN PRINT GR$"i";LC$:GOTO 5940
5920 IF FM<26 THEN PRINT GR$;MID$(" `",2+((1 AND PT)=1 OR ABS(B(PT))>8),1);LC$
5940 IF B(TM)<>-P THEN 5980
5960 PT=-25*(P>0):B(PT)=B(PT)-P:GOSUB 6060:B(TM)=0
5965 IF P=-1 THEN PRINT DA$(3)ELSE PRINT DA$(1)
5980 B(TM)=B(TM)+P:PT=TM:IF TM<26 THEN GOSUB 6060:PRINT DA$(2+P)
6000 IF MV<=-1 THEN MV=0
6020 PRINT A$:MV=MV+1
6040 RETURN
6060 IF PT>25 THEN RETURN
6080 IF PT=0 OR PT=25 THEN 6180
6100 VT=ABS(B(PT)):IF PT<13 THEN VT=19-VT
6120 TB=ABS(12.5-PT)*2+1:IF TB>12 THEN TB=TB+4
6140 TB=30-TB
6160 GOTO 6220
6180 VT=-B(PT):IF VT<0 THEN VT=19+VT
6200 TB=15
6220 PRINT ESC$"=";CHR$(31+2+VT);CHR$(31+40+TB);:RETURN
6240 LINE INPUT IN$
6250 PRINT A$;CO$;
6260 RETURN
7000 REM INPUT SI WAS HERE
7010 GOSUB 4580
7050 PRINT A$;" ";
7100 REM
7200 GOSUB 8250
7300 INPUT "PRESS RETURN TO ROLL";ZZ$
7400 RETURN
8000 REM DICE ROUTINE
8050 E$=CHR$(27):H$=CHR$(30)
8060 ER$=CHR$(26):PRINT ER$;
8070 RO$=E$+"k":PRINT RO$
8080 EG$=""
8090 RV$=E$+"j"
8100 TEMP$=RV$
8110 COF$=""
8120 CH$=""
8130 PRINT ER$
8150 FOR I=1 TO 6:FOR J=1 TO 6:READ DI$(I,J):NEXT J,I
8160 DATA" "," ^","^ ","^ ^","^ ^","^^^"
8170 DATA" ^ "," "," ^ "," "," ^ "," "
8180 DATA" ","^ "," ^","^ ^","^ ^","^^^"
8190 DATA" ","^ "," ^","^ ^","^ ^","^ ^"
8200 DATA" ^ "," "," ^ "," "," ^ ","^ ^"
8210 DATA" "," ^","^ ","^ ^","^ ^","^ ^"
8220 RETURN
8250 FOR I=1 TO 2
8260 FX=INT(RND(1)*6+1):T(I)=3*(RND(1)>.5)+3:CT(FX)=CT(FX)+1:D(I)=FX
8270 NEXT I
8275 RETURN
8280 PRINT H$;GR$;:FOR I=1 TO 3:PRINT
8283 FOR J=1 TO 2
8285 IF DI$(I+T(J),D(J))=""THEN DI$(I+T(J),D(J))=" "
8290 PRINT TAB(2*J+7);"| "+DI$(I+T(J),D(J))+" | ";:NEXT J,I
8300 PRINT CHR$(27);"G";:PRINT
8310 RETURN
8320 PRINT H$;E$+"F";:PRINT TAB(8);" zzzzz zzzzz "
8330 FOR I=1 TO 3:PRINT TAB(9);"| | | |"
8340 NEXT I
8350 PRINT TAB(10)"zzzzz zzzzz"
8355 PRINT LC$
8360 RETURN
8500 REM DELAY ROUTINE
8510 FOR I=1 TO 2000:NEXT I:RETURN
9000 RETURN : REM INSTRUCTION FILE READ ROUTINE WAS HERE