Compucolor.org – Virtual Media

Listing of file='ANALYZ.FOR;03' on disk='vmedia/backgammon-sideB-sector.ccvf'

	SUBROUTINE TEST(J1,K,K1,B1,DIE,H,T)
	INTEGER B1(26),DIE(4),H(5),T(4)
	BYTE J1,K,K1
	BYTE SUB

	IF(J1.GT.0)GOTO 3320
	RETURN

3320	K1= T(J1)
	B1(K1)= B1(K1)-1
	K= DIE(J1)
3350	IF(K1.NE.25)GOTO 3370
	K1= 0
3370	SUB = K1+K
	B1(SUB)= B1(SUB)+1
3380	IF(H(J1).EQ.0)GOTO 3410
	B1(SUB)= B1(SUB)+1
	H(J1)= 0
3410	RETURN
	END

	SUBROUTINE ANALYZ(F,B,B0,B1,DIE,H,M,T)
	REAL M(9),D,D1,D2
	INTEGER B(10),B0(4),B1(26),DIE(4),H(5),T(4)
	BYTE F,I,J,K,K1,L
	BYTE DUM,DUM1,DUM2,DUM3,SUB,IT
	BYTE C,C1
	COMMON /TEMP/T1,T2,T3,T4,T5
	COMMON /MORE/V,V1,V2,V3,V4
	V = 0.0
	V2= 3.5
	V3= 1.0
4350	DO 4400 K=1,F
	IF(T(K).NE.0)GOTO 4380
	V= V+40.0*V3
4380	IF(T(K).NE.25)GOTO 4400
	V= V+4000.0
4400	CONTINUE
4420	IF(B1(25).NE.0)GOTO 4620
4430	IF(B1(26).NE.0)GOTO 4620
4440	DO 4460 I=1,F
	IF(H(I).NE.0)GOTO 4620
4460	CONTINUE
4470	DO 4490 DUM=1,24
	I = 25-DUM
	IF(B1(I).GT.0)GOTO 4500
4490	CONTINUE
4500	DO 4520 DUM=1,I
	T1 = I+1-DUM
	IT = T1
	IF(B1(IT).LT.0)GOTO 4620
4520	CONTINUE
4540	V2= 0.0
	V3= 5.0
4570	DO 4600 I=1,6
	IF(B1(I).GE.0)GOTO 4600
	V= V-1000.0*IABS(B1(I))*(7-I)
4600	CONTINUE
	GOTO 6430

4620	C1= 0
4650	DO 4690 I=1,24
	IF(B1(I).NE.-1)GOTO 4690
	C1= C1+1
	B(C1)= I
4690	CONTINUE
4770	T1= 0.0
	T2= 0.0
	T3= 0.3
	T5= 0.0
4820	DO 4940 J=17,24
	IF(B1(J).GT.-2)GOTO 4880
	T1= T1+1.0
	IF(J.GT.18)GOTO 4880
	T1= T1-0.3
4880	IF(B1(J).NE.-1)GOTO 4910
	T2= T2+1.0
4910	IF(J.LE.21)GOTO 4940
	IF(B1(J).GE.0)GOTO 4940
	V= V+30.0*B1(J)
4940	CONTINUE

4950	V= V+T1*V2**2
4970	DO 5000 J=1,8
	IF(B1(J).LT.2)GOTO 5000
	T3= T3+1.0
5000	CONTINUE
5020	DO 5050 J=13,18
	IF(B1(J).GE.0)GOTO 5050
	V= V+IABS(B1(J))*V2
5050	CONTINUE
5060	T1= T1*V1**2
	T3= T3*V1**2
5090	DO 5130 J=1,F
	IF(H(J).EQ.0)GOTO 5130
	T5= T5+1.0
	V= V+(25.0-H(J))*T1*11.0/36.0
5130	CONTINUE
5140	T5= T5+B1(26)
5150	IF(T5.LT.4.0)GOTO 5200
	V= V-11.0/36.0*T2*T3
