home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part10 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  14.5 KB
  1. Path: uunet!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 [10/18]
  5. Date: 7 Apr 93 10:56:24 EDT
  6. Organization: Pembroke State University
  7. Lines: 436
  8. Message-ID: <1993Apr7.105624.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:652
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+
  13. X      IF(ENERGY .LE. 30.0) GO TO 5
  14. X      CALL GETCD
  15. X      IF(DIREC .LT. 0) RETURN`20
  16. XC--------MAKE SURE STARSHIP HAS SUFFICIENT ENERGY FOR TRIP
  17. X      POWER=20.0+100.0*DIST`20
  18. X      IF(POWER .LT. ENERGY) GO TO 20
  19. X 5    CALL SKIP(1)
  20. X      CALL PROUT(`20
  21. X     +   51HFIRST OFFICER SPOCK:  "CAPTAIN, THE IMPULSE ENGINES,51)
  22. X      CALL PROUT(`20
  23. X     +   51HREQUIRE 20.0 UNITS TO ENGAGE, PLUS 100.0 UNITS PER  ,51)`20
  24. X      IF(ENERGY .GT. 30.0) GO TO 10`20
  25. X      CALL PROUT(`20
  26. X     +   41HQUADRANT.  THEY ARE, THEREFORE, USELESS.",41)
  27. X      RETURN
  28. X 10   CALL CRAM(46HQUADRANT.  WE CAN GO, THEREFORE, A MAXIMUM OF )
  29. X      CALL CRAMF(0.01*(ENERGY-20.0)-0.05,0,1)`20
  30. X      CALL CREND
  31. X      CALL PROUT(11HQUADRANTS.",11)
  32. X      RETURN
  33. XC--------MAKE SURE ENOUGH TIME IS LEFT FOR THE TRIP`20
  34. X 20   TIME=DIST/0.095`20
  35. X      IF(TIME .LT. REMTIME) GO TO 30
  36. X      CALL PROUT(`20
  37. X     +   55HFIRST OFFICER SPOCK:  "CAPTAIN, OUR SPEED UNDER IMPULSE,55)
  38. X      CALL PROUT(`20
  39. X     +   54HPOWER IS ONLY 0.95 SECTORS PER STARDATE.  ARE YOU SURE,54)`20
  40. X      CALL PROUT(24HWE DARE SPEND THE TIME?",24)`20
  41. X      IF(JA(DUMMY)) GO TO 30
  42. X      RETURN
  43. XC--------ACTIVATE IMPULSE ENGINES AND PAY THE COST
  44. X 30   CALL MOVE`20
  45. X      IDIDIT=1
  46. X      IF(ALLDONE.NE.0) RETURN`20
  47. X      POWER=20.0+100.0*DIST`20
  48. X      ENERGY=ENERGY-POWER`20
  49. X      TIME=DIST/0.095`20
  50. X      IF(ENERGY .GT. 0) RETURN
  51. X      CALL FINISH(4)
  52. X      RETURN
  53. X 40   CALL SKIP(1)
  54. X      CALL PROUT(24HIMPULSE ENGINES DAMAGED.,24)`20
  55. X      RETURN
  56. X      END`20
  57. $ CALL UNPACK TRIMPULSE.FOR;1 1145252184
  58. $ create 'f'
  59. X      SUBROUTINE IRAN8(II,JJ)`20
  60. X      II=RANF(0)*8.+1.
  61. X      JJ=RANF(0)*8.+1.
  62. X      RETURN
  63. XC*`20
  64. X      ENTRY IRAN10
  65. XC*`20
  66. X      II=RANF(0)*10.+1.`20
  67. X      JJ=RANF(0)*10.+1.`20
  68. X      RETURN     `20
  69. X      END`20
  70. $ CALL UNPACK TRIRAN8.FOR;1 1769629508
  71. $ create 'f'
  72. X`09FUNCTION JA(DUMMY)
  73. X`09BYTE BITEM
  74. X`09REAL*8 AITEM
  75. X`09COMMON/SCANBF/KEY,AITEM
  76. X`09EQUIVALENCE (AITEM,BITEM)
  77. X10`09CALL SCAN
  78. X`09JA=0
  79. X`09IF(BITEM .EQ. 1HN) RETURN
  80. X`09JA=-1
  81. X`09IF(BITEM .EQ. 1HY) RETURN
  82. X`09CALL PROMPT(29HPLEASE ANSWER WITH YES OR NO:,29)
  83. X`09GO TO 10
  84. X`09END
  85. $ CALL UNPACK TRJA.FOR;1 897077176
  86. $ create 'f'
  87. X      SUBROUTINE LRSCAN`20
  88. X`09INCLUDE 'TREKCOM/NOLIST'
  89. X      IF(DAMAGE(2) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 40
  90. X      CALL SKIP(1)
  91. X      CALL CRAM(14HL. R. SCAN FOR)
  92. X      CALL CRAMLOC(1,QUADX,QUADY)`20
  93. X      CALL CREND
  94. X      I=QUADX-1`20
  95. X      II=QUADX+1
  96. X      J=QUADY-1`20
  97. X      JJ=QUADY+1
  98. X      DO 30 L=I,II
  99. X      DO 20 LL=J,JJ`20
  100. X      IVAL=-1`20
  101. X      IF(L .EQ. 0 .OR. L .GT. 8) GO TO 10`20
  102. X      IF(LL .EQ. 0 .OR. LL .GT. 8) GO TO 10`20
  103. X      IVAL=GALAXY(L,LL)`20
  104. X      STARCH(L,LL)=1
  105. X 10   CALL CRAMI(IVAL,5)
  106. X 20   CONTINUE
  107. X      CALL CREND
  108. X 30   CONTINUE
  109. X      RETURN
  110. X 40   CALL PROUT(22HL. R. SENSORS DAMAGED.,22)`20
  111. X      RETURN
  112. X      END`20
  113. $ CALL UNPACK TRLRSCAN.FOR;1 375549319
  114. $ create 'f'
  115. X      SUBROUTINE MOVE`20
  116. X`09INCLUDE 'TREKCOM/NOLIST'
  117. X`09LOGICAL*1 IQUAD,ISHIP
  118. X      INTEGER TRBEAM
  119. X      EQUIVALENCE (CRACKS(6),KDIDIT),(SHIP,ISHIP)
  120. X      IF(INORBIT .EQ. 0) GO TO 1
  121. X      CALL PROUT(32HSULU:  "LEAVING STANDARD ORBIT.",32)`20
  122. X      INORBIT=0`20
  123. X 1    ANGLE=((15.0-DIREC)*0.5235988)
  124. X      DELTAX=-SIN(ANGLE)
  125. X      DELTAY=COS(ANGLE)`20
  126. X      BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY))`20
  127. X      DELTAX=DELTAX/BIGGER
  128. X      DELTAY=DELTAY/BIGGER
  129. X      TRBEAM=0
  130. XC--------IF TRACTOR BEAM IS TO OCCUR, DO NOT MOVE FULL DISTANCE`20
  131. X      IF(DATE+TIME .LT. FUTURE(2)) GO TO 5
  132. X      TRBEAM=1
  133. X      CONDIT=IHRED
  134. X      DIST=DIST*(FUTURE(2)-DATE)/TIME+0.1`20
  135. X      TIME=FUTURE(2)-DATE + 1E-5
  136. XC--------MOVE WITHIN QUADRANT`20
  137. X 5    QUAD(SECTX,SECTY)=IHDOT`20
  138. X      X=SECTX`20
  139. X      Y=SECTY`20
  140. X      N=10.0*DIST*BIGGER+0.5
  141. X      IF(N .EQ. 0) GO TO 100
  142. X      DO 10 L=1,N`20
  143. X      X=X+DELTAX
  144. X      IX=X+0.5
  145. X      Y=Y+DELTAY
  146. X      IY=Y+0.5
  147. X      IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 40
  148. X      IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 40
  149. X      IQUAD=QUAD(IX,IY)`20
  150. X      IF(IQUAD .NE. IHDOT) GO TO 20`20
  151. X 10   CONTINUE
  152. X      DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2))`20
  153. X      SECTX=IX
  154. X      SECTY=IY
  155. X      GO TO 100`20
  156. XC--------OBJECT ENCOUNTERED ALONG FLIGHT PATH`20
  157. X 20   STOPEGY=50.0*DIST/TIME
  158. X      DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2))`20
  159. X      IF(IQUAD.EQ.IHK .OR. IQUAD.EQ.IHC .OR. IQUAD.EQ.IHS .OR.
  160. X     +  IQUAD.EQ.IHR)  GO TO 30`20
  161. X      IF(IQUAD.EQ.IHT) GO TO 30      `20
  162. X      IF(IQUAD .EQ. '@') GO TO 25`20
  163. XC--------OBJECT IS NOT AN ENEMY VESSEL, OR BLACK HOLE.
  164. X      CALL SKIP(1)
  165. X      CALL CRAMSHP
  166. X      IF(IQUAD.NE.IHNUM) CALL CRAM(21H BLOCKED BY OBJECT AT)
  167. X      IF(IQUAD.EQ.IHNUM) CALL CRAM(26H ENCOUNTERS THOLIAN WEB AT  )`20
  168. X      CALL CRAMLOC(2,IX,IY)`20
  169. X      CALL CRAMDMP(1H;)`20
  170. X      CALL CRAM(24HEMERGENCY STOP REQUIRED )
  171. X      CALL CRAMF(STOPEGY,0,2)`20
  172. X      CALL CRAMDMP(17H UNITS OF ENERGY.)
  173. X      ENERGY=ENERGY-STOPEGY`20
  174. X      SECTX=X-DELTAX+0.5
  175. X      SECTY=Y-DELTAY+0.5
  176. X      IF(ENERGY .GT. 0) GO TO 100`20
  177. X      CALL FINISH(4)
  178. X      RETURN
  179. XC--------OBJECT IS A BLACK HOLE.  SWALLOW SHIP.`20
  180. X 25   CALL REDALRT
  181. X      CALL SKIP(1)
  182. X      CALL CRAM3AS
  183. X      CALL CRAMSHP
  184. X      CALL CRAM(26H PULLED INTO BLACK HOLE AT)
  185. X      CALL CRAMLOC(2,IX,IY)`20
  186. X      CALL CREND
  187. X      IF(RANF(0).GT.0.50) GO TO 27   `20
  188. X      CALL IRAN8(QUADX,QUADY)`20
  189. X      CALL IRAN10(SECTX,SECTY)
  190. X      CALL PROUT(`20
  191. X     $55HSPOCK: "CAPTAIN, INSTRUMENTS INDICATE WE HAVE UNDERGONE   ,55)
  192. X      CALL CRAM(15H        A SPACE     )
  193. X      XTIMEW=RANF(0)
  194. X      IF(XTIMEW.GT.0.65) CALL CRAM(5H-TIME )   `20
  195. X      CALL CRAMDMP(14H PHASE SHIFT."  )`20
  196. X      IF(XTIMEW.GT.0.65) CALL TIMEWRP`20
  197. X      IF(XTIMEW.GT.0.65) KSTUF(4)=1  `20
  198. X      GO TO 95   `20
  199. X27    CALL FINISH(21)      `20
  200. X      RETURN     `20
  201. XC--------OBJECT IS AN ENEMY VESSEL; RAM HIM.
  202. X 30   SECTX=IX
  203. X      SECTY=IY
  204. X      CALL RAM(0,IQUAD,SECTX,SECTY)`20
  205. X      GO TO 100`20
  206. XC--------COMPUTE FINAL POSITION--NEW QUADRANT, NEW SECTOR`20
  207. X 40   X=10*(QUADX-1)+SECTX
  208. X      Y=10*(QUADY-1)+SECTY
  209. X      IX=X+10.0*DIST*BIGGER*DELTAX+0.5
  210. X      IY=Y+10.0*DIST*BIGGER*DELTAY+0.5
  211. XC--------CHECK FOR EDGE OF GALAXY`20
  212. X      KINKS=0`20
  213. X 45   KINK=0
  214. X      IF(IX .GT. 0) GO TO 50
  215. X      IX=-IX+1
  216. X      KINK=1
  217. X 50   IF(IY .GT. 0) GO TO 55
  218. X      IY=-IY+1
  219. X      KINK=1
  220. X 55   IF(IX .LE. 80) GO TO 60`20
  221. X      IX=161-IX`20
  222. X      KINK=1
  223. X 60   IF(IY .LE. 80) GO TO 65`20
  224. X      IY=161-IY`20
  225. X      KINK=1
  226. X 65   IF(KINK .EQ. 0) GO TO 70
  227. X      KINKS=1`20
  228. X      GO TO 45
  229. X 70   IF(KINKS .EQ. 0) GO TO 90`20
  230. X      NKINKS=NKINKS+1`20
  231. X      IF(NKINKS .EQ. 3) GO TO 80
  232. XC--------ISSUE REPRIMAND FOR HITTING EDGE OF GALAXY`20
  233. X      CALL SKIP(1)
  234. X      CALL PROUT(`20
  235. X     +   55HYOU HAVE ATTEMPTED TO CROSS THE NEGATIVE ENERGY BARRIER,55)
  236. X      CALL PROUT(`20
  237. X     +   56HAT THE EDGE OF THE GALAXY.  THE THIRD TIME YOU TRY THIS,,56)`20
  238. X      CALL PROUT(22HYOU WILL BE DESTROYED.,22)`20
  239. X      GO TO 90
  240. XC--------ONE, TWO, THREE STRIKES, YOU'RE OUT   `20
  241. X 80   CALL FINISH(6)
  242. X      RETURN
  243. XC--------COMPUTE FINAL POSITION OF STARSHIP IN NEW QUADRANT`20
  244. X90`09CONTINUE
  245. X      QUADX=(IX+9)/10`20
  246. X      QUADY=(IY+9)/10`20
  247. X      SECTX=IX-10*(QUADX-1)`20
  248. X      SECTY=IY-10*(QUADY-1)`20
  249. X`09IF(TRBEAM.NE.0) RETURN
  250. X95    CALL SKIP(1)
  251. X      CALL CRAM(8HENTERING)`20
  252. X      CALL CRAMLOC(1,QUADX,QUADY)`20
  253. X      CALL CREND
  254. X      QUAD(SECTX,SECTY)=ISHIP
  255. X      CALL NEWQUAD
  256. X      RETURN
  257. XC--------NO QUADRANT CHANGE; COMPUTE NEW ENEMY DISTANCES
  258. X 100  QUAD(SECTX,SECTY)=ISHIP
  259. X      CALL RESETD`20
  260. X      IF(KDIDIT .EQ. 0) CALL SORTKL`20
  261. X      RETURN
  262. X      END`20
  263. $ CALL UNPACK TRMOVE.FOR;1 122498841
  264. $ create 'f'
  265. X      SUBROUTINE MOVECOM
  266. XC
  267. XC`0920-APR-79
  268. XC`09MOVE RESETTING OF IRUN INTO THE LOOP.  THIS KEEPS A ROMULAN
  269. XC`09ACCOMPANYING THE SUPER-COMMANDER FROM ESCAPING, A SITUATION
  270. XC`09THAT RESULTS IN LOSING BASES, MESSING UP THE KLINGON
  271. XC`09BOOKKEEPING, ETC.
  272. XC
  273. X`09INCLUDE 'TREKCOM/NOLIST'
  274. X`09LOGICAL*1 ISHIP,IENM,IQUAD
  275. X      INTEGER COMX,COMY,SUPX,SUPY`20
  276. X`09EQUIVALENCE (CRACKS(5),LOCCOM),(SHIP,ISHIP)
  277. X      DATA KRAWLX,KRAWLY/1,1/`20
  278. X      IF((NENHERE.EQ.0).OR.(JUSTIN.EQ.1)) RETURN
  279. X      NBADDYS=COMHERE+ISHERE
  280. XC--------THIS CONTINUE STATEMENT IS FOR MNF    `20
  281. X      CONTINUE   `20
  282. X      IF(KSTUF(5).NE.0) NBADDYS=((COMHERE*2)+(ISHERE*2)+ `20
  283. X     $  (FLOAT(KLHERE)*1.23) + (FLOAT(IRHERE)*1.5)) / 2.0`20
  284. XC-------LOOP FOR MOVING ENEMIES BEGINS HERE.   `20
  285. X`09I=1
  286. X1`09IRUN=0
  287. X`09IX=KX(I)
  288. X`09IY=KY(I)
  289. X`09IENM=QUAD(IX,IY)
  290. X`09COMX=IX
  291. X`09COMY=IY
  292. X`09LOCCOM=I
  293. X      IF((KSTUF(5).EQ.0).AND.((IENM.NE.IHS).OR.(IENM.NE.IHC))) GO TO 500
  294. X      IF(IENM.NE.IHS) GO TO 3`20
  295. XC--------CHECK WITH SPY TO SEE IF S.C. SHOULD HI-TAIL IT.`20
  296. X      IF((KPOWER(LOCCOM).GT.500.) .AND. ((CONDIT.NE.IHDOCKD)
  297. X     +  .OR. (DAMAGE(4).NE.0.)))  GO TO 3`20
  298. X`09IRUN=1
  299. X`09MOTION=-10
  300. X      GO TO 8`20
  301. XC--------DECIDE WHETHER TO ADVANCE, RETREAT, OR HOLD POSITION`20
  302. XC        AND BY HOW MUCH
  303. X3`09MOTION=0
  304. X`09DIST1=KDIST(LOCCOM)
  305. X`09MDIST=DIST1+0.5
  306. X      FORCES=KPOWER(LOCCOM)+100.0*NENHERE +400.*(NBADDYS-1)`20
  307. X      IF(SHLDUP .EQ. 0) FORCES=FORCES+1000.`20
  308. X      IF((DAMAGE(3) .EQ. 0) .OR. (DAMAGE(4) .EQ. 0)) GO TO 4
  309. X      FORCES=FORCES+1000.`20
  310. X`09GO TO 7
  311. X4`09EFAC=1.
  312. X`09TFAC=1.
  313. X      IF(DAMAGE(3) .EQ. 0) GO TO 5
  314. X`09EFAC=0.
  315. X`09FORCES=FORCES+300.
  316. X 5    IF(DAMAGE(4) .EQ. 0) GO TO 6
  317. X`09TFAC=0.
  318. X`09FORCES=FORCES+300.
  319. X 6    FORCES=FORCES-50.*TORPS*TFAC+0.2*(2500.-ENERGY)*EFAC
  320. X     C   +0.6*(1250.-SHLD)*SHLDUP`20
  321. X 7    IF(FORCES .GT. 1000.0) MOTION=(1.-RANF(0)**2)*DIST1+1.0`20
  322. X      IF(CONDIT .EQ. IHDOCKD ) MOTION=MOTION-SKILL*(2.-RANF(0)**2)
  323. X      IF(MOTION .EQ. 0) MOTION=((FORCES+200.0*RANF(0))/150.0)-5.0`20
  324. X      IF(MOTION .EQ. 0) GO TO 500`20
  325. X      IF(IABS(MOTION) .GT. SKILL) MOTION=ISIGN(SKILL,MOTION)
  326. XC--------CALCULATE PREFERRED NUMBER OF STEPS TO MOVE COMMANDER
  327. X 8    NSTEPS=IABS(MOTION)`20
  328. X      IF((MOTION .GT. 0) .AND. (NSTEPS .GT. MDIST)) NSTEPS=MDIST
  329. X      NSTEPS=MIN0(10,NSTEPS)
  330. X      NSTEPS=MAX0(1,NSTEPS)`20
  331. XC--------COMPUTE PREFERRED VALUES OF DELTA X AND DELTA Y
  332. X      MX=SECTX-COMX`20
  333. X      MY=SECTY-COMY`20
  334. X      IF(2*IABS(MX) .LT. IABS(MY)) MX=0`20
  335. X      IF(2*IABS(MY) .LT. IABS(MX)) MY=0`20
  336. X      IF(MX .NE. 0) MX=ISIGN(1,MX*MOTION)`20
  337. X      IF(MY .NE. 0) MY=ISIGN(1,MY*MOTION)`20
  338. XC--------MAIN LOOP TO ATTEMPT TO MOVE COMMANDER <NSTEPS> STEPS
  339. X      NEXTX=COMX
  340. X      NEXTY=COMY
  341. X      QUAD(COMX,COMY)=IHDOT`20
  342. X      DO 60 LL=1,NSTEPS`20
  343. XC--------TEST IF PREFERRED POSITION IS AVAILABLE
  344. X      LOOKX=NEXTX+MX
  345. X      LOOKY=NEXTY+MY
  346. X1111  CONTINUE   `20
  347. X2222  CONTINUE   `20
  348. X      ASSIGN 10 TO NOEXIT`20
  349. X      IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,30,30
  350. X      IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,10,10
  351. X      IQUAD=QUAD(LOOKX,LOOKY)`20
  352. XC--------DECIDE IF COMMANDER SHOULD RAM`20
  353. X      IF(IQUAD .NE. ISHIP) GO TO 9010
  354. XC--------ONLY LET COMMANDERS RAM THE SHIP.     `20
  355. X      IF((IENM.NE.IHC).AND.(IENM.NE.IHS)) GO TO 9010
  356. XC--------WHAMO!  `20
  357. X      CALL RAM(1,IENM,COMX,COMY)
  358. X`09GO TO 500
  359. X 9010 IF(IQUAD .EQ. IHDOT) GO TO 50
  360. X`09GO TO 10
  361. XC--------TRY TO FUDGE ON Y COORDINATE`20
  362. X 10   IF(MY.EQ.KRAWLY .OR. MX.EQ.0) GO TO 30
  363. X      LOOKY=NEXTY+KRAWLY
  364. X      ASSIGN 20 TO NOEXIT`20
  365. X      IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,20,20
  366. X      IF(LOOKX .LE. 0 .OR. LOOKX .GT. 10) IF(MOTION)70,20,20
  367. X      IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50`20
  368. X 20   KRAWLY=-KRAWLY
  369. XC--------TRY TO FUDGE X COORDINATE
  370. X 30   IF(MX.EQ.KRAWLX .OR. MY.EQ.0) GO TO 60
  371. X      LOOKX=NEXTX+KRAWLX
  372. X      ASSIGN 40 TO NOEXIT`20
  373. X      IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,40,40
  374. X      IF(LOOKY .LE. 0 .OR. LOOKY .GT. 10) IF(MOTION) 70,40,40`20
  375. X      IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50`20
  376. X 40   KRAWLX=-KRAWLX
  377. X      GO TO 60
  378. X 50   NEXTX=LOOKX`20
  379. X      NEXTY=LOOKY`20
  380. X 60   CONTINUE
  381. XC--------PUT COMMANDER IN NEW PLACE WITHIN SAME QUADRANT
  382. X      QUAD(NEXTX,NEXTY)=IENM
  383. X      IF(NEXTX.EQ.COMX .AND. NEXTY.EQ.COMY) GO TO 500`20
  384. X      KX(LOCCOM)=NEXTX
  385. X      KY(LOCCOM)=NEXTY
  386. X      KDIST(LOCCOM)=
  387. X     +   SQRT(FLOAT((SECTX-NEXTX)**2 + (SECTY-NEXTY)**2))`20
  388. X`09MOTION=-1
  389. X`09IF(KDIST(LOCCOM) .LT. DIST1) MOTION=1
  390. X`09CALL CRAM3AS
  391. X`09CALL CRAMEN(IENM)
  392. X      IF(MOTION .GT. 0) CALL CRAM(12H ADVANCES TO)
  393. X      IF(MOTION .LT. 0) CALL CRAM(12H RETREATS TO)
  394. X      CALL CRAMLOC(2,NEXTX,NEXTY)`20
  395. X      CALL CREND
  396. X      GO TO 500`20
  397. XC--------TRY TO MOVE INTO ADJACENT QUADRANT, AVOIDING NEGATIVE ENERGY`20
  398. XC        BARRIER, SUPERNOVAE, AND QUADRANTS WITH MORE THAN 8 KLINGONS.
  399. X 70   IQX=QUADX+(LOOKX+9)/10-1
  400. X      IQY=QUADY+(LOOKY+9)/10-1
  401. X      IF(IQX.LT.1 .OR. IQX.GT.8) GO TO NOEXIT`20
  402. X      IF(IQY.LT.1 .OR. IQY.GT.8) GO TO NOEXIT`20
  403. X      IF(GALAXY(IQX,IQY) .GT. 899) GO TO NOEXIT`20
  404. XC--------ALSO AVOID INTRUDING ON ANOTHER COMMANDERS TERRITORY (UNLESS S.C.)`
  405. V20
  406. X      IF(IRUN.NE.0) GO TO 86
  407. X      IF(IENM .EQ. IHS) GO TO 85
  408. X      DO 80 L=1,REMCOM
  409. X      IF(CX(L).EQ.IQX .AND. CY(L).EQ.IQY) GO TO NOEXIT
  410. X 80   CONTINUE
  411. XC------DON'T LET ROMULANS LEAVE.     `20
  412. X      IF(IENM.EQ.IHR) GO TO NOEXIT   `20
  413. XC--------ALSO, REFUSE TO LEAVE IF CURRENTLY ATTACKING STARBASE (UNLESS S.C.)
  414. X      IF(BATX.EQ.QUADX .AND. BATY.EQ.QUADY) GO TO NOEXIT
  415. XC--------FINALLY, DON'T LEAVE WITH OVER 1000 UNITS OF ENERGY.      `20
  416. X 85   IF(KPOWER(LOCCOM) .GT. 1000.) GO TO NOEXIT
  417. XC--------PRINT ESCAPE MESSAGE AND MOVE COMMANDER TO ADJACENT QUADRANT`20
  418. X86`09CALL CRAM3AS
  419. X`09CALL CRAMEN(IENM)
  420. X      CALL CRAM(11H ESCAPES TO)`20
  421. X      CALL CRAMLOC(1,IQX,IQY)`20
  422. X      CALL CRAMDMP(23H (AND REGAINS STRENGTH))
  423. XC--------HANDLE LOCAL MATTERS RELATING TO COMMANDERS ESCAPE`20
  424. X      CALL LEAVE
  425. X`09I=I-1`09`09!NUMBER OF KLINGONS HAS BEEN REDUCED (IN QUAD)
  426. XC--------HANDLE GLOBAL MATTERS RELATING TO COMMANDERS ESCAPE
  427. X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-100`20
  428. X      GALAXY(IQX,IQY)=GALAXY(IQX,IQY)+100`20
  429. X      IF(IENM .EQ. IHC) GO TO 87
  430. X      IF(IENM .NE. IHS) GO TO 500    `20
  431. X`09ISHERE=0
  432. X`09ISCATE=0
  433. X`09IENTESC=0
  434. X`09ISATB=0
  435. X      FUTURE(6)=0.2777+DATE`20
  436. X      FUTURE(7)=1E38`20
  437. X`09ISX=IQX
  438. X`09ISY=IQY
  439. X`09GO TO 500
  440. X 87   DO 90 L=1,REMCOM
  441. X      IF(CX(L).EQ.QUADX .AND. CY(L).EQ.QUADY) GO TO 100`20
  442. X 90   CONTINUE
  443. X 100  CX(L)=IQX`20
  444. X      CY(L)=IQY`20
  445. X      COMHERE=0`20
  446. X500`09I=I+1
  447. +-+-+-+-+-+-+-+-  END  OF PART 10 +-+-+-+-+-+-+-+-
  448.