PROGRAM STREK
C**************************************************************
C**                                  *
C**   STEVE ILLENCIK
C**   REPUBLIC BUILDINGS CORP
C**   1202 INDUSTRIAL PARK
C**   VAN WERT, OHIO 45891
C**
C**    1-419-238-9533
C**
C** STAR TREK FORTRAN PROGRAM VERSION 2.0  
C**************************************************************
C** VARIABLES
C**    IQX - QUADRANT X COORDINANT
C**    IQY - QUADRANT Y COORDINANT
C**    ISX - SECTOR X COORDINANT
C**    ISY - SECTOR Y COORDINANT
C**    QUAD - QUADRANT RECORDS
C**    SECT - SECTOR RECORDS
C**
        COMMON/GENDTA/SDATE,COND(2),KLING,TMLEFT,ITORP,ENERGY,SHELDS
       COMMON /QUAD/IQAD(8,8),IQX,IQY
       COMMON /SECT/SEC(64,64),ISX,ISY,ISX8,ISY8
       COMMON /DAMAGS/IRPARS(10,2),IRAND,IRATE,IDMGD,TSTRT,GTIME
       COMMON /EKLNG/EKNG(6),IKS
       COMMON /GALAX/IGALX(8,8)
       COMMON /RMULN/IRMLN,IRMX,IRMY,IHTMS
       DATA YES/'YES'/
       DATA SNO/'NO'/
 40    TYPE 1006
 1006  FORMAT($,' DO YOU WISH INSTRUCTIONS>')
       ACCEPT 1002,STRUCT
       IF(STRUCT .EQ. SNO)GO TO 45
       TYPE 1007
 1007  FORMAT($,' DO YOU WANT NARRITIVE> ')
       ACCEPT 1002,STRUCT
       IF(STRUCT .EQ. YES)CALL HISTRY
       CALL INSTCT
C** INITIALIZE TIMER
 45    TBGIN = SECNDS(0.0)
       TSTRT = TBGIN
       CALL ASETP
       CALL SETUP
        CALL HEADR
       CALL STATUS
 50    IF(ENERGY .LE. 0.0)GO TO 60
C** UPDATE TIME
       TIME = SECNDS(TBGIN)
       TMLEFT = (GTIME - SECNDS(TBGIN))/60.
       IF(TMLEFT .LE. 2.0 .AND. TMLEFT .GE. 1.5)CALL ADVICE(3)
       IF(TMLEFT .LE. 0.0)GO TO 60
       IF(SHELDS .LT. 0.0)GO TO 60
       IF(KLING .LE. 0 .AND. IRMX .EQ. 0)GO TO 60
       IF(COND(1) .EQ. 'END')GO TO 60
       IF(ENERGY .LT. 569.0)CALL ADVICE(2)
       IF(SHELDS .LT. 500.0)CALL ADVICE(1)
       IF(ITORP .LE. 2)CALL ADVICE(5)
       GO TO 65
 60    CALL EOGAME
       GO TO 900
 65    TYPE 1004
 1004  FORMAT($,'  COMMAND> ')
       ACCEPT *,ICOMND
       IDMGD = 0
       CALL DAMGED
       IF(ICOMND .EQ. 98)GO TO 888
       IF(ICOMND .NE. 99)GO TO 70
       COND(1) ='END '
       COND(2) ='SURR'
       GO TO 50
 70    GO TO (90,100,200,300,400,500,600,700)ICOMND+1
       TYPE *,'  COMMANDS AVAILABLE'
       TYPE *,'     0 = SET COURSE'
       TYPE *,'     1 = SHORT RANGE SENSORS'
       TYPE *,'     2 = LONG RANGE SENSORS'
       TYPE *,'     3 = FIRE PHASORS'
       TYPE *,'     4 = FIRE TORPEDOES'
       TYPE *,'     5 = SHIELD CONTROL'
       TYPE *,'     6 = DAMAGE CONTROL'
       TYPE *,'     7 = COMPUTER REQUEST'
C**    TYPE *,'    98 = MAP UNIVERSE ARRAY  -  DIAGNOSTIC ONLY'
       TYPE *,'    99 = SURRENDER THE FEDERATION TO THE KLINGONS'
       GO TO 50
 90    CALL SETCRS
C** CHECK FOR ADVANCED GAME
       IF(IRMLN .EQ. 0)GO TO 50
       CALL ROMULN
       IDMGD = 3
       CALL DAMGED
       GO TO 50
 100   CALL SRSCAN
       GO TO 50
 200   CALL LRSCAN
       GO TO 50
C** FIRE PHASORS
 300   CALL FASORS
       GO TO 50
 400   CALL TORPS
       GO TO 50
 500   ENERGY = ENERGY+SHELDS
       TYPE 1005,ENERGY
 1005  FORMAT(' TOTAL ENERGY AVAILABLE = ',F7.1,/,
     * ' ENERGY TO SHIELDS =',$)
       ACCEPT *,SHELDS
       ENERGY = ENERGY - SHELDS
       GO TO 50
C** DAMAGE CONTROL
 600   IDMGD = 2
       CALL DAMGED
       CALL DAMGER
       GO TO 50
 700   CALL COMPUT
       GO TO 50
 888   CALL MAPER
       GO TO 50
 900   TYPE 1003
       ACCEPT 1002,ANEW
       IF(ANEW .EQ. YES)GO TO 45
       IF(ANEW .EQ. SNO)GO TO 999
       GO TO 900
 1003  FORMAT(/,$,' DO YOU WISH TO PLAY AGAIN? ')
 1002  FORMAT(A4)
 999   STOP
       END