home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part06 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.2 KB
  1. Path: uunet!usc!elroy.jpl.nasa.gov!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 [06/18]
  5. Date: 7 Apr 93 10:48:26 EDT
  6. Organization: Pembroke State University
  7. Lines: 525
  8. Message-ID: <1993Apr7.104826.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:648
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+
  13. X 20   CALL CRAM(42HHIS DESPERATE ATTEMPT TO RESCUE YOU . . . )
  14. X      IF(RANF(0) .GT. 0.5) GO TO 30`20
  15. X      CALL CRAMDMP(6HFAILS. )`20
  16. X 25   CALL FINISH(II)
  17. X`09RETURN
  18. X 30   CALL CRAMDMP(9HSUCCEEDS!)      `20
  19. X      IF(IMINE .EQ. 0) GO TO 45`20
  20. X      IMINE=0`20
  21. X      CALL CRAM(24HTHE CRYSTALS MINED WERE )
  22. X      IF(RANF(0) .GT. 0.25) GO TO 40
  23. X      CALL CRAMDMP(5HLOST.) `20
  24. X`09GO TO 45
  25. X 40   CALL CRAMDMP(6HSAVED.)
  26. X`09ICRYSTL=1
  27. X 45   IF(IGRAB.NE.0) RETURN`20
  28. XC--------CHECK TO SEE IF CAPTAIN IN SHUTTLE CRAFT`20
  29. X      IF(ICRAFT.NE.0) CALL FINISH(17)`20
  30. X      IF(ALLDONE.NE.0) RETURN`20
  31. XC--------INFORM CAPTAIN OF ATTEMPT TO REACH SAFETY
  32. X      CALL SKIP(1)
  33. X      IF(JUSTIN .EQ. 0) GO TO 50
  34. X 47   CALL REDALRT
  35. X      CALL CRAM(7H***THE )
  36. X      CALL CRAMSHP
  37. X      CALL CRAMDMP(37H HAS STOPPED IN A QUADRANT CONTAINING)
  38. X      CALL PROUT(15H   A SUPERNOVA.,2)
  39. X      CALL SKIP(1)
  40. X 50   CALL CRAM(49H***EMERGENCY AUTOMATIC OVERRIDE ATTEMPTS TO HURL )`20
  41. X      CALL CRAMSHP
  42. X      CALL CREND
  43. X      CALL PROUT(23HSAFELY OUT OF QUADRANT.,23)
  44. X      STARCH(QUADX,QUADY)=1`20
  45. XC--------TRY TO USE WARP ENGINES
  46. X      IF(DAMAGE(6) .EQ. 0) GO TO 100
  47. X      CALL SKIP(1)
  48. X      CALL PROUT(21HWARP ENGINES DAMAGED.,21)
  49. X      CALL FINISH(8)
  50. X      RETURN
  51. X 100  WARPFAC=6.0+2.0*RANF(0)`20
  52. X      WFACSQ=WARPFAC*WARPFAC
  53. X      CALL CRAM(19HWARP FACTOR SET TO )`20
  54. X      CALL CRAMF(WARPFAC,0,1)`20
  55. X      CALL CREND
  56. X      POWER=0.75*ENERGY`20
  57. X      DISTMAX=POWER/(WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1))
  58. X      DISTREQ=1.4142+2.0*RANF(0)
  59. X      DIST=AMIN1(DISTMAX,DISTREQ)`20
  60. X      TIME=10.0*DIST/WFACSQ`20
  61. X      DIREC=12.0*RANF(0)
  62. X      JUSTIN=0
  63. X      INORBIT=0`20
  64. X      CALL WARPX
  65. X      IF(ALLDONE.NE.0) RETURN`20
  66. X      IF(JUSTIN.NE.0) GO TO 200  `20
  67. X      CALL SKIP(1)
  68. X`09CALL CRAM('***')
  69. X`09CALL CRAMSHP
  70. X`09CALL CRAMDMP(' FAILS TO LEAVE QUADRANT.')
  71. X      CALL FINISH(8)
  72. X      RETURN
  73. XC--------REPEAT OVERRIDE IF SHIP JUMPED FROM ONE SUPERNOVA TO ANOTHER`20
  74. X 200  IF(GALAXY(QUADX,QUADY) .EQ. 1000) GO TO 47
  75. X      IF(REMKL .EQ. 0) CALL FINISH(1)`20
  76. X      RETURN
  77. X      END`20
  78. $ CALL UNPACK TRAUTOVER.FOR;1 2064069836
  79. $ create 'f'
  80. X`09SUBROUTINE CANTA
  81. XC
  82. XC`0923-OCT-79 (NEW ROUTINE)
  83. XC`09CANCELS TYPEAHEAD AT THE TERMINAL
  84. XC
  85. X`09CALL SYS$ASSIGN('TT',ICHAN,,)
  86. X`09CALL SYS$QIOW(,%VAL(ICHAN),%VAL('0831'X),,,,
  87. X`091`09`09DUMMY,%VAL(0),,,,)
  88. X`09CALL SYS$DASSGN(%VAL(ICHAN))
  89. X`09RETURN
  90. X`09END
  91. $ CALL UNPACK TRCANTA.FOR;1 1397624925
  92. $ create 'f'
  93. X      SUBROUTINE CHART
  94. X`09INCLUDE 'TREKCOM/NOLIST'
  95. X      CALL PROUT(31HSTAR CHART FOR THE KNOWN GALAXY,31)
  96. X      CALL SKIP(1)
  97. X      CALL PROUT(42H      1    2    3    4    5    6    7    8,42)`20
  98. X      CALL PROUT(44H    ----------------------------------------,44)`20
  99. X      CALL PROUT(3H  :,3)`20
  100. X      DO 50 I=1,8`20
  101. X      CALL CRAMI(I,1)`20
  102. X      CALL CRAM(2H :)`20
  103. X      DO 40 J=1,8`20
  104. X      IF(STARCH(I,J)) 10,20,30
  105. X 10   CALL CRAM(5H  .1.)
  106. X      GO TO 40
  107. X 20   CALL CRAM(5H  ...)
  108. X      GO TO 40
  109. X 30   IF(STARCH(I,J) .GT. 999) GO TO 35`20
  110. X      CALL CRAMI(GALAXY(I,J),5)`20
  111. X      GO TO 40
  112. X 35   CALL CRAMI(STARCH(I,J)-1000,5)
  113. X 40   CONTINUE
  114. X      CALL CREND
  115. X      CALL PROUT(3H  :,3)`20
  116. X 50   CONTINUE
  117. X      CALL SKIP(1)
  118. X      CALL CRAMSHP
  119. X      CALL CRAM(16H IS CURRENTLY IN)
  120. X      CALL CRAMLOC(1,QUADX,QUADY)`20
  121. X      CALL CREND
  122. X      RETURN
  123. X      END`20
  124. $ CALL UNPACK TRCHART.FOR;1 1645241146
  125. $ create 'f'
  126. X      SUBROUTINE CHOOSE(FROZEN)`20
  127. XC
  128. XC`0925-APR-79
  129. XC`09USE THE SYSTEM SERVICE SYS$GETTIM FOR THE RANDOM NUMBER SEED.
  130. XC`09THIS GREATLY REDUCES DEPENDENCE OF THE SEED ON TIME OF DAY.
  131. XC
  132. X`09INCLUDE 'TREKCOM/NOLIST'
  133. X`09COMMON/SCANBF/KEY,AITEM
  134. X`09INTEGER*4 ISEED(2)
  135. X      LOGICAL FROZEN
  136. X`09LOGICAL CROP
  137. X`09REAL*8`09AITEM,REGULAR,TOURNAMENT,FROZN,SHORT,MEDIUM,LONG
  138. X`091 ,NOVICE,FAIR,GOOD,EMERITUS,EXPERT,RHBLANK
  139. X`09EQUIVALENCE (AITEM,TNUMBER)
  140. X`09DATA REGULAR,TOURNAMENT,FROZN/7HREGULAR,8HTOURNAME,6HFROZEN/
  141. X`09DATA SHORT,MEDIUM,LONG/5HSHORT,6HMEDIUM,4HLONG/
  142. X`09DATA NOVICE,FAIR,GOOD,EXPERT/6HNOVICE,4HFAIR,4HGOOD,6HEXPERT/
  143. X`09DATA EMERITUS,RHBLANK/8HEMERITUS,1H /
  144. X      TNUMBER = 0.
  145. X      PASSWD = RHBLANK
  146. X`09ALLDONE=0
  147. X`09GAMEWON=0
  148. X`09CALL SYS$GETTIM(ISEED)
  149. X`09CALL RANSET(ISEED(1))
  150. X`09IPHWHO=0
  151. X5     FROZEN = .FALSE.
  152. XC--------ASK FOR PARAMETERS OF GAME, PREFERABLY ALL ON ONE LINE`20
  153. X      CALL PROMPT(`20
  154. X     +54HWOULD YOU LIKE A REGULAR, TOURNAMENT, OR FROZEN GAME?   ,54)
  155. X      CALL SCAN`20
  156. X`09IF(CROP(AITEM,REGULAR)) GO TO 9
  157. X`09IF(CROP(AITEM,TOURNAMENT)) GO TO 100
  158. X`09IF(CROP(AITEM,FROZN)) GO TO 200
  159. X      GO TO 5`20
  160. X 9    SKILL=0
  161. X`09LENGTH=0
  162. X 10   CALL SCAN`20
  163. X      IF(KEY .NE. IHALPHA) GO TO 20`20
  164. XC--------CHECK FOR DIFFERENT KINDS OF GAMES`20
  165. X      KSTUF(5)=0 `20
  166. X`09IF(CROP(AITEM,SHORT)) LENGTH=1
  167. X`09IF(CROP(AITEM,MEDIUM)) LENGTH=2
  168. X`09IF(CROP(AITEM,LONG)) LENGTH=4
  169. X`09IF(CROP(AITEM,NOVICE)) SKILL=1
  170. X`09IF(CROP(AITEM,FAIR)) SKILL=2
  171. X`09IF(CROP(AITEM,GOOD)) SKILL=3
  172. X`09IF(CROP(AITEM,EXPERT)) SKILL=4
  173. X`09IF(CROP(AITEM,EMERITUS)) SKILL=5
  174. X`09IF(SKILL.EQ.4) KSTUF(5)=1
  175. X`09IF(SKILL.EQ.5) KSTUF(5)=2
  176. X      IF(LENGTH*SKILL .EQ. 0) GO TO 10`20
  177. X`09GO TO 30
  178. X 20   IF(LENGTH .NE. 0) GO TO 25
  179. X      CALL PROMPT(45HWOULD YOU LIKE A SHORT, MEDIUM OR LONG GAME? ,45)`20
  180. X      GO TO 10
  181. X 25   IF(SKILL .NE. 0) GO TO 30`20
  182. X      CALL PROMPT(48HARE YOU NOVICE, FAIR, GOOD, EXPERT OR EMERITUS? `20
  183. X`091  ,48)
  184. X      GO TO 10
  185. XC--------READ IN SECRET PASSWORD
  186. X 30   CALL SCAN`20
  187. X`09PASSWD=AITEM
  188. X      IF(KEY .NE. IHEOL) GO TO 40`20
  189. X      CALL PROMPT(33HPLEASE TYPE IN A SECRET PASSWORD:,33)
  190. X      GO TO 30
  191. X40    CONTINUE   `20
  192. XC--------USE PARAMETERS TO GENERATE INITIAL VALUES OF THINGS
  193. X      DAMFAC=0.50*SKILL`20
  194. X      REMBASE=3.0*RANF(0)+2.0
  195. X      INPLAN=5. +6.*RANF(0)`20
  196. X      NROMREM=(2.+RANF(0))*SKILL
  197. X      NSCREM=SKILL/3
  198. X      REMTIME=7.0*LENGTH`20
  199. X`09INTIME=REMTIME
  200. X      RATE=(SKILL-2.0*RANF(0)+1.0)*SKILL*0.1 + 0.15`20
  201. X      REMKL=2.0*RATE*INTIME`20
  202. X`09INKLING=REMKL
  203. X      INCOM=SKILL+0.0625*INKLING*RANF(0)
  204. X      INCOM=MIN0(10,INCOM)`20
  205. X`09REMCOM=INCOM
  206. X      REMRES=(INKLING+4* INCOM        )*INTIME
  207. X`09INRESOR=REMRES
  208. X`09IF(INKLING.GT.50) REMBASE=REMBASE+1
  209. X`09INBASE=REMBASE
  210. X      RETURN
  211. XC--------PROCESS A TOURNAMENT REQUEST`20
  212. X 100  CALL SCAN
  213. X      CALL RANSET(ABS(TNUMBER))      `20
  214. X      THINGX=-1`20
  215. XC--------GO BACK FOR ANYTHING LEFT OUT
  216. X      IF (KEY.NE.IHEOL) GO TO 9`20
  217. X      CALL PROMPT(37HTYPE IN NAME OR NUMBER OF TOURNAMENT:   ,37)`20
  218. X      GO TO 100`20
  219. XC--------PROCESS A REQUEST FOR A FROZEN GAME
  220. X 200  CALL THAW`20
  221. XC--------MAKE SURE WE GOT A GAME OUT OF THAW
  222. X      IF(PASSWD.EQ.0.D0) GO TO 5`20
  223. X      FROZEN = .TRUE.`20
  224. XC--------DESTROY ANY "THINGS" IN FROZEN GAME.`20
  225. X      THINGX=0`20
  226. X`09THINGY=0
  227. X      DO 210 I=1,10`20
  228. X      DO 210 J=1,10`20
  229. X 210  IF(QUAD(I,J) .EQ. IHQUEST) QUAD(I,J)=IHDOT
  230. XC--------RESET PLAQUE STATUS
  231. X      ICITE=0`20
  232. X      RETURN
  233. X      END`20
  234. $ CALL UNPACK TRCHOOSE.FOR;1 946352103
  235. $ create 'f'
  236. X      SUBROUTINE CRAM(M)
  237. X`09COMMON/PRLUN/LUN
  238. X      BYTE M(1)
  239. XC--------<M> IS AN ARRAY CONTAINING CHARACTERS LJZF.  BYTES ARE PUT
  240. XC--------INTO THE OUTPUT BUFFER UP TO THE FIRST 00B BYTE.
  241. X      BYTE LINE(120)
  242. X      DATA LINE/120*0/,ICH/1/
  243. X`09K=80
  244. X`09GO TO 11
  245. XC*
  246. X`09ENTRY CRAMS(M,IK)
  247. XC*
  248. X`09K=IK
  249. X11    IDUMP=0
  250. X5     ICHX=0
  251. XC--------GET THE NEXT CHARACTER OF <M>
  252. X10`09ICHX=ICHX+1
  253. X`09IF (ICHX.GT.K) GOTO 21
  254. X`09KHAR=M(ICHX)
  255. XC--------PUT IT IN BUFFER
  256. X      IF(KHAR .EQ. 0) GO TO 21
  257. X`09LINE(ICH)=KHAR
  258. X      ICH=ICH+1
  259. X`09IF(ICH.GT.120) GOTO 25`20
  260. X`09IF((ICH.GT.72).AND.(LUN.EQ.1)) GOTO 25
  261. X      GO TO 10
  262. XC*
  263. X      ENTRY CRENDNO`20
  264. XC--------DUMP BUFFER AND SUPPRESS LINE FEED
  265. X`09CALL PROMPT (LINE,ICH)
  266. X`09GOTO 27
  267. XC*
  268. X      ENTRY CRAMDMP (M)
  269. XC--------INSERT FINAL ENTRY AND DUMP BUFFER
  270. X`09K=80
  271. X`09GO TO 22
  272. XC*
  273. X`09ENTRY CRMDPS(M,IK)
  274. X`09K=IK
  275. X22    IDUMP=1
  276. X      GO TO 5
  277. X21`09IF(IDUMP.EQ. 0) RETURN`20
  278. X      ENTRY CREND
  279. XC--------DUMP BUFFER AND GO TO NEW LINE`20
  280. X 25   CALL PROUT(LINE,ICH)
  281. X27      DO 30 L=1,ICH`20
  282. X 30   LINE(L)=0
  283. X      ICH=1
  284. X      RETURN
  285. X      END`20
  286. X      SUBROUTINE CRAMF(XX,W,D)
  287. X`09BYTE CF(10),CS(10)
  288. X`09INTEGER*4 I
  289. X      INTEGER W,D
  290. X      NEG=0
  291. X`09DO 5 N=1,10
  292. X5`09CF(N)=0
  293. X      X=XX
  294. X      IF(X .GE. 0) GO TO 10
  295. X      X=-XX
  296. X      NEG=1
  297. X 10   N=0`20
  298. X      IF(D .EQ. 0) GO TO 30
  299. XC--------CONVERT FRACTIONAL PART TO ASCII
  300. X      I=X*10**D+.5
  301. X      DO 20 N=1,D
  302. X      J=MOD(I,10)
  303. X`09CF(N)=1H0+J
  304. X 20   I=I/10
  305. XC--------INSERT DECIMAL POINT`20
  306. X      N=D+1
  307. X`09CF(N)=1H.
  308. XC--------CONVERT INTEGRAL PART TO ASCII
  309. X 30   J=MOD(I,10)
  310. X      N=N+1
  311. X`09CF(N)=1H0+J
  312. X      I=I/10
  313. X      IF(I .NE. 0) GO TO 30
  314. XC--------INSERT MINUS SIGN IF NEEDED
  315. X      IF(NEG .EQ. 0) GO TO 40`20
  316. X      N=N+1
  317. X`09CF(N)=1H-
  318. XC--------PAD WITH BLANKS TO TOTAL OF <W> CHARACTERS
  319. X 40   IF(N .GE. W .OR. N .GE. 9) GO TO 43
  320. X      N=N+1
  321. X`09CF(N)=1H`20
  322. X      GO TO 40
  323. X43`09DO 45 I=1,N
  324. X45`09CS(I)=CF(N-I+1)
  325. X`09CS(N+1)=0
  326. X 50   CALL CRAM(CS)`20
  327. X      RETURN
  328. X      END`20
  329. X      SUBROUTINE CRAMI(II,W)
  330. X`09BYTE CI(10),CS(10)
  331. X      INTEGER W
  332. X      I=II
  333. X      NEG=0
  334. X      IF(I .GE. 0) GO TO 10
  335. X      I=-II
  336. X      NEG=1
  337. XC--------CONVERT THE NUMBER ITSELF TO ASCII
  338. X10`09DO 15 N=1,10
  339. X15`09CI(N)=0
  340. X      N=0`20
  341. X 20   J=MOD(I,10)
  342. X      N=N+1
  343. X`09CI(N)=1H0+J
  344. X      I=I/10
  345. X      IF(I .NE. 0) GO TO 20
  346. XC--------INSERT MINUS SIGN IF NEEDED
  347. X 30   IF(NEG .EQ. 0) GO TO 40`20
  348. X      N=N+1
  349. X`09CI(N)=1H-
  350. XC--------PAD WITH BLANKS TO TOTAL OF <W> CHARACTERS
  351. X 40   IF(N .GE. W .OR. N .GE. 9) GO TO 43
  352. X      N=N+1
  353. X`09CI(N)=1H`20
  354. X      GO TO 40
  355. X43`09DO 45 I=1,N
  356. X45`09CS(I)=CI(N-I+1)
  357. X`09CS(N+1)=0
  358. X`09CALL CRAM(CS)`20
  359. X      RETURN
  360. X      END`20
  361. $ CALL UNPACK TRCRAM.FOR;1 1862929249
  362. $ create 'f'
  363. X      SUBROUTINE CRAMEN(II)`20
  364. X`09ENTRY CRAMENA(II)
  365. X`09INCLUDE 'TREKCOM/NOLIST'
  366. X`09LOGICAL*1 II
  367. X      IF(II .EQ. IHR) GO TO 10
  368. X      IF(II .EQ. IHK) GO TO 20
  369. X      IF(II .EQ. IHC) GO TO 30
  370. X      IF(II .EQ. IHS) GO TO 40
  371. X      IF(II .EQ. IHSTAR) GO TO 50`20
  372. X      IF(II .EQ. IHP) GO TO 60
  373. X      IF(II .EQ. IHB) GO TO 70
  374. X      IF(II .EQ. '@') GO TO 80
  375. X      IF(II .EQ. IHT) GO TO 85
  376. X      IF(II-2) 90,100,110`20
  377. X 10   CALL CRAM(7HROMULAN)`20
  378. X`09RETURN
  379. X 20   CALL CRAM(7HKLINGON)`20
  380. X`09RETURN
  381. X 30   CALL CRAM(9HCOMMANDER)`20
  382. X`09RETURN
  383. X 40   CALL CRAM(15HSUPER-COMMANDER)
  384. X`09RETURN
  385. X 50   CALL CRAM(4HSTAR)
  386. X`09RETURN
  387. X 60   CALL CRAM(6HPLANET)
  388. X`09RETURN
  389. X 70   CALL CRAM(8HSTARBASE)
  390. X`09RETURN
  391. X 80   CALL CRAM(10HBLACK HOLE)`20
  392. X`09RETURN
  393. X85    CALL CRAM(7HTHOLIAN)          `20
  394. X`09RETURN
  395. X 90   CALL CRAM(1HM)`20
  396. X`09RETURN
  397. X 100  CALL CRAM(1HN)`20
  398. X`09RETURN
  399. X 110  CALL CRAM(1HO)`20
  400. X`09RETURN
  401. X      END`20
  402. $ CALL UNPACK TRCRAMEN.FOR;1 909534196
  403. $ create 'f'
  404. X      SUBROUTINE CRAMLOC(KEY,IX,IY)`20
  405. X      IF(KEY .EQ. 1) CALL CRAM(9H QUADRANT)`20
  406. X      IF(KEY .EQ. 2) CALL CRAM(7H SECTOR)`20
  407. X      CALL CRAM(1H )
  408. X      CALL CRAMI(IX,0)
  409. X      CALL CRAM(3H - )
  410. X      CALL CRAMI(IY,0)
  411. X      RETURN
  412. X      END`20
  413. $ CALL UNPACK TRCRAMLOC.FOR;1 1579835490
  414. $ create 'f'
  415. X      SUBROUTINE CRAMSHP
  416. X`09INCLUDE 'TREKCOM/NOLIST'
  417. X`09BYTE ISHIP,ESC,BELLS(16)
  418. X      EQUIVALENCE(CRACKS(1),HIT),(CRACKS(5),IESC) ,(SHIP,ISHIP)
  419. X`09EQUIVALENCE (IESC,ESC)
  420. X`09DATA BELLS/7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7/
  421. X      IF(ISHIP .EQ. IHE) CALL CRAM(10HENTERPRISE)
  422. X      IF(SHIP .EQ. IHF) CALL CRAM(13HFAERIE QUEENE)`20
  423. X      RETURN
  424. XC*`20
  425. X      ENTRY CRAM3AS`20
  426. XC*`20
  427. X      CALL CRAM(3H***)
  428. X      RETURN
  429. XC*`20
  430. X      ENTRY STARS`20
  431. XC*`20
  432. X      CALL PROUT(`20
  433. X     +   54H******************************************************,54)`20
  434. X      RETURN
  435. XC*`20
  436. X      ENTRY REDALRT`20
  437. XC*`20
  438. XC-------RING THE BELL BEFORE THE RED ALERT     `20
  439. X`09CALL PROUT(BELLS,16)
  440. X      CALL PROUT(25H***RED ALERT!  RED ALERT!,25)
  441. X      RETURN
  442. XC*`20
  443. X      ENTRY BEGPARD`20
  444. XC*`20
  445. X      CALL PROUT(27H BEG YOUR PARDON, CAPTAIN?   ,27)
  446. X      RETURN
  447. XC*`20
  448. X      ENTRY MANORA
  449. XC*`20
  450. X      CALL PROMPT(26HMANUAL OR AUTOMATIC?         ,26)
  451. X      RETURN
  452. XC*`20
  453. X      ENTRY CASULTY`20
  454. XC*`20
  455. X      ICAS=HIT*RANF(0)*0.015
  456. X      IF(ICAS .LT. 2) RETURN
  457. X      CASUAL=CASUAL+ICAS
  458. X      CALL CRAM(42HMC COY:  "SICKBAY TO BRIDGE.  WE JUST HAD )
  459. X      CALL CRAMI(ICAS,0)
  460. X      CALL CRAMDMP(13H CASUALTIES.")
  461. X      RETURN
  462. XC*`20
  463. X      ENTRY RESETD
  464. XC*`20
  465. X      CALL NEWCOND
  466. X      IF(NENHERE .EQ. 0) RETURN`20
  467. X      DO 10 L=1,NENHERE`20
  468. X 10   KDIST(L)=SQRT( FLOAT((SECTX-KX(L))**2 +(SECTY-KY(L))**2))`20
  469. X      RETURN
  470. XC*`20
  471. X      ENTRY LEAVE`20
  472. XC*`20
  473. X`09KX(IESC)=KX(NENHERE)
  474. X`09KY(IESC)=KY(NENHERE)
  475. X      KDIST(IESC)=KDIST(NENHERE)
  476. X      KPOWER(IESC)=KPOWER(NENHERE)
  477. X      KLHERE=KLHERE-1`20
  478. X      NENHERE=NENHERE-1`20
  479. X      IF(CONDIT .NE. IHDOCKD )CALL NEWCOND
  480. X      RETURN
  481. XC*`20
  482. X      ENTRY SOS`20
  483. XC*`20
  484. XC-------- IESC PASSES WHICH KIND OF COMMANDER IS ATTACKING
  485. X`09IF(ESC .EQ. IHS) GO TO 20
  486. X`09ICSOS=0
  487. X`09IF(DAMAGE(9) .GT. 0) RETURN`20
  488. X`09ICSOS=1
  489. X`09IX=BATX`20
  490. X`09IY=BATY
  491. X`09DDAY=FUTURE(5)
  492. X`09GO TO 30
  493. X 20`09ISSOS=0
  494. X`09IF(DAMAGE(9) .GT. 0) RETURN`20
  495. X`09ISSOS=1
  496. X`09IX=ISX`20
  497. X`09IY=ISY
  498. X`09DDAY=FUTURE(7)
  499. X 30`09CALL SKIP(1)
  500. X      CALL CRAM(37HLT. UHURA:  "CAPTAIN, THE STARBASE IN)`20
  501. X      CALL CRAMLOC(1,IX,IY)`20
  502. X      CALL CREND
  503. X      CALL CRAM(22H  REPORTS IT IS UNDER )
  504. X`09CALL CRAMEN(ESC)
  505. X`09CALL CRAMDMP(8H ATTACK.)
  506. X      CALL CRAM(32H  IT CAN SURVIVE UNTIL STARDATE )
  507. X`09CALL CRAMF(DDAY     ,0,1)
  508. X`09CALL CRAMDMP(3H .")
  509. X      IF(RESTING .EQ. 0) RETURN`20
  510. X      CALL SKIP(1)
  511. X      CALL PROMPT(55HMR. SPOCK: CAPTAIN, SHALL WE CANCEL THE REST PERIOD
  512. X`091?      ,55)
  513. X      IF(JA(DUMMY)) RESTING=0`20
  514. X      RETURN     `20
  515. X      END`20
  516. $ CALL UNPACK TRCRAMSHP.FOR;1 625813761
  517. $ create 'f'
  518. X`09SUBROUTINE CRAMSP(NUM,STRING)
  519. XC
  520. XC`093-MAY-79 (NEW ROUTINE)
  521. XC`09CRAM SINGULAR OR PLURAL
  522. XC`09CRAMSP CRAMS THE INTEGER NUMBER 'NUM', FOLLOWED BY THE ASCII STRING
  523. XC`09'STRING', FOLLOWED BY AN 'S' IF NUM .NE. 1.
  524. XC
  525. X`09BYTE STRING(80),SEND(10),PEND(10)
  526. XC
  527. X`09CALL CRAMI(NUM,0)
  528. X`09CALL CRAM(' ')
  529. X`09CALL CRAM(STRING)
  530. X`09IF(NUM.NE.1)CALL CRAM('S')
  531. X`09RETURN
  532. XC
  533. X`09ENTRY CRAMSPI(NUM,STRING,SEND,PEND)
  534. XC
  535. XC`09CRAM SINGULAR OR PLURAL IRREGULAR
  536. +-+-+-+-+-+-+-+-  END  OF PART 6 +-+-+-+-+-+-+-+-
  537.