PROGRAM EMPIRE C C This program is a war game simulation for video terminals. C The game was originally written outside of Digital, probably a university. C This version of the game was made runnable on Digital Equipment VAX/VMS C FORTRAN by conversion from the TOPS-10/20 sources available around fall 1979. C After debugging it, numerous changes have been made. C C Now that you are the proud owner of the source and you are all gung ho C to do things right, there are a few things you should be aware of. C Unfortunately, there are many magic numbers controlling how many different C kinds of units can exist and how many of each, so think well before you C attempt to add another unit type. Also, "slight changes" to the way the units C work will typically have a fairly devastating affect on the computers C strategy. If you are interested in really hacking this, there is a plenty C of room for enhanced computer strategy. As you'll see, there are some C very good debugging tools tucked inside, and you will soon discover weak C points and bugs, that up until you, have remained problems (all the previous C programmers got lazy or lost interest). Finally, please be careful with C the version number and identification at start up to avoid confusion of C ongoing versions with private copies. If you make a change don't remove C the major version id, but rather add something like (V4.0 site.1 20-JUL-80). C INCLUDE 'EMPIRE.INC/NOLIST' COMMON /SEEDS/ SEED1,SEED2 INTEGER CSEED1(5) BYTE ODOR(2) EQUIVALENCE (ODOR(1),ORDERS) C WIN=0 !** NCYCLE=1 PASS=.FALSE. AUTOMV=.FALSE. C CALL STTRM CALL LIBPGE(1,1) C C GET THE RANDOM NUMBERS GOING. C CALL TIME(CSEED1) LPCNT = CSEED1(1)+CSEED1(2)+CSEED1(3)+CSEED1(4) IF (LPCNT .LT. 0) LPCNT=-LPCNT DO 5 I=1,LPCNT Q=RAN(SEED1,SEED2) 5 CONTINUE C TYPE 999 999 FORMAT(1X,//////////////) TYPE 998 998 FORMAT(' EMPIRE, Version 4.0 (RSX-11) 11-May-83'/) C TYPE 997 C997 FORMAT(' Please send bug reports to ELROND::EMPIRE'/) C TYPE 996 C996 FORMAT(' Known bugs/restrictions'/ C 1' None'/ C 9) CALL STROUT('Detailed directions are in EMPIRE.DOC',1) C C -1/0/1 = RESTORE/START/SAVE GAME C CALL GAME(-1,NUM) !Try to restore a previous game C C COMMAND LOOP STARTS HERE. C 100 IF (AUTOMV) GOTO 4200 !Don't ask if in auto move CALL LIBCUR(1,1) CALL STROUT('Your orders? ',13) ACCEPT 995, ORDERS 995 FORMAT(A2) C SPECIAL HACK FOR JE COMMAND IF ((ODOR(1).GE.'a').AND.(ODOR(1).LE.'z')) ODOR(1)=ODOR(1)-32 IF ((ODOR(2).GE.'a').AND.(ODOR(2).LE.'z')) ODOR(2)=ODOR(2)-32 IF ((SPECAL).AND.(ORDERS.EQ.'JE')) GOTO 3900 C LOOKUP COMMAND DO 200 I=1,20 200 IF (ORDERS.EQ.COMSCN(I)) GOTO 300 C IF (PASS) GOTO 2200 GOTO 100 C M,N,O,S,T,V,P,Y,C, L, H, J, 1, R, @, Q , +, A 300 CALL MAP(5) GOTO (4200,500,4200,700,800,900,1000,1100,5200,1100, 1 1400,1500,4100,1700,1800,1900,3700,2100) I GOTO 100 C400 GOTO 4200 !M - MOVE MODE 500 CALL LIBCUR(2,1) !N - FREE ENEMY MOVES CALL STROUT('Number of free enemy moves:',12) ACCEPT 993,NCYCLE GOTO 5300 C600 GOTO 4200 !O - MOVE MODE (SYNOMN FOR M) 700 CALL LIBPGE(1,1) !S - CLEAR THE SCREEN ISEC=-1 GOTO 100 800 CALL BLOCK(PMAP(1)) !T - PRINT OUT MAP GOTO 100 900 CALL GAME(+1,0) !V - SAVE GAME CALL STROUT('Game Saved.',1) GOTO 100 1000 CALL SECTOR(PMAP(1)) !P - PRINT OUT A SECTOR GOTO 100 1100 CALL DIREC !Y - ERROR MSG GOTO 100 C1200 GOTO 5200 !C - GIVE ONE FREE ENEMY MOVE C1300 CALL DIREC !L - ERROR MSG C GOTO 100 1400 CALL HELP !H - HELP ISEC=-1 GOTO 100 1500 MODE=1 !J - EDIT MODE Z6=0 CALL EDIT(Z6) GOTO 100 C1600 MODE=0 !1 - SET MODE=0 C JECTOR=-1 C GOTO 100 1700 CALL LIBCUR(3,40) !R - DISPLAY ROUND NUMBER CALL STROUT(' Round #',2) TYPE 994,MDATE 994 FORMAT('+',I4,1X,$) GOTO 100 1800 CALL GAME(-1,NUM) !@ - RESTORE GAME IF (NUM.NE.0) GOTO 5200 !** GOTO 100 1900 CALL LIBCUR(2,1) !Q - QUIT CALL STROUT(' QUIT- Are you sure? ',2) E=GETCHX() IF (E.NE.'Y' .AND. E.NE.'y') GOTO 100 CALL LIBPGE(1,1) CALL EXIT C2000 E=GETCHX() !+ - TURN ON PASS C IF (E.EQ.'+') PASS=.TRUE. C IF (E.EQ.'-') PASS=.FALSE. ! OR OFF C GOTO 100 2100 AUTOMV=.TRUE. !A - TURN ON AUTO MOVE MODE GOTO 4200 C C2200 DO 2300 I=21,40 !DEBUGGING COMMANDS C2300 IF (ORDERS.EQ.COMSCN(I)) GOTO 2400 C GOTO 100 C LO,NU,LI,TR,AR,TA,PA,A1,T3,A0,CO,CH,Q0, Q1,JE,CY,EX C2400 GOTO (2500,2600,2700,2800,2900,3000,3100,3200,3300, C 1 3400,3500,3600,3700,3800,3900,4000,4100) I-20 C GOTO 100 C C2500 TYPE 986, ((LOCI(I,J),J=1,11),I=1,10) !LO - C GOTO 100 C C2600 TYPE 989,NUMBER !NU - C GOTO 100 C C2700 TYPE 991, LIMIT !LI - C GOTO 100 C C2800 TYPE 990,TROOPT !TR - C GOTO 100 C C2900 TYPE 989,ARMTOT !AR - C GOTO 100 C C3000 TYPE 989,TARGET !TA - C GOTO 100 C C3100 TYPE 988, SUCCES,FAILUR !PA - C GOTO 100 C C3200 CALL BLOCK(RMAP(1)) !A1 - PRINT REFERENCE MAP C GOTO 100 C C3300 GOTO 100 !T3 - IGNORED C C3400 CALL BLOCK(EMAP(1)) !A0 - PRINT COMPUTER'S MAP C GOTO 100 C C3500 ACCEPT 993,I1 !CO - C ACCEPT 993,I2 993 FORMAT(I) C TYPE 987, (CODEFU(J),CODELA(J),J=I1,I1+I2) C GOTO 100 C C3600 ACCEPT 985,CODER !CH - SET CODER VARIABLE C GOTO 100 C 3700 ISEC=-1 !Q0 - DISPLAY ENEMY MAP SECTOR CALL LIBCUR(1,40) CALL STROUT('Sector?',12) JECTOR=IPHASE(GETCHX()) CALL MAP(1) CALL SECTOR(EMAP(1)) GOTO 100 C C3800 ISEC=-1 !Q1 - DISPLAY REFERENCE MAP SECTOR C CALL LIBCUR(1,40) C CALL STROUT('Sector?',12) C JECTOR=IPHASE(GETCHX()) C CALL MAP(2) C CALL SECTOR(RMAP(1)) C GOTO 100 C 3900 ISEC=-1 JECTOR=IPHASE(GETCHX()) !JE - DISPLAY ENEMY SECTOR OF CHOICE IF (JECTOR.LT.0.OR.JECTOR.GT.9) GOTO 3900 CALL MAP(1) CALL SECTOR(EMAP(1)) ISEC=-1 GOTO 100 C C4000 GOTO 100 !CY - IGNORED C 4100 EX=EXPL() !EX - DISPLY EXPLORE FUNCTION VALUE TYPE 992,EX GOTO 100 C 992 FORMAT('+EXP VALUE:',I5$) C991 FORMAT(1X,8I4) C990 FORMAT(1X,5I6) C989 FORMAT(1X,10I5) C988 FORMAT(' SUCCESS:',I6,' FAILURE:',I6) C987 FORMAT(1X,10I7) C986 FORMAT(11I5) C985 FORMAT(I) C C BEGIN MOVEMENT C C USER MOVE C 4200 CONTINUE C IF (MODE.EQ.0) GOTO 4400 IF (JECTOR.NE.-1) GOTO 4300 CALL LIBPGE(1,1) JECTOR=0 ISEC=-1 4300 ISTART=ISEC IF (ISEC.LT.0) ISTART=0 4400 CALL MAP(8) DO 4500 I=1,1500 4500 MOVEDFLAG(I)=0 DO 4700 JECT=ISTART,ISTART+9 C IF (MODE .EQ. 0) GOTO 4600 JECTOR=JECT IF (JECT.GT.9) JECTOR=JECT-10 LINE=KLINE(KI,JECTOR) IADJST=LINE+KI-300 4600 CALL SHIPMV(ITT,ITTH,5,'T',3) CALL SHIPMV(ICA,ICAH,7,'C',8) CALL SHIPMV(IBA,IBAH,8,'B',12) CALL SHIPMV(ICR,ICRH,6,'R',8) CALL SHIPMV(ISU,ISUH,4,'S',2) CALL SHIPMV(IDE,IDEH,3,'D',3) CALL ARMYMV CALL FIGHMV C IF (MODE.EQ.0) GOTO 4800 4700 CONTINUE 4800 CONTINUE C C HARDWARE PRODUCTION C DO 5100 Y=1,70 IF (OWNER(Y).NE.1) GOTO 5100 IF (PHASE(Y).EQ.14) GOTO 5100 CALL SENSOR(X(Y)) IF (PHASE(Y).EQ.8) GOTO 4900 IF ((PHASE(Y).LT.1).OR.(PHASE(Y).GT.15)) GOTO 4900 IF (MOD(PHASE(Y),2).EQ.0) GOTO 5000 IF (MOD(PHASE(Y),5).EQ.0) GOTO 5000 IF (PHASE(Y).EQ.1) GOTO 5000 C C CITY PHASE INCORRECT OR WE JUST TOOK IT C 4900 CALL LIBCUR(1,1) ISEC=-1 TYPE 984,X(Y) 984 FORMAT(' City at',I5) C I1=MODE C MODE=0 CALL LTR(X(Y),0) C MODE=I1 CALL STROUT('What are your production demands for this city? ',13) CALL PHASIN(Y,E) TYPE 977,E 977 FORMAT ('+',A1,$) GOTO 5100 5000 IF (MDATE.LT.FOUND(Y)) GOTO 5100 FOUND(Y)=MDATE+PHASE(Y)*5 CALL LIBCUR(3,1) CALL STROUT('City #',10) CALL DECPRT(Y) CALL STROUT(' at',10) CALL DECPRT(X(Y)) CALL STROUT(' has completed a',0) K=PHASE(Y) CD TYPE 983, HITS(K),X(Y),TIPE(K),CRAHIT(K),CRALOC(K), CD 1 LOPMAX(K),K CD983 FORMAT(' HITS:',I5,' X(Y):',I5,' TIPE(K):',I5,' CRAHIT(K):',I5,/ CD 1 ,' CRALOC(K):',I5,' LOPMAX(K):',I5,' K:',I) CALL PROD(HITS(K),X(Y),LIMIT(TIPE(K)),CRAHIT(K),CRALOC(K), 1 LOPMAX(K),TIPE(K)+1,0) 5100 CONTINUE 5200 CONTINUE C C COMPUTER MOVE C 5300 CONTINUE D CALL PME_INIT DO 5500 I=1,NCYCLE C CALL ARMCNT CALL TROOPM C CALL LIBCUR(1,1) CALL STROUT('... My turn, thinking ...',3) C CALL ARMYEN C CALL LIBLIN(1,1) !BLANK THE THINKING C CALL CARIER CALL ENEMYM('b',12,IBA2H,IBA2,8) CALL ENEMYM('r',8,ICR2H,ICR2,6) CALL ENEMYM('s',2,ISU2H,ISU2,4) CALL ENEMYM('d',3,IDE2H,IDE2,3) C CALL LIBCUR(1,1) CALL STROUT('... My turn, thinking ...',3) CALL FIGHTR C C AGE KNOWN ENEMY ARMY LOCATIONS C DO 5350 K=1,10 IF (LOCI(K,1)+21.GT.MDATE) GOTO 5350 !IF DATA IS NOT OLD DO 5340 J=1,11 5340 LOCI(K,J)=0 !ZERO THAT LINE 5350 CONTINUE C C PRODUCTION OF ENEMY HARDWARE C CALL CITYCT DO 5400 Y=1,70 IF ((X(Y).EQ.0).OR.(OWNER(Y).NE.2)) GOTO 5400 CALL SONAR(X(Y)) IF ((PHASE(Y).LE.0).OR.(MDATE.LT.FOUND(Y))) GOTO 5380 K=PHASE(Y) J=0 IF (K.EQ.1) J=1 CALL PROD(HITS(K),X(Y),LIMIT(TIPE(K)+8),CRAHIT(K)+IDE2H, 1 CRALOC(K)+1500,LOPMAX(K),J,1) 5380 IF ((PHASE(Y).LE.0).OR.(MDATE.GE.FOUND(Y))) CALL CITYPH(Y) 5400 CONTINUE MDATE=MDATE+1 NEWRND=1 IF (MOD(MDATE,4).EQ.0.OR.(MDATE.GT.160)) CALL GAME (+1,0) 5500 CONTINUE D CALL PME_EXIT NCYCLE=1 C IF (WIN.EQ.1) GOTO 100 IF (WIN.EQ.2) GOTO 5700 N=0 DO 5600 J=1,70 5600 IF (OWNER(J).EQ.1) N=N+1 IF (N.LT.30) GOTO 5700 IF (NUMBER(9).GT.N/2) GOTO 5700 CALL LIBPGE(1,1) TYPE 982 982 FORMAT(' The computer acknowledges defeat. Do'/ 1 ' you wish to smash the rest of the enemy? ',$) ACCEPT 981,ORDERS 981 FORMAT(4A1) IF ((ORDERS.NE.'Y').AND.(ORDERS.NE.'y')) CALL EXIT TYPE 980 980 FORMAT(' The enemy inadvertantly revealed its code used for'/ 1 ' receiving battle information. You can display what they''ve'/ 1 ' learned through the command ''JE''(cr)(lf), followed by the'/ 1 ' sector number.') SPECAL=.TRUE. WIN=2 AUTOMV=.FALSE. GOTO 100 5700 IF ((NUMBER(9).GT.0).OR.(LIMIT(9).GT.0)) GOTO 5800 CALL LIBPGE(1,1) TYPE 979 979 FORMAT(' The enemy is incapable of defeating you.'/ 1 ' You are free to rape the empire as you wish.'/ 1 ' There may be, however, remnants of the enemy fleet'/ 1 ' to be routed out and destroyed.') WIN=1 AUTOMV=.FALSE. GOTO 100 5800 DO 5900 I=1,70 5900 IF (OWNER(I).EQ.1) GOTO 100 CALL MAP(4) DO 6000 I=1,LIMIT(1) 6000 IF (RLMAP(I).NE.0) GOTO 100 CALL LIBPGE(1,1) WIN=1 TYPE 978 978 FORMAT(' You have been rendered incapable of'/ 1 ' defeating the rampaging enemy fascists! The'/ 1 ' empire is lost. If you have any ships left, you may'/ 1 ' attempt to harass enemy shipping.') AUTOMV=.FALSE. GOTO 100 END C BLOCK DATA FOR EMPIRE C BLOCK DATA C SUBROUTINE BLOCK_DATA_EMPDAT C INCLUDE 'EMPIRE.INC/LIST' C DATA COMMAN/'S','R','I','K','O','L','F','G','P','H', 1 'Y','T','V','J','?',0,0,'U','N','+'/ DATA COMM/'D','E','W','Q','A','Z','X','C','S', 1 'L','B','F','T','G','V','J','U',-1,-1, 2 'O','P','R','I','M','K','N', 3 'S','?','Y','H'/ DATA IOTAB/0,500,700,900,1100,1200,1300,1400,1500,2000, 1 2200,2400,2600,2700,2800,2900/ DATA OVRPOP/ 1 9,001,002,9,003,004,05,9,9,9,06,9,07,9,9,08, 2 0,499,199,0,199,199,83,0,0,0,99,0,99,0,0,99/ DATA COMSCN/'M','N','O','S','T','V','P','Y','C','L','H','J', 1 '1','R','@','Q','+','A',0,0, 2 'LO','NU','LI','TR','AR','TA','PA','A1', 3 'T3','A0','CO','CH','Q0','Q1','JE','CY','EX',0,0,0/ DATA ARROW/-101,-100,-99,-1,0,1,99,100,101/ DATA CMYTBL/6104,6103,6102,6105,6101,6106,6107,6108,0/ DATA CRAHIT/0,0,0,0, 200, 400,0,0,0, 500,0, 600,0,0, 700/ DATA CRALOC/0,500,0,700,900,1100,0,0,0,1200,0,1300,0,0,1400/ DATA HITS/1,1,0,3,2,3,0,0,0,8,0,8,0,0,12/ DATA IARROW/0,1,-99,-100,-101,-1,99,100,101,0/ DATA INDEX/11,12,0,13,14,15,0,0,0,16,0,17,0,0,18/ DATA KBFUDG/-101,-100,-99,-1,1,99,100,101,0/ DATA KBTBL/'Q','W','E','A','D','Z','X','C',' '/ DATA LOPMAX/500,200,0,200,200,100,0,0,0,100,0,100,0,0,100/ DATA OKA/'+',' ','*','X','O'/ DATA OKB/'+',' ','O','t','*'/ DATA OKC/'.',' ','O','*','X'/ DATA PH/1,2,4,5,6,10,12,15/ DATA PHAZE/'A','F','D','S','T','R','C','B'/ DATA PHAZEE/1,2,4,5,6,10,12,15/ DATA STEP/37/,POSIT/65/,START/102/ DATA TIPE/1,2,0,3,4,5,0,0,0,6,0,7,0,0,8/ END SUBROUTINE LTR(Z6,ITURN) C C DOES SHORT RANGE SCAN AROUND LOCATION Z6 C INCLUDE 'EMPIRE.INC/NOLIST' C IF (MODE.NE.1) GOTO 700 CALL SENSOR(Z6) RETURN C100 IF (ITURN.NE.1) GOTO 700 C DO 200 I7=1,8 C I8=Z6+IARROW(I7+1) !** C200 IF (RMAP(I8).NE.PMAP(I8)) GOTO 300 C GOTO 700 C300 TYPE 999 C999 FORMAT(' BEFORE SENSOR PROBE') C L6=Z6 C IF (L6.LT.101) L6=L6+100 C IF (L6.GT.5900) L6=L6-100 C IF (L6/100*100.EQ.L6) L6=L6-1 C IF (L6/100*100+1.EQ.L6) L6=L6+1 C DO 600 I=-101,99,100 C DO 400 I9=0,2 C400 D2(I9+1)=OMAP(L6+I+I9) !** C DO 500 I9=0,2 C500 G2(I9+1)=PMAP(L6+I+I9) !** C600 TYPE 998,(G2(J),J=1,3),(D2(J),J=1,3) C998 FORMAT(1X,3A1,3X,3A1) C CALL SENSOR(Z6) C TYPE 997 C997 FORMAT(' AFTER SENSOR PROBE') 700 CALL MAP(5) L6=Z6 IF (L6.LT.301) L6=L6+300-(L6-1)/100*100 IF (L6.GT.5700) L6=L6-(L6-1)/100*100+5600 IF ((L6-1)/100*100+97.LT.L6) L6=97+(L6-1)/100*100 IF ((L6-1)/100*100+4.GT.L6) L6=L6/100*100+4 DO 900 I=-303,297,100 DO 800 I9=0,6 800 G2(I9+1)=PMAP(L6+I+I9) !** 900 TYPE 996, (G2(J),J=1,7) 996 FORMAT(1X,7A1) 1000 CALL STROUT(0,1) RETURN END SUBROUTINE PHASIN(NUM,E) C C PROMPT FOR CITY PRODUCTION TYPE, SET PROD ACCORDINGLY C INCLUDE 'EMPIRE.INC/NOLIST' C E=GETCHX() DO 200 I=1,8 200 IF (E.EQ.PHAZE(I)) GOTO 300 CALL HUH E=' ' RETURN !IF HE DOESN'T DO IT RIGHT, LEAVE IT 300 PHASE(NUM)=PHAZEE(I) FOUND(NUM)=MDATE+6*PHASE(NUM) RETURN END C C CURSOR POSITIONING AND OUTPUT SUBROUTINES C SUBROUTINE CURSOR(N) C C POSITION CURSOR TO MAP LOCATION N C IMPLICIT INTEGER(A-Z) CALL LIBCUR(N/100+1,MOD(N,100)+1) END C SUBROUTINE STROUT(LINE,N) C C TYPE OUT ASCIZ TEXT 'LINE' AND WHERE N IS A TWO DIGIT NUMBER 'AB' C A=NUMBER OF TRAILING SPACES (1-4), C B=0 MEANS DO NOTHING ELSE, B=1 MEANS CLEAR LINE AND TYPE CRLF, C B=3 MEANS CLEAR LINE C IMPLICIT INTEGER(A-Z) LOGICAL*1 LINE(80),BLANKS(4) DATA BLANKS/' ',' ',' ',' '/ C C FIND LENGTH OF STRING AND PRINT IT. J=1 DO 100 I=1,80 IF (LINE(I).EQ.0) GOTO 200 IF (LINE(I).NE.' ') J=I 100 CONTINUE 200 TYPE 300,(LINE(I),I=1,J) 300 FORMAT('+',A1,$) C C NOW SEPARATE PIECES OF N J=MIN0(IABS(N/10),4) IF (J.NE.0) TYPE 300,(BLANKS(I),I=1,J) C J=MOD(N,10) IF (J.NE.0) CALL LIBLIN IF (J.EQ.1) TYPE 400 400 FORMAT(1X) RETURN END C FUNCTION GETCHX C C READS A CHARACTER WITH NO ECHO C IMPLICIT INTEGER (A-Z) BYTE GETC C GETCHX=GETC(I) IF (GETCHX.GT.96) GETCHX=GETCHX-32 END FUNCTION EDGER(I) C C RETURN NUMBER OF SEA SQUARES THAT ARE ADJACENT TO LOCATION I C INCLUDE 'EMPIRE.INC/NOLIST' C EDGER=0 CALL MAP(3) DO 100 IA=1,8 100 IF (OMAP(I+IARROW(IA+1)).EQ.'.') EDGER=EDGER+1 RETURN END INTEGER FUNCTION RND(X) INTEGER X,SEED1,SEED2,LPCNT REAL RAN,Q COMMON /SEEDS/ SEED1,SEED2 10 RND = IFIX(FLOAT(X)*RAN(SEED1,SEED2)) C WRITE (3,20) RND,X,SEED1,SEED2 C20 FORMAT (' RND=',I5,' X=',I5,' SEEDS=',2I10) RETURN END SUBROUTINE SONAR(Z6) C C UPDATES COMPUTER'S MAP AROUND LOCATION Z6 C INCLUDE 'EMPIRE.INC/NOLIST' BYTE I100 C DO 1300 I=1,8 LOCUS=Z6+IARROW(I+1) !** CALL MAP(2) AB=RMAP(LOCUS) CALL MAP(1) IF (AB.NE.EMAP(LOCUS)) EMAP(LOCUS)=AB IF ((AB.NE.'*').AND.(AB.NE.'O')) GOTO 400 DO 100 I1=1,70 100 IF (TARGET(I1).EQ.LOCUS) GOTO 1300 DO 200 I1=1,70 200 IF (TARGET(I1).EQ.0) GOTO 300 300 TARGET(I1)=LOCUS 400 IF ((AB.LT.'A').OR.(AB.GT.'T')) GOTO 1300 IF (AB.NE.'A'.AND.AB.NE.'O') GOTO 1100 C C WE MUST NOW FIGURE OUT IF THE ARMY IS A THREAT TO ANY OF THE COMPUTER'S C CITIES, I.E. IF IT IS ON THE CONTINENT WITH ANY OF THEM. IF SO, PUT C THE ARMY IN THE LOCI ARRAY. THE FIRST INDEX IS THE CONTINENT, THE C SECOND IS THE NTH ARMY DISCOVERED ON THAT CONTINENT - 1. THE (N,1) C ARGUMENT IS THE DATE OF THE LAST ARMY DISCOVERED ON THE C NTH CONTINENT. THUS WE HAVE A MEANS OF DETERMINING THE AGE OF THE DATA C ARMDEF=0 DO 480 Y=1,LIMIT(9) CALL MAP(4) IF (RLMAP(IAR2+Y).EQ.0) GOTO 480 IF (IDIST(LOCUS,RLMAP(IAR2+Y)).GT.14) GOTO 480 MOVE=PATH(RLMAP(IAR2+Y),LOCUS,1,OKA,FLAG) IF (FLAG.NE.0) ARMDEF=ARMDEF+1 480 CONTINUE IF (ARMDEF.GE.7) GOTO 520 DO 500 K=1,70 IF ((OWNER(K).NE.2).OR.(PHASE(K).EQ.1)) GOTO 500 IF (FOUND(K)-MDATE-5.LE.0) GOTO 500 IF (IDIST(X(K),LOCUS).GT.18) GOTO 500 MOVE=PATH(X(K),LOCUS,1,OKA,FLAG) IF (FLAG.NE.0) PHASE(K)=-1 500 CONTINUE C 520 IF (AB.EQ.'O') GOTO 1300 DO 600 K=1,10 IF (LOCI(K,2).EQ.0) GOTO 600 DO 550 J=2,11 IF (LOCI(K,J).EQ.LOCUS) GOTO 800 550 CONTINUE MOVE=PATH(LOCUS,LOCI(K,2),1,OKA,FLAG) J=11 IF (FLAG.NE.0) GOTO 800 600 CONTINUE DO 700 K=1,10 700 IF (LOCI(K,2).EQ.0) GOTO 760 OLDEST=10000 DO 750 J=1,10 IF (LOCI(J,1).LT.OLDEST) THEN OLDEST=LOCI(J,1) K=J ENDIF 750 CONTINUE 760 DO 770 J=2,11 770 LOCI(K,J)=0 GOTO 1000 800 DO 900 J=J,3,-1 900 LOCI(K,J)=LOCI(K,J-1) !SHIFT EVERYTHING UP THE ARRAY 1000 LOCI(K,1)=MDATE LOCI(K,2)=LOCUS GOTO 1300 C 1100 ISHIPT=0 IF (AB.EQ.'D') ISHIPT=1 IF (AB.EQ.'S') ISHIPT=2 IF (AB.EQ.'T') ISHIPT=3 IF (AB.EQ.'R') ISHIPT=4 IF (AB.EQ.'C') ISHIPT=5 IF (AB.EQ.'B') ISHIPT=6 IF (ISHIPT.EQ.0) GOTO 1300 DO 1200 IB=1,4 1200 TROOPT(ISHIPT,IB)=TROOPT(ISHIPT,IB+1) TROOPT(ISHIPT,5)=LOCUS 1300 CONTINUE CALL MAP(2) I100=RMAP(Z6) CALL MAP(1) EMAP(Z6)=I100 IF (CODER.EQ.10) CALL SENSOR(Z6) RETURN END SUBROUTINE SENSOR(Z6) C C UPDATES PLAYER'S MAP AROUND LOCATION Z6 C AND SCREEN IF CURRENT SECTOR IS DISPLAYED C INCLUDE 'EMPIRE.INC/NOLIST' C IBEFOR=-100 DO 100 I=1,9 I1=Z6+ARROW(I) CALL MAP(2) AB=RMAP(I1) CALL MAP(5) IF (AB.EQ.PMAP(I1)) GOTO 100 PMAP(I1)=AB IF (JECTOR.EQ.-1) GOTO 100 IF (ISEC.EQ.-1) GOTO 100 LINE=KLINE(KI,ISEC) IY=(I1-1)/100*100 IX=I1-IY IF ((IY.LT.LINE).OR.(IY.GT.LINE+1900) 1 .OR.(IX.LE.KI).OR.(IX.GT.KI+70)) GOTO 100 I1=I1-LINE-KI IF (IBEFOR+1.NE.I1) CALL CURSOR(I1+300) IBEFOR=I1 TYPE 999,AB 999 FORMAT('+',A1$) 100 CONTINUE RETURN END SUBROUTINE HUH IMPLICIT INTEGER(A-Z) C CALL LIBCUR(1,40) CALL STROUT(' Huh?',2) RETURN END