DataMuseum.dk

top - metrics - download

    Length: 6476 (0x194c)
    Types: TextFile
    Names: »fightr.f«

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Empire/fightr.f« 

TextFile

	SUBROUTINE FIGHTR
C
C THIS SUBROUTINE HANDLES ENEMY FIGHTER MOVES
C
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
C 
C IFO=7: CITY LOCATION
C IFO=6: CARRIER NUMBER
C IFO=5: TARGET LOCATION
C IFO=4: TARGET LOCATION, KAMIKAZE MISSION
C IFO=3: DIRECTIONAL
C IFO=2: DIRECTIONAL, KAMIKAZE MISSION
C
	MONKEY=0
	NUMBER(2)=0
	IF (CODER.EQ.2) PRINT 999
999	FORMAT(' FIGHTER CODES')
	DO 3600 Y=1,LIMIT(10)
	DO 3500 I1=1,4
	Z6=RLMAP(2000+Y)
	IF (Z6.EQ.0) GOTO 3600
C	DIR=MOD(Y,2)*2-1
comment	UNUSED
	MONKEY=Y
	STOPF=1
	P=0
	Z7=Z6
	AB=RMAP(Z6)
	DO 100 IA=1,6
	DO 100 IB=1,5
100	IF (TROOPT(IA,IB).EQ.Z6) TROOPT(IA,IB)=0
	IF ((AB.NE.'f').AND.(AB.NE.'X').AND.(AB.NE.'c')) GOTO 3400
	IF ((AB.EQ.'X').OR.(AB.EQ.'c')) RANG(Y)=20
	IF (RANG(Y).NE.0) GOTO 200
	RMAP(Z6)=OMAP(Z6)
	GOTO 3400
C 
C MOVE SELECTION
C
200	IF (CODELA(Y+IFI2-1500).EQ.Z6) GOTO 1100
	IFO=CODEFU(Y+IFI2-1500)
	ILA=CODELA(Y+IFI2-1500)
C 
C DOES A NEW CODE NEED TO BE SELECTED? 1100:YES, 2600:NO
C
	GOTO (1100,300,600,700,800,900,1000) IFO
	GOTO 1100
C 
300	IF (irand(100).LT.5) ILA=ICORR(ILA+1)
comment	**
	IF (RANG(Y).GT.10) GOTO 2600
	DO 400 I=1,70
	IF (X(I).EQ.0.OR.OWNER(I).NE.2) GOTO 400
	IF (IDIST(Z6,X(I)).GT.RANG(Y)) GOTO 400
	IFO=7
	ILA=X(I)
	GOTO 2600
400	CONTINUE
C 
600	IF (irand(100).LT.10) ILA=ICORR(ILA+1)
comment	**
	IF (RANG(Y).LE.11) GOTO 1100
	GOTO 2600
C 
700	IF (ILA.EQ.Z6) GOTO 1100
	GOTO 2600
C 
800	IF ((ILA.EQ.Z6).OR.(RANG(Y).LE.11)) GOTO 1100
	GOTO 2600
C 
900	IF (Z6.EQ.RLMAP(ILA+2800)) GOTO 1100
comment	IF LANDED
	IF (RLMAP(ILA+2800).EQ.0) GOTO 1100
comment	IF CARRIER DOESN'T EXIST
	IF (IDIST(Z6,RLMAP(ILA+2800)).GT.RANG(Y)) GOTO 1100
comment	IF OUT OF RANG
	GOTO 2600
C 
1000	IF (Z6.EQ.ILA) GOTO 1100
comment	IF LANDED
	IF (IDIST(Z6,ILA).GT.RANG(Y)) GOTO 1100
comment	IF OUT OF RANG
	GOTO 2600
C 
C NEW CODE SELECTION
C
1200	FUEL=RANG(Y)
comment	NO CHOICE BUT BE KAMIKAZE
	GOTO 1400
comment	START LOOKING FOR ENEMY TROOP TRANS.
1100	IF (AB.EQ.'f') GOTO 2100
comment	IF FIGHTER IS AIRBORNE
	ID=0
1300	FUEL=RANG(Y)/2
comment	DO THIS SO CRAFT CAN RETURN TO REFUEL
	IF (irand(100).LT.5) FUEL=RANG(Y)
