home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part17 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.4 KB
  1. Path: uunet!decwrl!concert!lester.appstate.edu!pembvax1.pembroke.edu!rennie
  2. From: rennie@pembvax1.pembroke.edu
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Star Trek - Part [17/18]
  5. Date: 7 Apr 93 11:09:57 EDT
  6. Organization: Pembroke State University
  7. Lines: 436
  8. Message-ID: <1993Apr7.110957.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:659
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 17 -+-+-+-+-+-+-+-+
  13. X221`09CALL CRAM(11HSTARBASE IN )
  14. X`09CALL CRAMLOC(1,BATX,BATY)
  15. X`09CALL CRAMDMP(27H IS CURRENTLY UNDER ATTACK.)
  16. X`09CALL CRAM(31HIT CAN HOLD OUT UNTIL STARDATE  )
  17. X`09CALL CRAMF(FUTURE(5),0,1)
  18. X`09CALL CRAMDMP(1H.)
  19. XC*--IS THE SUPER COMMANDER ATTACKING?
  20. X240`09IF(ISSOS.EQ.0)GO TO 245
  21. X`09IF(ISATB.NE.1) GOTO 245
  22. X`09CALL CRAM(11HSTARBASE IN )
  23. X`09CALL CRAMLOC(1,ISX,ISY)
  24. X`09CALL CRAMDMP(33H IS UNDER SUPER-COMMANDER ATTACK. )
  25. X`09CALL CRAM(31HIT CAN HOLD OUT UNTIL STARDATE )
  26. X`09CALL CRAMF(FUTURE(7),0,1)
  27. X`09CALL CRAMDMP(1H.)
  28. XC*--ISSUE CAVEAT IF THE SUBSPACE RADIO HAS BEEN BROKEN
  29. X245`09IF(ISUBDAM.EQ.0)GO TO 249
  30. X`09CALL CRAM('THE SUBSPACE RADIO ')
  31. X`09IF(DAMAGE(9).NE.0)CALL CRAM('IS')
  32. X`09IF(DAMAGE(9).EQ.0)CALL CRAM('WAS')
  33. X`09CALL CRAMDMP(' DAMAGED.  THUS YOU MAY NOT HAVE COMPLETE')
  34. X`09CALL CRAMDMP('INFORMATION ON SUPERNOVAS AND ATTACKS ON BASES.')
  35. XC*--HOW MANY CASUALTIES?
  36. X249`09IF(CASUAL.EQ.0) GOTO 250
  37. X`09CALL CRAMSPI(CASUAL,'CASUALT','Y','IES')
  38. X`09CALL CRAMDMP(' SUFFERED SO FAR.')
  39. X250`09IF(NHELP.EQ.0) GOTO 260
  40. X`09CALL CRAMSP(NHELP,'CALL')
  41. X`09CALL CRAMDMP(' FOR HELP.')
  42. X260`09CALL SKIP(1)
  43. XC*--AND LET HIM PLAY IT
  44. X`09RETURN
  45. XC*--THAT WAS A BAD FREEZE OR FILE NOT OPENED
  46. X800`09CALL PROUT(17H GAME NOT FROZEN.  ,17)
  47. XC*--TELL CHOOSE THAT WE DIDN'T GET ANYTHING
  48. X`09PASSWD=0.D0
  49. X`09RETURN
  50. X`09END
  51. $ CALL UNPACK TRTHAW.FOR;1 1667292104
  52. $ create 'f'
  53. X      SUBROUTINE TIMEWRP
  54. X`09INCLUDE 'TREKCOM/NOLIST'
  55. X      DIMENSION PICTURE(226)
  56. X      EQUIVALENCE (PICTURE,DATE)
  57. X      CALL PROUT(21H***TIME WARP ENTERED.,21)
  58. X      IF(SNAP.NE.0 .AND. RANF(0).LT.0.5) GO TO 10`20
  59. XC--------TRAVEL FORWARD IN TIME`20
  60. X      TIME=-0.5*INTIME*ALOG(RANF(0))
  61. X      CALL CRAM(35HYOU ARE TRAVELLING FORWARD IN TIME )`20
  62. X      CALL CRAMF(TIME,0,2)
  63. X      CALL CRAMDMP(11H STARDATES.)
  64. XC--------CHEAT TO MAKE SURE NO TRACTOR BEAMS OCCUR DURING TIME WARP`20
  65. X      FUTURE(2)=FUTURE(2)+TIME
  66. X      GO TO 40
  67. XC--------TRAVEL BACKWARD IN TIME
  68. X 10   XDATE=DATE
  69. X      DATE=SNAPSHT(1)`20
  70. X      CALL CRAM(36HYOU ARE TRAVELLING BACKWARD IN TIME )
  71. X      CALL CRAMF(XDATE-DATE,0,2)
  72. X      CALL CRAMDMP(11H STARDATES.)
  73. X      SNAP=0
  74. X      DO 20 L=2,226`20
  75. X 20   PICTURE(L)=SNAPSHT(L)`20
  76. X      IF(REMCOM .EQ. 0) GO TO 25
  77. X      FUTURE(2)=DATE+EXPRAN(INTIME/REMCOM)
  78. X      FUTURE(4)=DATE+EXPRAN(0.3*INTIME)`20
  79. X 25   FUTURE(1)=DATE+EXPRAN(0.5*INTIME)`20
  80. X      FUTURE(3)=DATE+EXPRAN(0.5*INTIME)`20
  81. X      IF(NSCREM.NE.0) FUTURE(6)=0.2777
  82. X      ISATB=0`20
  83. X      FUTURE(5)=1E38`20
  84. X`09FUTURE(7)=1E38
  85. X`09BATX=0
  86. X`09BATY=0
  87. XC--------REVERT STAR CHART TO EARLIER ERA.
  88. X      DO 30 L=1,8`20
  89. X      DO 30 LL=1,8
  90. X 30   STARCH(L,LL)=MIN0(1,STARCH(L,LL))`20
  91. X      CALL PROUT(`20
  92. X     +   57HSPOCK HAS RECONSTRUCTED A CORRECT STAR CHART FROM MEMORY.
  93. X`091 ,57)
  94. XC--------MODIFY DESTINATION QUADRANT TO CORRESPOND TO NEW TIME
  95. X 40   CALL NEWQUAD
  96. X      RETURN
  97. X      END`20
  98. $ CALL UNPACK TRTIMEWRP.FOR;1 1768519900
  99. $ create 'f'
  100. X`09PROGRAM STARTRK
  101. XC*********************************************************************
  102. XC*                                                                   *
  103. XC*                       THE STAR TREK GAME                          *
  104. XC*                               BY                                  *
  105. XC*               DAVID MATUSZEK AND PAUL REYNOLDS                    *
  106. XC*                                                                   *
  107. XC*              WITH MODIFICATIONS AND ADDITIONS BY                  *
  108. XC*                           DON SMITH                               *
  109. XC*                                                                   *
  110. XC*                                                                   *
  111. XC*         PERMISSION IS HEREBY GRANTED FOR THE COPYING,             *
  112. XC*    DISTRIBUTION, MODIFICATION AND USE OF THIS PROGRAM AND         *
  113. XC*    ASSOCIATED DOCUMENTATION FOR RECREATIONAL PURPOSES,            *
  114. XC*    PROVIDED THAT ALL REFERENCES TO THE AUTHORS ARE RETAINED.      *
  115. XC*    HOWEVER, PERMISSION IS NOT AND WILL NOT BE GRANTED FOR         *
  116. XC*    THE SALE OR PROMOTIONAL USE OF THIS PROGRAM OR PROGRAM         *
  117. XC*    DOCUMENTATION, OR FOR USE IN ANY SITUATION IN WHICH            *
  118. XC*    PROFIT MAY BE CONSIDERED AN OBJECTIVE, SINCE IT IS THE         *
  119. XC*    DESIRE OF THE AUTHORS TO RESPECT THE COPYRIGHTS OF THE         *
  120. XC*    ORIGINATORS OF STAR TREK.                                      *
  121. XC*                                                                   *
  122. XC*********************************************************************
  123. XC
  124. XC`094-APR-79
  125. XC`09MAKE COMMAND INPUT REPROMPT AFTER A BLANK LINE WITHOUT
  126. XC`09TYPING OUT A BUNCH OF GARBAGE.
  127. XC`09ALSO GET RID OF THE CRAP ABOUT TYPING SOMETHING TO GET
  128. XC`09YOUR CITATION.
  129. XC`0913-APR-79
  130. XC`09ADD EMERGENCY EXIT COMMAND.
  131. XC`0925-APR-79
  132. XC`09GET RID OF COMMON /RAN/, WHICH IS NOT REFERENCED.
  133. XC`091-MAY-79
  134. XC`09REDO ALL MODULES TO GET THEIR COMMON FROM AN INCLUDE STATEMENT.
  135. XC`09THIS SHOULD GREATLY SIMPLIFY MAINTENANCE AND EXTENSION OF THE
  136. XC`09GAME.
  137. XC`09ALSO ADD 'GAME' COMMAND TO MAKE LIFE EASIER FOR THE PLAYER ON
  138. XC`09A SOFT COPY TERMINAL.
  139. XC`0931-MAY-79
  140. XC`09CLOSE PRINT FILE AND RESET LUN TO 1 AFTER OUTPUTTING SCORE
  141. XC`09AND/OR CITATION.
  142. XC
  143. X`09PARAMETER NCOMMDS=23
  144. X`09INCLUDE 'TREKCOM/LIST'
  145. X`09INTEGER CROP
  146. X`09LOGICAL FROZEN
  147. X`09REAL*8 ITEM,HELPX,TERM,ABAN,DEST,FREE,DEATH,AITEM
  148. X`09REAL*8 COMMAND(NCOMMDS)
  149. X`09COMMON/PRLUN/LUN
  150. X`09COMMON/SCANBF/KEY,AITEM
  151. X`09EQUIVALENCE (AITEM,ITEM)
  152. X`09EQUIVALENCE (CRACKS(6),KDIDIT)
  153. XC
  154. XC`09MASTER COMMAND LIST - INCLUDES ALL ABBREVIATABLE COMMANDS
  155. XC
  156. X      DATA COMMAND/6HSRSCAN,6HLRSCAN,7HPHASERS,7HPHOTONS,4HMOVE,
  157. X     +   7HSHIELDS,4HDOCK,7HDAMAGES,5HCHART,7HIMPULSE,4HREST,4HWARP,
  158. X     +   6HSTATUS,7HSENSORS,5HORBIT,8HTRANSPOR,4HMINE,8HCRYSTALS,
  159. X     +   7HSHUTTLE,7HPLANETS,7HREQUEST,6HEMEXIT,4HGAME/`20
  160. XC
  161. XC`09ALPHANUMERIC DATA
  162. XC
  163. X      DATA IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED,IHYELLO,
  164. X     +IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB/2HEO,2HRE,
  165. X     +2HAL,1HS,1HR,1HC,1HK,2HGR,2HRE,2HYE,2HDO,1HE,1HF,
  166. X     +1H ,1H.,1H?,1HP,1H*,1HB/
  167. X      DATA IHT,IHNUM/1HT,1H#/`20
  168. XC
  169. XC`09DEVICE LIST
  170. XC
  171. XC`09DEVICES ARE:
  172. XC`091.  S. R. SENSORS
  173. XC`092.  L. R. SENSORS
  174. XC`093.  PHASERS
  175. XC`094.  PHOTON TUBES
  176. XC`095.  LIFE SUPPORT
  177. XC`096.  WARP ENGINES
  178. XC`097.  IMPULSE ENGINES
  179. XC`098.  SHIELDS
  180. XC`099.  SUBSPACE RADIO
  181. XC`0910. SHUTTLE CRAFT
  182. XC`0911. COMPUTER
  183. XC`0912. TRANSPORTER
  184. XC`0913. SHIELD CONTROL
  185. XC`0914. DEATHRAY
  186. XC
  187. X`09DATA DEVICE/8HS. R. SE,5HNSORS,8HL. R. SE,5HNSORS,
  188. X`091 7HPHASERS,1H ,8HPHOTON T,4HUBES,8HLIFE SUP,4HPORT,
  189. X`092 8HWARP ENG,4HINES,8HIMPULSE ,7HENGINES,7HSHIELDS,1H ,
  190. X`093 8HSUBSPACE,6H RADIO,8HSHUTTLE ,5HCRAFT,8HCOMPUTER,1H ,
  191. X`094 8HTRANSPOR,3HTER,8HSHIELD C,6HONTROL,8HDEATHRAY,
  192. X`095 1H /
  193. XC
  194. XC`09NON-ABBREVIATABLE COMMAND LIST
  195. XC
  196. X`09DATA HELPX,TERM,ABAN,DEST,FREE,DEATH/'HELP','TERMINAT',
  197. X`091 'ABANDON','DESTRUCT','FREEZE','DEATHRAY'/
  198. XC
  199. X`09NDEVICE=14
  200. X`09ICITE=0
  201. XC--------PRINT OUT PRELIMINARY MESSAGES`20
  202. X      CALL PRELIM`20
  203. XC--------INITIALIZE AND START NEW GAME
  204. X10`09CALL CHOOSE(FROZEN)
  205. X`09IF(FROZEN) GOTO 15
  206. X`09CALL SETUP
  207. XC--------REQUEST NEW COMMAND AND BRANCH TO CODE FOR THAT COMMAND
  208. X 15   MOVED=0`20
  209. X 20   IF(ALLDONE.NE.0) GO TO 9999`20
  210. X`09JUSTIN=0
  211. X`09TIME=0.
  212. X      KDIDIT=0
  213. X      CALL PROMPT(10HCOMMAND:  ,10)`20
  214. X      CALL SCAN`20
  215. X      DO 30 L=1,NCOMMDS
  216. X`09IF(CROP(ITEM,COMMAND(L)))
  217. X     +   GO TO (100,200,300,400,500,600,700,800,900,1000,`20
  218. X     +   1100,1200,1300,1400,1450,1500,1550,1600,1650,1670,
  219. X     +   1680,1685,1690),L
  220. X 30   CONTINUE
  221. X      IF(ITEM .EQ. HELPX     ) GO TO 1700
  222. X      IF(ITEM .EQ. TERM) GO TO 9000
  223. X      IF(ITEM .EQ. ABAN  ) GO TO 1900
  224. X      IF(ITEM .EQ. DEST ) GO TO 2000
  225. X      IF(ITEM .EQ. FREE   ) GO TO 2100
  226. X      IF(ITEM .EQ. DEATH ) GO TO 2200
  227. X      IF(KEY .NE. IHEOL) GO TO 40`20
  228. XC     CALL PROUT(18HBLANK LINE IGNORED,18)`20
  229. X      GO TO 20
  230. X 40   CALL PROUT(`20
  231. X     +   42HUNRECOGNIZED COMMAND.  LEGAL COMMANDS ARE:,42)`20
  232. X      CALL PROUT(`20
  233. X     +   37H   SRSCAN    MOVE      PHASERS   HELP,37)
  234. X      CALL PROUT(`20
  235. X     +   40H   STATUS    IMPULSE   PHOTONS   ABANDON,40) `20
  236. X      CALL PROUT(`20
  237. X     +   41H   LRSCAN    WARP      SHIELDS   DESTRUCT,41)
  238. X      CALL PROUT(`20
  239. X     +   42H   CHART     REST      DOCK      TERMINATE,42)`20
  240. X      CALL PROUT(`20
  241. X     +   38H   DAMAGES   FREEZE    SENSORS   ORBIT,38)`20
  242. X      CALL PROUT(`20
  243. X     +   40H   TRANSPORT MINE      CRYSTALS  SHUTTLE,40) `20
  244. X      CALL PROUT(`20
  245. X     +   39H   PLANETS   REQUEST   DEATHRAY  EMEXIT,39)
  246. X      CALL PROUT(
  247. X     +    7H   GAME,7)
  248. X      GO TO 20
  249. XC--------SHORT RANGE SCAN`20
  250. X 100  CALL SRSCAN`20
  251. X      GO TO 20
  252. XC--------LONG RANGE SCAN
  253. X 200  CALL LRSCAN`20
  254. X      GO TO 20
  255. XC--------FIRE PHASERS`20
  256. X 300  CALL PHASERS
  257. X 305  IF(IDIDIT .EQ. 0) GO TO 20
  258. X 310  CALL ATTACK`20
  259. X 320  IF(KDIDIT.NE.0) GO TO 2500`20
  260. X`09GO TO 15
  261. XC--------FIRE PHOTON TORPEDOS`20
  262. X 400  CALL PHOTONS
  263. X 410  IF(IDIDIT .EQ. 0) GO TO 20
  264. X      MOVED=0`20
  265. X      GO TO 2500
  266. XC--------MOVE UNDER WARP DRIVE
  267. X 500  IF(MOVED .EQ. 0) GO TO 510
  268. X505   MOVED=2    `20
  269. X 510  CALL WARP`20
  270. X520   IF((IDIDIT.EQ.0).AND.(MOVED.EQ.2)) MOVED=1 `20
  271. X      IF(IDIDIT.EQ.0) GO TO 20
  272. X      IF((MOVED.EQ.2).AND.(JUSTIN.EQ.0)) CALL ATTACK
  273. X`09MOVED=1
  274. X`09GO TO 2500
  275. XC--------RAISE OR LOWER DEFLECTOR SHIELDS`20
  276. X 600  CALL SHIELDS
  277. X      IF(IDIDIT .EQ. 0) GO TO 20
  278. X      CALL ATTACK`20
  279. X      SHLDCHG=0`20
  280. X      GO TO 320`20
  281. XC--------DOCK AT STARBASE`20
  282. X 700  CALL DOCK`20
  283. X      IF(IDIDIT.NE.0) GO TO 310
  284. X`09GO TO 20
  285. XC--------LOOK AT DAMAGE REPORT
  286. X 800  CALL DREPORT
  287. X      GO TO 20
  288. XC--------LOOK AT STAR CHART`20
  289. X 900  CALL CHART
  290. X      GO TO 20
  291. XC--------MOVE UNDER IMPULSE POWER`20
  292. X 1000 IF(MOVED.NE.0) GO TO 505
  293. X      CALL IMPULSE
  294. X      GO TO 520`20
  295. XC--------REST AND REPAIR
  296. X 1100 CALL WAIT`20
  297. X      GO TO 410`20
  298. XC--------CHANGE WARP FACTOR`20
  299. X 1200 CALL SETWARP
  300. X      GO TO 20
  301. XC--------ASK FOR STATUS INFORMATION`20
  302. X 1300 CALL STATUS`20
  303. X      GO TO 20
  304. XC--------GET A SENSOR SCAN OF QUADRANT.`20
  305. X 1400 CALL SENSOR`20
  306. X      GO TO 20
  307. XC--------ENTER STANDARD ORBIT.
  308. X 1450 CALL ORBIT
  309. X      GO TO 410`20
  310. XC--------TRANSPORT SOMEBODY SOMEWHERE.
  311. X 1500 CALL BEAM`20
  312. X      GO TO 20
  313. XC--------DO A LITTLE DIGGING.`20
  314. X 1550 CALL MINE`20
  315. X      GO TO 410`20
  316. XC--------LOAD SOME CRYSTALS (AND HOPE FOR THE BEST.)
  317. X 1600 CALL CRYSTAL
  318. X      GO TO 20
  319. XC--------GO FOR A SPIN IN GALILEO.
  320. X 1650 CALL GALILEO
  321. X      GO TO 410`20
  322. XC--------GET A PLANET LIST
  323. X 1670 CALL PLANET`20
  324. X      GO TO 20
  325. XC--------INDIVIDUAL PIECE OF INFORMATION FROM STATUS REQUESTED.`20
  326. X 1680 CALL REQUEST
  327. X      GO TO 20
  328. XC--------EMERGENCY EXIT - FREEZE ON EMSAVE.TRK AND BUG OUT
  329. X 1685 CALL EMEXIT
  330. X      GO TO 20
  331. XC--------GAME - TYPE OUT INFORMATION ON CURRENT GAME
  332. X 1690 CALL GAME
  333. X      GO TO 20
  334. XC--------CALL STARBASE FOR HELP`20
  335. X 1700 CALL HELP`20
  336. X      GO TO 20
  337. XC--------ABANDON SHIP`20
  338. X 1900 CALL ABANDON
  339. X      GO TO 20
  340. XC--------SELF-DESTRUCT
  341. X 2000 CALL DESTRCT
  342. X      GO TO 20
  343. XC--------FREEZE THE CURRENT GAME
  344. X 2100 CALL FREEZE`20
  345. X      IF(IDIDIT.EQ.1) GO TO 9999`20
  346. X`09GO TO 20
  347. XC--------TRY A DESPERATION MEASURE
  348. X 2200 CALL DEATHRA
  349. X      GO TO 305`20
  350. XC--------AFTER COMMANDS WHICH MAY USE TIME, DO CHECKING`20
  351. X 2500 IF(ALLDONE.NE.0) GO TO 9999`20
  352. X      IF(TIME .NE. 0.) CALL EVENTS`20
  353. X      IF(ALLDONE.NE.0) GO TO 9999`20
  354. X      IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 2510
  355. X      CALL AUTOVER
  356. X`09KDIDIT=0
  357. X`09MOVED=0
  358. X      GO TO 2500
  359. XC--------CHECK FOR MOVE AND FIRE OPTION`20
  360. X2510  IF(NENHERE.EQ.0) CALL MOVETHO  `20
  361. X      IF(KDIDIT .EQ. 1  .OR.  NENHERE .EQ. 0) GO TO 15   `20
  362. X      IF(MOVED .EQ. 0  .OR. JUSTIN .EQ. 1) GO TO 310`20
  363. X`09GO TO 20
  364. XC--------GAME HAS ENDED.  START NEW GAME OR FINALIZE.`20
  365. X9000`09CALL SCORE
  366. X9999`09IF(LUN.EQ.2)CALL CLOSE(2)
  367. X`09LUN=1
  368. X      CALL SKIP(2)
  369. X      CALL STARS
  370. X      CALL SKIP(1)
  371. X      CALL PROMPT(30HDO YOU WANT TO PLAY AGAIN?    ,30)`20
  372. X      IF(JA(DUMMY)) GO TO 10
  373. X      CALL SKIP(1)
  374. X      CALL PROUT(`20
  375. X     +   48HMAY THE GREAT BIRD OF THE GALAXY ROOST UPON YOUR,48)`20
  376. X      CALL PROUT(12HHOME PLANET.,12)`20
  377. X      CALL SKIP(1)
  378. XC     IF(ICITE .EQ. 0) GO TO 99999
  379. XC     CALL PROUT(52HDON'T FORGET TO TYPE <RSF> TO RECEIVE YOUR CITATION.
  380. V     `20
  381. XC    C,52)
  382. X99999`09CALL EXIT
  383. X`09END
  384. $ CALL UNPACK TRTREK.FOR;1 1064939805
  385. $ create 'f'
  386. X      SUBROUTINE WAIT`20
  387. X`09INCLUDE 'TREKCOM/NOLIST'
  388. X`09REAL*8 AITEM
  389. X`09COMMON/SCANBF/KEY,AITEM
  390. X`09EQUIVALENCE(AITEM,FNUM)
  391. XC--------DO COMMAND SCANNING
  392. X      IDIDIT=0
  393. X 10   CALL SCAN
  394. X`09ANUM=FNUM`09`09!SAVE SCAN BUFFER
  395. X      IF(KEY .NE. IHEOL) GO TO 20`20
  396. X      CALL PROMPT(10HHOW LONG? ,10)`20
  397. X      GO TO 10
  398. X20`09IF(KEY .NE. IHREAL) GO TO 60
  399. X      IF(ANUM .LE. 0.) RETURN`20
  400. X      IF(ANUM.LT.REMTIME .AND.NENHERE.EQ.0) GO TO 30`20
  401. X      CALL PROMPT(13HARE YOU SURE?,13)
  402. X      IF(JA(DUMMY) .EQ. 0) RETURN`20
  403. XC--------ALTERNATE REST PERIODS (EVENTS) WITH ATTACKS`20
  404. X 30   RESTING=1`20
  405. X      AITEM2=ANUM
  406. X 40   IF(ANUM .LE. 0.) RESTING=0
  407. X      IF(RESTING .EQ. 0) GO TO 50`20
  408. X`09TEMP=ANUM
  409. X      IF(NENHERE.NE. 0) TEMP=AMIN1(ANUM,1.0+RANF(0))
  410. X`09TIME=TEMP
  411. X      IF(TIME .LT. ANUM) CALL ATTACK`20
  412. X      IF(NENHERE.EQ.0) CALL MOVETHO  `20
  413. X      IF(ALLDONE.NE.0) RETURN`20
  414. X      CALL EVENTS`20
  415. X      IDIDIT=1
  416. X      IF(ALLDONE.NE.0) RETURN`20
  417. X      ANUM=ANUM-TEMP
  418. X      IF(GALAXY(QUADX,QUADY) .NE. 1000) GO TO 40
  419. X`09RESTING=0
  420. X`09TIME=0
  421. X      GOTO 55    `20
  422. X 50   CALL CRAMF(REMTIME,0,2)`20
  423. X      CALL CRAMDMP(16H STARDATES LEFT.)`20
  424. X55    IF(CONDIT.NE.IHDOCKD) RETURN   `20
  425. X      IF((AITEM2-ANUM).GE.9.99) DAMAGE(14)=0  `20
  426. XC*--------HANDLE SPECIAL CASE OF DEATHRAY REPAIRS.`20
  427. X      RETURN
  428. X 60   CALL BEGPARD
  429. X      RETURN
  430. X      END`20
  431. $ CALL UNPACK TRWAIT.FOR;1 1578988330
  432. $ create 'f'
  433. X      SUBROUTINE WARP`20
  434. X`09INCLUDE 'TREKCOM/NOLIST'
  435. X      INTEGER BLOOEY,TWARP
  436. X      IDIDIT=0
  437. X      IF(DAMAGE(6) .GT. 10.0) GO TO 90
  438. X      IF(DAMAGE(6) .EQ. 0.0  .OR.  WARPFAC .LE. 4.0) GO TO 3
  439. X      CALL PROUT(52HENGINEER SCOTT:  "SORRY, CAPTAIN.  UNTIL THIS DAMAGE
  440. X     +,52)`20
  441. X      CALL PROUT(43H  IS REPAIRED, I CAN ONLY GIVE YOU WARP 4.",43)
  442. X      RETURN
  443. XC--------READ IN COURSE AND DISTANCE
  444. X 3    CALL GETCD
  445. X      IF(DIREC .LT. 0) RETURN`20
  446. XC--------MAKE SURE STARSHIP HAS ENOUGH ENERGY TO MAKE THE TRIP
  447. +-+-+-+-+-+-+-+-  END  OF PART 17 +-+-+-+-+-+-+-+-
  448.