	PROGRAM STARTR
C*********************************************************************
C*                                                                   *
C*                       THE STAR TREK GAME                          *
C*                               BY                                  *
C*               DAVID MATUSZEK AND PAUL REYNOLDS                    *
C*                                                                   *
C*              WITH MODIFICATIONS AND ADDITIONS BY                  *
C*                           DON SMITH                               *
C*                                                                   *
C*                      ADAPTED FOR RT-11 BY                         *
C*                         DAVID SWEENEY                             *
C*                                                                   *
C*         PERMISSION IS HEREBY GRANTED FOR THE COPYING,             *
C*    DISTRIBUTION, MODIFICATION AND USE OF THIS PROGRAM AND         *
C*    ASSOCIATED DOCUMENTATION FOR RECREATIONAL PURPOSES,            *
C*    PROVIDED THAT ALL REFERENCES TO THE AUTHORS ARE RETAINED.      *
C*    HOWEVER, PERMISSION IS NOT AND WILL NOT BE GRANTED FOR         *
C*    THE SALE OR PROMOTIONAL USE OF THIS PROGRAM OR PROGRAM         *
C*    DOCUMENTATION, OR FOR USE IN ANY SITUATION IN WHICH            *
C*    PROFIT MAY BE CONSIDERED AN OBJECTIVE, SINCE IT IS THE         *
C*    DESIRE OF THE AUTHORS TO RESPECT THE COPYRIGHTS OF THE         *
C*    ORIGINATORS OF STAR TREK.                                      *
C*                                                                   *
C*********************************************************************
C*BEGIN COMMON 
      COMMON SNAP,SNAPSHT(247), 
     +   DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL,
     +   KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), 
     +   NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM,
     +   NSCKILL,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY,
     +   QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20),  
     +   FUTURE(10),MESSAGE(5,10),
     +   INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD,
     +   INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, 
     +   QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), 
     +   LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, 
     +   KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8),
     +   DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,
     +   DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET,
     +   IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT,
     +   IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO,
     +   CRACKS(12) 
      INTEGER SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS,
     +   REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, 
     +   SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, 
     +   ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, 
     +   THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS
      REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD,   
     +   INENRG,INLSR 
	BYTE QUAD
	REAL*8 DEVICE,PASSWD
C*END COMMON 
	LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB
	1 ,IHSTAR,IHT,IHQUEST,IHNUM
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
	COMMON /PLAQ/ISCORE,PERDATE,ISKILL
	COMMON /RAN/IRAN1,IRAN2
      INTEGER XOR ,CROP
	LOGICAL FROZEN,LOCKUP
	REAL*8 ITEM,HELPX,TERM,ABAN,DEST,FREE,DEATH,AITEM
      REAL*8 COMMAND(21) 
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE (AITEM,ITEM)
      EQUIVALENCE (CRACKS(6),KDIDIT)
      DATA COMMAND/6HSRSCAN,6HLRSCAN,7HPHASERS,7HPHOTONS,4HMOVE,
     +   7HSHIELDS,4HDOCK,7HDAMAGES,5HCHART,7HIMPULSE,4HREST,4HWARP,
     +   6HSTATUS,7HSENSORS,5HORBIT,8HTRANSPOR,4HMINE,8HCRYSTALS,
     +   7HSHUTTLE,7HPLANETS,7HREQUEST/ 
      DATA IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED,IHYELLO,
     +IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB,IHT,IHNUM
     +/2HEO,2HRE,2HAL,1HS,1HR,1HC,1HK,2HGR,2HRE,2HYE,2HDO,1HE,1HF,
     +1H ,1H.,1H?,1HP,1H*,1HB,1HT,1H#/
	DATA DEVICE/8HS. R. SE,5HNSORS,8HL. R. SE,5HNSORS,
	1 7HPHASERS,1H ,8HPHOTON T,4HUBES,8HLIFE SUP,4HPORT,
	2 8HWARP ENG,4HINES,8HIMPULSE ,7HENGINES,7HSHIELDS,1H ,
	3 8HSUBSPACE,6H RADIO,8HSHUTTLE ,5HCRAFT,8HCOMPUTER,1H ,
	4 8HTRANSPOR,3HTER,8HSHIELD C,6HONTROL,8HDEATHRAY,
	5 1H /
	DATA HELPX,TERM,ABAN,DEST,FREE,DEATH/'HELP','TERMINAT',
	1 'ABANDON','DESTRUCT','FREEZE','DEATHRAY'/
	NDEVICE=14
	ICITE=0
