	PROGRAM PLAYER

	INCLUDE 'LEDFOR.COM/-LI'
	INCLUDE 'PLAYER.COM/-LI'
	INCLUDE 'COMMND.COM/-LI'
	INCLUDE 'BUFFER.COM/-LI'

	REAL OVER(4)
	INTEGER*2 ILOCAT
	DATA OVER /6RREADY ,6RMESAGE,6RREDRAW,6RTWENTY/
	DATA ILOCAT/0/

	CALL MNLOAD(OVER(1))	! Load ready
	CALL READY
	CALL MNLOAD(OVER(2))	! Load mesage
C
C	*** This is the top of the loop ***
C
10021	CONTINUE

C	Generate new display
	DO 10046 IX=1,21
	DO 10049 IY=1,17
	NEWBUF(IX,IY)=' '
10049	CONTINUE
10046	CONTINUE

	I=INT(XCORD(WHO))
	J=INT(YCORD(WHO))
	IXB=0
	IXRIG=I+10
	IF(IXRIG.GT.100)IXRIG=100
	IXLEF=I-10
	IF(IXLEF.GE.1)GOTO 10015
	IXLEF=1
	IXB=20-IXRIG
10015	CONTINUE
	IYSCA=0
	IYBOT=J-8
	IF(IYBOT.LT.1)IYBOT=1
	IYTOP=J+8
	IF(IYTOP.LE.100)GOTO 10016
	IYTOP=100
	IYSCA=IYBOT-84
10016	CONTINUE

	DO 10052 IX=IXLEF,IXRIG
	IXB=IXB+1
	IYB=IYSCA
	DO 10054 IY=IYTOP,IYBOT,-1
	IYB=IYB+1
	NEWBUF(IXB,IYB)=UNIV(IX,IY)
	IF(NEWBUF(IXB,IYB).LT.'1')GOTO 10054
	IF(NEWBUF(IXB,IYB).GT.'8')GOTO 10054
	J=NEWBUF(IXB,IYB)-"60
	IF(.NOT.CLOAK(J))GOTO 10054
	NEWBUF(IXB,IYB)='.'
	IF(J.NE.WHO)GOTO 10054
	NEWBUF(IXB,IYB)='~'
10054	CONTINUE
10052	CONTINUE
C
C	Generate report
C
	VALUE=XTOCLK(COURSE(WHO))
	ENCODE(28,10063,NEWREP)VALUE,WARP(WHO),ENERGY(WHO),SHIELD(WHO)
10063	FORMAT(2X,F5.2,2X,F5.2,F7.1,F7.1)
C
C	Generate scores
C
	ENCODE(56,10064,NEWSCR)SCORE
10064	FORMAT(8I7)
C
C	Generate new coordinates
C
	ENCODE(15,10070,NEWCOR)XCORD(WHO),YCORD(WHO)
10070	FORMAT('X:',F5.1,' Y:',F5.1)
C
C	Redraw display for a 'reset'
C
	IF(.NOT.RESET)GOTO 10122
	CALL MNLOAD(OVER(3))	! Load redraw
	CALL REDRAW
	CALL MNLOAD(OVER(4))	! Load twenty
	GOTO 10120
C
C	** Start of updating code **
C
C	Compare and update display
C
10122	CONTINUE
	DO 10102 IY=1,17
	DO 10104 IX=1,21
	IF(NEWBUF(IX,IY).EQ.OLDBUF(IX,IY))GOTO 10104
	CALL WRITE(IY,2*(IX-1)+24,NEWBUF(IX,IY),1)
	OLDBUF(IX,IY)=NEWBUF(IX,IY)
10104	CONTINUE
10102	CONTINUE
C
C	Compare and update coordinates
C
	DO 10095 I=3,15
	IF(OLDCOR(I).EQ.NEWCOR(I))GOTO 10095
	CALL WRITE(2,3+I,NEWCOR(I),1)
	OLDCOR(I)=NEWCOR(I)
10095	CONTINUE
C
C	Compare and update reports
C
	DO 10111 IY=1,4
	DO 10114 IX=1,7
	IF(OLDREP(IX,IY).EQ.NEWREP(IX,IY))GOTO 10114
	OLDREP(IX,IY)=NEWREP(IX,IY)
	CALL WRITE(IY+3,IX+11,NEWREP(IX,IY),1)
10114	CONTINUE
10111	CONTINUE

	IF(HYPER(WHO).EQ.HYPX)GOTO 10115
	HYPX=HYPER(WHO)
	CALL WRITE(8,14,0)
	CALL NUMBER(HYPX)
10115	IF(TORPS(WHO).EQ.TORX)GOTO 10116
	CALL WRITE(9,14,0)
	TORX=TORPS(WHO)
	CALL NUMBER(TORX)
10116	CONTINUE
C
C
C	Compare and update time
C
	DO 10121 I=1,15
	IF(TIM(I).EQ.OLDTIM(I))GOTO 10121
	CALL WRITE(14,I,TIM(I),1)
	OLDTIM(I)=TIM(I)
