PROGRAM DRIVER
C
C     AUTHOR: DON LEDFORD
C
C     DECEMBER 1978	JOHN LUTCH	ADDED CLOAKING
C     DECEMBER 1978	DON LEDFORD	ADDED ANTI-MATTER
C     MARCH 1979	RAY FRENCH	ADDED CONTINUOUS DISPLAY
C     OCTOBER 1979	DON LEDFORD	ADDED ROBOT SHIPS
C     JULY 1982		DTC & DO	REFORMATTED SCREEN
C     JULY 1982		DTC & DO	ADDED DAMAGE CONTROL
C     JULY 1982		DTC & DO	ADDED SHIP HOMING
C     AUGUST 1982	DTC & DO	ADDED ENEMY/FRIENDLY STARBASES
C     AUGUST 1982	DTC & DO	VARIOUS BUG FIXES
C     SEPTEMBER 1982	DTC & DO	CHANGE FIRING ALGORITHMS
C     SEPTEMBER 1982	DTC & DO	MAKE MORE GAME PARAMETERS DYNAMIC
C     OCTOBER 1982	DTC		ADDED MULTIPLE BLACK HOLES
C     OCTOBER 1982	DTC & DO	ADDED STARBASE DEFENSES
C     NOVEMBER 1982	DTC		ADDED UNIVERSE VERIFICATION
C     NOVEMBER 1982	DTC & DO	ADDED FREIGHTERS FOR STARBASES
C     DECEMBER 1982	DO		ADDED ABILITY TO GATHER STATISTICS
C     DECEMBER 1982	DO		ADDED MAPPABLE UNIVERSE COMMON
C     JANUARY 1983	DO		CHANGED CLOAKING CAPABILITIES
C     JANUARY 1983	DO & DTC	ADDED MULTIPLE UNIVERSES
C     MARCH 1983	DO		ADDED LOWERCASE CAPABILITY
C     MARCH 1983	DO		REARRANGED/IMPROVED HELP SCREEN
C     MARCH 1983	DO & DTC	REWROTE ANTI-MATTER HANDLING
C
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH,SECNDS
	EQUIVALENCE (HDRAIN,RCNTRL(7)),(CDRAIN,RCNTRL(8))
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,I,TIMR,DURARY(13),TIMMAX
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE
	BYTE GINBUF(200),MESSAG,INITLS,CHAR
	COMMON /ACCUM/ ACCUME
	COMMON /STATS/SEN(8),IPHA(8),IFRGHT(8),IPODS(8),IHOM(8),ITORP(8),
	1      IMESS(8),IDEST(8),IOEN(8),GMTIM,IJMPS(8)
	COMMON /MAPPNG/ IRDB(8),IWDB(8),MAPS,ICURBS,ICURTP
	COMMON /TORPES/ XHOM(8,15),YHOM(8,15),TLOCS(8,15,3),TDIR(8,15)
	INTEGER*4 MAPS
	LOGICAL*1 OK,YES,CNF,GATHER,ACCUME
	DATA DURARY/5,6,8,9,11,12,14,15,17,18,20,21,23/
C
C
	GMTIM=SECNDS(0)
C
C      INITIALIZE THE GAME
C
	CALL INIT(GATHER,TIMMAX)
C
C     * HERE STARTS THE ACTUAL GAME PLAYING
C
	TIMR=0
	ICLK=0
	GO TO 10090
10088	IF (THRU) GO TO 10089
C
C	THE PLAYER TASKS NEED SOME CPU TIME TOO !
C
10090	CALL WAIT(40,0,M)
C
C	NEED TO WAIT FOR DUMP TO BE TAKEN?
C
10024	IF (.NOT.DIP(1)) GOTO 10025
	CALL WAIT(2,2,M)
	GOTO 10024
10025	ICLK=ICLK+1
	TIMR = TIMR + 1
	IF (TIMR.NE.TIMMAX) GOTO 10091
C
C     * VERIFY THE UNIVERSE AND CLEAN IT UP
C
C	CALL VFY(0)
	TIMR = 0
C
C     * GATHER STATISTICS IF WE WANT TO
C
10091	IF (GATHER) CALL GETSTA(0)
C
C     * REPAIR DAMAGE IF IT'S TIME TO
C
	IF (ICLK.GT.DURARY(ICNTRL(7))) CALL REPAIR(ICLK)
C
C     * FIRE TORPEDOES
C
	CALL TORPI
C
C     * DESTROY ANY STARBASES TARGETED FOR DESTRUCTION
C
	CALL EBASE
C
C     * FIRE PHASERS
C
	CALL PHASER
C
C     * MOVE ACTIVE TORPEDOES
C
	CALL MTORPS
C
C     * MOVE FREIGHTERS
C
	CALL FRGHT
C
C     * MAKE ANY HYPERSPACE JUMPS
C
	CALL JMPHYP
C
C     * MOVE SHIPS
C
	CALL MSHIPS(CDRAIN,HDRAIN)
C
C     * MOVE HOMERS
C
	CALL MHOMER
C
C     * MOVE THE "BLACK HOLE"
C
     	CALL MHOLE
C
C     * HANDLE ALL ANTI-MATTER TRANSACTIONS
C
	CALL MANTI
C
C     * GATHER MORE STATISTICS IF WE WANT TO
C
	IF (GATHER) CALL GETSTA(1)
C
C     THE FOLLOWING CODE (IF UNCOMMENTED) WILL CHECK TO SEE
C     IF THERE ARE STILL ANY PLAYERS.  IF NOT, IT WILL WAIT
C     30 SECONDS AND THEN EXIT IF NO NEW PLAYERS HAVE STARTED.
C
	IWTIM=0
11001	CONTINUE
	THRU=.FALSE.
	IF (.NOT.(PAUS(1) .OR. PAUS(2) .OR. PAUS(3) .OR.
	1 PAUS(4) .OR. PAUS(5) .OR. PAUS(6) .OR. PAUS(7)
	1 .OR. PAUS(8))) CALL WAIT (1,2,M)
	IWTIM=IWTIM + 1
C
	IF (.NOT.(PAUS(1) .OR. PAUS(2) .OR. PAUS(3) .OR.
	1 PAUS(4) .OR. PAUS(5) .OR. PAUS(6) .OR. PAUS(7)
	1 .OR. PAUS(8))) THRU=.TRUE.
	IF (THRU.AND.IWTIM.LT.30) GOTO 11001
C
	GO TO  10088
10089	CONTINUE
	IF (GATHER) CALL GETSTA(2)
	WRITE (5,23000) MAPS
23000	FORMAT (' Number of universe maps made : ',I10)
	STOP
	END