SUBROUTINE UNIPAG
C
C	This routine is used to show current relative universe
C	positions, as well as activity
C
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,WHO,IPRM(6),NOUT,UXOFF(4),UYOFF(4)
C
C	The following arrays will control the update of the screen
C
	INTEGER LSTUNI(8)
	INTEGER LSTFRT(8,4)
	INTEGER IXBASE(8,4)
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE
	BYTE MESSAG,INITLS,UNIVLN(80),SBUFF(1850),CHAR,SPACE(36),DOTS(4)
	BYTE UPLIN (5),SEPER(84),SPACES(6)
	LOGICAL*1 FLG
	EQUIVALENCE (SPACE(1),SPACES(1))
C
C   THE FOLLOWING PARAMETERS ARE FOR CURSOR ADDRESSING.
C
	BYTE ESCPOS(2)
	COMMON/CURSOR/ESCPOS,IOFSET
	DATA ESCPOS/"33,'Y'/
	DATA IOFSET/"37/
	DATA SPACE/36*' '/
	BYTE VT100(5),CLRIT(2),CNGBCK(2),REV(4),REG(4)
	DATA UXOFF/4,4,16,16/
	DATA UYOFF/4,45,4,45/
	DATA IPRM/6*0/
	DATA DOTS/4*'.'/
	DATA REV/"33,'[','7','m'/
	DATA REG/"33,'[','0','m'/
	DATA VT100/"33,'[','?','2','l'/
	DATA CLRIT/"33,'K'/
	DATA CNGBCK/"33,'<'/
	DATA UPLIN/"33,'F','x',"33,'G'/
	DATA SEPER/"33,'F',40*'q','n',39*'q',"33,'G'/
	CALL GETCHR
	WRITE (5,5) VT100
5	FORMAT (' ',5A1)
	CALL GETADR(IPRM,SBUFF)
	CALL CLEAR
	DO 10, I=1,3,2
	WRITE (5,1) I,IHOLE(I),IMAXX,IMAXY,UPLIN,I+1,IHOLE(I+1),IMAXX,IMAXY
1	FORMAT (' Universe ',I1,' Black Holes = ',I1,' (',I3,',',I3,')',T42,
	1 5A1,'Universe ',I1,' Black Holes = ',I1,' (',I3,',',I3,')')
	WRITE (5,2) UPLIN
2	FORMAT (' sh wrp xcord ycord energy frght bs CDTH',T42,5A1,
	1 'sh wrp xcord ycord energy frght bs CDTH')
	WRITE (5,3) SEPER
3	FORMAT (1X,84A1)
	DO 9, J=1,8
	WRITE (5,74) J,UPLIN,J
74	FORMAT (1X,I2,T42,5A1,I2)
9	CONTINUE
	IF (I.EQ.1) WRITE (5,3)SEPER
10	CONTINUE
	NOUT=0
	IF (IUNIMX.GT.3) GOTO 14
	DO 11, I=IUNIMX+1,4
	ENCODE (45,12,UNIVLN) CNGBCK,REV,REG,VT100
12	FORMAT (2A1,4A1,'**** Not in configuration ****',4A1,5A1)
	CALL BUFFIL (UXOFF(I)+4,UYOFF(I),UNIVLN,45,NOUT,SBUFF)
