SUBROUTINE DISSHP(WHO,ICHAR,TYPE,FLG,IU)
C
C	DISPLAY A SHIP FOR TRDEMO
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,IDMGE(8)
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE,FLG
	BYTE MESSAG,INITLS
	LOGICAL*1 OK,XXX,DONE,YES,WARN,US,TYPE
	REAL SC(9),R(9)
	BYTE BLANK(80),OBUFF(19,19),ALPHA
C
C     NOTE, THE SEQUENCE OF THE NEXT TWO STATEMENTS IS SIGNIFICANT
C
	BYTE BLUNK
	BYTE NBUFF(19,19)
C
C
	BYTE SBUFF(1850),INCHAR(2),CHAR
	BYTE VT100(5),CLRIT(2),CNGBCK(2)
	INTEGER IPRM(6),WHO,INCHR
	BYTE BHOLE (15)
	DATA BHOLE /"33,'<',"33,'[','1','m','#',"33,'[','m',"33,'[','?',
	1 '2','l'/
	DATA VT100/"33,'[','?','2','l'/
	DATA CLRIT/"33,'K'/
	DATA CNGBCK/"33,'<'/
C
C   THE FOLLOWING PARAMETERS ARE FOR CURSOR ADDRESSING.
C
	BYTE ESCPOS(2)
	COMMON/CURSOR/ESCPOS,IOFSET
	DATA ESCPOS/"33,'Y'/
	DATA IOFSET/"37/
	COMMON /REF/IL,INI(8)
	LOGICAL*1 INI
C
C
C
	DATA BLANK/80*' '/
	DATA BLUNK/' '/
	DATA SC/9*-9999./
	DATA R/9*-9999./
	DATA IDMGE/8*-9999./
	DATA DONE/.FALSE./
	DATA OK/.FALSE./
	DATA I5/5/
	WRITE (5,1)VT100
