-+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+
X`09IF (CODER.NE.9) GOTO 1500
X`09CALL LIB$SET_CURSOR(2,1)
X`09TYPE 999,X(I),INT,PHASE(I),EDGE
X999`09FORMAT('+CITY:',I4,' FROM:',I2,' TO:',I2,' EDGE:',I1,3X,$)
X`09CALL GETCHX(E)
X1500`09RETURN
X`09END
X`0C
XC`20
X`09SUBROUTINE FIND(OWN,Z6,Z8,H2)
XC
XC CROSS-REFERENCE SUBROUTINE, IT FINDS DATA ON WHATEVER
XC CRAFT IS AT POINT Z6.
XC`20
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09IF (H2.GT.0) GOTO 1100
XC`20
XC NOW WE MUST DESTROY OWN
XC FIRST OF ALL, UPDATE TROOPT
XC
X`09ISHP=0
X`09IF (OWN.EQ.'D') ISHP=1
X`09IF (OWN.EQ.'S') ISHP=2
X`09IF (OWN.EQ.'T') ISHP=3
X`09IF (OWN.EQ.'R') ISHP=4
X`09IF (OWN.EQ.'C') ISHP=5
X`09IF (OWN.EQ.'B') ISHP=6
X`09IF (ISHP.EQ.0) GOTO 200
X`09DO 100 Z=1,5
X100`09IF (TROOPT(ISHP,Z).EQ.Z6) TROOPT(ISHP,Z)=0
XC`20
XC  NOW DESTROY THE CRAFT, SET RLMAP(N)=0
XC`20
X200`09IF (OWN.NE.'C') GOTO 400
X`09DO 300 Z=1,200
X`09IF (RLMAP(500+Z).NE.Z6) GOTO 300
X`09RLMAP(500+Z)=0
X`09IF (MODE.EQ.1) CALL LIB$SET_CURSOR(2,60)
X`09TYPE 999,Z
X999`09FORMAT('+Fighter #'I3' sunk.'$)
X300`09CONTINUE
XC`20
X400`09IF (OWN.NE.'T') GOTO 600
X`09DO 500 Z=1,500
X`09IF (RLMAP(Z).NE.Z6) GOTO 500
X`09RLMAP(Z)=0
X`09IF (MODE.EQ.1) CALL LIB$SET_CURSOR(2,60)
X`09TYPE 998,Z
X998`09FORMAT('+Army #'I3' sunk.'$)
X500`09CONTINUE
XC`20
X600`09IF (OWN.NE.'t') GOTO 800
X`09DO 700 Z=1501,2000
X700`09IF (RLMAP(Z).EQ.Z6) RLMAP(Z)=0
XC`20
X800`09IF (OWN.NE.'c') GOTO 1000
X`09DO 900 Z=2001,2200
X900`09IF (RLMAP(Z).EQ.Z6) RLMAP(Z)=0
XC`20
X1000`09RLMAP(Z8)=0
X`09IF ((OWN.GE.'a').AND.(OWN.LE.'t')) CALL SONAR(Z6)
X`09IF ((OWN.GE.'A').AND.(OWN.LE.'T')) CALL SENSOR(Z6)
X`09RETURN
XC`20
X1100`09IF (H2.EQ.30) GOTO 1200
X`09IF ((OWN.EQ.'A').OR.(OWN.EQ.'F').OR.(OWN.EQ.'a').OR.(OWN.EQ.'f'))
X`091`09 GOTO 1500
X`09IF ((OWN.GE.'A').AND.(OWN.LE.'T')) J1TS(Z8-700)=H2
X`09IF ((OWN.GE.'a').AND.(OWN.LE.'t')) J1TS(Z8-1400)=H2
X`09GOTO 1500
X1200`09H2=0
X`09IA=1
X`09IF (OWN.EQ.'T') IA=1101
X`09IF (OWN.EQ.'C') IA=1301
X`09IF (OWN.EQ.'a') IA=1501
X`09IF (OWN.EQ.'f') IA=2001
X`09IF (OWN.EQ.'t') IA=2601
X`09IF (OWN.EQ.'c') IA=2801
X`09DO 1300 Z8=IA,3000
X1300`09IF (RLMAP(Z8).EQ.Z6) GOTO 1400
X`09PAUSE ' ERROR IN SUBROUTINE FIND, "CONTINUE" TO CONTINUE'
X997`09FORMAT(' ERROR IN SUB. FIND')
X`09GOTO 1500
X1400`09IF ((OWN.EQ.'A').OR.(OWN.EQ.'F').OR.(OWN.EQ.'a').OR.(OWN.EQ.'f'))
X`091`09H2=1
X`09IF (H2.EQ.1) GOTO 1500
X`09IF ((OWN.GE.'A').AND.(OWN.LE.'T')) H2=J1TS(Z8-700)
X`09IF ((OWN.GE.'a').AND.(OWN.LE.'t')) H2=J1TS(Z8-1400)
X1500`09RETURN
X`09END
XC`20
X`09SUBROUTINE SONAR(Z6)
XC
XC UPDATES COMPUTER'S MAP AROUND LOCATION Z6
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC`20
X`09DO 1300 I=0,8
X`09LOCUS=Z6+IARROW(I+1)`09`09`09!**
X`09AB=RMAP(LOCUS)
X`09AC=EMAP(LOCUS)
X`09IF (AB.NE.AC) EMAP(LOCUS)=AB
X`09IF (AB.EQ.'A') GOTO 90
X`09IF (AC.NE.'A') GOTO 90
XC
XC NOW WE HAVE A LOCATION THAT USED TO BE A PLAYER ARMY- CLEAN LOCI FOR IT
XC
X`09DO 440 K=1,10
X`09IF (LOCI(K,2).EQ.0) GOTO 440
X`09DO 430 J=2,10
X`09IF (LOCI(K,J).EQ.LOCUS) GOTO 450
X430`09CONTINUE
X440`09CONTINUE
X`09GOTO 90
X
X450`09DO 420 J=J,10
X`09LOCI(K,J)=LOCI(K,J+1)
X420`09CONTINUE
X`09LOCI(K,11)=0
X
X90`09IF (I.EQ.0) GOTO 1300
X`09IF ((AB.NE.'*').AND.(AB.NE.'O')) GOTO 400
X`09DO 100 I1=1,70
X100`09IF (TARGET(I1).EQ.LOCUS) GOTO 1300
X`09DO 200 I1=1,70
X200`09IF (TARGET(I1).EQ.0) GOTO 300
X300`09TARGET(I1)=LOCUS
X400`09IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 1300
X`09IF (AB.NE.'A'.AND.AB.NE.'O') GOTO 1100
X`09IF (AC.EQ.'A') GOTO 520
XC`20
XC WE MUST NOW FIGURE OUT IF THE ARMY IS A THREAT TO ANY OF THE COMPUTER'S
XC CITIES, I.E. IF IT IS ON THE CONTINENT WITH ANY OF THEM. IF SO, PUT
XC THE ARMY IN THE LOCI ARRAY. THE FIRST INDEX IS THE CONTINENT, THE
XC SECOND IS THE NTH ARMY DISCOVERED ON THAT CONTINENT - 1. THE (N,1)
XC ARGUMENT IS THE DATE OF THE LAST ARMY DISCOVERED ON THE
XC NTH CONTINENT. THUS WE HAVE A MEANS OF DETERMINING THE AGE OF THE DATA
XC`20
X`09ARMDEF=0
X`09DO 480 Y=1,LIMIT(9)
X`09IF (RLMAP(IAR2+Y).EQ.0) GOTO 480
X`09IF (IDIST(LOCUS,RLMAP(IAR2+Y)).GT.14) GOTO 480
X`09MOVE=PATH(RLMAP(IAR2+Y),LOCUS,1,OKA,FLAG)
X`09IF (FLAG.NE.0) ARMDEF=ARMDEF+1
X480`09CONTINUE
X`09IF (ARMDEF.GE.7) GOTO 520
X
X`09DO 500 K=1,70
X`09IF ((OWNER(K).NE.2).OR.(PHASE(K).EQ.1)) GOTO 500
X`09IF (FOUND(K)-MDATE-5.LE.0) GOTO 500
X`09IF (IDIST(X(K),LOCUS).GT.18) GOTO 500
X`09MOVE=PATH(X(K),LOCUS,1,OKA,FLAG)
X`09IF (FLAG.NE.0) PHASE(K)=-1
X500`09CONTINUE
XC`20
X520`09IF (AB.EQ.'O') GOTO 1300
X`09DO 600 K=1,10
X`09IF (LOCI(K,2).EQ.0) GOTO 600
X`09IF (LOCI(K,2).EQ.LOCUS) GOTO 1050
X`09DO 550 J=3,10
X`09IF (LOCI(K,J).EQ.LOCUS) GOTO 800
X550`09CONTINUE
X`09MOVE=PATH(LOCUS,LOCI(K,2),1,OKA,FLAG)
X`09J=11
X`09IF (FLAG.NE.0) GOTO 800
X600`09CONTINUE
X
X`09DO 700 K=1,10
X700`09IF (LOCI(K,2).EQ.0) GOTO 760
X
X`09OLDEST=10000
X`09DO 750 J=1,10
X`09IF (LOCI(J,1).LT.OLDEST) THEN
X`09  OLDEST=LOCI(J,1)
X`09  K=J
X`09ENDIF
X750`09CONTINUE
X760`09DO 770 J=2,11
X770`09LOCI(K,J)=0
X`09GOTO 1000
X
X800`09DO 900 J=J,3,-1
X900`09LOCI(K,J)=LOCI(K,J-1)`09`09`09!SHIFT EVERYTHING UP THE ARRAY
X1000`09LOCI(K,2)=LOCUS
X1050`09LOCI(K,1)=MDATE
X`09GOTO 1300
XC`20
X1100`09ISHIPT=0
X`09IF (AB.EQ.'D') ISHIPT=1
X`09IF (AB.EQ.'S') ISHIPT=2
X`09IF (AB.EQ.'T') ISHIPT=3
X`09IF (AB.EQ.'R') ISHIPT=4
X`09IF (AB.EQ.'C') ISHIPT=5
X`09IF (AB.EQ.'B') ISHIPT=6
X`09IF (ISHIPT.EQ.0) GOTO 1300
X`09DO 1200 IB=1,4
X1200`09TROOPT(ISHIPT,IB)=TROOPT(ISHIPT,IB+1)
X`09TROOPT(ISHIPT,5)=LOCUS
X1300`09CONTINUE
X`09IF (CODER.EQ.10) CALL SENSOR(Z6)
X`09RETURN
X`09END
X`0C
X`09SUBROUTINE HELP
XC
XC HELP - PRINT HELP FILE
XC
X`09CALL ERASE_PAGE(1,1)
X`09CALL STROUT('EMPIRE.HLP  (see EMPIRE.DOC for more detail)',1)
X`09CALL STROUT('ORDERS MODE-----------
X`091`09MOVE MODE-------------`09EDIT MODE-------------',0)
X`09CALL LIB$SET_CURSOR(6,1)
X`09CALL STROUT('A: Stay in Move mode',1)
X`09CALL STROUT('C: Give 1 free move',1)
X`09CALL STROUT('G: GIGI color terminal',1)
X`09CALL STROUT('H: This text',1)
X`09CALL STROUT('J: Enter Edit mode',1)
X`09CALL STROUT('L: Log every 20 moves',1)
X`09CALL STROUT('M: Enter Move mode',1)
X`09CALL STROUT('N: Give n free moves',1)
X`09CALL STROUT('P: Refresh sector',1)
X`09CALL STROUT('Q: Quit game',1)
X`09CALL STROUT('R: Display round #',1)
X`09CALL STROUT('S: Clear screen',1)
X`09CALL STROUT('T: Print out map',1)
X`09CALL STROUT('V: VT125 graphics',0)
XC
X`09CALL LIB$SET_CURSOR(4,25)
X`09CALL STROUT('QWE: Movement',0)
X`09CALL LIB$SET_CURSOR(5,25)
X`09CALL STROUT('A D  direction',0)
X`09CALL LIB$SET_CURSOR(6,25)
X`09CALL STROUT('ZXC',0)
X`09CALL LIB$SET_CURSOR(7,25)
X`09CALL STROUT('<space>: Sit',0)
X`09CALL LIB$SET_CURSOR(8,25)
X`09CALL STROUT('G: Sleep till full T,C',0)
X`09CALL LIB$SET_CURSOR(9,25)
X`09CALL STROUT('H: This text',0)
X`09CALL LIB$SET_CURSOR(10,25)
X`09CALL STROUT('I: Set direction',0)
X`09CALL LIB$SET_CURSOR(11,25)
X`09CALL STROUT('J: Enter Edit mode',0)
X`09CALL LIB$SET_CURSOR(12,25)
X`09CALL STROUT('K: Wake piece',0)
X`09CALL LIB$SET_CURSOR(13,25)
X`09CALL STROUT('L: Set city direction',0)
X`09CALL LIB$SET_CURSOR(14,25)
X`09CALL STROUT('O: Cancel Auto moves',0)
X`09CALL LIB$SET_CURSOR(15,25)
X`09CALL STROUT('P: Refresh screen',0)
X`09CALL LIB$SET_CURSOR(16,25)
X`09CALL STROUT('R: Random for Armies',0)
X`09CALL LIB$SET_CURSOR(17,25)
X`09CALL STROUT('S: Sentry',0)
X`09CALL LIB$SET_CURSOR(18,25)
X`09CALL STROUT('U: Go land to refuel',0)
X`09CALL LIB$SET_CURSOR(19,25)
X`09CALL STROUT('?: Display function',0)
XC
X`09CALL LIB$SET_CURSOR(4,49)
X`09CALL STROUT('QWE: Cursor',0)
X`09CALL LIB$SET_CURSOR(5,49)
X`09CALL STROUT('A D  direction',0)
X`09CALL LIB$SET_CURSOR(6,49)
X`09CALL STROUT('ZXC',0)
XC`09CALL LIB$SET_CURSOR(8,49)
XC`09CALL STROUT('G: Sleep til full T,C',0)
X`09CALL LIB$SET_CURSOR(9,49)
X`09CALL STROUT('H: This text',0)
X`09CALL LIB$SET_CURSOR(10,49)
X`09CALL STROUT('I: Set direction',0)
X`09CALL LIB$SET_CURSOR(11,49)
X`09CALL STROUT('K: Wake anything',0)
X`09CALL LIB$SET_CURSOR(12,49)
X`09CALL STROUT('M: Set path start',0)
X`09CALL LIB$SET_CURSOR(13,49)
X`09CALL STROUT('N: Set path end',0)
X`09CALL LIB$SET_CURSOR(14,49)
X`09CALL STROUT('O: Exit Edit mode',0)
X`09CALL LIB$SET_CURSOR(15,49)
X`09CALL STROUT('P: Change sector',0)
X`09CALL LIB$SET_CURSOR(16,49)
X`09CALL STROUT('R: Random for armies',0)
X`09CALL LIB$SET_CURSOR(17,49)
X`09CALL STROUT('S: Sentry ',0)
X`09CALL LIB$SET_CURSOR(18,49)
X`09CALL STROUT('Y: Set city production',0)
X`09CALL LIB$SET_CURSOR(19,49)
X`09CALL STROUT('?: Display function',1)
X`09CALL STROUT('Piece---Yours-Enemy-Moves-Hits-Cost
X`091`09Piece---Yours-Enemy-Moves-Hits-Cost',1)
X`09CALL STROUT('Army        A a       1    1     5
X`091`09Transport   T t       2    3    30',1)
X`09CALL STROUT('Fighter     F f       4    1    10
X`091`09Cruiser     R r       2    8    50',1)
X`09CALL STROUT('Destroyer   D d       2    3    20
X`091`09Carrier     C c       2    8    60',1)
X`09CALL STROUT('Submarine   S s       2    2    25
X`091`09Battleship  B b       2   12    75',0)
XC
X`09RETURN
X`09END
XC`20
X`09FUNCTION EXPL
XC`20
XC THIS SUBROUTINE SEARCHES FOR UNKNOWN TERRITORY AND RETURNS A VALUE
XC IN EXPL.
XC`20
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09IF (FULL.EQ.2) GOTO 300
X`09BEGPOS=START
X`09GOTO 200
X100`09IF ((EMAP(POSIT).EQ.' ').AND.(ORDER(POSIT).EQ.0)) GOTO 400
X200`09POSIT=POSIT+STEP
X`09IF (POSIT.LT.5900) GOTO 100
X`09START=START+1
X`09POSIT=START
X`09IF (START.EQ.BEGPOS+37) GOTO 300
X`09GOTO 100
X300`09EXPL=0
X`09FULL=2
XC`09CALL LIB$SET_CURSOR(1,1)
XC`09TYPE 999,POSIT,STEP,START,BEGPOS,KNOWN
XC999`09FORMAT('+POSIT,STEP,START,BEGPOS,KNOWN:',5I5$)
X`09RETURN
X400`09EXPL=POSIT
X`09RETURN
X`09END
XC`20
X`09FUNCTION IPORT(Z6)
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09IPORT=0
X`09ID=500
X`09DO 100 I=1,70
X`09IF (X(I).EQ.0) GOTO 100
X`09IF (RMAP(X(I)).NE.'X') GOTO 100
X`09IF (EDGER(X(I)).EQ.0) GOTO 100
X`09IF (IDIST(X(I),Z6).GE.ID) GOTO 100
X`09IPORT=X(I)
X`09ID=IDIST(X(I),Z6)
X100`09CONTINUE
X`09IF (IPORT.NE.0) RETURN
X`09IPORT=RND(5798)+102
X`09RETURN
X`09END
XC`20
X`09INTEGER FUNCTION HITS(OWN)
X`09IMPLICIT INTEGER(A-Z)
X`09INTEGER B(8)
X`09BYTE ATYP(8),OWN
X`09DATA ATYP/'A','F','D','S','T','R','C','B'/
X`09DATA B/ 1 , 1,  3,  2,  3,  8,  8, 12 /
XC
X`09HITS=0
X`09DO 100 I=1,8
X`09IF (OWN.EQ.ATYP(I)) GOTO 200
X100`09CONTINUE
X`09RETURN
X200`09HITS=B(I)
X`09RETURN
X`09END
XC`20
X`09FUNCTION ATTACK(OWN1,OWN2,IH1,AGGR)
X`09IMPLICIT INTEGER(A-Z)
X`09BYTE OWN1,OWN2
XC
X`09H1=IH1
X`09C1=COST(OWN1,H1)
X`09C2=COST(OWN2,0)
X`09S1=1
X`09S2=1
X`09IF (OWN1.EQ.'s') S1=3
X`09IF (OWN2.EQ.'S') S2=3
X`09H2=HITS(OWN2)
X`09H1=(H1+S2-1)/S2
X`09H2=(H2+S1-1)/S1
X`09ATTACK=(((C2*100)*H1)/H2)-(C1*100)+(AGGR*100)
X`09RETURN
X`09END
XC`20
X`09FUNCTION COST(OWN,H)
X`09IMPLICIT INTEGER(A-Z)
X`09INTEGER COSVAL(14)
X`09BYTE`09COSTAB(14),OWN
X`09DATA COSVAL/0,2,4,6,3,5,4,1,3,3,7,5,11,11/
X`09DATA COSTAB/'F','D','S','T','R','C','B',
X`091`09`09`09    'f','d','s','t','r','c','b'/
X`09DO 100 I=1,14
X100`09IF (OWN.EQ.COSTAB(I)) GOTO 200
X`09PAUSE 'BAD CALL TO FUNCTION COST!'
X`09COST=0
X`09RETURN
X200`09COST=COSVAL(I)
X`09IF (I.GE.9)COST=COST-H
X`09RETURN
X`09END
XC`20
X`09FUNCTION POSCHK(Z6,OWN)
XC
XC DETERMINES IF Z6 IS IN CURRENT UPDATE SECTOR SHOWING
XC`090=NO, 1=YES
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
X`09INTEGER LOWSCRS(5),HIGHSCRS(5)
X`09DATA LOWSCRS/1,14,24,34,44/
X`09DATA HIGHSCRS/15,25,35,45,58/
XC
X`09IF (MODE.EQ.1) GOTO 100
X`09POSCHK=1
X`09GOTO 400
X100`09JECT=JECTOR
X`09POSCHK=0
X`09IY=(Z6-1)/100
X`09IX=Z6-IY*100
X`09ADJUST=1
X`09IF (OWN.EQ.'F') ADJUST=0
X`09IF (JECT.GT.4) GOTO 200
X`09IF (IX.GT.(SWIDTH-5+ADJUST)) GOTO 400
X`09GOTO 300
X200`09IF (IX.LT.(100-(SWIDTH-5)-ADJUST)) GOTO 400
X`09JECT=JECT-5
X300`09IF ((IY.LT.(LOWSCRS(JECT+1)-ADJUST)).OR.
X`091   (IY.GT.(HIGHSCRS(JECT+1)+ADJUST))) GOTO 400
X`09POSCHK=1
X400`09RETURN
X`09END
XC`20
X`09FUNCTION SCRCHK(Z6)
XC
XC DETERMINES IF Z6 IS IN CURRENT SCREEN SECTOR SHOWING
XC`090=NO, 1=YES
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09IF (MODE.EQ.1) GOTO 100
X`09SCRCHK=1
X`09GOTO 400
X100`09JECT=JECTOR
X`09SCRCHK=0
X`09IY=(Z6-1)/100
X`09IX=Z6-IY*100
X`09IF (JECT.GT.4) GOTO 200  !CHECK X COORD FIRST
X`09IF (IX.GT.SWIDTH) GOTO 400
X`09GOTO 300
X200`09IF (IX.LT.(100-SWIDTH)) GOTO 400
X`09JECT=JECT-5
X300`09IF ((IY.LT.(JECT*10)).OR.(IY.GT.(JECT*10+19))) GOTO 400
X`09SCRCHK=1`09`09`09!PASSED, IT'S GOOD
X400`09RETURN
X`09END
X`0C
X`09SUBROUTINE PROD(AHITS,Z6,ALIMIT,ACRAHIT,
X`091`09`09ACRALOC,ALOPMAX,AAR2S,J,ARANGE)
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
X`09INTEGER AAR2S(500),ARANGE(200)
XC
X`09DO 1000 I=ACRALOC+1,ALOPMAX+ACRALOC
X`09IF (RLMAP(I).NE.0) GOTO 1000
X`09IF (I.GT.ALIMIT+ACRALOC) ALIMIT=I-ACRALOC
X`09RLMAP(I)=Z6
X`09IF (AHITS.GT.1) J1TS(ACRAHIT+I-ACRALOC)=AHITS
X`09IF (J.GT.1) MYCODE(I)=0
X`09IF (J.LT.2) CODEFU(I-1500)=0
X`09IF (J.LT.2) CODELA(I-1500)=0
X`09IF (J.EQ.1) AAR2S(I-1500)=0
X`09IF (ACRALOC.EQ.2000) ARANGE(I-2000)=20
X`09IF (J.EQ.3) ARANGE(I-500)=20
X`09GOTO(100,200,300,400,500,600,700,800,900) J
X100`09RETURN
X200`09CALL STROUT('n Army',1)
X`09RETURN
X300`09CALL STROUT(' Fighter',1)
X`09RETURN
X400`09CALL STROUT(' Destroyer',1)
X`09RETURN
X500`09CALL STROUT(' Submarine',1)
X`09RETURN
X600`09CALL STROUT(' Troop Transport',1)
X`09RETURN
X700`09CALL STROUT(' Cruiser',1)
X`09RETURN
X800`09CALL STROUT(' Aircraft Carrier',1)
X`09RETURN
X900`09CALL STROUT(' Battleship',1)
X`09RETURN
X1000`09CONTINUE
X`09RETURN
X`09END
XC
X`09SUBROUTINE ARMCNT
XC
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09DO 100 I=1,20
X100`09ARMTOT(I)=0
X`09DO 300 I=1,LIMIT(9)
X`09IF (CODEFU(I).NE.1) GOTO 300
X`09ILA=CODELA(I)
X`09DO 200 I2=1,20
X200`09IF (TARGET(I2).EQ.ILA) ARMTOT(I2)=ARMTOT(I2)+1
X300`09CONTINUE
X`09RETURN
X`09END
XC`20
X`09FUNCTION ARMJMP(Z6,AR2SC)
XC`20
XC THIS SUBROUTINE DETERMINES WHETHER OR NOT AN ARMY SHOULD GET OFF
XC THE TROOP TRANSPORT IT IS ON. 0=NO, 1=YES
XC`20
X`09INCLUDE 'EMPIRE.INC/NOLIST'
XC
X`09ARMJMP=0
X`09DO 100 I=1,8
X100`09IF (OMAP(Z6+IARROW(I+1)).NE.'.') GOTO 200`09!** NOT ALL SEA SURROUND
X`09RETURN
XC`20
X200`09IF (AR2SC.EQ.0) GOTO 400`09`09!BEEN ON TROOP TRANSPORT
XC`09`09`09`09`09`09!FOR A LONG TIME
X`09DO 300 I=1,8
X`09LOC=Z6+IARROW(I+1)`09`09`09!**
X`09IF (OMAP(LOC).EQ.'.') GOTO 300
X`09IF (ORDER(LOC).NE.0) GOTO 300
X`09AB=RMAP(LOC)
X`09IF ((AB.EQ.'A').OR.(AB.EQ.'F')) GOTO 400
X`09IF ((AB.EQ.'*').OR.(AB.EQ.'O')) GOTO 400
+-+-+-+-+-+-+-+-  END  OF PART 9 +-+-+-+-+-+-+-+-