C--------PRINT OUT PRELIMINARY MESSAGES 
      CALL PRELIM 
C--------INITIALIZE AND START NEW GAME
10	IF (.NOT.LOCKUP()) GO TO 12
	CALL SKIP(1)
	CALL PROUT(33HGAME LOCKED DURING WORKING HOURS.,33)
	CALL SKIP(3)
	CALL EXIT
12	CALL CHOOSE(FROZEN)
	IF(.NOT.FROZEN) CALL SETUP
C--------REQUEST NEW COMMAND AND BRANCH TO CODE FOR THAT COMMAND
 15   MOVED=0 
 20   IF(ALLDONE.NE.0) GO TO 9999 
	JUSTIN=0
	TIME=0.
      KDIDIT=0
      CALL PROMPT(10HCOMMAND:  ,10) 
      CALL SCAN 
      DO 30 L=1,21
	IF(CROP(ITEM,COMMAND(L)))
     +   GO TO (100,200,300,400,500,600,700,800,900,1000, 
     +   1100,1200,1300,1400,1450,1500,1550,1600,1650,1670,1680),L
 30   CONTINUE
      IF(ITEM .EQ. HELPX     ) GO TO 1700
      IF(ITEM .EQ. TERM) GO TO 9000
      IF(ITEM .EQ. ABAN  ) GO TO 1900
      IF(ITEM .EQ. DEST ) GO TO 2000
      IF(ITEM .EQ. FREE   ) GO TO 2100
      IF(ITEM .EQ. DEATH ) GO TO 2200
      IF(KEY .NE. IHEOL) GO TO 40 
      CALL PROUT(18HBLANK LINE IGNORED,18) 
      GO TO 20
 40     CALL PROUT(42HUNRECOGNIZED COMMAND.  LEGAL COMMANDS ARE:,42) 
       CALL PROUT(37H   SRSCAN    MOVE      PHASERS   HELP,37)
      CALL PROUT(41H   STATUS    IMPULSE   PHOTONS   ABANDON ,41)  
      CALL PROUT(41H   LRSCAN    WARP      SHIELDS   DESTRUCT,41)
      CALL PROUT(42H   CHART     REST      DOCK      TERMINATE,42) 
      CALL PROUT(38H   DAMAGES   FREEZE    SENSORS   ORBIT,38) 
      CALL PROUT(41H   TRANSPORT MINE      CRYSTALS  SHUTTLE ,41)  
      CALL PROUT(31H   PLANETS   REQUEST   DEATHRAY,31)
      GO TO 20
C--------SHORT RANGE SCAN 
 100  CALL SRSCAN 
      GO TO 20
C--------LONG RANGE SCAN
 200  CALL LRSCAN 
      GO TO 20
C--------FIRE PHASERS 
 300  CALL PHASERS
 305  IF(IDIDIT .EQ. 0) GO TO 20
 310  CALL ATTACK 
 320  IF(KDIDIT.NE.0) GO TO 2500 
	GO TO 15
C--------FIRE PHOTON TORPEDOS 
 400  CALL PHOTONS
 410  IF(IDIDIT .EQ. 0) GO TO 20
      MOVED=0 
      GO TO 2500
C--------MOVE UNDER WARP DRIVE
 500  IF(MOVED .EQ. 0) GO TO 510
505   MOVED=2     
 510  CALL WARP 
520   IF((IDIDIT.EQ.0).AND.(MOVED.EQ.2)) MOVED=1  
      IF(IDIDIT.EQ.0) GO TO 20
      IF((MOVED.EQ.2).AND.(JUSTIN.EQ.0)) CALL ATTACK
	MOVED=1
	GO TO 2500