5200	IF(C1.LE.0)GOTO 5250
	V= V+300.0
5220	IF(V.GE.M(9))GOTO 5240
	GOTO 6700

5240	V= V-300.0
5250	DO 5280 J=1,4
	IF(B1(J).GT.-1)GOTO 5280
	V= V-IABS(B1(J))*T3/V1*(5-J)
5280	CONTINUE
5300	IF(T5.GT.3.0)GOTO 6130
5310	IF(C1.EQ.0)GOTO 6130
5330	DO 6110 J=1,C1
	DUM1 = B(J)+1
	DO 6110 K=DUM1,26
	C= 0
5360	IF(K.LT.26)GOTO 5400
5370	DO 5390 K1=1,F
	IF(H(K1).NE.0)GOTO 5410
5390	CONTINUE
5400	IF(B1(K).LE.0)GOTO 6110
5410	IF(K.GT.24)GOTO 5640
	T4= 1.0
5460	IF(B(J).GT.6)GOTO 5480
	T4= 0.5
5480	IF(B1(K).NE.2)GOTO 5650
	T4= T4-1.0
5500	DO 5540 DUM2=1,6
	K1 = K-DUM2
5510	IF(K1.LT.1)GOTO 5600
	IF(B1(K1).NE.-1)GOTO 5540
	T4= T4+11.0+K-K1
5540	CONTINUE
5550	DO 5590 DUM2=7,11
	K1 = K-DUM2
5560	IF(K1.LT.1)GOTO 5600
	IF(B1(K1).NE.-1)GOTO 5590
	T4= T4+2.0
5590	CONTINUE
5600	T4= (36.0-T4)/36.0*B(J)/12.0
5610	IF(T4.GE.0.0)GOTO 5630
	T4= 0.15
5630	IF(T4.LT.1.0)GOTO 5650
5640	T4= 1.0
5650	D= K-B(J)
5670	IF(K.LT.26)GOTO 5690
	D= D-1.0
5690	IF(T5.GT.0.0)GOTO 5910
5700	IF(D.EQ.1.0)GOTO 5920
5710	IF(D.GT.11.0)GOTO 5980
5730	IF(B(J).GT.13)GOTO 5750
5740	IF(B1(26).NE.0)GOTO 5920
5750	D1= 1.0
5760	D2= D-D1
5770	IF(D2.LE.6.0)GOTO 5800
	D1= D1+1.0
	GOTO 5760

5800	SUB = K-D1
	IF(SUB.LE.0)GOTO 5840
	IF(B1(SUB).LT.0)GOTO 5840
	C= C+2
	GOTO 5870

5840	SUB = K-D2
	IF(SUB.LE.0)GOTO 5870
	IF(B1(SUB).LT.0)GOTO 5870
5860	C= C+2
5870	IF(D2-D1.LE.1.0)GOTO 5910
	D1= D1+1.0
	D2= D2-1.0
5900	GOTO 5800

5910	IF(D.GT.6.0)GOTO 5980
5920	IF(B(J).GT.18)GOTO 5950
5940	IF(T5.GT.1.0)GOTO 5970
5950	C= C+11
	GOTO 5980

5970	C= C+1
5980	D2= 3.0
6000	IF(INT(D/D2)*D2.NE.D)GOTO 6060
	D1= 0.0
	D1= D1+D/D2
6030	SUB = K-D1
	IF(SUB.LT.1)GOTO 6060
	IF(B1(SUB).GT.1)GOTO 6060
	C= C+1
6060	IF(D2.NE.3.0)GOTO 6100
	D2= 4.0
	GOTO 6000

6100	V= V-C/36.0*B(J)*T3*T4
6110	CONTINUE

6130	T1= 0.0
	T2= 0.0
6160	DO 6320 K=16,23
6170	IF(B1(K+1).GT.-2)GOTO 6190
	T1= T1+1.0
6190	IF(T1.LT.T2)GOTO 6300
	T2= T1
	T3= 1.0
