SUBROUTINE EDIT(Z5) C C EDIT MODE COMMAND SUBROUTINE C TEST ROUTINES FOR PATH C INCLUDE 'EMPIRE.INC/NOLIST' C Z6=Z5 WHTFLG=0 MOVFLG=0 OLDJ=JECTOR CALL MAP(5) CALL SECTOR(PMAP(1)) 100 LINE=KLINE(KI,JECTOR) IADJST=LINE+KI-300 IF (Z6.EQ.0) Z6=IADJST+1240 DIR=1 200 CALL CURSOR(Z6-IADJST) E=GETCHX() Z7=Z6 DO 300 I=1,8 300 IF (E.EQ.COMM(I)) Z6=Z6+IARROW(I+1) !IF CURSOR MOVE, CHANGE LOCATION IF ((SCRCHK(Z6).EQ.1).AND.(ORDER(Z6).EQ.0)) GOTO 400 Z6=Z7 !IF NOT ON SCREEN, GET BACK GOTO 4500 400 IF (Z6.EQ.Z7) GOTO 500 GOTO 200 500 DO 600 I=10,30 J=I 600 IF (E.EQ.COMM(I)) GOTO 700 GOTO 4500 C L, B, F, T, G, V, J, U,-1,-1 PRIV CMDS C700 IF (PASS) GOTO (800,900,1000,1100,1200,1400,1500,1600,1700,1800) J-9 C O, P, R, I, M, K, N, S, ?, Y, H NORMAL CMDS 700 CALL MAP(2) GOTO (1300,1900,4300,2100,2500,2700,2900,3100,3200,4200,4400) J-19 GOTO 4500 C C800 ISEC=-1 !N - DISPLAY ENEMY SECTOR C CALL SECTOR(EMAP(1)) C GOTO 200 C C900 BEG=Z6 !B - SET BEG C IX='B' C TYPE 999,IX 999 FORMAT('+',A1,$) C GOTO 200 C C1000 END=Z6 !F - SET END C IX='E' C TYPE 999,IX C GOTO 200 C C1100 FLAG=1000 !T - SINGLE STEP & TRACE PATH C CALL PATH(BEG,END,DIR,OKC,FLAG) C GOTO 200 C C1200 FLAG=1001 !G - SHOW PATH CHOSEN C CALL PATH(BEG,END,DIR,OKC,FLAG) C GOTO 200 C 1300 CONTINUE !O - RETURN TO CALLER JECTOR=OLDJ !RESTORE SECTOR NUMBER LINE=KLINE(KI,JECTOR) IADJST=LINE+KI-300 CALL MAP(5) CALL SECTOR(PMAP(1)) ! REFRESH OUR MAP RETURN C C1400 DIR=-DIR !V - REVERSE DIRECTION C GOTO 200 C C1500 H2=30 !J - DISPLAY CODE VALUES FOR C OWN2=RMAP(Z6) ! ENEMY UNITS C IF (OWN2.LT.'a' .OR. OWN2.GT.'9') GOTO 4500 C CALL FIND(OWN2,Z6,Z8,H2) C CALL LIBCUR(1,50) C CALL STROUT(' Code:',2) C TYPE 998,CODEFU(Z8-1500),CODELA(Z8-1500) C998 FORMAT('+ ',2I6,1X$) C GOTO 200 C C1600 ISEC=-1 !U - DISPLAY REFERENCE SECTOR C CALL SECTOR(RMAP(1)) C GOTO 200 C C1700 CONTINUE ! SHOULDN'T HAPPEN C1800 CONTINUE C STOP C C P: PRINT OUT NEW SECTOR C 1900 ISEC=-1 CALL LIBCUR(2,40) CALL STROUT(' New Sector:',12) JECTOR=IPHASE(GETCHX()) IF (JECTOR.LT.0.OR.JECTOR.GT.9) GOTO 1900 CALL MAP(5) CALL SECTOR(PMAP(1)) ISEC=-1 Z6=0 GOTO 100 C C R: PRINT OUT THE ROUND NUMBER C C2000 CALL LIBCUR(2,50) C CALL STROUT(' Round #',12) C CALL DECPRT(MDATE) C CALL EOL C GOTO 200 C C I: DIRECTIONAL STASIS C 2100 AB=RMAP(Z6) IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 4500 E=GETCHX() DO 2200 I=1,8 J=I 2200 IF (COMM(I).EQ.E) GOTO 2300 GOTO 4500 2300 IF (AB.NE.'O') GOTO 2400 FIPATH(CITFND(Z6))=J+6100 GOTO 200 2400 H2=30 CALL FIND(AB,Z6,MOVFLG,H2) CALL MAP(7) MYCODE(MOVFLG)=J+6100 GOTO 200 C C M: SAY WE WANT TO MOVE TO A LOCATION C 2500 AB=RMAP(Z6) IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 4500 IF (AB.NE.'O') GOTO 2600 WHTFLG='CI' MOVFLG=CITFND(Z6) GOTO 200 2600 H2=30 CALL FIND(AB,Z6,MOVFLG,H2) WHTFLG='UN' GOTO 200 C C K: WAKE UP ANYTHING AND EVERYTHING C 2700 AB=RMAP(Z6) IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 4500 IF (AB.NE.'O') GOTO 2800 FIPATH(CITFND(Z6))=0 !IF CITY, KILL FLIGHT PATH DO 2750 I=501,1500 !WAKE ANY FIGHTERS OR SHIPS CALL MAP(4) IF (RLMAP(I).NE.Z6) GOTO 2750 CALL MAP(7) MYCODE(I) = 0 C IF (RLMAP(I).EQ.Z6) MYCODE(I)=0 2750 CONTINUE GOTO 200 2800 H2=30 !NOT A CITY, FIND THE UNIT CALL FIND(AB,Z6,MOVFLG,H2) CALL MAP(7) MYCODE(MOVFLG)=0 !ZERO ANY FUNCTION CODE IF (AB.NE.'T') GOTO 2817 !IF TRANSPORT, WAKE ARMIES ABOARD DO 2816 J=1,500 CALL MAP(4) IF (RLMAP(J).NE.Z6) GOTO 2816 CALL MAP(7) MYCODE(J) = 0 2816 CONTINUE C2816 IF (RLMAP(J).EQ.Z6) MYCODE(J)=0 GOTO 200 2817 IF (AB.NE.'C') GOTO 200 !IF CARRIER, WAKE FIGHTERS ABOARD DO 2818 J=501,700 CALL MAP(4) IF (RLMAP(J).NE.Z6) GOTO 2818 CALL MAP(7) MYCODE(J) = 0 2818 CONTINUE C2818 IF (RLMAP(J).EQ.Z6) MYCODE(J)=0 GOTO 200 C C N: GO HERE C 2900 IF (WHTFLG.NE.'CI') GOTO 3000 FIPATH(MOVFLG)=Z6 GOTO 200 3000 IF (WHTFLG.NE.'UN') GOTO 4500 CALL MAP(7) MYCODE(MOVFLG)=Z6 GOTO 200 C C S: GOTO SLEEP C 3100 AB=RMAP(Z6) IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 4500 IF (AB.EQ.'O') GOTO 4500 H2=30 CALL FIND(AB,Z6,MOVFLG,H2) CALL MAP(7) MYCODE(MOVFLG)=50 GOTO 200 C C ?: REQUEST INFO C 3200 AB=RMAP(Z6) IF (AB.EQ.'O') GOTO 3800 C IF ((AB.EQ.'X').AND.(PASS)) GOTO 3800 IF ((AB.GE.'A').AND.(AB.LE.'T')) GOTO 3250 C IF ((AB.GE.'a').AND.(AB.LE.'t').AND.(PASS)) GOTO 3250 GOTO 4500 3250 H2=30 CALL FIND(AB,Z6,MOVFLG,H2) C IF (MOVFLG.LE.1500) THEN DO 3300 I=1,8 3300 IF (AB.EQ. PHAZE(I)) RELNUM=MOVFLG-CRALOC(PHAZEE(I)) CALL HEAD(AB,RELNUM,MOVFLG,Z6,H2) !DISPLAY STANDARD HEADER C ELSE C CALL LIBCUR(1,1) C TYPE 989,MOVFLG,CODEFU(MOVFLG-1500),CODELA(MOVFLG-1500),H2 C989 FORMAT('+ UNIT=',I5,' FUNCTION=',I5,' SUB FUNC=',I5, C 1 ' HITS=',I2,$) C CALL LIBLIN C ENDIF IF ((AB.EQ.'A').OR.(AB.EQ.'F')) GOTO 200 C IF ((AB.EQ.'A').OR.(AB.EQ.'F').OR.(AB.EQ.'a').OR.(AB.EQ.'f')) GOTO 200 C CALL LIBCUR(2,1) !DO HITS FOR SHIPS C CALL STROUT(' Hits left:',10) C CALL DECPRT(H2) C CALL LIBLIN N=0 C BASE=0 C IF (MOVFLG.GT.1500) BASE=1500 IF (AB.NE.'T') GOTO 3500 C IF ((AB.NE.'T').AND.(AB.NE.'t')) GOTO 3500 CALL MAP(4) DO 3400 I=1,500 !COUNT ARMIES 3400 IF (RLMAP(I).EQ.Z6) N=N+1 C3400 IF (RLMAP(I+BASE).EQ.Z6) N=N+1 IF (N.EQ.0) GOTO 3700 CALL LIBCUR(3,1) C IF (MODE.EQ.1) CALL LIBCUR(3,1) CALL DECPRT(N) CALL STROUT(' armies aboard.',1) GOTO 200 3500 CALL MAP(4) IF (AB.NE.'C') GOTO 200 C3500 IF ((AB.NE.'C').AND.(AB.NE.'c')) GOTO 200 DO 3600 I=501,700 !COUNT FIGHTERS 3600 IF (RLMAP(I).EQ.Z6) N=N+1 C3600 IF (RLMAP(I+500+BASE).EQ.Z6) N=N+1 IF (N.EQ.0) GOTO 3700 CALL LIBCUR(3,1) C IF (MODE.EQ.1) CALL LIBCUR(3,1) CALL DECPRT(N) CALL STROUT(' fighters aboard.',1) GOTO 200 3700 CALL LIBCUR(3,1) C3700 IF (MODE.EQ.1) CALL LIBCUR(3,1) !NOTHING THERE CALL STROUT('Nothing aboard.',1) GOTO 200 C C DISPLAY CITIES INFO C 3800 J=CITFND(Z6) !FIND CITY C BASE=0 C IF (OWNER(J).EQ.2) BASE=1500 N=0 CALL MAP(4) DO 3900 I=501,700 C DO 3900 I=BASE+501,BASE+700 !COUNT FIGHTERS 3900 IF (RLMAP(I).EQ.Z6) N=N+1 CALL LIBCUR(2,1) CALL STROUT(' Fighters landed:',10) CALL DECPRT(N) N=0 DO 4000 I=701,1500 C DO 4000 I=BASE+701,BASE+1500 !COUNT SHIPS 4000 IF (RLMAP(I).EQ.Z6) N=N+1 CALL STROUT(' Ships docked:',10) CALL DECPRT(N) CALL LIBLIN 4150 CALL LIBCUR(1,1) !EXPLAIN PRODUCTION CALL STROUT(' City at location:',10) CALL DECPRT(Z6) CALL STROUT(' Producing:',10) DO 4100 I=1,8 4100 IF (PHASE(J).EQ.PHAZEE(I)) TYPE 997,PHAZE(I) 997 FORMAT('+',A1,$) CALL STROUT(' Completion:',10) CALL DECPRT(FOUND(J)) CALL STROUT(' Fpath:',10) IF (FIPATH(J).LT.100) CALL STROUT('sit',0) IF ((FIPATH(J).GT.100).AND.(FIPATH(J).LT.6000)) 1 CALL DECPRT(FIPATH(J)) IF (FIPATH(J).GT.6100) TYPE 997, COMM(FIPATH(J)-6100) CALL LIBLIN GOTO 200 C C Y: ENTER NEW CITY PRODUCTION C 4200 AB=RMAP(Z6) IF (AB.NE.'O') GOTO 4500 J=CITFND(Z6) CALL LIBCUR(2,40) CALL STROUT(' New Production:',13) CALL PHASIN(J,E) TYPE 999,E GOTO 4150 C C R: SET ARMY TO MOVE AT RANDOM C 4300 AB=RMAP(Z6) IF (AB.NE.'A') GOTO 4500 H2=30 CALL FIND(AB,Z6,MOVFLG,H2) CALL MAP(7) MYCODE(MOVFLG)=100 GOTO 200 C C H: GET HELP C 4400 CALL HELP E=GETCHX() ISEC=-1 CALL MAP(5) CALL SECTOR(PMAP(1)) ISEC=-1 GOTO 100 C 4500 CALL HUH GOTO 200 END SUBROUTINE FGHT(Z6,H1,H2,OWN1,OWN2) C INCLUDE 'EMPIRE.INC/NOLIST' C C WRITE (3,1) C1 FORMAT (' START OF FGHT') IF ((OWN2.LT.'A').OR.(OWN2.GT.'T')) GOTO 100 IF (MODE.EQ.1) CALL LIBCUR(2,1) CALL IDEN(OWN2) CALL STROUT('is under attack at',10) CALL DECPRT(Z6) CALL STROUT('.',1) 100 CALL LIBCUR(3,1) S1=1 S2=1 IF ((OWN1.EQ.'S').OR.(OWN1.EQ.'s')) S1=3 IF ((OWN2.EQ.'S').OR.(OWN2.EQ.'s')) S2=3 IF (H2.EQ.0) GOTO 300 200 IF (RND(100).LE.50) GOTO 300 !** H1=H1-S2 H=H2 IF (H1.GT.0) GOTO 200 OWN=OWN1 CALL IDEN(OWN) OWN=OWN2 CALL STROUT('destroyed,',10) GOTO 400 300 H2=H2-S1 H=H1 IF (H2.GT.0) GOTO 200 OWN=OWN2 CALL IDEN(OWN) OWN=OWN1 CALL STROUT('destroyed,',10) 400 CALL IDEN(OWN) CALL STROUT('has',10) CALL DECPRT(H) CALL STROUT(' hits left.',2) C IF (MODE.EQ.0) CALL STROUT(0,1) RETURN END 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 INCLUDE 'EMPIRE.INC/NOLIST' BYTE OKVECT(5) INTEGER BEG1,END1 C BEG1 = BEG END1 = END BACKUP=1 TDIR=DIR ! GET A DIRECTION TO FIDDLE WITH DIR3=TDIR*3 Z6=BEG1 MAXMVE=(2 * IDIST(BEG1,END1))+1 ! COMPUTE MAX MOVES TO GET THERE MOVNUM=MAXMVE 100 DO 200 I=1,100 ! CLEAR G2 ARRAY G2(I)=0 200 CONTINUE C STRGHT: ! TRY STRAIGHT MOVE FIRST 300 MOOVE= MOV(Z6,END1) Z62=Z6+IARROW(MOOVE+1) CALL MAP(1) AB=EMAP(Z62) IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 900 !IF NO GOOD, FOLLOW SHORE C OKSET: ! STRAGHT MOVE WORKING 400 BAKADR=1 C OKMOVE: 500 IF (Z6 .EQ. BEG1) MOVE1=MOOVE Z6=Z62 C IF (FLAG.GE.1000) CALL TEST4(Z6,FLAG,TDIR,MOVE1,MOVNUM,BEG, C 1 END,G2,BAKADR) IF (Z6 .EQ. END1) GOTO 800 ! IF Z6=END, WE'RE DONE C DOMORE: 600 MOVNUM=MOVNUM-1 IF (MOVNUM .EQ. 0) GOTO 700 ! REACHED MAX MOVES, TRY NEW DIRECTION C STRGHT, CHKNXT GOTO (300, 1300), BAKADR ! CONTINUE, IN SAME MANNER C TRYDIR:: 700 DIR3=-DIR3 ! NEGATE CURRENT DIRECTION TDIR=-TDIR IF (TDIR .EQ. DIR) GOTO 1200 ! GIVE UP IF BACK TO START MOVNUM=MAXMVE ! ELSE, TRY AGAIN BACKUP=1 Z6=BEG1 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) ! TRY AGAIN Z62=Z6+IARROW(MOV1+1) CALL MAP(1) AB=EMAP(Z62) IF (COMPAR(AB,Z62,OKVECT).EQ.1) MOV1=MOOVE ! ??? 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 CALL MAP(1) 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(BEG1,END1) FAILUR=FAILUR+1 FLAG=0 RETURN C CHKNXT: 1300 T1=MOV(Z6,END1) Z62=Z6+IARROW(T1+1) CALL MAP(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 C END C FUNCTION COMPAR(AB,Z62,OKVECT) C C USED BY PATH, CHECKS IF AB OR LOCATION Z62 IS A TYPE CONTAINED IN OKVECT C IMPLICIT INTEGER(A-Z) BYTE OKVECT(5),AB BYTE OMAP(6000) COMMON/MAPPED/OMAP C COMPAR = 1 IF (AB .EQ. OKVECT(1)) RETURN CALL MAP(3) IF (OMAP(Z62) .EQ. OKVECT(1)) RETURN IF (AB .EQ. OKVECT(2)) RETURN IF (AB .EQ. OKVECT(3)) RETURN IF (AB .EQ. OKVECT(4)) RETURN IF (AB .EQ. OKVECT(5)) RETURN COMPAR = 0 RETURN END C C SUBROUTINE TEST4(Z6,FLAG,DIR,MOVE1,MOVNUM,BEG,END,AG2,FLAG2) C C TEST SUBROUTINE FOR PATH, DISPLAYS CURRENT PATH PROGRESS C C INCLUDE 'EMPIRE.INC/NOLIST' C INTEGER AG2(100) C C CALL CURSOR(Z6-IADJST) C IF (FLAG.NE.1001) E=GETCHX() !WAIT FOR CHAR IF TRACE MODE C C IX='G' !DISPLAY CURRENT MOVE ON MAP C IF (FLAG2.EQ.1) TYPE 999,IX C IX='H' C IF (FLAG2.EQ.2) TYPE 999,IX C IF (FLAG.EQ.1001) RETURN CC PROCESS THIS CHAR C IF (E.EQ.' ') RETURN !SPACE, CONTINUE C IF (E.EQ.'G') GOTO 100 !G, DISPLAY G2 ARRAY C C CALL LIBCUR(1,1) !IF NOT SPACE OR "G", SHOW PATH VARIABLES C TYPE 998,Z6,MOVE1,MOVNUM C999 FORMAT('+',A1$) C998 FORMAT(' Z6:',I4,' MOVE1:',I1,' MOVNUM:',I3) C CALL LIBCUR(2,1) C TYPE 997,BEG,END,IADJST,DIR,FLAG C997 FORMAT(' BEG:'I4' END:'I4' IADJST:'I4' TDIR:'I2' FLAG:'I4) C C IF (FLAG2 .EQ. 1) TYPE 996 C996 FORMAT(' FLAG2: MOVE ') C IF (FLAG2 .EQ. 2) TYPE 995 C995 FORMAT(' FLAG2: SHORE') CC RETURN C C100 CALL LIBCUR(1,1) C TYPE 994,AG2 C994 FORMAT(1X,16I5) C RETURN C END SUBROUTINE CITYCT C INCLUDE 'EMPIRE.INC/NOLIST' C NUMBER(9)=0 DO 100 I=11,18 100 NUMBER(I)=0 DO 200 I=1,70 IF (OWNER(I).NE.2) GOTO 200 NUMBER(9)=NUMBER(9)+1 IF (PHASE(I).LE.0) GOTO 200 !HANDLES JUST CAPTURED CITY INDEXX=INDEX(PHASE(I)) NUMBER(INDEXX)=NUMBER(INDEXX)+1 200 CONTINUE C C NOW LET NUMBER(10)=LAST FILLED SLOT IN TARGET C DO 300 I=70,1,-1 IF (TARGET(I).EQ.0) GOTO 300 NUMBER(10)=I GOTO 400 300 CONTINUE NUMBER(10)=0 400 RETURN END C SUBROUTINE CITYPH(I) C INCLUDE 'EMPIRE.INC/NOLIST' C C NUMBER(1-8): NUMBERS OF UNITS C NUMBER(11-18): NUMBERS OF CITIES WITH EACH PHASE C NUMBER(9): NUMBER OF CITIES C NUMBER(10): NUMBER OF TARGET CITIES C INT=PHASE(I) IF (PHASE(I).NE.-1) GOTO 100 PHASE(I)=1 GOTO 1400 100 EDGE=EDGER(X(I)) C C IF WE HAVE A PHASE OF 0, MAKE SOMETHING! C IF (PHASE(I).EQ.0) GOTO 600 C C IF CITY IS SURROUNDED BY ARMIES, MAKE SOMETHING ELSE C IF (PHASE(I).NE.1) GOTO 300 CALL MAP(2) DO 200 J=1,8 200 IF (RMAP(X(I)+IARROW(J+1)).EQ.'+') GOTO 300 !** GOTO 600 C C IF CRAFT NUMBERS ARE GETTING GROSSLY LARGE, PRODUCE SOMETHING ELSE C 300 IF (NUMBER(OVRPOP(PHASE(I)+1,1)).GT. 1 OVRPOP(PHASE(I)+1,2)) GOTO 600 !** C IF (EDGE.NE.8) GOTO 400 IF ((NUMBER(9).GT.1).AND.(PHASE(I).EQ.1)) GOTO 1100 IF (NUMBER(9).GT.1) GOTO 1400 IF (NUMBER(5).LT.1) PHASE(I)=6 IF (NUMBER(5).GT.0) PHASE(I)=1 GOTO 1400 C 400 IF (PHASE(I).NE.1) GOTO 600 N=0 DO 500 J=IAR2+1,IAR2+LIMIT(9) CALL MAP(4) Z=RLMAP(J) IF (Z.EQ.0) GOTO 500 IF (IDIST(X(I),Z).GT.6) GOTO 500 CALL MAP(1) IF (EMAP(Z).EQ.'t') GOTO 500 MOVE=PATH(X(I),Z,1,OKA,FLAG) IF (FLAG.EQ.0) GOTO 500 N=N+1 IF ((N.GT.6).AND.(NUMBER(11).GT.1)) GOTO 800 500 CONTINUE IF ((N.GT.3).AND.(NUMBER(11).GT.1)) GOTO 600 GOTO 1400 C C SELECT A NEW PHASE FOR THE CITY C 600 CONTINUE C C IF THERE ARE ENEMY ARMIES ON THE CONTINENT, PRODUCE ARMIES! C IF (EDGE.EQ.8) GOTO 1050 DO 700 J=1,10 IF (LOCI(J,2).EQ.0) GOTO 700 MOVE=PATH(X(I),LOCI(J,2),1,OKA,FLAG) IF (FLAG.EQ.0) GOTO 700 PHASE(I)=1 GOTO 1300 700 CONTINUE C 800 PHASE(I)=2 IF (EDGE.GT.0) GOTO 900 !IF NOT LANDLOCKED IF (NUMBER(1).LE.3*NUMBER(2)) PHASE(I)=1 !IF SMALL .NE. OF ARMIES GOTO 1300 C 900 PHASE(I)=1 N=0 DO 1000 J=IAR2+1,IAR2+LIMIT(9) CALL MAP(4) Z=RLMAP(J) IF (Z.EQ.0) GOTO 1000 IF (IDIST(X(I),Z).GT.6) GOTO 1000 CALL MAP(1) IF (EMAP(Z).EQ.'t') GOTO 1000 !IF ON TROOP TRANSPORT MOVE=PATH(X(I),Z,1,OKA,FLAG) IF (FLAG.EQ.0) GOTO 1000 N=N+1 1000 CONTINUE IF (N.LT.3) GOTO 1300 1050 PHASE(I)=2 IF (NUMBER(2)*2.GT.NUMBER(9)) GOTO 1100 IF ((NUMBER(5).LT.3).AND.(NUMBER(15).LT.2)) GOTO 1100 IF (NUMBER(2)*4.LT.NUMBER(9)) GOTO 1300 IF (INT.EQ.2) GOTO 1300 IF (INT.GT.2) GOTO 1100 IF (RND(100).LT.50) GOTO 1300 C C SELECT A SHIP, GUARANTEEING AT LEAST TWO CITIES PRODUCING TROOP TRANSPORTS C 1100 PHASE(I)=PH(8) DO 1200 J=8,4,-1 1200 IF (NUMBER(J+10).GE.NUMBER(J+9)) PHASE(I)=PH(J-1) IF (INT.GT.2) PHASE(I)=INT IF (NUMBER(17).EQ.0) PHASE(I)=12 IF (NUMBER(15).LT.2) PHASE(I)=6 C 1300 IF ((NUMBER(9).GT.1).AND.(NUMBER(15).EQ.0).AND.(EDGE.GT.0)) 1 PHASE(I)=6 1400 FOUND(I)=5*PHASE(I)+MDATE IF (INT.EQ.PHASE(I)) GOTO 1500 FOUND(I)=6*PHASE(I)+MDATE CALL CITYCT C IF (CODER.NE.9) GOTO 1500 C CALL LIBCUR(2,1) C TYPE 999,X(I),INT,PHASE(I),EDGE C999 FORMAT('+CITY:',I4,' FROM:',I2,' TO:',I2,' EDGE:',I1,3X,$) C CALL GETCHX(E) 1500 RETURN END C SUBROUTINE FIND(OWN,Z6,Z8,H2) C C CROSS-REFERENCE SUBROUTINE, IT FINDS DATA ON WHATEVER C CRAFT IS AT POINT Z6. C INCLUDE 'EMPIRE.INC/NOLIST' C CALL MAP(4) IF (H2.GT.0) GOTO 1100 C C NOW WE MUST DESTROY OWN C FIRST OF ALL, UPDATE TROOPT C ISHP=0 IF (OWN.EQ.'D') ISHP=1 IF (OWN.EQ.'S') ISHP=2 IF (OWN.EQ.'T') ISHP=3 IF (OWN.EQ.'R') ISHP=4 IF (OWN.EQ.'C') ISHP=5 IF (OWN.EQ.'B') ISHP=6 IF (ISHP.EQ.0) GOTO 200 DO 100 Z=1,5 100 IF (TROOPT(ISHP,Z).EQ.Z6) TROOPT(ISHP,Z)=0 C C NOW DESTROY THE CRAFT, SET RLMAP(N)=0 C 200 IF (OWN.NE.'C') GOTO 400 DO 300 Z=1,200 IF (RLMAP(500+Z).NE.Z6) GOTO 300 RLMAP(500+Z)=0 IF (MODE.EQ.1) CALL LIBCUR(2,60) TYPE 999,Z 999 FORMAT('+Fighter #'I3' sunk.'$) 300 CONTINUE C 400 IF (OWN.NE.'T') GOTO 600 DO 500 Z=1,500 IF (RLMAP(Z).NE.Z6) GOTO 500 RLMAP(Z)=0 IF (MODE.EQ.1) CALL LIBCUR(2,60) TYPE 998,Z 998 FORMAT('+Army #'I3' sunk.'$) 500 CONTINUE C 600 IF (OWN.NE.'t') GOTO 800 DO 700 Z=1501,2000 700 IF (RLMAP(Z).EQ.Z6) RLMAP(Z)=0 C 800 IF (OWN.NE.'c') GOTO 1000 DO 900 Z=2001,2200 900 IF (RLMAP(Z).EQ.Z6) RLMAP(Z)=0 C 1000 RLMAP(Z8)=0 IF ((OWN.GE.'a').AND.(OWN.LE.'t')) CALL SONAR(Z6) IF ((OWN.GE.'A').AND.(OWN.LE.'T')) CALL SENSOR(Z6) RETURN C 1100 IF (H2.EQ.30) GOTO 1200 IF ((OWN.EQ.'A').OR.(OWN.EQ.'F').OR.(OWN.EQ.'a').OR.(OWN.EQ.'f')) 1 GOTO 1500 CALL MAP(8) IF ((OWN.GE.'A').AND.(OWN.LE.'T')) J1TS(Z8-700)=H2 IF ((OWN.GE.'a').AND.(OWN.LE.'t')) J1TS(Z8-1400)=H2 GOTO 1500 1200 H2=0 IA=1 IF (OWN.EQ.'T') IA=1101 IF (OWN.EQ.'C') IA=1301 IF (OWN.EQ.'a') IA=1501 IF (OWN.EQ.'f') IA=2001 IF (OWN.EQ.'t') IA=2601 IF (OWN.EQ.'c') IA=2801 DO 1300 Z8=IA,3000 1300 IF (RLMAP(Z8).EQ.Z6) GOTO 1400 PAUSE ' ERROR IN SUBROUTINE FIND, "CONTINUE" TO CONTINUE' 997 FORMAT(' ERROR IN SUB. FIND') GOTO 1500 1400 IF ((OWN.EQ.'A').OR.(OWN.EQ.'F').OR.(OWN.EQ.'a').OR.(OWN.EQ.'f')) 1 H2=1 IF (H2.EQ.1) GOTO 1500 CALL MAP(8) IF ((OWN.GE.'A').AND.(OWN.LE.'T')) H2=J1TS(Z8-700) IF ((OWN.GE.'a').AND.(OWN.LE.'t')) H2=J1TS(Z8-1400) 1500 RETURN END C FUNCTION EXPL C C THIS SUBROUTINE SEARCHES FOR UNKNOWN TERRITORY AND RETURNS A VALUE C IN EXPL. C INCLUDE 'EMPIRE.INC/NOLIST' C IF (FULL.EQ.2) GOTO 300 BEGPOS=START GOTO 200 100 CALL MAP(1) IF ((EMAP(POSIT).EQ.' ').AND.(ORDER(POSIT).EQ.0)) GOTO 400 200 POSIT=POSIT+STEP IF (POSIT.LT.5900) GOTO 100 START=START+1 POSIT=START IF (START.EQ.BEGPOS+37) GOTO 300 GOTO 100 300 EXPL=0 FULL=2 C CALL LIBCUR(1,1) C TYPE 999,POSIT,STEP,START,BEGPOS,KNOWN C999 FORMAT('+POSIT,STEP,START,BEGPOS,KNOWN:',5I5$) RETURN 400 EXPL=POSIT RETURN END C INTEGER FUNCTION HITS(OWN) IMPLICIT INTEGER(A-Z) INTEGER B(8) BYTE ATYP(8),OWN DATA ATYP/'A','F','D','S','T','R','C','B'/ DATA B/ 1 , 1, 3, 2, 3, 8, 8, 12 / C HITS=0 DO 100 I=1,8 IF (OWN.EQ.ATYP(I)) GOTO 200 100 CONTINUE RETURN 200 HITS=B(I) RETURN END C FUNCTION COST(OWN,H) IMPLICIT INTEGER(A-Z) INTEGER COSVAL(14) BYTE COSTAB(14),OWN DATA COSVAL/0,2,4,6,3,5,4,1,3,3,7,5,11,11/ DATA COSTAB/'F','D','S','T','R','C','B', 1 'f','d','s','t','r','c','b'/ DO 100 I=1,14 100 IF (OWN.EQ.COSTAB(I)) GOTO 200 PAUSE 'BAD CALL TO FUNCTION COST!' COST=0 RETURN 200 COST=COSVAL(I) IF (I.GE.9)COST=COST-H RETURN END C FUNCTION SCRCHK(Z6) C C DETERMINES IF Z6 IS IN CURRENT SCREEN SECTOR SHOWING C 0=NO, 1=YES C INCLUDE 'EMPIRE.INC/NOLIST' C IF (MODE.EQ.1) GOTO 100 SCRCHK=1 GOTO 400 100 JECT=JECTOR SCRCHK=0 IY=(Z6-1)/100 IX=Z6-IY*100 IF (JECT.GT.4) GOTO 200 !CHECK X COORD FIRST IF (IX.GT.70) GOTO 400 GOTO 300 200 IF (IX.LT.30) GOTO 400 JECT=JECT-5 300 IF ((IY.LT.(JECT*10)).OR.(IY.GT.(JECT*10+19))) GOTO 400 SCRCHK=1 !PASSED, IT'S GOOD 400 RETURN END C FUNCTION MOV(I6,I7) C C RETURNS THE INDEX-1 INTO IARROW FOR THE DIRECTION OF THE MOVE C FROM I6 TO I7 C INCLUDE 'EMPIRE.INC/NOLIST' LOGICAL XMAJOR C IY6=(I6-1)/100 IY7=(I7-1)/100 IX6=I6-(100*IY6) IX7=I7-(100*IY7) IY=IY7-IY6 IX=IX7-IX6 C SCREEN OUT TRIVIAL CASES IF (IX.EQ.0) THEN DIR=SIGN(100,IY) GOTO 100 ENDIF IF (IY.EQ.0) THEN DIR=SIGN(1,IX) GOTO 100 ENDIF C THIS ATTEMPTS A LINE-OF-SIGHT APPROXIMATION C unfortunately a true LOS requires knowing where you came from! C this routine currently tries to keep near a 3 to 1 ratio. DX=ABS(IX) !GET DELTA X DY=ABS(IY) !GET DELTA Y XMAJOR=.TRUE. !ASSUME X IS MAJOR CHANGE IF (DY.GT.DX) THEN ! IF WRONG, SWITCH DX=DY DY=ABS(IX) XMAJOR=.FALSE. ENDIF C ! the divisor determines the slope C ! perfect case would be delta y at start IF (IFIX(FLOAT(DX)/3+.5).GT.DY) THEN !IF MAJOR IS LONG, GO STRAIGHT IF (XMAJOR) THEN DIR=SIGN(1,IX) ELSE DIR=SIGN(100,IY) ENDIF ELSE !OTHERWISE, TAKE DIAGONAL DIR=SIGN(100,IY)+SIGN(1,IX) ENDIF 100 DO 200 I=1,9 !FIND THE INDEX 200 IF (IARROW(I).EQ.DIR) GOTO 300 300 MOV=I-1 !FOR COMPATIBILITY (?) C OLD WAY: FOR HISTORIANS C THIS DOES NOT DO A "TRUE" LINE OF SIGHT, FAVORS DIAGONALS C IF ((IY.LT.0).AND.(IX.GT.0)) MOV=2 C IF ((IY.LT.0).AND.(IX.EQ.0)) MOV=3 C IF ((IY.LT.0).AND.(IX.LT.0)) MOV=4 C IF ((IY.EQ.0).AND.(IX.LT.0)) MOV=5 C IF ((IY.GT.0).AND.(IX.LT.0)) MOV=6 C IF ((IY.GT.0).AND.(IX.EQ.0)) MOV=7 C IF ((IY.GT.0).AND.(IX.GT.0)) MOV=8 C IF ((IY.EQ.0).AND.(IX.GT.0)) MOV=1 C IF ((IX.EQ.0).AND.(IY.EQ.0)) MOV=0 RETURN END SUBROUTINE BLOCK(AMAP) C C THIS SUBROUTINE MAKES A COPY OF MAP II INTO SUPPLIED FILE SPEC C INCLUDE 'EMPIRE.INC/NOLIST' BYTE AMAP(6000) C ISEC=-1 CALL LIBPGE(1,1) JECTOR=-1 CALL STROUT(' Output file:',12) ACCEPT 999,TTY 999 FORMAT(20A1) CALL LIBPGE(1,1) TTY(20)=0 OPEN(UNIT=2,NAME=TTY,ACCESS='SEQUENTIAL',FORM='FORMATTED', 1 STATUS='NEW',ERR=600) DO 500 J=0,5900,100 DO 200 K=100,1,-1 AB=AMAP(K+J) 200 IF (AB.NE.' ') GOTO 300 GOTO 500 300 DO 400 L=1,K 400 G2(L)=AMAP(J+L) WRITE(2,998) (G2(L),L=1,K) 998 FORMAT(1X,100A1) 500 CONTINUE CLOSE(UNIT=2) RETURN 600 TYPE 997,TTY 997 FORMAT (' ERROR, Unable to open output file ',20A1) RETURN END C SUBROUTINE SECTOR(AMAP) C C THIS SUBROUTINE DISPLAY SECTOR JECTOR FROM MAP II C IF ISEC=JECTOR, MAP WILL NOT BE DISPLAYED AGAIN C INCLUDE 'EMPIRE.INC/NOLIST' BYTE AMAP(6000) C IF (JECTOR.EQ.-1) GOTO 200 IF (MODE.NE.1) RETURN IF (ISEC.NE.JECTOR) GOTO 100 IF (NEWRND.EQ.1) GOTO 1300 RETURN 100 ISEC=JECTOR GOTO 300 200 CALL STROUT('Sector?',12) JECTOR=IPHASE(GETCHX()) IF ((JECTOR.LT.0).OR.(JECTOR.GT.9)) GOTO 200 ISEC=JECTOR JECTOR=-1 !LET MAIN KNOW THAT UPDATING SECTOR ISNT USED 300 CALL LIBPGE(1,1) LINE=KLINE(KI,ISEC) LINEFI=LINE+2000 !LINEFI=LINE AFTER LAST LINE OF SECTOR LINEC=LINE-100 !GET SET FOR LINE 400 400 LINEC=LINEC+100 !GOTO NEXT LINE IF (LINEC.GE.LINEFI) GOTO 1000 !CHECK FOR END OF SECTOR KSTART=KI+1 !IF LINE IS BROKEN, KSTART WILL BE MODIFIED 500 DO 600 J=KSTART,KI+70 !KI ITSELF IS NOT IN SECTOR AB=AMAP(J+LINEC) !GET CHARACTER 600 IF (AB.NE.' ') GOTO 700 !FIND FIRST NON-BLANK SPOT GOTO 400 !NO CHARACTERS IN THIS LINE 700 KINIT=J !AB IS ALREADY CALCULATED G2(J)=AB !AVOIDS REPITITION DO 800 J=KINIT+1,KI+70 !LOOK FOR BLANK CHARACTER AB=AMAP(J+LINEC) !GET CHARACTER IF (AB.EQ.' ') GOTO 900 !EXIT LOOP IF BLANK 800 G2(J)=AB !PUT CHAR. STRING IN AN ARRAY 900 KFINAL=J-1 !SET END OF CHAR. STRING CALL CURSOR(KINIT-LINE+LINEC-KI+300) !POSITION CURSOR TYPE 999,(G2(J),J=KINIT,KFINAL) 999 FORMAT('+',A1,$) IF (KFINAL.GE.KI+70) GOTO 400 !NEXT LINE KSTART=KFINAL+1 !LOOK AT REST OF LINE GOTO 500 1000 KURSOR=2300 DO 1100 I=KI,KI+70,10 !PRINT X COORDINATES CALL CURSOR(KURSOR) CALL DECPRT(I) KURSOR=KURSOR+10 1100 CONTINUE C KURSOR=372 DO 1200 I=LINE/100,LINE/100+19,2 !PRINT Y COORDINATES CALL CURSOR(KURSOR) CALL DECPRT(I) KURSOR=KURSOR+200 1200 CONTINUE C CALL LIBCUR(5,78) TYPE 998,'S',10,8,'e',10,8,'c',10,8,'t',10,8,'o',10,8,'r',10,10,8, 1 ISEC,10,10,10,8,'R',10,8,'o',10,8,'u',10,8,'n',10,8,'d' 998 FORMAT('+',$,19A1,I1,17A1) 1300 CALL LIBCUR(20,79) K=0 DO 1400 I=3,0,-1 J=MDATE/(10**I) IF (K.EQ.0.AND.J.EQ.0) GOTO 1400 K=1 TYPE 997,10,8,MOD(J,10) 997 FORMAT('+',$,2A1,I1) 1400 CONTINUE C NEWRND=0 CALL LIBCUR(1,1) !SET CURSOR TO BEG. OF SCREEN RETURN END C SUBROUTINE IDEN(OWN) C INCLUDE 'EMPIRE.INC/NOLIST' C IF ((OWN.GE.'a').AND.(OWN.LE.'t')) CALL STROUT('Enemy',10) IF ((OWN.LE.'T').AND.(OWN.GE.'A')) CALL STROUT('Your',10) IF ((OWN.EQ.'A').OR.(OWN.EQ.'a')) GOTO 100 IF ((OWN.EQ.'F').OR.(OWN.EQ.'f')) GOTO 200 IF ((OWN.EQ.'D').OR.(OWN.EQ.'d')) GOTO 300 IF ((OWN.EQ.'S').OR.(OWN.EQ.'s')) GOTO 400 IF ((OWN.EQ.'T').OR.(OWN.EQ.'t')) GOTO 500 IF ((OWN.EQ.'R').OR.(OWN.EQ.'r')) GOTO 600 IF ((OWN.EQ.'C').OR.(OWN.EQ.'c')) GOTO 700 C C THEN IT IS A BATTLESHIP! C CALL STROUT('Battleship',10) RETURN 100 CALL STROUT('Army',10) RETURN 200 CALL STROUT('Fighter',10) RETURN 300 CALL STROUT('Destroyer',10) RETURN 400 CALL STROUT('Submarine',10) RETURN 500 CALL STROUT('Troop Transport',10) RETURN 600 CALL STROUT('Cruiser',10) RETURN 700 CALL STROUT('Aircraft Carrier',10) RETURN END C SUBROUTINE HEAD(OWN1,Y,NUM,Z6,H1) C INCLUDE 'EMPIRE.INC/NOLIST' C CALL LIBCUR(1,1) CALL IDEN(OWN1) CALL DECPRT(Y) CALL STROUT(' at',10) CALL DECPRT(Z6) CALL LIBLIN CALL MAP(7) CALL STSOUT(MYCODE(NUM)) IF (OWN1 .EQ. 'F') THEN CALL LIBCUR(1,60) CALL STROUT('Range:',10) CALL MAP(8) CALL DECPRT(RANGE(Y)) ENDIF IF ((OWN1.NE.'F').AND.(OWN1.NE.'A')) THEN CALL LIBCUR(1,60) CALL STROUT('Hits left:',10) CALL DECPRT(H1) ENDIF RETURN END C SUBROUTINE STSOUT(MYCOD) C C DISPLAY MYCOD FUNCTION IN ENGLISH C INCLUDE 'EMPIRE.INC/NOLIST' C CALL LIBCUR(1,40) CALL STROUT('Function:',10) IF (MYCOD.LT.6100) GOTO 200 IF (MYCOD.EQ.9997) THEN !=9997, FILL FUNCTION CALL STROUT('Fill',13) GOTO 300 ENDIF DO 100 I=6101,6108 100 IF (I.EQ.MYCOD) TYPE 999,COMM(I-6100) !6101<=MYCOD<=6108, DIRECTION 999 FORMAT('+',A1,$) GOTO 300 200 IF (MYCOD.GT.100) THEN !100