SUBROUTINE DISBAS(WHO)
C
C	ROUTINE TO DISPLAY THE STATUS OF STARBASES FOR A PLAYER
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,WHO
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,OK,FBASE,DONE
	BYTE MESSAG,INITLS,OUTBUF(80)
	DATA OUTBUF/80*' '/
C
C
	CALL CPOS(L)
	IU=(IUNIV(WHO)-1)*20
	ICNT = 0
C
	DO 10001 I=1,ICNTRL(1)*2,2
	IF (IBASE(WHO,IU+I).EQ.0) GOTO 10001
C
	ICNT = ICNT + 1
	ENCODE (2,99,OUTBUF(((ICNT-1)*19)+1)) (I+1)/2
99	FORMAT (I2)
10002	FORMAT (I3)
	OUTBUF(((ICNT-1)*19)+3) = ';'
	ENCODE (3,10002,OUTBUF(((ICNT-1)*19)+4)) IBASE(WHO,IU+I)
	OUTBUF(((ICNT-1)*19)+7) = ','
	ENCODE (3,10002,OUTBUF(((ICNT-1)*19)+8)) IBASE(WHO,IU+I+1)
	OUTBUF(((ICNT-1)*19)+11) = ';'
	ENCODE (5,10003,OUTBUF(((ICNT-1)*19)+12)) BASEN(WHO,IU/2+((I+1)/2))
10003	FORMAT (I5)
	IF (ICNT.LT.4) GOTO 10001
	WRITE (5,10004) OUTBUF
10004	FORMAT (' ',80A1)
	DO 10005 J=1,80
10005	OUTBUF(J)=' '
	ICNT=0
10001	CONTINUE
C
	IF (ICNT.GT.0) WRITE (5,10004) OUTBUF
	DO 10006 J=1,80
10006	OUTBUF(J)=' '
C
	RETURN
	END