11	CONTINUE
	IPRM(2)=NOUT
	IF (NOUT.NE.0) CALL WTQIO("410,5,1,,,IPRM)
14	DO 15,I=1,8
	LSTUNI(I)=-1
	DO 15,J=1,5
	LSTFRT(I,J)=1
	IF (FLOAD(J,I).EQ.0) LSTFRT(I,J)=0
	IXBASE(I,J)=-1
15	CONTINUE
C
C
C	NOW COMES THE REAL UPDATE FOR THE SCREEN
C
100	CONTINUE
	NOUT=0
	DO 1000, IU=1,IUNIMX
	IF (IU.GT.4) GOTO 1000
	DO 950, ISHP=1,8
	IOFF=(IU-1)*20
	ICNT=0
	DO 101, K=1,ICNTRL(1)*2,2
	IF (IBASE(ISHP,IOFF+K).NE.0) ICNT=ICNT+1
101	CONTINUE
	IF (IUNIV(ISHP).NE.IU.AND.LSTUNI(ISHP).NE.IU.AND.(FLOAD(IU,ISHP)
	1 .EQ.0.AND.LSTFRT(ISHP,IU).EQ.0).AND.ICNT.EQ.IXBASE(ISHP,IU)
	2 .AND.(XSHIP(ISHP))) GOTO 900
C
C	We have something to do
C
	IF (XSHIP(ISHP)) GOTO 150
C
C	Clean-up for this ship, (perform rundown)
C
	IF (LSTUNI(ISHP).EQ.-1) GOTO 900
	IF (IU.EQ.IUNIMX.OR.IU.EQ.4) LSTUNI(ISHP)=-1
	LSTFRT(ISHP,IU)=0
	IXBASE(ISHP,IU)=-1
	CALL BUFFIL (UXOFF(IU)+ISHP,UYOFF(IU),SPACE,36,NOUT,SBUFF)
	GOTO 900
C
C	Now we either get to show the whole ship, erase and leave freighter,
C	or erase the freighter
C
150	IF (IUNIV(ISHP).NE.IU) GOTO 200
	IF (FLOAD(IU,ISHP).EQ.0) LSTFRT(ISHP,IU) = 0
	IF (FLOAD(IU,ISHP).NE.0) LSTFRT(ISHP,IU) = 1
	ENCODE (23,151,UNIVLN) WARP(ISHP),XCORD(ISHP),YCORD(ISHP),ENERGY(ISHP)
151	FORMAT (F3.1,1X,F5.1,1X,F5.1,I7,1X)
	IX=FXCORD(IU,ISHP)/10
	IY=FYCORD(IU,ISHP)/10
	IF (LSTFRT(ISHP,IU).EQ.0) ENCODE (6,152,UNIVLN(24)) SPACES
152	FORMAT (6A1)
	IF (LSTFRT(ISHP,IU).NE.0) ENCODE (6,153,UNIVLN(24)) IX,IY
153	FORMAT (I2,',',I2,1X)
	IXBASE(ISHP,IU)=ICNT
	ENCODE (3,160,UNIVLN(30)) ICNT
160	FORMAT (I2,1X)
	ENCODE (4,154,UNIVLN(33)) DOTS
154	FORMAT (4A1)
	IF (CLOAK(ISHP)) UNIVLN(33)='*'
	IF (DOCKED(ISHP)) UNIVLN(34)='*'
	IF (ITRAC(ISHP).EQ.0) GOTO 156
	ENCODE (1,155,CHAR) ITRAC(ISHP)
155	FORMAT (I1)
	UNIVLN(35)=CHAR
156	IF (IHOME(ISHP).EQ.0) GOTO 157
	ENCODE (1,155,CHAR) IHOME(ISHP)
	UNIVLN(36)=CHAR
157	IF (LSTUNI(ISHP).NE.-1.AND.LSTUNI(ISHP).NE.IU)
	1 CALL BUFFIL (UXOFF(LSTUNI(ISHP))+ISHP,UYOFF(LSTUNI(ISHP)),
	2 SPACE,36,NOUT,SBUFF)
	IF (LSTUNI(ISHP).NE.-1.AND.LSTUNI(ISHP).NE.IU) IXBASE(ISHP,
	1 LSTUNI(ISHP))=-1
	LSTUNI(ISHP)=IUNIV(ISHP)
	CALL BUFFIL(UXOFF(IU)+ISHP,UYOFF(IU),UNIVLN,36,NOUT,SBUFF)
	GOTO 900
200	IF (LSTUNI(ISHP).NE.IU) GOTO 300
C
C	Erase the previous ship
C
	CALL BUFFIL (UXOFF(IU)+ISHP,UYOFF(IU),SPACE,36,NOUT,SBUFF)
	LSTFRT(ISHP,IU)=0
	LSTUNI(IU)=-1
	IXBASE(ISHP,IU)=-1
300	CONTINUE
C
C	UPDATE FREIGHTER STATUS IF NEEDED
C
	IF (LSTFRT(ISHP,IU).EQ.1.AND.FLOAD(IU,ISHP).EQ.0)
	1 CALL BUFFIL (UXOFF(IU)+ISHP,UYOFF(IU)+23,SPACE,6,NOUT,SBUFF)
	IF (FLOAD(IU,ISHP).EQ.0) GOTO 350
	IX=FXCORD(IU,ISHP)/10
	IY=FYCORD(IU,ISHP)/10
	ENCODE (6,153,UNIVLN) IX,IY
	CALL BUFFIL (UXOFF(IU)+ISHP,UYOFF(IU)+23,UNIVLN,6,NOUT,SBUFF)
350	LSTFRT(ISHP,IU)=1
	IF (FLOAD(ISHP,IU).EQ.0) LSTFRT(ISHP,IU)=0
	IF (ICNT.EQ.IXBASE(ISHP,IU)) GOTO 900
	IXBASE(ISHP,IU)=ICNT
	ENCODE (3,160,UNIVLN) ICNT
	CALL BUFFIL (UXOFF(IU)+ISHP,UYOFF(IU)+29,UNIVLN,3,NOUT,SBUFF)
900	CONTINUE
950	CONTINUE
1000	CONTINUE
	IPRM(2)=NOUT
	IF (NOUT.NE.0) CALL WTQIO("410,5,1,,,IPRM)
	CALL WAIT (1,2,IDS)
	CALL INCHR(CHAR)
	IF (CHAR.EQ.0) GOTO 100
	WRITE (5,1001) CNGBCK
1001	FORMAT (1X,2A1)
	RETURN
	END