SUBROUTINE ORBIT
	CALL PROSPC(1)
	RETURN
	END
	SUBROUTINE BEAM
	CALL PROSPC(2)
	RETURN
	END
	SUBROUTINE MINE
	CALL PROSPC(3)
	RETURN
	END
	SUBROUTINE GALILEO
	CALL PROSPC(4)
	RETURN
	END
	SUBROUTINE PROSPC(IZ)
C*       
C*  SUBROUTINE PROSPC CONTAINS ENTRY POINTS FOR : 
C*       
C*  ORBIT,BEAM,MINE,GALILEO
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
	+ ,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  
	CALL SKIP(1)
	GOTO (1001,1002,1003,1004),IZ
C* 
C      ENTRY ORBIT 
C* 
1001	IDIDIT=0
	IF(INORBIT .EQ. 0) GO TO 2
      CALL PROUT(26HALREADY IN STANDARD ORBIT.      ,26) 
      RETURN
C--------CHECK FOR ENGINE DAMAGE. 
 2    IF((DAMAGE(7) .EQ. 0.) .OR. (DAMAGE(6) .EQ. 0.)) GO TO 3
      CALL PROUT(38HBOTH WARP AND IMPULSE ENGINES DAMAGED.      ,38) 
      RETURN
C--------CHECK TO SEE IF SHIP ADJACENT TO PLANET. 
 3    IF(PLNETX .EQ. 0) GO TO 5
      IF(IABS(SECTX-PLNETX).LE.1 .AND. IABS(SECTY-PLNETY).LE.1) GO TO 10
 5    CALL CRAMSHP
      CALL CRAMDMP(24H NOT ADJACENT TO PLANET.  ) 
      RETURN
 10   TIME = .02+.03*RANF(0)
      IF(DAMAGE(6) .GT. 0.) TIME=TIME*10. 
