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
C	university.  This version of the game was made runnable on Digital
C	Equipment VAX/VMS FORTRAN by conversion from the TOPS-10/20 sources
C	available around fall 1979.  After debugging it, numerous changes
C	have been made.
C
C	Now that you are the proud owner of the source and you are all gung
C	ho to do things right, there are a few things you should be aware of.
C	Unfortunately, there are many "magic" numbers controlling how many
C	different kinds of units can exist and how many of each, so think
C	well before you attempt to add another unit type.  Also, "slight
C	changes" to the way the units work will typically have a devastating
C	affect on the computer's strategy.  If you are interested in really
C	hacking this, there is plenty of room for enhanced computer strategy.
C
C	As you'll see, there are some very good debugging tools tucked inside,
C	and you will soon discover weak points and bugs that up until you,
C	have remained problems (all the previous  programmers got lazy or
C	lost interest).  Finally, please be careful with the version number
C	and identification at start up to avoid confusion of ongoing versions
C	with private copies.  If you make a change, don't remove the major
C	version id, but rather add something like (V4.0 site.1 20-JUL-80).
C
C	Revision History:
C
C	V4.0A  Rework cruddy Macro subroutines and convert to VT100 keypad
C	V4.0B  Add escape sequences to do bright and blinking bright pieces
C	V4.0C  Blow away save files when doing final exit
C	V4.0D  Check for total defeat of the computer
C
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	
	Write (5, 999)