1	FORMAT(' ',5A1)
	IF (TYPE.NE."110) GOTO 10005
	WRITE (5,3)
3	FORMAT ('$Enter universe number :')
	CALL GETINT (IU,OK,1,IUNIMX)
	IF (.NOT.FLG) GOTO 10005
	WHO=1
	DO 74, I=1,IHOLE(IU)
	IF (HDIS(IU,I).LT.HDIS(IU,WHO)) WHO=I
74	CONTINUE
C
C
10005	DO 100, I=1,9
	IF (I.LE.8) IDMGE(I) = -9999
	IF (I.LE.8) INI(I) = ' '
	SC (I)=-9999.
	R(I) = -9999.
100	CONTINUE
	CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(81,.TRUE.,.FALSE.,.FALSE.,.FALSE.,)
	CALL GETADR(IPRM,SBUFF)
	L=20
	ITERM=2
	CALL RBUFF(OBUFF,ITERM,TYPE,IHOLE(IU))
	IRC=0
	GO TO  10023
10021	IF (DONE) GO TO 10022
C
C     THE FOLLOWING WAIT CONTROLS THE UPDATE RATE, WHICH IS NORMALLY
C     SET TO A HALF SECOND (30 CLOCK TICKS).
C
10023	CALL WAIT(30,0,M)
	NC=1
C
C	SEE IF ANYTHING WAS ENTERED
C
	CALL INCHR(ICHAR)
	IF (ICHAR.EQ."33) GOTO 10022
	IF (ICHAR.EQ."27) GOTO 10005
	IF (ICHAR.EQ."130.OR.ICHAR.EQ."106.OR.ICHAR.EQ."110.OR.ICHAR.EQ."123)
	1  GOTO 10022
	IF (ICHAR.LT."61.OR.ICHAR.GT."71) GOTO 27004
	DECODE (1,101,ICHAR) WHO
101	FORMAT (I1)
	GOTO 10005
C
C     PLACE LOCAL SCAN ON TERMINAL
C
27004	CALL STRMOV(BLUNK,1,361,NBUFF,1)
	ID=9
C
	IF (TYPE.EQ."110) GOTO 23000
	IX3=XCORD(WHO)
	IY3=YCORD(WHO)
	IU=IUNIV(WHO)
	GOTO 23002
C
C	Find the black hole
C
23000	IF(.NOT.FLG) GOTO 23001
	J=WHO
	DO 23078, I=1,IHOLE(IU)
	IF (HDIS(IU,I).LT.HDIS(IU,WHO)) WHO=I
23078	CONTINUE
	IF (WHO.NE.J) GOTO 10005
23001	IX3=HX(IU,WHO)
	IY3=HY(IU,WHO)
23002	CONTINUE
	DO 10028 IX=-ID,ID
	IX1=IX3+IX
	DO 10028 IY=-ID,ID
	IY1=IY3+IY
10035	IF (IX1.LT.IMAXX.AND.IX1.GT.1.AND.IY1.LT.IMAXY.AND.IY1.GT.1)
	1 GOTO 10038
	GO TO  10037
10038	CALL UNIV(IX1,IY1,ALPHA,IU)
	GO TO  10036
10037	IF ((IX1.EQ.IMAXX.OR.IX1.EQ.1.OR.IY1.EQ.IMAXY.OR.
	1 IY1.EQ.1).AND.((IX1.LT.IMAXX.AND.IX1.GT.1).OR.
	2 (IY1.LT.IMAXY.AND.IY1.GT.1))) GO TO 10040
	GO TO 10039
10040	CALL UNIV(IX1,IY1,CHAR,IU)
	IF (CHAR.EQ.'.') GO TO 10043
	GO TO 10041
10043	ALPHA='-'
	GO TO  10036
10041	CALL UNIV(IX1,IY1,ALPHA,IU)
	GO TO  10036
10039	IF (IX1.GT.IMAXX) IX1=IX1-IMAXX
	IF (IX1.LT.1) IX1=IX1+IMAXX
	IF (IY1.GT.IMAXY) IY1=IY1-IMAXY
	IF (IY1.LT.1) IY1=IY1+IMAXY
	CALL UNIV(IX1,IY1,ALPHA,IU)
10036	CONTINUE
10045	NBUFF(10+IX,10+IY)=ALPHA
	IF (NBUFF(10+IX,10+IY).NE.'B'.OR.TYPE.EQ."110) GOTO 10028
	US = .FALSE.
	IOFF=(IU-1)*20
	DO 10044 IB=1,20,2
	IF (IBASE(WHO,IOFF+IB).EQ.0) GOTO 10044
	IF (IBASE(WHO,IOFF+IB).EQ.IX1.AND.IBASE(WHO,IOFF+IB+1).EQ.IY1)
	1  US = .TRUE.
10044	CONTINUE
	IF (.NOT.US) NBUFF(10+IX,10+IY)='E'
10028	CONTINUE
C
C FILL UP THE BUFFER FOR DRAWING THE CURRENT UNIVERSE
C
10055	NOUT=0
	DO 10049 IX=1,19
	DO 10049 IY=1,18
	IF (NBUFF(IX,IY).EQ.OBUFF(IX,IY)) GO TO 10049
	SBUFF(NOUT+1)=ESCPOS(1)
	SBUFF(NOUT+2)=ESCPOS(2)
	SBUFF(NOUT+3)=IOFSET+20-IY
	SBUFF(NOUT+4)=2*IX+IOFSET+1
	SBUFF(NOUT+5)=NBUFF(IX,IY)
	CHAR = NBUFF(IX,IY)
	IF (CHAR.EQ.'-'.OR.CHAR.EQ.'.'.OR.CHAR.EQ.'*'.OR.CHAR.EQ.'H'
	1 .OR.CHAR.EQ.'R'.OR.CHAR.EQ.'B'.OR.CHAR.EQ.'E'.OR.ITERM.NE.2)
	1 GOTO 10056
	BHOLE (7) = CHAR
	DO 10030,I=1,15
10030	SBUFF (NOUT+4+I) = BHOLE (I)
	NOUT = NOUT + 14
10056	CONTINUE
	IF (ITERM.EQ.2.AND.NBUFF(IX,IY).EQ.'.') SBUFF(NOUT+5)=' '
	NOUT=NOUT+5
	OBUFF(IX,IY)=NBUFF(IX,IY)
10049	CONTINUE
C
C
	IF (NOUT.EQ.0) GO TO 10057
	IPRM(2)=NOUT
	CALL WTQIO("410,5,1,,,IPRM)
10057	L=20
C
10063	CALL REFRSH(SC,R,IDMGE,WHO,SBUFF,IPRM,TYPE,IU)
C
C     * WRITE OUT MESSAGES FROM DRIVER
C
	IF (TYPE.EQ."110) GOTO 10021
	DO 30500, I=1,10
	CALL MESSG(ISENT(WHO,I),L)
	IF (L.LT.0) GOTO 10021
30500	CONTINUE
C
C      CHECK FOR MESSAGES FROM OTHER PLAYERS
C
	IF (MESSAG(WHO*60-59).EQ.' ') GO TO 10349
	CALL CPOS(L)
	WRITE(5,10352) CLRIT
10352	FORMAT(' CAPTAIN, MESSAGE COMING IN ON SUB SPACE RADIO',2A1)
	IF (MESSAG(WHO*60-59).NE.'0') WRITE(5,10353) MESSAG(WHO*60-59),CLRIT
10353	FORMAT(' FREQUENCY ',A1,'   ***',2A1)
	IF (MESSAG(WHO*60-59).EQ.'0') WRITE (5,10400)
10400	FORMAT (' *** DISPATCH FROM STARFLEET COMMAND *** ')
C
	WRITE(5,10354) (MESSAG(I),I=WHO*60-58,WHO*60)
10354	FORMAT(10X,60A1)
	CALL STRMOV(BLANK,1,60,MESSAG,WHO*60-59)
10349	IF (ENERGY(WHO).LT.900.AND.WARN) GO TO 10357
	GO TO 10355
10357	CALL CPOS(L)
	TYPE *,' SCOTT HERE CAPTAIN,'
	TYPE *,' OUR ENERGY SUPPLY IS GETTING DANGEROUSLY LOW, SIR.'
	WARN=.FALSE.
	GO TO  10356
10355	WARN=.TRUE.
10356	GO TO  10021
10022	WRITE (5,32000) CNGBCK
32000	FORMAT (' ',2A1)
	RETURN
	END

	SUBROUTINE CPOS(L)
	CALL CLEARS(22,1,5)
	CALL POSNOC(20,1,5)
	L=20
	RETURN
	END

	SUBROUTINE BUFFIL(IY,IX,ST,L,N,BUFF)
	COMMON/CURSOR/ESCPOS,IOFSET
	BYTE ST(L),BUFF(2000)
	BYTE ESCPOS(2)
C
	BUFF(N+1)=ESCPOS(1)
	BUFF(N+2)=ESCPOS(2)
	BUFF(N+3)=IY+IOFSET
	BUFF(N+4)=IX+IOFSET
	CALL STRMOV(ST,1,L,BUFF,N+5)
	N=N+4+L
	RETURN
	END


	SUBROUTINE REFRSH(SC,R,IDMGE,WHO,SBUFF,IPRM,TYPE,IU)
C
C      REFRESH THE SCREEN FOR PLAYER
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,IDMGE(8),WHO
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE,TYPE
	BYTE MESSAG,INITLS
	COMMON /UNIV/ UNI
	INTEGER UNI
	REAL SC(8),R(9)
	INTEGER IPRM(2)
	BYTE SBUFF(2000)
	BYTE STRING(100)
	COMMON /REF/IL,INI(8)
	LOGICAL*1 INI
C
C
	NOUT=0
	IF (TYPE.EQ."110.AND.R(1).EQ.IHWHO(IU,WHO)) GOTO 10000
	IF (TYPE.NE."110) GOTO 10001
	R(1) = IHWHO(IU,WHO)
	GOTO 45020
10001	IF (R(1).EQ.ENERGY(WHO)) GOTO 10000
	R(1)=ENERGY(WHO)
45020	ENCODE(7,10003,STRING) R(1)
10003	FORMAT(F7.1)
	CALL BUFFIL(2,55,STRING,7,NOUT,SBUFF)
10000	IF (TYPE.EQ."110.AND.R(2).EQ.HDIS(IU,WHO)) GOTO 10004
	IF (TYPE.NE."110) GOTO 45021
	R(2)=HDIS(IU,WHO)
	GOTO 45022
45021	IF (R(2).EQ.SHIELDS(WHO)) GOTO 10004
	R(2)=SHIELDS(WHO)
45022	ENCODE(7,10007,STRING) R(2)
10007	FORMAT(F7.1)
	CALL BUFFIL(3,55,STRING,7,NOUT,SBUFF)
10004	IF (TYPE.EQ."110.AND.R(3).EQ.HWARP(IU,WHO)) GOTO 10008
	IF (TYPE.NE."110) GOTO 45000
	R(3) = HWARP(IU,WHO)
	GOTO 45001	
45000	IF (R(3).EQ.WARP(WHO)) GOTO 10008
	R(3)=WARP(WHO)
45001	ENCODE(6,10011,STRING) R(3)
10011	FORMAT(F6.2)
	CALL BUFFIL(5,54,STRING,6,NOUT,SBUFF)
10008	IF (TYPE.EQ."110.AND.R(4).EQ.HDIR(IU,WHO)) GOTO 10012
	IF (TYPE.NE."110) GOTO 45002
	R(4) = HDIR(IU,WHO)
	GOTO 45003
45002	IF (R(4).EQ.DIR(WHO)) GOTO 10012
	R(4)=DIR(WHO)
45003	IF (R(4).GT.90.) V=(450.-R(4))/30.
	IF (R(4).LE.90.) V=(90.-R(4))/30.
	ENCODE(5,10018,STRING) V
10018	FORMAT(F5.2)
	CALL BUFFIL(6,55,STRING,5,NOUT,SBUFF)
10012	IF (TYPE.EQ."110.AND.R(5).EQ.HX(IU,WHO)) GOTO 10019
	IF (TYPE.NE."110) GOTO 45004
	R(5)=HX(IU,WHO)
	GOTO 45005
45004	IF (R(5).EQ.XCORD(WHO)) GOTO 10019
	R(5)=XCORD(WHO)
45005	ENCODE(5,10022,STRING) R(5)
10022	FORMAT(F5.1)
	CALL BUFFIL(8,55,STRING,5,NOUT,SBUFF)
10019	IF (UNI.EQ.IU) GOTO 50000
	ENCODE (1,50001,STRING) IU
	UNI=IU
	CALL BUFFIL(7,55,STRING,1,NOUT,SBUFF)
50001	FORMAT (I1)
50000	IF (TYPE.EQ."110.AND.R(6).EQ.HY(IU,WHO)) GOTO 10023
	IF (TYPE.NE."110) GOTO 45006
	R(6) = HY(IU,WHO)
	GOTO 45007
45006	IF (R(6).EQ.YCORD(WHO)) GOTO 10023
	R(6)=YCORD(WHO)
45007	ENCODE(5,10026,STRING) R(6)
10026	FORMAT(F5.1)
	CALL BUFFIL(9,55,STRING,5,NOUT,SBUFF)
10023	IF (TYPE.EQ."110) GOTO 10035
	IR=R(7)
	IF (IR.EQ.TORPS(WHO)) GOTO 10027
	R(7)=TORPS(WHO)
	ENCODE(3,10030,STRING) TORPS(WHO)
10030	FORMAT(I3)
	CALL BUFFIL(11,55,STRING,3,NOUT,SBUFF)
10027	IR=R(8)
	IF (IR.EQ.NHOM(WHO)) GOTO 10031
	R(8)=NHOM(WHO)
	ENCODE(3,10034,STRING) NHOM(WHO)
10034	FORMAT(I3)
	CALL BUFFIL(12,55,STRING,3,NOUT,SBUFF)
10031	IF (IL.EQ.IACTRP(WHO)) GOTO 30000
	ENCODE(3,10034,STRING) IACTRP(WHO)
	CALL BUFFIL(12,61,STRING,3,NOUT,SBUFF)
	IL=IACTRP(WHO)
30000	IR=R(9)
	IF (IR.EQ.HYPER(WHO,1)) GOTO 10035
	R(9)=HYPER(WHO,1)
	ENCODE(3,10038,STRING) (HYPER(WHO,I),I=1,2)
10038	FORMAT(I1,'/',I1)
	CALL BUFFIL(13,57,STRING,3,NOUT,SBUFF)
10035	DO 10040 J=1,8
	IF (SC(J).EQ.SCORE(J).AND.INI(J).EQ.INITLS(J,1)) GOTO 10040
	INI(J)=INITLS(J,1)
	SC(J)=SCORE(J)
	ENCODE(8,10045,STRING) SC(J)
10045	FORMAT(F8.0)
	CALL BUFFIL(J+4,70,STRING,8,NOUT,SBUFF)
	CALL BUFFIL(J+4,79,INITLS(J,1),1,NOUT,SBUFF)
	CALL BUFFIL(J+4,80,INITLS(J,2),1,NOUT,SBUFF)
10040	CONTINUE
	IF (TYPE.EQ."110) GOTO 10052
	DO 10050 J=1,4
	IF (IDMGE(J).EQ.IDAMGE(WHO,J)) GO TO 10050
	IDMGE(J)=IDAMGE(WHO,J)
	ENCODE(3,10051,STRING) IDAMGE(WHO,J)
10051	FORMAT(I3)
	CALL BUFFIL(J+16,56,STRING,3,NOUT,SBUFF)
10050	CONTINUE
	DO 10052 J=5,8
	IF (IDMGE(J).EQ.IDAMGE(WHO,J)) GO TO 10052
	IDMGE(J)=IDAMGE(WHO,J)
	ENCODE (3,10051,STRING) IDAMGE(WHO,J)
	CALL BUFFIL(J+12,76,STRING,3,NOUT,SBUFF)
10052	CONTINUE
	IF (TYPE.NE."110) GOTO 10053
	DO 25100, J=1,IHOLE(IU)
	IX=HX(IU,J)
	IY=HY(IU,J)
	ENCODE (29,25101,STRING) IHWHO(IU,J),HWARP(IU,J),IX,IY,HDIS(IU,J)
25101	FORMAT (I2,T7,F4.1,T14,I3,','I3,T22,F7.2)
	CALL BUFFIL(16+J,49,STRING,29,NOUT,SBUFF)
25100	CONTINUE
10053	CONTINUE
	IF (NOUT.EQ.0) GOTO 10046
	IPRM(2)=NOUT
	CALL WTQIO("410,5,1,,,IPRM)
10046	RETURN
	END
	SUBROUTINE RBUFF(OBUFF,ITERM,TYPE,IHOLE)
	COMMON /HLP/HELP
	COMMON /UNIV/ UNI
	INTEGER UNI
	LOGICAL*1 HELP,TYPE
	BYTE TOPLIN(42),MIDLIN(40),BOTLIN(42),UNDLIN(17),UNDDMG(41)
	BYTE ALTLN1(13),ALTLN2(37)
	BYTE OBUFF(19,19)
	DATA TOPLIN/"33,'F','l',38*'q','k'/
	DATA MIDLIN/'x',38*' ','x'/
	DATA BOTLIN/'m',38*'q','j',"33,'G'/
	DATA UNDLIN/"33,'F',13*'q',"33,'G'/
	DATA UNDDMG/"33,'F',37*'q',"33,'G'/
	DATA ALTLN1/13*'-'/
	DATA ALTLN2/37*'-'/
	IF (HELP) GO TO 10005
	DO 10001 IX=1,19
	DO 10004 IY=1,19
	OBUFF(IX,IY)="0
10004	CONTINUE
10001	CONTINUE
	CALL CLEAR
C
C     * DRAW NEW SCREEN
C
	UNI = -1
	IF (ITERM.NE.2) GO TO 10005
	CALL CURWRT(1,1,TOPLIN,42,5)
	DO 100 L=2,19
	CALL CURWRT(L,1,MIDLIN,40,5)
100	CONTINUE
	CALL CURWRT(20,1,BOTLIN,42,5)      
10005	IF (TYPE.EQ."123) CALL CURWRT(2,44,'ENERGY   :',10,5)
	IF (TYPE.EQ."110) CALL CURWRT(2,44,'TARGET   :',10,5)
	IF (TYPE.EQ."123) CALL CURWRT(3,44,'SHIELDS  :',10,5)
	IF (TYPE.EQ."110) CALL CURWRT(3,44,'DISTANCE :',10,5)
	CALL CURWRT(4,44,' ',1,5)
	CALL CURWRT(5,44,'WARP     :',10,5)
	CALL CURWRT(6,44,'HEADING  :',10,5)
	CALL CURWRT(7,44,'UNIVERSE :',10,5)
	CALL CURWRT(8,44,'X CO-ORD :',10,5)
	CALL CURWRT(9,44,'Y CO-ORD :',10,5)
	CALL CURWRT(10,44,' ',1,5)
	IF (TYPE.EQ."110) GOTO 23000
	CALL CURWRT(11,44,'TORPS    :',10,5)
	CALL CURWRT(12,44,'SEEKERS  :',10,5)
	CALL CURWRT(12,59,'/',1,5)
	CALL CURWRT(13,44,'HYPER    :',10,5)
	CALL CURWRT(14,44,' ',1,5)
23000	IF (TYPE.EQ."123) CALL CURWRT(15,43,'           DAMAGE REPORT',
	1 25,5)
	IF (TYPE.NE."110) GOTO 24000
	CALL CURWRT(15,43,'HOLE TARGET  WARP   POSITN   DISTANCE',37,5)
24000	IF (ITERM.EQ.1) CALL CURWRT(16,43,ALTLN2,37,5)
	IF (ITERM.EQ.2) CALL CURWRT(16,43,UNDDMG,41,5)
	IF (TYPE.NE."110) GOTO 23101
	DO 23102, I=1,IHOLE
	ENCODE (2,23103,CHAR) I
23103	FORMAT (I2)
	CALL CURWRT(16+I,43,CHAR,2,5)
23102	CONTINUE
	GOTO 23100
23101	CALL CURWRT(17,43,'PHASERS:        %   NAV-COMPUT:     %',37,5)
	CALL CURWRT(18,43,'TORPEDOES:      %   WARP-DRIVE:     %',37,5)
	CALL CURWRT(19,43,'SCANNERS:       %   ANTI-MATTER:    %',37,5)
	CALL CURWRT(20,43,'CLOAKING:       %   SHIELDS:        %',37,5)
23100	CALL CURWRT(3,72,'SCORES',6,5)
	IF (ITERM.EQ.1) CALL CURWRT(4,68,ALTLN1,13,5)
	IF (ITERM.EQ.2) CALL CURWRT(4,68,UNDLIN,17,5)
	CALL CURWRT(5,68,'1',1,5)
	CALL CURWRT(6,68,'2',1,5)
	CALL CURWRT(7,68,'3',1,5)
	CALL CURWRT(8,68,'4',1,5)
	CALL CURWRT(9,68,'5',1,5)
	CALL CURWRT(10,68,'6',1,5)
	CALL CURWRT(11,68,'7',1,5)
	CALL CURWRT(12,68,'8',1,5)
	RETURN
	END