C--------GO AHEAD, SULU.
      CALL PROUT(47HHELMSMAN SULU:  "ENTERING STANDARD ORBIT, SIR.",47)
      CALL NEWCOND
      ASSIGN 17 TO IWHERE 
 16   IDIDIT=1
      CALL EVENTS 
      IF(ALLDONE.EQ.1 .OR. GALAXY(QUADX,QUADY).EQ.1000 .OR. JUSTIN.EQ.1)
     +  RETURN
      GO TO IWHERE
 17   CALL CRAM(17HSULU:  "ALTITUDE   ) 
      HEIGHT=1400.+7200.*RANF(0)
      CALL CRAMF(HEIGHT,0,2)
      CALL CRAMDMP(13H KILOMETERS.")
	INORBIT=1
	RETURN
C* 
C      ENTRY BEAM
C* 
1002	IF(DAMAGE(12) .EQ. 0) GO TO 19
      CALL PROUT(21HTRANSPORTER DAMAGED.    ,21) 
	IF(DAMAGE(10) .NE. 0) RETURN
	CALL SKIP(1)
      CALL PROUT(47HSPOCK:  "MAY I SUGGEST THE SHUTTLE CRAFT, SIR.",47)
      RETURN
 19   IF(INORBIT.NE.0) GO TO 1910 
 1901 CALL CRAMSHP
      CALL CRAMDMP(23H NOT IN STANDARD ORBIT.   ) 
      RETURN
 1910 IF(SHLDUP .EQ. 0) GO TO 1920
      CALL PROUT(41HIMPOSSIBLE TO TRANSPORT THROUGH SHIELDS.  ,41)   
      RETURN
 1920 IF(PLNETS(IPLANET,5) .EQ. 1) GO TO 1940
 1930 CALL PROUT(56HSPOCK:  "CAPTAIN, WE HAVE NO INFORMATION ON THIS PLA
     CNET,      ,56) 
      CALL PROUT(64H  AND STARFLEET REGULATIONS CLEARLY STATE THAT IN TH
     CIS SITUATION    ,64) 
      CALL PROUT(23H  YOU MAY NOT GO DOWN."    ,23)
      RETURN
 1940 IF(LANDED .EQ. 1) GO TO 30
      IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 20
      CALL PROUT(45HSPOCK:   "CAPTAIN, I FAIL TO SEE THE LOGIC IN,45) 
      CALL PROUT( 
     +51H  EXPLORING A PLANET WITH NO DILITHIUM CRYSTALS.    ,51)    
	CALL PROMPT(30H  ARE YOU SURE THIS IS WISE?"       ,30) 
	IF(JA(DUMMY) .EQ. 0) RETURN
 20   CALL PROUT(41HSCOTTY:  "TRANSPORTER ROOM READY, SIR."     ,41) 
      CALL SKIP(1)
      CALL PROUT(62HKIRK AND LANDING PARTY PREPARE TO BEAM DOWN TO PLAN
     +ET SURFACE.       ,62) 
      CALL SKIP(1)
      CALL PROUT(18HKIRK:  "ENERGIZE."   ,18)
 21   CALL SKIP(1)
      CALL PROUT(41HWWHOOOIIIIIRRRRREEEE.E.E. . . . .  .   .       ,41)
      IF(RANF(0) .GT. 0.98) GO TO 35
      CALL PROUT(41H.   .  . . . . .E.E.EEEERRRRRIIIIIOOOHWW      ,41) 
      CALL SKIP(1)
      CALL PROUT(19HTRANSPORT COMPLETE.    ,19)
      LANDED = LANDED *(-1) 
      IF((LANDED .NE. 1) .AND. (IMINE .EQ. 1)) ICRYSTL = 1
      IMINE=0 
      RETURN
C--------READY TO BEAM UP TO SHIP.
 30   IF(ISCRAFT .EQ. 1) GO TO 32 
      CALL PROUT(42HYOU MAY NOT LEAVE SHUTTLE CRAFT ON PLANET.    ,42) 
      RETURN
 32   CALL PROUT(42HLANDING PARTY ASSEMBLED, READY TO BEAM UP.     ,42)
      CALL SKIP(1)
      CALL PROUT(31HKIRK WHIPS OUT COMMUNICATOR...   ,31)  
      CALL PROUT(17HBEEP  BEEP  BEEP     ,17)
      CALL SKIP(1)
      CALL PROUT(54H"KIRK TO ENTERPRISE:  LOCK ON COORDINATES...ENERGIZE
     C."    ,54) 
      GO TO 21
C--------CATASTROPHE!       
 35   CALL SKIP(1)
      CALL PROUT(31HBOOOIIIOOOIIOOOOIIIOIING . . .   ,31)      
	CALL SKIP(1)
      CALL PROUT(38HSCOTTY:  "OH MY GOD!  I'VE LOST THEM."    ,38)   
	CALL FINISH(13)
	RETURN
C* 
C      ENTRY MINE
C* 
1003	IDIDIT=0
      IF(LANDED .EQ. 1) GO TO 50
      CALL PROUT(27HMINING PARTY NOT ON PLANET.   ,27) 
      RETURN
 50   IF(PLNETS(IPLANET,4) .EQ. 1) GO TO 51
      CALL PROUT(37HNO DILITHIUM CRYSTALS ON THIS PLANET.    ,37)
      RETURN
 51   TIME =(0.1+0.2*RANF(0)) * PLNETS(IPLANET,3)
	ASSIGN 52 TO IWHERE
	GO TO 16
 52   CALL PROUT(26HMINING OPERATION COMPLETE.   ,26)
	IMINE=1
	RETURN
C* 
C      ENTRY GALILEO 
C* 
1004	IDIDIT = 0
      IF(DAMAGE(10)) 70,72,73
 70   IF(DAMAGE(10) .EQ. -1.) GO TO 71
      CALL PROUT(36HSHUTTLE CRAFT NOW SERVING BIG MAC'S.,36)
	RETURN
 71   CALL PROUT(38HYE FAERIE QUEENE HAS NO SHUTTLE CRAFT.  ,38) 
      RETURN
 72   CALL PROUT(22HSHUTTLE CRAFT DAMAGED.  ,22) 
      RETURN
 73   IF(INORBIT .NE. 1) GO TO 1901 
      IF(SHLDUP .EQ. 0 .AND. CONDIT .NE. IHDOCKD) GO TO 80
      CALL PROUT(42HSHUTTLE CRAFT CANNOT PASS THROUGH SHIELDS.,42) 
      RETURN
 80   IF(PLNETS(IPLANET,5) .NE. 1) GO TO 1930
      TIME=3.0E-5*HEIGHT
      IF(LANDED .NE. 1) GO TO 100 
      IF(ISCRAFT .NE. 1) GO TO 98 
C--------SHUTTLE CRAFT TO THE RESCUE. 
      IF(DAMAGE(12) .NE. 0) GO TO 90
	CALL PROMPT(47HSPOCK:  "WOULD YOU RATHER USE THE TRANSPORTER?",47)
      IF(JA(DUMMY)) RETURN
      CALL CRAM(13HSHUTTLE CREW ) 
	GO TO 94
 90   CALL CRAM(13HRESCUE PARTY ) 
94	CALL CRAMDMP(
	+50HBOARDS "GALILEO" AND SWOOPS TOWARD PLANET SURFACE.)
      ISCRAFT=0 
      ASSIGN 140 TO IWHERE 
      GO TO 16
C--------LANDING PARTY BOARDS GALILEO FOR TRIP BACK TO SHIP.
 98   CALL PROUT(35HYOU AND YOUR MINING PARTY BOARD THE   ,35) 
      CALL PROUT( 
     +51HSHUTTLE CRAFT FOR THE TRIP BACK TO THE ENTERPRISE.     ,51) 
      CALL SKIP(1)
      CALL PROUT(26HTHE SHORT HOP BEGINS . . .   ,26)
	ICRAFT=1
	LANDED=-1
	ASSIGN 120 TO IWHERE
	GO TO 16
C--------LANDING PARTY HEADS DOWN TO PLANET.
 100  CALL PROUT(42HMINING PARTY ASSEMBLES IN THE HANGAR DECK,,42) 
      CALL PROUT(45HREADY TO BOARD THE SHUTTLE CRAFT "GALILEO."  ,45)  
      CALL SKIP(1)
      CALL PROUT(41HTHE HANGAR DOORS OPEN;  THE TRIP BEGINS.  ,41)   
	ICRAFT=1
	ISCRAFT=0
	ASSIGN 130 TO IWHERE
	GO TO 16
120	ISCRAFT=1
	IF(IMINE.NE.0) ICRYSTL=1
	IMINE=0
	GO TO 135
130	LANDED = 1
135	ICRAFT = 0
140	CALL SKIP(1)
	CALL PROUT(14HTRIP COMPLETE.,14)
	RETURN
      END