PROGRAM STRTRK C C SSSSSSS TTTTTTTT A RRRRRRR C SSSSSSSS TTTTTTTT AAA RRRRRRRR C SS TT AAA RR RR C SSSSSSS TT AA AA RR RR C SSSSSSS TT AA AA RRRRRRRR C SS TT AAAAAAA RRRRRRR C SS TT AAAAAAA RR RR C SSSSSSSS TT AA AA RR RR C SSSSSSS TT AA AA RR RR C C C C TTTTTTTT RRRRRRR EEEEEEEEE KK KK C TTTTTTTT RRRRRRRR EEEEEEEEE KK KK C TT RR RR EE KK KK C TT RR RR EEEEEE KKKKKK C TT RRRRRRRR EEEEEE KKKKK C TT RRRRRRR EE KK KK C TT RR RR EE KK KK C TT RR RR EEEEEEEEE KK KK C TT RR RR EEEEEEEEE KK KK C C C 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 AND CASSIUS SMITH * C* * 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********************************************************************* INCLUDE 'TREK.COM' INCLUDE 'TREK2.COM' COMMON /RAN/IRAN1,IRAN2 INTEGER XOR ,CROP LOGICAL FROZEN REAL*8 ITEMB,HELPX,TERM,ABAN,DEST,FREE,DEATH,AITEM REAL*8 COMMND(21) REAL*4 MCR COMMON/SCANBF/KEY,AITEM EQUIVALENCE (AITEM,ITEMB) EQUIVALENCE (CRACKS(6),KDIDIT) DATA MCR/6R...MCR/ DATA COMMND/6HSRSCAN,6HLRSCAN,7HPHASERS,7HPHOTONS,4HMOVE, + 7HSHIELDS,4HDOCK,7HDAMAGES,5HCHART,7HIMPULSE,4HREST,4HWARP, + 6HSTATUS,7HSENSORS,5HORBIT,8HTRANSPOR,4HMINE,8HCRYSTALS, + 7HSHUTTLE,7HPLANETS,7HREQUEST/ DATA IHEOL,IHREAL,IHALPH,IHS,IHR,IHC,IHK,IHGRN,IHRED,IHYELO, +IHDCKD,IHE,IHF,IHBLNK,IHDOT,IHQUST,IHP,IHSTAR,IHB/2HEO,2HRE, +2HAL,1HS,1HR,1HC,1HK,2HGR,2HRE,2HYE,2HDO,1HE,1HF, +1H ,1H.,1H?,1HP,1H*,1HB/ DATA IHT,IHNUM/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'/ DATA IEOL/'EO'/ DATA IDISC/6/ NDEVIC=14 ICITE=0 C--------OPEN UP FILE FOR BATTLE LOG 7 IF (NODISC .NE. 0) CLOSE (UNIT=IDISC) !CLOSE FILE IF OPEN OPEN (UNIT=IDISC,NAME='[307,6]BATTLE.LOG',TYPE='NEW', & ERR=8,DISPOSE='SAVE') NODISC = 0 C--NO ERROR SO ALL O.K. GO TO 9 8 STOP ' --- *FATAL* FILE OPEN ERROR' C--------PRINT OUT PRELIMINARY MESSAGES 9 CALL PRELIM C--------INITIALIZE AND START NEW GAME 10 CALL CHOOSE(FROZEN) IF(FROZEN) GOTO 15 CALL SETUP C--------REQUEST NEW COMMAND AND BRANCH TO CODE FOR THAT COMMAND 15 MOVED=0 20 IF(ALLDON.NE.0) GO TO 9999 JUSTIN=0 TIME=0. KDIDIT=0 CALL PROMPT(10HCOMMAND: ,10) CALL SCAN DO 30 L=1,21 IF(CROP(ITEMB,COMMND(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(ITEMB .EQ. HELPX ) GO TO 1700 IF(ITEMB .EQ. TERM) GO TO 9000 IF(ITEMB .EQ. ABAN ) GO TO 1900 IF(ITEMB .EQ. DEST ) GO TO 2000 IF(ITEMB .EQ. FREE ) GO TO 2100 IF(ITEMB .EQ. DEATH ) GO TO 2200 IF(KEY .NE. IEOL) 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 PHASER 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 PHOTON 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 SHIELD IF(IDIDIT .EQ. 0) GO TO 20 CALL ATTACK SHLDCH=0 GO TO 320 C--------DOCK AT STARBASE 700 CALL DOCK IF(IDIDIT.NE.0) GO TO 310 GO TO 20 C--------LOOK AT DAMAGE REPORT 800 CALL DREPRT 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 IMPULS GO TO 520 C--------REST AND REPAIR 1100 CALL WAIT GO TO 410 C--------CHANGE WARP FACTOR 1200 CALL SETWRP 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 CRYSTL GO TO 20 C--------GO FOR A SPIN IN GALILEO. 1650 CALL GALLEO GO TO 410 C--------GET A PLANET LIST 1670 CALL PLANET GO TO 20 C--------INDIVIDUAL PIECE OF INFORMATION FROM STATUS REQUESTED. 1680 CALL REQUST GO TO 20 C--------CALL STARBASE FOR HELP 1700 CALL HELP GO TO 20 C--------ABANDON SHIP 1900 CALL ABANDN GO TO 20 C--------SELF-DESTRUCT 2000 CALL DSTRCT 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 DTHRAY GO TO 305 C--------AFTER COMMANDS WHICH MAY USE TIME, DO CHECKING 2500 IF(ALLDON.NE.0) GO TO 9999 IF(TIME .NE. 0.) CALL EVENTS IF(ALLDON.NE.0) GO TO 9999 IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 2510 CALL AUTOVR KDIDIT=0 MOVED=0 GO TO 2500 C--------CHECK FOR MOVE AND FIRE OPTION 2510 IF(NENHER.EQ.0) CALL MOVTHO IF(KDIDIT .EQ. 1 .OR. NENHER .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(5) CLOSE (UNIT=IDISC) !CLOSE BATTLE.LOG FILE NODISC = 1 !SET FLAG FOR PROUT & PROMPT CALL PROMPT(30HDO YOU WANT TO PLAY AGAIN? ,30) IF(JA(DUMMY)) GO TO 7 CALL SKIP(1) CALL PROUT( + 48HA RECORD OF YOUR GAME HAS BEEN CREATED, AND MAY ,48) CALL PROUT( + 48HBE PRINTED BY THE MCR COMMAND: QUE BATTLE.LOG/DE,48) CALL SKIP(1) CALL PROUT( + 48HMAY THE GREAT BIRD OF THE GALAXY ROOST UPON YOUR,48) CALL PROUT(12HHOME PLANET.,12) CALL SKIP(1) IF(ICITE .EQ. 0) GO TO 99999 CALL PROUT(52HDON'T FORGET TO TYPE TO RECEIVE YOUR CITATION. C,52) 99999 CALL REQUES(MCR) END