C--------RAISE OR LOWER DEFLECTOR SHIELDS 
 600  CALL SHIELDS
      IF(IDIDIT .EQ. 0) GO TO 20
      CALL ATTACK 
      SHLDCHG=0 
      GO TO 320 
C--------DOCK AT STARBASE 
 700  CALL DOCK 
	GO TO 305
C--------LOOK AT DAMAGE REPORT
 800  CALL DREPORT
      GO TO 20
C--------LOOK AT STAR CHART 
 900  CALL CHART
      GO TO 20
C--------MOVE UNDER IMPULSE POWER 
 1000 IF(MOVED.NE.0) GO TO 505
      CALL IMPULSE
      GO TO 520 
C--------REST AND REPAIR
 1100 CALL WAIT 
      GO TO 410 
C--------CHANGE WARP FACTOR 
 1200 CALL SETWARP
      GO TO 20
C--------ASK FOR STATUS INFORMATION 
 1300 CALL STATUS 
      GO TO 20
C--------GET A SENSOR SCAN OF QUADRANT. 
 1400 CALL SENSOR 
      GO TO 20
C--------ENTER STANDARD ORBIT.
 1450 CALL ORBIT
      GO TO 410 
C--------TRANSPORT SOMEBODY SOMEWHERE.
 1500 CALL BEAM 
      GO TO 20
C--------DO A LITTLE DIGGING. 
 1550 CALL MINE 
      GO TO 410 
C--------LOAD SOME CRYSTALS (AND HOPE FOR THE BEST.)
 1600 CALL CRYSTAL
      GO TO 20
C--------GO FOR A SPIN IN GALILEO.
 1650 CALL GALILEO
      GO TO 410 
C--------GET A PLANET LIST
 1670 CALL PLANET 
      GO TO 20
C--------INDIVIDUAL PIECE OF INFORMATION FROM STATUS REQUESTED. 
 1680 CALL REQUEST
      GO TO 20
C--------CALL STARBASE FOR HELP 
 1700 CALL HELP 
      GO TO 20
C--------ABANDON SHIP 
 1900 CALL ABANDON
      GO TO 20
C--------SELF-DESTRUCT
 2000 CALL DESTRCT
      GO TO 20
C--------FREEZE THE CURRENT GAME
 2100 CALL FREEZE 
      IF(IDIDIT.EQ.1) GO TO 9999 
	GO TO 20
C--------TRY A DESPERATION MEASURE
 2200 CALL DEATHRA
      GO TO 305 
C--------AFTER COMMANDS WHICH MAY USE TIME, DO CHECKING 
 2500 IF(ALLDONE.NE.0) GO TO 9999 
      IF(TIME .NE. 0.) CALL EVENTS 
      IF(ALLDONE.NE.0) GO TO 9999 
      IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 2510
      CALL AUTOVER
	KDIDIT=0
	MOVED=0
      GO TO 2500
C--------CHECK FOR MOVE AND FIRE OPTION 
2510  IF(NENHERE.EQ.0) CALL MOVETHO   
      IF(KDIDIT .EQ. 1  .OR.  NENHERE .EQ. 0) GO TO 15    
      IF(MOVED .EQ. 0  .OR. JUSTIN .EQ. 1) GO TO 310 
	GO TO 20
C--------GAME HAS ENDED.  START NEW GAME OR FINALIZE. 
9000	CALL SCORE
 9999 CALL SKIP(2)
      CALL STARS
      CALL SKIP(1)
      CALL PROMPT(30HDO YOU WANT TO PLAY AGAIN?    ,30) 
      IF(JA(DUMMY)) GO TO 10
      CALL SKIP(1)
      CALL PROUT( 
     +   48HMAY THE GREAT BIRD OF THE GALAXY ROOST UPON YOUR,48) 
      CALL PROUT(12HHOME PLANET.,12) 
      CALL SKIP(1)
	CALL EXIT
	END