comment	** 1 IN 20 IS KAMIKAZE
1400	ISHIPT=3
comment	ENEMY TROOP TRANSPORTS
C
C LOOK FOR ENEMY TROOP TRANSPORTS, THEN SUBMARINES
C
1500	DO 1600 I=1,5
	IF (TROOPT(ISHIPT,I).EQ.0) GOTO 1600
	IF (IDIST(Z6,TROOPT(ISHIPT,I)).GT.FUEL) GOTO 1600
comment	OUT OF RANG
	IFO=5
	IF (FUEL.EQ.RANG(Y)) IFO=4
	ILA=TROOPT(ISHIPT,I)
	GOTO 2600
comment	PROCEED TO MOVE CORRECTION
1600	CONTINUE
	IF (ISHIPT.EQ.2) GOTO 1700
comment	IF ALREADY LOOKED FOR SUBS
	ISHIPT=2
	GOTO 1500
comment	NOW LOOK FOR SUBS
1700	IF (ID.EQ.1000) GOTO 1900
comment	IF NO REFUELING SPOT WITHIN RANG
	IF (irand(100).LT.33) GOTO 1900
comment	** LOOK FOR ENEMY CONCENTRATIONS
	IF (irand(100).LT.50) GOTO 2100
comment	** MOVE TOWARDS CITY OR CARRIER
C
C MOVE IN A RANDOM DIRECTION
C
1800	IFO=3
	ILA=irand(8)+1
	IF (irand(100).LT.5) IFO=2
comment	** ONE OUT OF 20 WILL BE KAMIKAZE
	IF (NUMBER(2).LE.2) IFO=3
	GOTO 2600
comment	PROCEED TO MOVE CORRECTION
C
C MOVE TOWARD AN ENEMY CONCENTRATION WITHIN RANG
C
1900	DO 2000 I=1,10
	DO 2000 J=2,11
	IF (LOCI(I,J).EQ.0) GOTO 2000
	IF (IDIST(Z6,LOCI(I,J)).GT.FUEL) GOTO 2000
comment	IF OUT OF RANG
	IFO=5
	IF (FUEL.EQ.RANG(Y)) IFO=4
comment	KAMIKAZE
	ILA=LOCI(I,J)
	GOTO 2600
comment	PROCEED TO MOVE CORRECTION
2000	CONTINUE
	IF (ID.EQ.1000) GOTO 1800
comment	IF NO CITY OR CARRIER IS WITHIN RANG
C
C NOW MOVE TOWARDS A CITY CLOSEST TO ENEMY CONCENTRATION
C
2100	IA=MOD(Y,10)+1
	DO 2200 IB=IA,IA+9
	I=IB
	IF (I.GT.10) I=I-10
	IF (LOCI(I,2).EQ.0) GOTO 2200
	LOC=LOCI(I,2)
	ID=IDIST(Z6,LOCI(I,2))
	GOTO 2300
2200	CONTINUE
	LOC=EXPL()
2300	ID=1000
	IGARBG=irand(70+LIMIT(15))+1
comment	**
	DO 2500 ILOOP=IGARBG,IGARBG+70+LIMIT(15)
	IA=ILOOP
	IF (IA.GT.70+LIMIT(15)) IA=IA-70-LIMIT(15)
	IF (IA.GT.70) GOTO 2400
	IF (OWNER(IA).NE.2) GOTO 2500
	IF (IDIST(Z6,X(IA)).GT.RANG(Y)) GOTO 2500
	IF (IDIST(X(IA),LOC).GE.ID) GOTO 2500
	IFO=7
	ILA=X(IA)
	ID=IDIST(X(IA),LOC)
	GOTO 2500
2400	IB=IA-70
	IF (RLMAP(2800+IB).EQ.0) GOTO 2500
	IF (IDIST(Z6,RLMAP(2800+IB)).GT.RANG(Y)) GOTO 2500
	IF (IDIST(RLMAP(2800+IB),LOC).GE.ID) GOTO 2500
	IF ((RANG(Y).EQ.20).AND.(IDIST(Z6,RLMAP(2800+IB)).GT.12)
     1	.AND.(CODEFU(1300+IB).NE.9)) GOTO 2500
	IFO=6
	ILA=IB
	ID=IDIST(RLMAP(2800+IB),LOC)
2500	CONTINUE
	IF (ID.EQ.1000) GOTO 1200
	GOTO 2600
