DataMuseum.dk

top - metrics - download

    Length: 2696 (0xa88)
    Types: TextFile
    Names: »movcor.f«

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

TextFile

	FUNCTION MOVCOR
     1	(IFO,ITURN,Z6,MOVE,IH1,IS1,AGGR,OWN1,EXPLOR,DIR,DEST,ORIG,HMAX)
C
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
	character ab
C
C 
C CHECK FOR IMPOSSIBLE CONDITION FOR MOVE
C
	IF ((.NOT.PASS).OR.(IABS(MOVE).LE.8)) GOTO 100
	call clear
	call topini
	PRINT 999,OWN1,Z6,MOVE,IFO
999	FORMAT(1X,A1,' @ ',I4,' ATTEMPTED ',I,' WITH IFO ',I4)
C 
100	MOVE=IABS(MOVE)
C 
	IF (ITURN.EQ.1) BLAH=0
comment	**
	IF (BLAH.LT.0) MOVE=ICORR(I2+irand(3)-1)
comment	**
C 
C CHECK FOR SOMETHING TO ATTACK, OR, SOMETHING TO RUN FROM
C BLAH.LT.0: RUN
C BLAH.GE.0: ATTACK
C
	DO 200 IX=1,8
	I1=IX
	LOC=Z6+IARROW(I1+1)
comment	**
	AB=RMAP(LOC)
	IF (OMAP(LOC).NE.'.') GOTO 200
	IF ((AB.LT.'B').OR.(AB.GT.'T')) GOTO 200
comment	IF SH/PL, LOOK
	BLAH=ATTACK(OWN1,AB,IH1,AGGR)
	IF (BLAH.GE.0) GOTO 1200
comment	** ATTACK IT
	GOTO 300
comment	RUN FROM IT
200	CONTINUE
	I1=0
comment	NOTHING OF INTEREST HERE
	GOTO 800
C 
C SELECT AN APPROPRIATE ESCAPE MOVE
C
300	IS=irand(3)
	DO 600 IN=1,8
	I2=IN
	IF ((IS.EQ.0).OR.(IN.GT.3)) GOTO 500
	IF (IS.NE.1) GOTO 400
	IF (IN.EQ.1) I2=2
	IF (IN.EQ.2) I2=3
	IF (IN.EQ.3) I2=1
	GOTO 500
400	IF (IN.EQ.1) I2=3
	IF (IN.EQ.2) I2=1
	IF (IN.EQ.3) I2=2
500	I=IARROW(ISCAPE(I2,I1)+1)+Z6
comment	**
	IF ((RMAP(I).EQ.'.').AND.(ORDER(I).EQ.0)) GOTO 700
600	CONTINUE
	I1=0
	GOTO 800
700	I1=ISCAPE(I2,I1)
	IF (OMAP(I).NE.'.') call topmsg ( 3, 'ISCAPE ERROR' )
	GOTO 1200
C 
800	IF (EXPLOR.EQ.0) GOTO 1000
comment	**
	EXPMAX=0
	DO 900 IX=MOVE,MOVE+7
	I1=ICORR(IX)
	LOC1=Z6+IARROW(I1+1)
comment	**
	IF (ORDER(LOC1).NE.0) GOTO 900
	IF (RMAP(LOC1).NE.'.') GOTO 900
	IF (DEST.GT.0) THEN
	  IF (IDIST(Z6,DEST).LT.IDIST(LOC1,DEST)) GOTO 900
	ENDIF
	NEXP=0
	IF (EMAP(LOC1+IARROW(I1+1)).EQ.' ') NEXP=1
comment	**
	IF (EMAP(LOC1+IARROW(ICORR(I1-1)+1)).EQ.' ') NEXP=NEXP+1
comment	**
	IF (EMAP(LOC1+IARROW(ICORR(I1+1)+1)).EQ.' ') NEXP=NEXP+1
comment	**
	IF (EMAP(LOC1+IARROW(ICORR(I1+2)+1)).EQ.' ') NEXP=NEXP+1
comment	**
	IF (EMAP(LOC1+IARROW(ICORR(I1-2)+1)).EQ.' ') NEXP=NEXP+1
comment	**
	IF (NEXP.EQ.5) GOTO 1200
	IF (NEXP.LE.EXPMAX) GOTO 900
	EXPMAX=NEXP
	I11=I1
900	CONTINUE
	I1=0
	IF (EXPMAX.EQ.0) GOTO 1000
	I1=I11
	GOTO 1200
1000	I2=MOVE
	LOC1=Z6+IARROW(MOVE+1)
comment	**
	AB=RMAP(LOC1)
	IF (LOC1.NE.ORIG) THEN
	  IF (((AB.EQ.'.').OR.(AB.EQ.'X')).AND.(ORDER(LOC1).EQ.0)) GOTO 1200
	ENDIF
	M=MOVE
	IA=ICORR(M-DIR*3)
	IF (RMAP(Z6+IARROW(IA+1)).NE.'.') M=IA
comment	**
	DO 1100 I=0,7*DIR,DIR
	I2=ICORR(M+I)
	I3=Z6+IARROW(I2+1)
comment	**
	IF ((RMAP(I3).EQ.'.').AND.(ORDER(I3).EQ.0).AND.(I3.NE.ORIG)) GOTO 1200
1100	CONTINUE
	I2=0
1200	IF (I1.NE.0) I2=I1
	IF (RMAP(Z6+IARROW(MOVE+1)).NE.'X') MOVE=I2
comment	**
	IF ((RMAP(Z6).EQ.'X').AND.(IH1.LT.HMAX)) MOVE=0
	MOVCOR=MOVE
	RETURN
	END