home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / startrek / part18 < prev    next >
Encoding:
Internet Message Format  |  1993-04-06  |  5.9 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 [18/18]
  5. Date: 7 Apr 93 11:10:38 EDT
  6. Organization: Pembroke State University
  7. Lines: 165
  8. Message-ID: <1993Apr7.111038.1@pembvax1.pembroke.edu>
  9. NNTP-Posting-Host: papa.pembroke.edu
  10. Xref: uunet vmsnet.sources.games:660
  11.  
  12. -+-+-+-+-+-+-+-+ START OF PART 18 -+-+-+-+-+-+-+-+
  13. X      POWER=(DIST+0.05)*WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1)
  14. X      IF(POWER .LT. ENERGY) GO TO 10
  15. X      CALL SKIP(1)
  16. X      CALL PROUT(24H"ENGINEERING TO BRIDGE--,24)`20
  17. X      IF(SHLDUP.EQ.0 .OR. 0.5*POWER.GT.ENERGY) GO TO 5
  18. X      CALL PROUT(`20
  19. X     +61H  WE HAVEN'T THE ENERGY TO GO THAT FAR WITH THE SHIELDS UP."`20
  20. X     +   ,61)
  21. X      RETURN
  22. X 5    IWARP=(ENERGY/(DIST+0.05))**0.3333333333
  23. X      IF(IWARP .LE. 0) GO TO 8
  24. X      CALL CRAM(
  25. X     +   53H  WE HAVEN'T THE ENERGY.  BUT WE COULD DO IT AT WARP ) `20
  26. X      CALL CRAMI(IWARP,0)`20
  27. X      IF(SHLDUP.NE.0) GO TO 6`20
  28. X      CALL CRAMDMP(2H.")
  29. X      RETURN
  30. X 6    CALL CRAMDMP(1H,)`20
  31. X      CALL PROUT(31H  IF YOU'LL LOWER THE SHIELDS.",31)   `20
  32. X      RETURN
  33. X 8    CALL PROUT(`20
  34. X     +   51H  WE CAN'T DO IT, CAPTAIN.  WE HAVEN'T THE ENERGY.",51) `20
  35. X      RETURN
  36. XC--------MAKE SURE ENOUGH TIME IS LEFT FOR TRIP`20
  37. X 10   TIME=10.0*DIST/WFACSQ`20
  38. X      IF(TIME .LT. 0.80*REMTIME) GO TO 20`20
  39. X      CALL SKIP(1)
  40. X      CALL PROUT(`20
  41. X     +   51HFIRST OFFICER SPOCK:  "CAPTAIN, I COMPUTE THAT SUCH,41)
  42. X      CALL CRAM(37H  A TRIP WOULD REQUIRE APPROXIMATELY )`20
  43. X      CALL CRAMF(100.0*TIME/REMTIME,0,2)
  44. X`09CALL CRAMDMP(9H % OF OUR)
  45. X      CALL PROMPT(`20
  46. X     +   48H  REMAINING TIME.  ARE YOU SURE THIS IS WISE?"  ,48)`20
  47. X      IF(JA(DUMMY)) GO TO 20
  48. X      RETURN
  49. XC*`20
  50. X      ENTRY WARPX`20
  51. XC*`20
  52. X20`09BLOOEY=0
  53. X`09TWARP=0
  54. X      IF(WARPFAC .LE. 6.0) GO TO 50`20
  55. XC--------DECIDE IF ENGINE DAMAGE WILL OCCUR`20
  56. X      PROB=DIST*(6.0-WARPFAC)**2/66.666666666`20
  57. X      IF(PROB .GT. RANF(0)) BLOOEY=1
  58. X      IF(BLOOEY.NE.0) DIST=RANF(0)*DIST`20
  59. XC----------DECIDE IF TIME WARP WILL OCCUR`20
  60. X      TWARP=0`20
  61. X      IF(WARPFAC .LT. 10.0) GO TO 40
  62. X      IF(0.5*DIST .GT. RANF(0)) TWARP=1`20
  63. X 40   IF(BLOOEY .EQ. 0 .AND. TWARP .EQ. 0) GO TO 50`20
  64. XC--------IF ENGINE DAMAGE OR TIME WARP SHOULD OCCUR, CHECK PATH`20
  65. X      ANGLE=((15.0-DIREC)*0.5235998)
  66. X      DELTAX=-SIN(ANGLE)
  67. X      DELTAY=COS(ANGLE)`20
  68. X      BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY))`20
  69. X      DELTAX=DELTAX/BIGGER
  70. X      DELTAY=DELTAY/BIGGER
  71. X      N=10.0*DIST*BIGGER+0.5
  72. X      X=SECTX`20
  73. X      Y=SECTY`20
  74. X      IF(N .EQ. 0) GO TO 50`20
  75. X      DO 45 L=1,N`20
  76. X      X=X+DELTAX
  77. X      IX=X+0.5
  78. X      IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 50
  79. X      Y=Y+DELTAY
  80. X      IY=Y+0.5
  81. X      IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 50
  82. X      IF(QUAD(IX,IY) .EQ. IHDOT)  GO TO 45
  83. X`09BLOOEY=0
  84. X`09TWARP=0
  85. X 45   CONTINUE
  86. XC--------ACTIVATE WARP ENGINES AND PAY THE COST`20
  87. X50    KSTUF(4)=0 `20
  88. X      CALL MOVE  `20
  89. X      IF(ALLDONE.NE.0) RETURN`20
  90. X      ENERGY=ENERGY - DIST*WARPFAC*WARPFAC*WARPFAC*(SHLDUP+1)`20
  91. X      IF(ENERGY .GT. 0) GO TO 55
  92. X      CALL FINISH(4)
  93. X      RETURN
  94. X55    IF(KSTUF(4).EQ.0) TIME=10.0*DIST/WFACSQ  `20
  95. XC--------ENTER TIME WARP
  96. X      IF(TWARP.NE.0) CALL TIMEWRP`20
  97. XC--------DAMAGE WARP ENGINES
  98. X      IF(BLOOEY .EQ. 0) GO TO 60
  99. X      DAMAGE(6)=DAMFAC*(3.0*RANF(0)+1.0)
  100. X      CALL SKIP(1)
  101. X      CALL PROUT(24H"ENGINEERING TO BRIDGE--,24)`20
  102. X      CALL PROUT(44H  SCOTT HERE.  THE WARP ENGINES ARE DAMAGED.,44)`20
  103. X      CALL PROUT(41H  WE'LL HAVE TO REDUCE SPEED TO WARP 4."  ,41)  `20
  104. X 60   IDIDIT=1
  105. X      RETURN
  106. XC--------NO WARP ENGINES
  107. X 90   CALL SKIP(1)
  108. X      CALL PROUT(25HWARP ENGINES INOPERATIVE.,25)
  109. X      RETURN
  110. X      END`20
  111. $ CALL UNPACK TRWARP.FOR;1 1632833976
  112. $ create 'f'
  113. X      SUBROUTINE ZAP
  114. X`09INCLUDE 'TREKCOM/NOLIST'
  115. X      INTEGER CDAM(5)`20
  116. X      EQUIVALENCE (CRACKS(1),HIT),(CRACKS(3),IHURT),(CRACKS(4),L)`20
  117. X      PFAC=1.0/INSHLD`20
  118. X      CHGFAC=1.0
  119. X      IF(SHLDCHG .EQ. 1) CHGFAC=0.25+0.50*RANF(0)`20
  120. X      IF(SHLDUP .EQ. 0 .AND. SHLDCHG .EQ. 0) GO TO 10`20
  121. X      PROPOR=AMAX1(PFAC*SHLD,0.10)
  122. X      HITSH=PROPOR*CHGFAC*HIT+1.0`20
  123. X      ABSORB=0.8*HITSH
  124. X      IF(ABSORB .GT. SHLD) ABSORB=SHLD
  125. X      SHLD=SHLD-ABSORB
  126. X      IF(SHLD .LE. 0.0) SHLDUP=0
  127. X      HIT=HIT-HITSH`20
  128. X      IF(PROPOR .GT. 0.1 .AND. HIT .LT. (0.005*ENERGY)) RETURN
  129. XC--------IT'S A HIT!  PRINT OUT HIT SIZE
  130. X 10   IHURT=1`20
  131. X      CALL CRAMF(HIT,8,2)`20
  132. X      CALL CRAM(9H UNIT HIT)
  133. X      IF(L .EQ. 0) GO TO 15`20
  134. X      CALL CRAM(6H FROM )`20
  135. X      JX=KX(L)
  136. X      JY=KY(L)
  137. X      CALL CRAMENA(QUAD(JX,JY),0,JX,JY)`20
  138. X 15   CALL CREND
  139. XC--------DECIDE IF HIT IS CRITICAL
  140. X      IF(HIT .LT. (275.0-25.0*SKILL)*(1.0+0.5*RANF(0))) GO TO 60
  141. X      NCRIT=1.0 + HIT/(500.0+100.0*RANF(0))`20
  142. X      CALL CRAM(17H***CRITICAL HIT--)`20
  143. XC--------SELECT DEVICE(S) AND CAUSE DAMAGE
  144. X      KTR=1`20
  145. X      DO 50 LL=1,NCRIT
  146. X 20   J=NDEVICE*RANF(0)+1.0`20
  147. X      IF(DAMAGE(J) .LT. 0) GO TO 20`20
  148. XC*--------CHEAT TO PREVENT DEATHRAY FROM BEING DAMAGED.   `20
  149. X      IF(J.EQ.14) GOTO 20  `20
  150. XC--------CHEAT TO PREVENT SHUTTLE DAMAGE UNLESS ON SHIP.
  151. X      IF((J .EQ. 10) .AND. (ISCRAFT .NE. 1)) GO TO 20`20
  152. X      CDAM(LL)=J
  153. X      EXTRADM=(HIT*DAMFAC)/(NCRIT*(75.0+25.0*RANF(0)))
  154. X      DAMAGE(J)=DAMAGE(J)+EXTRADM`20
  155. X      IF(LL .EQ. 1) GO TO 40
  156. X      DO 30 LLL=2,LL
  157. X      IF(J .EQ. CDAM(LLL-1)) GO TO 50`20
  158. X 30   CONTINUE
  159. X      KTR=KTR+1`20
  160. X      IF(KTR .EQ. 3) CALL CREND`20
  161. X      CALL CRAM(5H AND )
  162. X 40   CALL CRAMS(DEVICE(1,J),16)
  163. X 50   CONTINUE
  164. X      CALL CRAMDMP(9H DAMAGED.)`20
  165. XC--------PRINT MESSAGE IF SHIELDS WERE UP AND GOT KNOCKED DOWN
  166. X      IF(DAMAGE(8) .EQ. 0) GO TO 60`20
  167. X      IF(SHLDUP.NE.0) CALL PROUT(24H***SHIELDS KNOCKED DOWN.,24)`20
  168. X      SHLDUP=0
  169. XC--------IF SUBSPACE RADIO GOT DAMAGED, REMEMBER THE FACT.
  170. X 60`09IF(DAMAGE(9).GT.0)ISUBDAM=1
  171. X      ENERGY=ENERGY-HIT`20
  172. X      RETURN     `20
  173. X      END`20
  174. $ CALL UNPACK TRZAP.FOR;1 1115636691
  175. $ v=f$verify(v)
  176. $ EXIT
  177.