Listing of file='BCKGMN.FOR;08' on disk='vmedia/backgammon-sideB-sector.ccvf'
INTEGER A1(26),B(10),B0(4),B1(26),DIE(4),H(5),T(4)
INTEGER SEC
REAL M(9)
REAL T1,T2,T3,T4,T5
REAL V,V1,V2,V3,V4
BYTE CI
BYTE COMP,PLAYER
BYTE FROMTO(13,3),PCS(18),SCREEN(16),SETUP(8)
BYTE ANS,CHRN,CHRY,F,I,J,J1,K,K1,L,P,X,Y
BYTE F2,F4,O1
BYTE BADCNT,MOVCNT
BYTE DUM,DUM1,DUM2,DUM3,DUM4,SUB
COMMON /TEMP/T1,T2,T3,T4,T5
COMMON /MORE/V,V1,V2,V3,V4
DATA CHRN,CHRY/'N','Y'/
DATA FROMTO/
* 29,19,'F','R','O','M',' ',' ',19,'T','O',18,X'EF',
* 19,31,'F','R','O','M',' ',' ',15,'T','O',18,X'EF',
* 19,'F','R','O','M',' ',' ',31,'T','O',15,18,X'EF'/
DATA PCS/17,'P','I','E','C','E','S',18,10,26,26,26,26,
* ' ',' ',26,26,X'EF'/
DATA SCREEN/'L','O','A','D',' ',
* 'B','C','K','G','M','N','.','D','I','S',0/
DATA SETUP/6,2,29,15,12,27,24,X'EF'/
DATA SEC/X'81B9'/
CALL SETVEC
K = PEEK(SEC)
A = PEEK(SEC+1)
A = RND(-A)
DO 50 I= 1,K
50 A= (PEEK(SEC)*RND(1.0)+1.0)
240 CALL OSTR(SETUP)
CALL FCS(SCREEN)
DO 410 I=1,26
B1(I)= 0
410 A1(I)= 0
B1(24) = 2
B1(19) = -5
B1(17) = -3
B1(13) = 5
B1(12) = -5
B1(8) = 3
B1(6) = 5
B1(1) = -2
COMP = 15
PLAYER = 15
MOVCNT = 0
BADCNT = 0
CALL BOARD(A1,B1)
V1=4.0
V4=3.0
510 CALL ROLL(F,DIE)
IF(DIE(1).EQ.DIE(2)) GOTO 510
520 IF(DIE(1).LT.DIE(2)) GOTO 540
CALL CLEAR
CALL PRINT('COMPUTER GOES FIRST@')
CALL WAIT
GOTO 2340
540 CALL CLEAR
CALL PRINT('YOU GO FIRST@')
CALL WAIT
550 CALL BOARD(A1,B1)
570 CALL ROLL(F,DIE)
580 DO 590 I=1,F
590 H(I)= 0
O1=0
P= 0
DO 615 Y=14,18
CALL CURSOR(0,Y)
CALL PRINT(' @')
615 CONTINUE
620 DO 2020 L=1,F
CALL BOARD(A1,B1)
P= P+1
GOTO 640
630 CALL BADMOV(BADCNT)
640 CALL COMMNT
IF(B1(26).EQ.0)GOTO 930
C
C PLAYER IS ON BAR
C
650 DO 690 J=1,F
IF(DIE(J).GT.6)GOTO 690
SUB = 25-DIE(J)
IF(B1(SUB).GT.-2)GOTO 720
690 CONTINUE
CALL CLEAR
700 CALL PRINT('THAT''S IT FOR YOUR TURN - TOUGH@')
CALL WAIT
GOTO 2300
720 CALL CURSOR(3,13+P)
CALL PRINT(' @')
CALL CURSOR(2,13)
CALL OSTR(FROMTO(1,3))
CALL CURSOR(3,13+P)
CALL PRINT('BAR@')
730 CALL CURSOR(8,13+P)
CALL RDNUM(J)
CALL CURSOR(2,13)
CALL OSTR(FROMTO(1,1))
CALL CLEAR
790 IF(J.LT.1)GOTO 870
IF(J.GT.24)GOTO 870
IF(B1(J).LE.-2)GOTO 1400
DO 860 I=1,F
IF(DIE(I).EQ.25-J)GOTO 890
860 CONTINUE
870 CALL PRINT('YOU CAN''T DO THAT@')
GOTO 630
890 B1(26)= B1(26)-1
T(I)=26
DIE(I)= DIE(I)*100
GOTO 1580
C
C NORMAL PLAYER MOVE
C
930 CALL CURSOR(2,13+P)
CALL PRINT(' @')
CALL CURSOR(2,13)
CALL OSTR(FROMTO(1,2))
CALL CURSOR(3,13+P)
CALL RDNUM(I)
CALL CURSOR(2,13)
CALL OSTR(FROMTO(1,3))
CALL CURSOR(8,13+P)
CALL RDNUM(J)
CALL CURSOR(2,13)
CALL OSTR(FROMTO(1,1))
CALL CLEAR
1000 IF(I.EQ.0)GOTO 1050
IF(I.GT.24)GOTO 1390
IF(J.GT.24)GOTO 1390
IF(J.EQ.0)GOTO 1660
GOTO 1410
1050 IF(J.EQ.0)GOTO 7380
1070 DO 1140 K=1,24
IF(B1(K).LT.1)GOTO 1140
DO 1140 K1=1,F
IF(DIE(K1).GT.99)GOTO 1140
T1= DIE(K1)
TEMP = K-T1
IF(TEMP.LT.1.0)GOTO 1140
SUB = K-T1
IF(B1(SUB).GT.-2)GOTO 1360
1140 CONTINUE
1170 DO 1190 K=7,26
IF(B1(K).GT.0)GOTO 1340
1190 CONTINUE
1210 DO 1320 K1=1,F
IF(DIE(K1).GT.99)GOTO 1320
1240 DO 1270 DUM=1,6
K = 7-DUM
IF(K.LT.DIE(K1))GOTO 1270
IF(B1(K).GT.0)GOTO 1360
1270 CONTINUE
1280 DO 1320 DUM=1,6
K = 7-DUM
IF(B1(K).LT.1)GOTO 1320
T1= K
GOTO 1360
1320 CONTINUE
1340 L= F
GOTO 2030
1360 DUM = K-T1
CALL PRINT('YOU CAN MOVE FROM @')
CALL WRNUM(K)
CALL PRINT(' TO @')
CALL WRNUM(DUM)
GOTO 630
1380 CALL PRINT('NOT QUITE YET@')
GOTO 630
1390 CALL PRINT('TRY AGAIN@')
GOTO 630
1400 CALL PRINT('I AM ALREADY AT @')
CALL WRNUM(J)
GOTO 630
1410 IF(B1(I).LE.0)GOTO 1710
IF(B1(J).LE.-2)GOTO 1400
1480 DO 1530 K=1,F
IF((I-J).NE.DIE(K))GOTO 1530
DIE(K)= DIE(K)*100
T(K)= I
GOTO 1570
1530 CONTINUE
CALL PRINT('CREATIVE, BUT WRONG@')
GOTO 630
1570 CALL CLEAR
B1(I)= B1(I)-1
1580 IF(B1(J).NE.-1)GOTO 1640
B1(25)= B1(25)-1
O1= O1+1
H(O1)= J
B1(J)= 0
1640 B1(J)= B1(J)+1
GOTO 2020
1660 DO 1690 K=7,26
IF(B1(K).GT.0)GOTO 1380
1690 CONTINUE
IF(B1(I).GT.0)GOTO 1740
1710 CALL PRINT('YOU HAVE NO PIECES ON @')
CALL WRNUM(I)
GOTO 630
1740 DO 1760 K=1,F
IF(DIE(K).EQ.I)GOTO 1860
1760 CONTINUE
1770 DUM = I+1
DO 1790 K=DUM,6
IF(B1(K).GT.0)GOTO 1840
1790 CONTINUE
1800 DO 1830 K=1,F
IF(DIE(K).GT.99)GOTO 1830
IF(DIE(K).GT.I)GOTO 1860
1830 CONTINUE
1840 CALL PRINT('COUNT AGAIN@')
GOTO 630
1860 B1(I)= B1(I)-1
PLAYER = PLAYER-1
CALL CURSOR(12,13)
CALL OSTR(PCS(1))
CALL WRNUM(PLAYER)
DO 1890 K1=1,6
IF(B1(K1).GT.0)GOTO 1950
1890 CONTINUE
1920 CALL BOARD(A1,B1)
CALL CLEAR
1930 CALL PRINT('DARN IT, YOU WIN@')
1931 CALL WAIT
CALL WAIT
1940 GOTO 7410
1950 T(K)= I
1960 DIE(K)= DIE(K)*100
1970 GOTO 2020
2020 CONTINUE
2030 CALL BOARD(A1,B1)
2040 CALL CLEAR
CALL PRINT('OK (Y/N) ? @')
2050 ANS = CI(3)
CALL CLEAR
IF(ANS.NE.X'FF')GOTO 2060
CALL PRINT('ARE YOU FINISHED YET ? @')
GOTO 2050
2060 IF(ANS.EQ.CHRY)GOTO 2300
IF(ANS.EQ.13) GOTO 2300
IF(ANS.NE.CHRN)GOTO 2040
2100 DO 2200 I=1,F
IF(DIE(I).LT.100)GOTO 2130
DIE(I)= DIE(I)/100
2130 K= DIE(I)
K1= T(I)
B1(K1)= B1(K1)+1
IF(K1-K.LT.1)GOTO 2195
IF(K1.NE.26) GOTO 2190
K1= 25
2190 SUB = K1-K
B1(SUB)= B1(SUB)-1
GOTO 2200
2195 PLAYER = PLAYER+1
CALL CURSOR(12,13)
CALL OSTR(PCS(1))
CALL WRNUM(PLAYER)
2200 CONTINUE
2210 IF(O1.EQ.0)GOTO 2260
2220 DO 2250 I=1,O1
SUB = H(I)
B1(SUB)= -1
2250 B1(25)= B1(25)+1
2260 CALL BOARD(A1,B1)
2275 CALL CLEAR
2280 CALL PRINT('RE-ENTER MOVES@')
BADCNT = 0
GOTO 580
C
C COMPUTER'S MOVE
C
2300 BADCNT = 0
CALL CLEAR
W = RND(1.0)
IF(W.LT.0.85) GOTO 2340
DUM = PLAYER-COMP+3
IF(DUM.LT.1) DUM = 1
IF(DUM.GT.5) DUM = 5
GOTO (2305,2310,2315,2320,2325),DUM
2305 CALL PRINT('PHOOEY ON YOU@')
GOTO 2335
2310 CALL PRINT('NOT MUCH OF A LEAD@')
GOTO 2335
2315 DO 2316 DUM=1,24
DUM1 = 25-DUM
IF(B1(DUM1).GT.0) GOTO 2317
2316 CONTINUE
2317 DO 2318 DUM2=1,24
IF(B1(DUM2).LT.0) GOTO 2319
2318 CONTINUE
2319 IF(DUM-DUM2)2320,2330,2310
2320 CALL PRINT('I HAVE THE EDGE@')
GOTO 2335
2325 CALL PRINT('GOODIE - I''M WINNING@')
GOTO 2335
2330 CALL PRINT('I''LL THRASH THE PANTS OFF YOU@')
2335 CALL WAIT
2340 CALL ROLL(F,DIE)
M(9)= -9999999.
CALL CLEAR
2345 CALL PRINT(' *** QUIET - I''M THINKING ***@')
2350 DO 2360 IT=1,F
2360 H(IT)= 0
T1 = F
2390 F2= 0
2410 F4= 0
2420 IF(B1(25).EQ.0)GOTO 2790
2440 SUB =1+F4
DUM = DIE(SUB)
IF(B1(DUM).LT.2)GOTO 2530
2460 IF(F4.EQ.0)GOTO 2480
2470 CALL TEST(J1,K,K1,B1,DIE,H,T)
2480 GOTO 3420
2490 IF(F.EQ.1)GOTO 3550
2500 CALL CLEAR
MOVCNT = MOVCNT+1
IF(MOVCNT.GT.3) MOVCNT = 3
GOTO (2501,2502,2503),MOVCNT
2501 CALL PRINT('I CAN''T MOVE@')
GOTO 2520
2502 CALL PRINT('OH NO, NOT AGAIN!@')
GOTO 2520
2503 CALL PRINT('YOU DIRTY RAT@')
2520 CALL WAIT
GOTO 570
2530 F4= F4+1
B1(25)= B1(25)+1
K= DIE(F4)
B1(K)= B1(K)-1
IF(B1(K).NE.0)GOTO 2640
H(F4)= K
B1(K)= -1
2640 T(F4)= 25
J1= F4+1
IF(F4.LT.F)GOTO 2420
DO 2770 K=1,F
K1= DIE(K)
B1(K1)= B1(K1)+1
IF(H(K).EQ.0)GOTO 2740
B1(K1)= 1
2740 B1(25)= B1(25)-1
M(2*K-1)= 25.0
M(2*K)= DIE(K)
2770 CONTINUE
GOTO 3550
2790 IF(F4.NE.0)GOTO 2820
J1= 1
2820 N= 1
2840 DO 2860 K=1,18
IF(B1(K).LT.0)GOTO 2890
2860 CONTINUE
GOTO 6840
2890 IF(B1(N).LE.-1)GOTO 2990
2900 N= N+1
2910 IF(N.LE.24)GOTO 2890
2930 J1= J1-1
2940 IF(J1.LT.1)GOTO 3420
N= T(J1)+1
CALL TEST(J1,K,K1,B1,DIE,H,T)
GOTO 2890
2990 K= DIE(J1)
IF(N+K.GT.24)GOTO 2930
SUB = N+K
IF(B1(SUB).GE.2)GOTO 2900
T(J1)= N
B1(N)= B1(N)+1
SUB = N+K
B1(SUB)= B1(SUB)-1
3060 IF(B1(SUB).NE.0)GOTO 3090
H(J1)= SUB
B1(SUB)= -1
3090 J1= J1+1
3100 IF(J1.GT.F)GOTO 3130
N= T(J1-1)
GOTO 2840
3130 IF(F2.LT.F)GOTO 3230
IF(F.EQ.1)GOTO 3230
IF(F.EQ.3)GOTO 3230
IF(T(1).EQ.T(2))GOTO 3250
IF(T(1)+DIE(1).NE.T(2))GOTO 3230
IF(H(1).NE.0)GOTO 3230
IF(T(1)+DIE(2).GT.24)GOTO 3230
SUB = T(1)+DIE(2)
IF(B1(SUB).GE.2)GOTO 3230
GOTO 3250
3230 CALL ANALYZ(F,B,B0,B1,DIE,H,M,T)
3250 J1= F
3260 N= T(J1)+1
3270 CALL TEST(J1,K,K1,B1,DIE,H,T)
GOTO 2890
3420 IF(F2.GE.F)GOTO 3500
3430 IF(DIE(1).EQ.DIE(2))GOTO 3500
3450 F2=2
3460 INTG= DIE(2)
3470 DIE(2)= DIE(1)
3480 DIE(1)= INTG
GOTO 2410
3500 IF(M(9).GT.-9999999.)GOTO 3550
3520 F= F-1
3530 IF(F.GT.0)GOTO 2390
GOTO 2500
3550 MOVCNT = 0
DO 3555 Y=22,25
CALL CURSOR(2,Y)
CALL PRINT(' @')
3555 CONTINUE
3560 DO 3750 I=1,F
3570 K= I*2-1
IF(M(K).NE.25.0)GOTO 3620
CALL CURSOR(3,21+I)
CALL PRINT('BAR@')
CALL CURSOR(8,21+I)
DUM = M(K+1)
CALL WRNUM(DUM)
3600 B1(25)= B1(25)+1
GOTO 3700
3620 IF(M(K+1).LT.25.0)GOTO 3670
3630 CALL CURSOR(8,21+I)
CALL PRINT('OFF@')
CALL CURSOR(3,21+I)
K = M(K)
CALL WRNUM(K)
3650 B1(K)= B1(K)+1
COMP = COMP-1
CALL CURSOR(12,21)
CALL OSTR(PCS(1))
CALL WRNUM(COMP)
GOTO 3750
3670 CALL CURSOR(2,21)
CALL OSTR(FROMTO(1,1))
3671 CALL CURSOR(3,21+I)
DUM = M(K)
CALL WRNUM(DUM)
3672 CALL CURSOR(8,21+I)
DUM = M(K+1)
CALL WRNUM(DUM)
K= M(K)
3690 B1(K)= B1(K)+1
3700 K= M(2*I)
3710 B1(K)= B1(K)-1
3720 IF(B1(K).NE.0)GOTO 3750
B1(26)= B1(26)+1
B1(K)= -1
3750 CONTINUE
GOTO 550
6840 DO 6860 K=1,F
6860 B0(K)= 0
6880 DO 7070 K=J1,F
6890 K1= 25-DIE(K)
6900 IF(B1(K1).LT.0)GOTO 7040
6910 DUM = K1-1
DO 6930 IT=19,DUM
T1 = IT
6920 IF(B1(IT).LT.0)GOTO 7310
6930 CONTINUE
6940 DUM1 = 25-DIE(K)
DO 6960 K1=DUM1,24
6950 IF(B1(K1).LT.0)GOTO 7040
6960 CONTINUE
6965 CALL BOARD(A1,B1)
6966 CALL CLEAR
6970 CALL PRINT('I WIN!!!@')
6971 CALL WAIT
6980 CONTINUE
GOTO 7410
7040 B0(K)= K1
7050 T(K)= 0
7060 B1(K1)= B1(K1)+1
7070 CONTINUE
DO 7100 K=19,24
IF(B1(K).LT.0)GOTO 7120
7100 CONTINUE
GOTO 6965
7120 IF(B1(26).GT.0)GOTO 7250
7130 DO 7150 K=19,24
7140 IF(B1(K).GT.0)GOTO 7250
7150 CONTINUE
7160 DO 7180 K=1,F
IF(T(K).GT.0)GOTO 7250
7180 CONTINUE
7190 DO 7230 K=1,F
SUB = B0(K)
B1(SUB)= B1(SUB)-1
M(2*K-1)= B0(K)
7230 M(2*K)= 27.0
GOTO 3550
7250 CONTINUE
7260 IF(T(1).GT.0)GOTO 7300
7270 IF(T(2).GT.0)GOTO 7300
7280 IF(F2.LT.F)GOTO 7300
GOTO 7310
7300 CALL ANALYZ(F,B,B0,B1,DIE,H,M,T)
7310 CONTINUE
7320 DO 7360 K=J1,F
7330 IF(B0(K).EQ.0)GOTO 7360
K1= B0(K)
B1(K1)= B1(K1)-1
7360 CONTINUE
GOTO 2890
7380 CONTINUE
7390 CALL CLEAR
CALL PRINT('I AGREE - YOU ARE IN POOR SHAPE@')
CALL WAIT
7410 CALL CLEAR
7440 CALL PRINT('PLAY AGAIN (Y/N) ? @')
7450 ANS = CI(0)
CALL CLEAR
IF(ANS.EQ.CHRN)GOTO 7500
IF(ANS.EQ.CHRY)GOTO 240
GOTO 7440
7500 CALL CO(12)
CALL CO(27)
CALL CO(11)
STOP
END