SUBROUTINE SSCAN (XX,YY,WHO,SBUFF,OBUFF,L,IPRM)
C
C	ROUTINE TO PLACE A LOCAL SCAN ON A TERMINAL FOR PLAYER
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,WHO,IPRM(6)
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,OK,FBASE,US,EDGE
	BYTE CHAR,MESSAG,INITLS,CLRIT(2)
	BYTE BLUNK,NBUFF(19,19),SBUFF(2250),OBUFF(19,19),ALPHA
	COMMON/CURSOR/ESCPOS,IOFSET
	BYTE ESCPOS(2)
C	BYTE BHOLE (15)
C	DATA BHOLE /"33,'<',"33,'[','1','m','#',"33,'[','m',"33,'[','?',
C	1 '2','l'/
C
C
	DO 20000 II=1,10
	IF (ISENT(WHO,II).EQ.3) GOTO 20001
20000	CONTINUE
	BLUNK=' '
	NOUT=0
	CALL STRMOV(BLUNK,1,361,NBUFF,1)
	ID=SCAN(WHO)
	IF (ID.GT.9) ID=9
C
	XX=XCORD(WHO)
	YY=YCORD(WHO)
C
C     IF HOMING IS ACTIVE, ALTER OUR COURSE APPROPRIATELY
C
	IF (IUNIV(WHO).NE.IUNIV(IHOME(WHO)).OR.IHOME(WHO).LE.0
	1  .OR.(CLON(IHOME(WHO)).AND.CLOAK(IHOME(WHO)))) GOTO 10034
	II=IHOME(WHO)
	IX=XCORD(II)
	IY=YCORD(II)
	CALL COURSE (XX,YY,IX,IY,EDIR,EE)
	IF (EDIR.LT.3) DIR(WHO) = (3.-EDIR)*30
	IF (EDIR.GE.3) DIR(WHO) = (15.-EDIR)*30
10034	CONTINUE
	DO 10028 IX=-ID,ID
	IX1=XX+IX
	DO 10028 IY=-ID,ID
	IY1=YY+IY
	EDGE = .FALSE.
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,IUNIV(WHO))
	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,IUNIV(WHO))
	IF (CHAR.EQ.'.') GO TO 10043
	EDGE = .TRUE.
	GO TO 10041
10043	ALPHA='-'
	GO TO  10036
10041	CALL UNIV(IX1,IY1,ALPHA,IUNIV(WHO))
	GO TO  10036
10039	ALPHA='.'
10036	IF (ALPHA.GE.49.AND.ALPHA.LE.56.AND.CLOAK(ALPHA-48)) GO TO 10047
	IF (ALPHA.NE.'F') GOTO 10045
C
C	FIND THIS FREIGHTERS OWNER
C
	DO 20010, II=1,8
	IF (FLOAD(IUNIV(WHO),II).EQ.0) GOTO 20010
	IIX = FXCORD(IUNIV(WHO),II)
	IIY = FYCORD(IUNIV(WHO),II)
	IF (IIX.NE.IX1.OR.IIY.NE.IY1) GOTO 20010
C
C	FOUND THE OWNER, NOW CHECK DISTANCE, CLOAKING
C
	IF (CLOAK(II).AND.FNEAR(IUNIV(WHO),II)) GOTO 10047
20010	CONTINUE
	GOTO 10045
10047	NBUFF(10+IX,10+IY)='.'
	IF (EDGE) NBUFF(10+IX,10+IY) = '-'
	GO TO 10028
10045	NBUFF(10+IX,10+IY)=ALPHA
	IF (NBUFF(10+IX,10+IY).NE.'B') GOTO 10028
	US = .FALSE.
	IOFF=(IUNIV(WHO)-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)
C	CHAR = NBUFF(IX,IY)
C	IF (CHAR.EQ.'-'.OR.CHAR.EQ.'.'.OR.CHAR.EQ.'*'.OR.CHAR.EQ.'H'
C	1 .OR.CHAR.EQ.'R'.OR.CHAR.EQ.'B'.OR.CHAR.EQ.'E') GOTO 10056
C	BHOLE (7) = CHAR
C	DO 10030,I=1,15
C	CHAR = BHOLE(I)
C	SBUFF (NOUT+4+I) = BHOLE (I)
C10030	CONTINUE
C	NOUT = NOUT + 14
C10056	CONTINUE
	IF (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
20001	RETURN
	END