DataMuseum.dk

top - metrics - download

    Length: 2059 (0x80b)
    Types: TextFile
    Names: »path.f«

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

TextFile

	FUNCTION PATH(BEG,END,DIR,OKVECT,FLAG)
C
C PATH SUBROUTINE FOR EMPIRE
C  FINDS DIRECTION TO MOVE UNIT, FROM BEG TO END, OKVECT SPECIFIES OK TERRAIN.
C
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	character	OKVECT(5)
C
	BACKUP=1
	TDIR=DIR
comment	GET A DIRECTION TO FIDDLE WITH
	DIR3=TDIR*3
	Z6=BEG
	MAXMVE=(2 * IDIST(BEG,END))+1
comment	COMPUTE MAX MOVES TO GET THERE
	MOVNUM=MAXMVE
100	DO 200 I=1,100
comment	CLEAR G2 ARRAY
	G2(I)=0
200	CONTINUE

C STRGHT:
comment	TRY STRAIGHT MOVE FIRST
300	MOOVE= MOV(Z6,END)
	Z62=Z6+IARROW(MOOVE+1)
	AB=EMAP(Z62)
	IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 900
comment	IF NO GOOD, FOLLOW SHORE

C OKSET:
comment	STRAGHT MOVE WORKING
400	BAKADR=1

C OKMOVE:
500	IF (Z6 .EQ. BEG) MOVE1=MOOVE
	Z6=Z62
	IF (FLAG.GE.1000) CALL TEST4(Z6,FLAG,TDIR,MOVE1,MOVNUM,BEG,
     1 END,G2,BAKADR)
	IF (Z6 .EQ. END) GOTO 800
comment	IF Z6=END, WE'RE DONE

C DOMORE:
600	MOVNUM=MOVNUM-1
	IF (MOVNUM .EQ. 0) GOTO 700
comment	REACHED MAX MOVES, TRY NEW DIRECTION
C		STRGHT,	CHKNXT
	GOTO	(300,	1300), BAKADR
comment	CONTINUE, IN SAME MANNER

C TRYDIR::
700	DIR3=-DIR3
comment	NEGATE CURRENT DIRECTION
	TDIR=-TDIR
	IF (TDIR .EQ. DIR) GOTO  1200
comment	GIVE UP IF BACK TO START
	MOVNUM=MAXMVE
comment	ELSE, TRY AGAIN
	BACKUP=1
	Z6=BEG
	GOTO 100

C SUCCES:				SUCCESS, RETURN
800	PATH=MOVE1
	SUCCES=SUCCES+1
	FLAG=1
	RETURN

C FOLSHR:				FOLLOW THE SHORE
900	MOV1=ICORR(MOOVE-DIR3)
comment	TRY AGAIN
	Z62=Z6+IARROW(MOV1+1)
	AB=EMAP(Z62)
	IF (COMPAR(AB,Z62,OKVECT).EQ.1) MOV1=MOOVE
comment	???
C STFOL:
1000	DO 1100 IVAR= MOV1,MOV1+7*TDIR,TDIR
	MOOVE=ICORR(IVAR)
	Z62=Z6+IARROW(MOOVE+1)
	IF (ORDER(Z62) .NE. 0) GOTO 1100
	AB=EMAP(Z62)
	IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 1100
C OKSET2:
	BAKADR=2
	GOTO 500
1100	CONTINUE

C FAILUR:
1200	PATH=MOV(BEG,END)
	FAILUR=FAILUR+1
	FLAG=0
	RETURN

C CHKNXT:
1300	T1=MOV(Z6,END)
	Z62=Z6+IARROW(T1+1)
	AB=EMAP(Z62)
	IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 900
	DO 1400 IVAR=BACKUP,1,-1
	IF (Z6 .EQ. G2(IVAR)) GOTO 900
1400	CONTINUE
	G2(BACKUP)=Z6
	BACKUP=BACKUP+1
	IF (BACKUP .LE. 100) GOTO 300
	GOTO 700

	END