C
C MOVE CORRECTION
C
2600	IZOT=0
	MOOV=0
	IF (ILA.GT.100) IZOT=MOV(Z6,ILA)
	IF (ILA.LT.10) IZOT=ILA
	IF (IFO.EQ.6) IZOT=MOV(Z6,RLMAP(2800+ILA))
	IF ((IFO.LT.4).AND.(irand(100).LT.5)) IZOT=ICORR(IZOT+1)
comment	**
	DO 2700 I=1,8
	AC=RMAP(Z6+IARROW(I+1))
comment	**
	IF ((AC.NE.'D').AND.(AC.NE.'S').AND.(AC.NE.'T')
     1	.AND.(AC.NE.'F').AND.(AC.NE.'A')) GOTO 2700
	MOOV=I
	GOTO 3100
2700	CONTINUE
C 
C LOOK FOR TERRITORY TO EXPLOR IN FRONT
C
	IF (RANG(Y).LE.10) GOTO 2900
comment	IF LOW ON FUEL
	IZOT2=IZOT
comment	STORE IZOT A MOMENT
	Z62=Z6+IARROW(ICORR(IZOT2+1)+1)
comment	**
	IF (ORDER(Z62).NE.0) GOTO 2800
comment	IF ON THE EDGE OF THE MAP
	IF (EMAP(Z62).EQ.' ') IZOT=ICORR(IZOT2+1)
comment	IF Z62 IS UNEXPLORED
2800	Z62=Z6+IARROW(ICORR(IZOT2-1)+1)
comment	**TRY OTHER SIDE
	IF (ORDER(Z62).NE.0) GOTO 2900
comment	IF ON THE EDGE OF THE MAP
	IF (EMAP(Z62).EQ.' ') IZOT=ICORR(IZOT2-1)
comment	IF Z62 IS UNEXPLORED
C 
2900	DESTIN=ILA
	IF (IFO.EQ.6) DESTIN=RLMAP(2800+ILA)
	ID=IZOT
	DO 3000 I=0,7
	IZOT=ICORR(ID+I)
	NEWLOC=Z6+IARROW(IZOT+1)
comment	**
	IF (IFO.GT.3) THEN
	  IF (IDIST(Z6,DESTIN).LE.IDIST(NEWLOC,DESTIN)) GOTO 3000
	ENDIF
	AC=RMAP(NEWLOC)
	IF ((((AC.GE.'A').AND.(AC.LE.'T')).OR.
     1	(AC.EQ.'X').OR.(AC.EQ.'.').OR.
     1	(AC.EQ.'c').OR.(AC.EQ.'+')).AND.(ORDER(NEWLOC).EQ.0))
     1	GOTO 3100
3000	CONTINUE
	IZOT=0
3100	CODEFU(IFI2-1500+Y)=IFO
	CODELA(IFI2-1500+Y)=ILA
	IF (IFO.LT.4) CODELA(IFI2-1500+Y)=IZOT
	IF (CODER.EQ.2) PRINT 998,IFO,CODELA(IFI2-1500+Y)
998	FORMAT(I)
	IF (MOOV.NE.0) IZOT=MOOV
	Z6=Z6+IARROW(IZOT+1)
comment	**
C 
C MOVE EVALUATION
C
	IF (AB.EQ.'f') RMAP(Z7)=OMAP(Z7)
	AB=RMAP(Z6)
	IF ((AB.EQ.'.').OR.(AB.EQ.'+')) GOTO 3200
	IF ((AB.EQ.'X').OR.(AB.EQ.'c')) GOTO 3300
	IF (OMAP(Z6).EQ.'*') GOTO 3400
	H2=30
	P=1
	H1=1
	OWN1='f'
	OWN2=AB
	CALL FIND(OWN2,Z6,Z8,H2)
	CALL FGHT(Z6,H1,H2,OWN1,OWN2)
	CALL FIND(OWN2,Z6,Z8,H2)
	IF (H1.LE.0) GOTO 3400
3200	RMAP(Z6)='f'
	STOPF=0
3300	RANG(Y)=RANG(Y)-1
	IF (I1.EQ.1) NUMBER(2)=NUMBER(2)+1
	RLMAP(2000+Y)=Z6
	CALL SONAR(Z6)
	IF (P.EQ.1) CALL SENSOR(Z6)
	IF (STOPF.EQ.1) GOTO 3600
3500	CONTINUE
	GOTO 3600
3400	RLMAP(2000+Y)=0
	CALL SONAR(Z6)
	IF (P.EQ.1) CALL SENSOR(Z6)
3600	CONTINUE
	RETURN
	END