10121	CONTINUE

	IF(OLDTIM(16).EQ.TIM(16))GOTO 10119
	CALL WRITE(14,17,TIM(16),1)
	OLDTIM(16)=TIM(16)
C
C	Compare and update scores and manned ships
C
10119	DO 10120 IY=1,8
	DO 10123 IX=1,7
	IF(OLDSCR(IX,IY).EQ.NEWSCR(IX,IY))GOTO 10112
	CALL WRITE(IY+5,IX+71,NEWSCR(IX,IY),1)
	OLDSCR(IX,IY)=NEWSCR(IX,IY)

C	Now check manned ships
10112	IF(.NOT.(OLDACT(IY).XOR.ALIVE(IY)))GOTO 10123
	TMP=' '
	IF(ALIVE(IY))TMP='*'
	CALL WRITE(IY+5,69,TMP,1)
	OLDACT(IY)=ALIVE(IY)
10123	CONTINUE
10120	CONTINUE
C
C	** Top of command loop **
C
C
C	Flush the buffer and delay a second before continuing
C
	CALL FLUSH
	CALL MARK(24,60,1)
	CALL WFLOR(24,25)
	CALL BANDIT			! *** Robot time...
	IF(CMD(1).EQ.0)GOTO 10132
C
C	Got a command
C
	IF(CMD(1).EQ."32)GOTO 10022	! Exit
	IF(CMD(1).EQ.'R')GOTO 10146	! Reset
	IF(CMD(1).EQ."15)GOTO 10138	! Null command
	LOOP=2
	CALL WRITE(19,35,0)
	IF(CMD(1).EQ.'X')GOTO 10278	! Explode
	IF(CMD(1).EQ.'W')GOTO 10137	! Warp
	IF(CMD(1).EQ.'C')GOTO 10139	! Course
	IF(CMD(1).EQ.'P')GOTO 10200	! Phaser
	IF(CMD(1).EQ.'T')GOTO 10185	! Torpedo
	IF(CMD(1).EQ.'Z')GOTO 10286	! Launch
	IF(CMD(1).EQ.'S')GOTO 10160	! Shields
	IF(CMD(1).EQ.'L')GOTO 10225	! Locate
	IF(CMD(1).EQ.'F')GOTO 10258	! Cloak
	IF(CMD(1).EQ.'A')GOTO 10270	! Un-cloak
	IF(CMD(1).EQ.'H')GOTO 10148	! Hyperspace
C
C	Not a valid command
C
	CALL FILL(7,1)
	CALL FILL('Illegal command.    ')
	GOTO 10138
C
C	Reset command
C
10146	RESET=.TRUE.
	CALL CLREF(25)
	CMD(1)=0
	GOTO 10021
C
C	Warp command
C
10137	CALL CONREL(VALUE,OK,0.0,20.0,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(VALUE.NE.0.0)GOTO 10140
	WARP(WHO)=0.0
	CALL FILL('Engines stop.       ')
	GOTO 10138

10140	CLOAK(WHO)=.FALSE.
	WARP(WHO)=VALUE
	CALL FILL('Helm acknowledges.  ')
	GOTO 10138
C
C	Course command
C
10139	CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(.NOT.OK)GOTO 10138
	COURSE(WHO)=XTODEG(VALUE)
10158	CALL FILL('Helm responds.      ')
	GOTO 10138
C
C	Hyperspace command
C
10148	CALL CONINT(I,OK,1,6,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(.NOT.OK)GOTO 10138
	HYPER(WHO)=I
	CALL FILL('Navigation responds.')
	GOTO 10138
C
C	Shield command
C
10160	CALL CONREL(VALUE,OK,-1.E36,1.E36,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF((.NOT.OK).OR.(VALUE.EQ.0.0))GOTO 10165
	IF((SHIELD(WHO).GE.0.0).AND.(SHIELD(WHO)+VALUE.LE.0.0))GOTO 10178
	IF(ENERGY(WHO)-VALUE.LT.0.0)GOTO 10180
	ENERGY(WHO)=ENERGY(WHO)-VALUE
	SHIELD(WHO)=SHIELD(WHO)+VALUE
	CALL FILL('Defense responds.   ')
	GOTO 10138

10165	IF(SHIELD(WHO).LT.1000.0)GOTO 10167
	VALUE=100.0
	GOTO 10168
10167	VALUE=AINT(SHIELD(WHO))/10.0
10168	ENCODE(20,10166,IBUF)VALUE
10166	FORMAT('Shields at ',F<2+IWR(VALUE)>.1,' %',<5-IWR(VALUE)>X)
	CALL FILL(IBUF,20)
	GOTO 10138

10178	ENERGY(WHO)=ENERGY(WHO)+SHIELD(WHO)
	SHIELD(WHO)=0.0
	CALL FILL('All energy to ship. ')
	GOTO 10138

10180	CALL FILL(7,1)
	CALL FILL('That is impossible! ')
	GOTO 10138
C
C	Torpedo command
C
10185	IF(LAUNCH(WHO).GE.0.0)GOTO 10202
	IF(TORPS(WHO).LE.0)GOTO 10205
	CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(OK)GOTO 10213
	LAUNCH(WHO)=COURSE(WHO)
	GOTO 10212
10213	LAUNCH(WHO)=XTODEG(VALUE)
10212	TORPS(WHO)=TORPS(WHO)-1
	CALL FILL('Torpedo fired.      ')
	GOTO 10138

10205	CALL FILL(7,1)
	CALL FILL('Out of torpedoes.   ')
	GOTO 10138

10202	CALL FILL(7,1)
	CALL FILL('Torpedo not ready!  ')
	GOTO 10138
C
C	Phaser command
C
10200	IF(PHA(WHO).GE.0.0)GOTO 10227
	CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(OK)GOTO 10234
	PHA(WHO)=COURSE(WHO)
	GOTO 10235
10234	PHA(WHO)=XTODEG(VALUE)
10235	ENERGY(WHO)=ENERGY(WHO)-50.0
	CALL FILL('Phaser banks fired. ')
	GOTO 10138

10227	CALL FILL(7,1)
	CALL FILL('* Phasers not ready!')
	GOTO 10138
C
C	Long range scan command
C
10225	CALL CONINT(I,OK,0,8,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(.NOT.OK)I=ILOCAT
	ILOCAT=I
	IF(I.NE.0)GOTO 10151
	IX=INT(ZX/10.0)
	IY=INT(ZY/10.0)
	GOTO 10152

10151	IF(.NOT.ALIVE(I))GOTO 10257
	IX=INT(XCORD(I)/10.0)
	IY=INT(YCORD(I)/10.0)
10152	X=FLOAT(IX*10)
	Y=FLOAT(IY*10)
	VALUE=XTOCLK(ATAN2(Y-YCORD(WHO),X-XCORD(WHO))*180.0/3.1415926)
10254	ENCODE(20,10256,IBUF)VALUE
10256	FORMAT('Course is ',F<3+IWR(VALUE)>.2,<7-IWR(VALUE)>X)
	CALL FILL(IBUF,20)
	GOTO 10138

10257	CALL FILL('No signal.          ')
	GOTO 10138
C
C	Cloaking command
C
10258	IF(CLOAK(WHO))GOTO 10272
	CLOAK(WHO)=.TRUE.
	WARP(WHO)=0.0
	CALL FILL('Cloak activated.    ')
	GOTO 10138

10272	CALL FILL(7,1)
	CALL FILL('* Already cloaked!  ')
	GOTO 10138
C
C	Un-cloak command
C
10270	IF(.NOT.CLOAK(WHO))GOTO 10280
	CLOAK(WHO)=.FALSE.
	CALL FILL('Cloak deactivated.  ')
	GOTO 10138

10280	CALL FILL(7,1)
	CALL FILL('* Not cloaked yet!  ')
	GOTO 10138
C
C	Detonate anti-matter device
C
10278	IF(IPOD(WHO).NE.2)GOTO 10288
	IPOD(WHO)=3
	CALL FILL('Detonation signaled!')
	GOTO 10138

10288	CALL FILL(7,1)
	CALL FILL('* Pod not active!   ')
	GOTO 10138
C
C	Launch anti-matter device
C
10286	IF(IPOD(WHO).NE.0)GOTO 10295
	CALL CONREL(VALUE,OK,0.0,12.0,RANGE)
	IF(.NOT.RANGE)GOTO 10141
	IF(OK)GOTO 10287
	CALL FILL('Anti-matter ready.  ')
	GOTO 10138

10287	DPOD(WHO)=XTODEG(VALUE)
	IPOD(WHO)=1
	CALL FILL('Pod requested.      ')
	GOTO 10138

10295	CALL FILL(7,1)
	CALL FILL('* No pod availiable.')
	GOTO 10138

10141	CALL FILL(7,1)
	CALL FILL('* Invalid input.    ')
10138	CONTINUE
	CMD(1)=0
	CALL CLREF(25)
C
C	Clean up command message
C
10132	IF(LOOP.LT.0)GOTO 10133
	LOOP=LOOP-1
	IF(LOOP.EQ.0)CALL WRITE(19,35,'                    ')
C
C	Write out messages from zip
C
10133	CALL MESAGE
C
C	Clean up old messages
C
	CALL BLANKS
	GOTO 10021
C
C	Exit nicely
C
10022	CALL WRITE(23,1,0)
	CALL FLUSH
	THRU=THRU-1
	IF(THRU.LT.0)THRU=0
	ALIVE(WHO)=.FALSE.
	CLOAK(WHO)=.TRUE.
	WARP(WHO)=0.0
	IF(IPOD(WHO).NE.2)GOTO 10023
	IF(UNIV(INT(XPOD(WHO)),INT(YPOD(WHO))).EQ.'@')
     $	UNIV(INT(XPOD(WHO)),INT(YPOD(WHO)))='.'
10023	CALL EXIT
	END