6250	DO 6280 J=K,24
	IF(B1(J).LE.0)GOTO 6280
	T3= T3+B1(J)
6280	CONTINUE
6290	V= V+T2*T2*T3
6300	IF(B1(K+1).LT.-1)GOTO 6320
	T1 = 0.0
6320	CONTINUE
6340	L= 5
6350	DUM3 = L+2
	DO 6390 K=L,DUM3
	V= V-B1(K)*V2*30.0
6370	IF(B1(K).GT.-3)GOTO 6390
	V= V+B1(K)*V2*30.0+90.0
6390	CONTINUE
6400	IF(L.GE.18)GOTO 6430
	L= 18
	GOTO 6350

6430	T1= 0.0
	T2= 0.0
	T3= 0.0
	T4= 0.0
6520	DO 6620 J=1,24
6530	IF(B1(J).GE.0)GOTO 6620
	T1= T1+1.0
6550	IF(J.GE.19)GOTO 6570
	T4= T4+(19.0-J)*IABS(B1(J))+(3.0-INT((J-1)/6.0))*
     *	    3.0*IABS(B1(J))
6570	IF(B1(J).GT.-2)GOTO 6620
	T2= T2+1.0
6600	IF(B1(J).GT.-3)GOTO 6620
	T3= T3-(B1(J)*B1(J))+12
6620	CONTINUE
6630	T2= T2*V2
	V= V+T1+V2*T2+V2*T3-V3*T4

6700	IF(V.LE.M(9))GOTO 6830
6710	DO 6810 J=1,F
6720	IF(T(J).NE.0)GOTO 6760
6730	SUB = (J-1)*2+1
	M(SUB)= B0(J)
6740	M(2*J)= 28.0
	GOTO 6810
6760	SUB = (J-1)*2+1
	M(SUB)= T(J)
6770	IF(T(J).EQ.25)GOTO 6800
6780	M(2*J)= T(J)+DIE(J)
	GOTO 6810
6800	M(2*J)= DIE(J)
6810	CONTINUE
6820	M(9)= V
6830	RETURN
	END

	SUBROUTINE BADMOV(BADCNT)
	BYTE BADCNT,I

	BADCNT = BADCNT+1
	IF(BADCNT.LT.2) GOTO 15
	I = BADCNT-1
	IF(I.GT.4) I = 4
	CALL CO(13)
	CALL CO(10)
	GOTO (11,12,13,14),I
11	CALL PRINT('LOOK CLOSER@')
	GOTO 15
12	CALL PRINT('USE YOUR HEAD@')
	GOTO 15
13	CALL PRINT('DO YOU KNOW HOW TO PLAY?@')
	GOTO 15
14	CALL PRINT('I WANT A NEW #?$*%" OPPONENT!@')
15	RETURN
	END

	SUBROUTINE COMMNT
	BYTE I

	W = RND(1.0)
	IF(W.GT.0.2) GOTO 30
	CALL CO(13)
	CALL CO(10)
	I = INT(RND(1.0)*9.0+1.0)
	GOTO (21,22,23,24,25,26,27,28,29),I
21	CALL PRINT('HOPE YOU DON''T MIND COMMENTS@')
	GOTO 30
22	CALL PRINT('IS YOUR HEART REALLY IN THIS ?@')
	GOTO 30
23	CALL PRINT('TERRIBLE MOVE!@')
	GOTO 30
24	CALL PRINT('SUCKER!!!@')
	GOTO 30
25	CALL PRINT('DEE, DEE, DEE, DUM ...@')
	GOTO 30
26	CALL PRINT('AM I DISTURBING YOU ?@')
	GOTO 30
27	CALL CO(17)
	CALL CO(31)
	CALL PRINT('<---- * PSYCH-OUT * ---->@')
	CALL CO(15)
	CALL CO(18)
	GOTO 30
28	CALL PRINT('LET''S SEE WHAT YOU CAN DO@')
	GOTO 30
29	CALL PRINT('WHAT A WEENIE!@')
30	RETURN
	END