PROGRAM PLAYER
C
C	PLAYER PROGRAM FOR PLAYING MTREK.  THIS PROGRAM IS THE ACTUAL
C	INTERFACE WITH THE DRIVER PROGRAM (MTREK) AND THE HUMAN.
C
C	SEE MTREK.FTN FOR THE MODIFICATION HISTORY OF THE ENTIRE MTREK GAME.
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,IDMGE(8)
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE
	BYTE MESSAG,INITLS
	LOGICAL*1 OK,XXX,DONE,YES,WARN,US,DMP
	REAL SC(15),R(9)
	BYTE BLANK(80),OBUFF(19,19)
	CHARACTER*2 COMMND
	BYTE SBUFF(2500),INCHAR(2),CLRIT(2)
	INTEGER IPRM(6),WHO,INCHR
	DATA CLRIT/"33,'K'/
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)
	COMMON /MAPPNG/ IRDB(8),IWDB(8),MAPS,ICURBS,ICURTP
	INTEGER*4 MAPS
	LOGICAL*1 INI
C
C
C
	DATA BLANK/80*' '/, SC/15*-9999./, R/9*-9999./, IDMGE/8*-9999./
	DATA IL/-9999/, DONE/.FALSE./, OK/.FALSE./, I5/5/
	WARN=.FALSE.
	CALL INIPLA (IPRM,SBUFF,OK,WHO)
10005	CALL RBUFF(OBUFF)
	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)
	DMP = .FALSE.
C
C	DO WE NEED TO PAUSE (SNAPSHOT GAME DUMP REQUESTED)?
C
10024	IF (.NOT.DIP(1)) GOTO 10025
	I=44
	IF (.NOT.DMP) CALL MESSG(I,L)
	DMP = .TRUE.
	CALL WAIT(2,2,M)
	GOTO 10024
10025	NC=1
	COMMND(1:1)='0'