999	FORMAT(1X,//////////////)
	Write (5, 998)
998	FORMAT(' EMPIRE, Version 4.0D (RSX-11) 28-Jul-86'/)
	Write (5, 997)
997	FORMAT(' Please send bug reports to MIIM::MITCHELL'/)
C	Write (5, 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)
	CALL WAIT (2, 2)
	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)
	Write (5, 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	Write (5, 986) ((LOCI(I,J),J=1,11),I=1,10) !LO -
C	GOTO 100
C
C2600	Write (5, 989) NUMBER		!NU -
C	GOTO 100
C
C2700	Write (5, 991) LIMIT		!LI -
C	GOTO 100
C
C2800	Write (5, 990) TROOPT		!TR -
C	GOTO 100
C
C2900	Write (5, 989) ARMTOT		!AR -
C	GOTO 100
C
C3000	Write (5, 989) TARGET		!TA -
C	GOTO 100
C
C3100	Write (5, 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	Write (5, 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
	Write (5, 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
	Write (5, 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)
	Write (5, 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	Write (5, 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 
C	=================================================================
C	End of game computation section
C	=================================================================
C
	If (WIN .EQ. 1) Goto 100		! User has already won
	If (WIN .EQ. 2) Goto 5700		! User has probably won
C	Count up how many cities the player owns
	N = 0
	Do 5600 J = 1, 70
	If (OWNER(J) .EQ. 1) N = N + 1
 5600	Continue
C	If player owns > 30 cities, and computer owns half or less number
C	of cities player owns, computer gives up
	If ((N .LT. 30) .OR. (NUMBER(9) .GT. (N/2))) Goto 5700
	Call LIBPGE (1,1)
	Write (5, 982)
982	FORMAT(' The computer acknowledges a crushing defeat.', /, 
     +	' Do you wish to smash the rest of the enemy? ', $)
	Accept 981, ORDERS
981	Format (4A1)
	If ((ORDERS .EQ. 'Y') .OR. (ORDERS .EQ. 'y')) Goto 3333
C
C	User wants to quit.  Blast away saved map file and EMSAVE.DAT
C
	Write (5, 3332)
3332	Format (1X, 'Destroying save file and exiting to RSX ...')
	Open (Unit=1, Name='EMSAVE.DAT', Type='OLD', Dispose='DELETE')
	Close (UNIT=1, DISPOSE='DELETE')
	Call EXIT
C
C	User doesn't want to quit.  Give him access to JE and proceed.
C
3333	Write (5, 980)
980	FORMAT(' The enemy inadvertently revealed his 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
C
C	If computer owns no cities, and no armies, it's impossible for it
C	to win
C
5700	If ((NUMBER(9) .GT. 0) .OR. (LIMIT(9) .GT. 0)) Goto 5800
	Do 8837 J = 1, 9
	If (NUMBER(I) .NE. 0) Goto 8836
 8837	Continue
C
C	Computer doesn't own a damn thing.  Clean up and exit.
C
	CALL LIBPGE(1,1)
	Write (5, 8833)
 8833	Format (' You have totally annihilated the forces of the', 
     +	' computer!', /,
     +	' Not a single enemy force opposes your domination of the',
     +	' world!', //,
     +	' "Congratulations, Commander!  You have done well!", says the',
     +	' Commander-in-Chief ', /, 
     +	' as he musters you out with a substantial pension.', //,
     +	' But as the throngs cheer your triumphant return to the',
     +	' Homeland, in this,', /,
     +	' your moment of greatest glory, remember - as did the Romans:', /,
     +	' "Caesar, thou art but a mortal man."', ///)
	Write (5, 3332)
	Open (Unit=1, Name='EMSAVE.DAT', Type='OLD', Dispose='DELETE')
	Close (UNIT=1, DISPOSE='DELETE')
	Call EXIT
C
C	Computer still owns at least one playing piece
C
 8836	CALL LIBPGE(1,1)
	Write (5, 979)
  979	Format (' The enemy is incapable of defeating you!', /,
     +	' You are free to pillage the empire as you wish!', /,
     +	' There may be, however, remnants of the enemy fleet',
     +	' to be routed out and destroyed.')
	WIN = 1
	AUTOMV = .FALSE.
	Goto 100
C
C	If the player owns even one city, or one army, he might win (ha)
C
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
	Write (5, 978)
  978	Format (' You have been rendered incapable of defeating the',
     +	' rampaging enemy fascists!', /,
     +	' The empire is lost!', /,
     +	' If you have any ships left, you may 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','+'/
C
C
C	Define keys which move the current piece during player edit phase.
C
C	Standard, ordinary, non-CRT keypad type (original version)
C	DATA COMM /'D', 'E', 'W', 'Q', 'A', 'Z', 'X', 'C', 'S', 'L',
C     +	'B', 'F', 'T', 'G', 'V', 'J', 'U', -1, -1, 'O', 'P', 'R', 'I',
C     +	'M', 'K', 'N', 'S', '?', 'Y', 'H'/
C	VT52/VT100 numeric keypad type (much easier to use)
	DATA COMM /'6', '9', '8', '7', '4', '1', '2', '3', 'S', 'L',
     +	'B', 'F', 'T', 'G', 'V', 'J', 'U', -1, -1, 'O', 'P', 'R', 'I',
     +	'M', 'K', 'N', 'S', '?', 'Y', 'H'/
C
	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/
C
C
C	Define keys which move the current piece during player movement phase.
C
C	Standard, ordinary, non-CRT keypad type (original version)
C	DATA KBTBL /'Q', 'W', 'E', 'A', 'D', 'Z', 'X', 'C', ' '/
C	VT52/VT100 numeric keypad type (much easier to use)
	DATA KBTBL /'7', '8', '9', '4', '6', '1', '2', '3', '5'/
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	Write (5, 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	Write (5, 998) (G2(J),J=1,3),(D2(J),J=1,3)
C998	FORMAT(1X,3A1,3X,3A1)
C	CALL SENSOR(Z6)
C	Write (5, 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	Write (5, 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

	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	Write (5, 300) (LINE(I),I=1,J)
300	FORMAT('+',<J>A1,$)
C
C NOW SEPARATE PIECES OF N
	J=MIN0(IABS(N/10),4)
	IF (J.NE.0) Write (5, 300) (BLANKS(I),I=1,J)
C
	J=MOD(N,10)
	IF (J.NE.0) CALL LIBLIN
	IF (J.EQ.1) Write (5, 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
	ESC = 27
	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
	If (((AB .GE. 'A') .AND. (AB .LE. 'Z')) .AND. (AB .NE. 'X')) Then
	Write (5, 998) ESC, AB, ESC
998	Format ('+', A1, '[1m', A1, A1, '[0m'$)
	Else If (((AB .GE. 'a') .AND. (AB .LE. 'z')) .OR. (AB .EQ. 'X')) Then
	Write (5, 997) ESC, AB, ESC
997	Format ('+', A1, '[1;5m', A1, A1, '[0m'$)
	Else
	Write (5, 999) AB
999	Format ('+', A1$)
	End If
100	CONTINUE
	RETURN
	END
	SUBROUTINE HUH
	IMPLICIT INTEGER(A-Z)
C
	CALL LIBCUR(1,40)
	CALL STROUT('  Huh?',2)
	RETURN
	END