C
C     GET A COMMAND (IF ONE'S THERE)
C
	CALL INCHR(INCHAR(1),1)
	IF (INCHAR(1).EQ.0) GOTO 27004
	IF (INCHAR(1).NE."114.AND.INCHAR(1).NE."106.AND.INCHAR(1).NE."124)
	1 GOTO 27002
27001	CALL INCHR(INCHAR(2),1)
	IF (INCHAR(2).NE.0) GOTO 27003
	CALL WAITFR("15)
	GOTO 27001
27002	INCHAR(2)="40
27003	ENCODE(2,27000,COMMND) INCHAR
27000	FORMAT (2A1)
C
C     PLACE LOCAL SCAN ON TERMINAL
C
27004	CALL SSCAN (XX,YY,WHO,SBUFF,OBUFF,L,IPRM)
C
C     CHECK FOR NO INPUT
C
10062	IF (COMMND(1:1).EQ.'0') GO TO 10063
	CALL CHKCMD(COMMND,OK)
	IF (.NOT.OK) GOTO 10237
C
C     HELP COMMAND
C
	IF (COMMND(1:1).EQ.' ') CALL HELPSC(SBUFF,SC,R,IPRM,IDMGE,
	1  WHO,OBUFF)
C
C	HYPERSPACE JUMP COMMAND
C
	IF (COMMND(1:1).EQ.'J') CALL JMPHYP(WHO,L)
C
C	TRACTOR BEAMS
C
	IF (COMMND(1:2).EQ.'TR') CALL TRACTR (WHO,L)
C
C     WARP FACTOR COMMAND
C
	IF (COMMND(1:1).EQ.'W') CALL WARPC(WHO,L)
C
C     COURSE COMMAND
C
	IF (COMMND(1:1).EQ.'C') CALL ECOURS(WHO,L)
C
C     HYPERSPACE COMMAND
C
	IF (COMMND(1:1).EQ.'H') CALL HYPERC(WHO,L)
C
C     SHIELD COMMAND
C
	IF (COMMND(1:1).EQ.'S') CALL SHLDC(WHO,L)
C
C     QUIT COMMAND
C
	IF (COMMND(1:1).EQ.'Q') CALL QUIT(WHO,L,DONE)
	IF (DONE) GOTO 10022
C
C     * HOMING TORPEDO LAUNCH
C
	IF (COMMND(1:1).EQ.'K') CALL HTORP(WHO,L)
C
C     RESET COMMAND
C
	IF (COMMND(1:1).EQ.'R') CALL RESET(SC,R,IDMGE,OBUFF,SBUFF,IPRM,
	1 WHO)
C
C     TORPEDO COMMAND
C
	IF (COMMND(1:2).EQ.'TO') CALL TORP(WHO,L)
C
C     PHASER COMMAND
C
	IF (COMMND(1:1).EQ.'P') CALL PHASER(WHO,L)
C
C     LONG RANGE SCAN COMMAND
C
	IF (COMMND(1:2).EQ.'LS') CALL SCANC(WHO,L,XX,YY)
C
C     MESSAGE COMMAND
C
	IF (COMMND(1:1).EQ.'M') CALL SNDMES(WHO,L)
C
C     CLOAKING COMMAND
C
	IF (COMMND(1:2).EQ.'FA'.OR.COMMND(1:1).EQ.'A')
	1  CALL CLOAKC(WHO,L,COMMND)
C
C     EXPLODE ANTI-MATTER DEVICE
C
	IF (COMMND(1:1).EQ.'N'.OR.COMMND(1:1).EQ.'Z'.OR.COMMND(1:1).EQ.'X') 
	1 CALL ANTIM(WHO,L,COMMND)
C
C  LOCATE NEAREST FRIENDLY STARBASE
C
	IF (COMMND(1:2).EQ.'LB') CALL LOCATE(WHO,L,COMMND,XX,YY)
C
C  LOCATE NEAREST ENEMY STARBASE
C
	IF (COMMND(1:2).EQ.'LE') CALL LOCATE(WHO,L,COMMND,XX,YY)
C
C  LOCATE ACTIVE FREIGHTER
C
	IF (COMMND(1:2).EQ.'LF') CALL LOCATE(WHO,L,COMMND,XX,YY)
C
C  LAUNCH A FREIGHTER
C
	IF (COMMND(1:2).EQ.'FR') CALL FRGHT(WHO,L)
C
C  FIRE ON ENEMY STARBASE
C
	IF (COMMND(1:1).EQ.'D') CALL EBASE(WHO,L)
C
C  MANIPULATE HOMING DEVICE
C
	IF (COMMND(1:1).EQ.'O') CALL HOMING(WHO,L)
C
C  DISPLAY STATUS OF STARBASES
C
	IF (COMMND(1:1).EQ.'E') CALL DISBAS(WHO)
	GOTO 10063
C
C
10237	CALL CPOS(L)
	WRITE(5,10251) CLRIT
10251	FORMAT(' Sorry Captain, I did not understand',2A1)
C
10063	CALL REFRSH(SC,R,IDMGE,WHO,SBUFF,IPRM)
C
C     * WRITE OUT MESSAGES FROM DRIVER
C
	DO 30500, I=1,10
	CALL MESSG(ISENT(WHO,I),L)
	IF (L.LT.0) GOTO 10358
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)
	CALL WAIT(1,2,M)
C
10349	IF (ENERGY(WHO).LT.900.AND.WARN) GO TO 10021
	IF (ENERGY(WHO).GT.900) GOTO 10021
	CALL CPOS(L)
	WRITE (5,10350) CLRIT,CLRIT
10350	FORMAT (' Scott here, captain,',2A1,/,
	1 ' Our energy supply is getting dangerously low, sir.',2A1)
	WARN=.TRUE.
	GO TO  10021
C
10358	CALL WAIT(3,2,M)
	CLOAK(WHO)=.FALSE.
	WARP(WHO)=0
	IACTN(WHO)=0
	XSHIP(WHO)=.TRUE.
	DOCKED(WHO)=.FALSE.
	CLON(WHO)=.FALSE.
	IHOME(WHO)=0
	CALL RBUFF(OBUFF)
	DO 10281 K=1,15
	SC(K)=-9999.
	IF (K.LE.8) R(K)=-9999.
	IF (K.LE.8) IDMGE(K)=-9999.
	IF (K.LE.8) IDAMGE(WHO,K)=0.
10281	CONTINUE
	ENERGY(WHO)=10000
	FBASE(WHO)=.FALSE.
	R(9)=-9999.
C
	GOTO 10021
10022	CALL EXIT
	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