home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.lbl.gov / 2014.05.ftp.ee.lbl.gov.tar / ftp.ee.lbl.gov / mtrek.shar.Z / mtrek.shar / zip.ftn < prev    next >
Text File  |  1990-04-02  |  18KB  |  907 lines
  1.     PROGRAM ZIP
  2. C
  3. C    Control code for the driver program
  4. C
  5.     INCLUDE 'LEDFOR.COM/-LI'
  6.     INCLUDE 'BUFFER.COM/-LI'
  7.     BYTE HOLE
  8.     REAL*4 OVER(2)
  9.  
  10.     DATA OVER/6RZIPINT,6RPHASER/
  11.     DATA HOLE/.FALSE./
  12.  
  13.     CALL MNLOAD(OVER(1))        ! Load ZIPINT
  14.     CALL ZIPINT
  15.     CALL MNLOAD(OVER(2))        ! Load PHASER
  16. C
  17. C    Here starts the actual game playing
  18. C
  19. 10000    CALL MARK(1,60,1)
  20.     CALL WAITFR(1)
  21.  
  22. C    Fire torpedoes
  23.     CALL TORPI
  24.  
  25. C    Fire phasers
  26.     CALL PHASER
  27.  
  28. C    Move active torpedoes
  29.     CALL MTORPS
  30.  
  31. C    Move ships
  32.     CALL MSHIPS
  33.  
  34. C    Move the "black hole"
  35.     CALL MHOLE(HOLE)
  36.     HOLE=.NOT.HOLE
  37.  
  38. C    Handle all anti-matter transactions
  39.     CALL MANTI
  40.  
  41. C    Update system time
  42.     IF(HOLE)CALL SYSTIM
  43.     IF(THRU.NE.0)GOTO 10000
  44.  
  45. C    All players are gone; wait 7 seconds before exiting
  46.     THRU=-2
  47.     DO 10001 K=1,7
  48.     CALL MARK(1,60,1)
  49.     CALL WAITFR(1)
  50.     IF(THRU.LE.0)GOTO 10001
  51.     GOTO 10000
  52. 10001    CONTINUE
  53.     CALL EXIT
  54.     END
  55.     SUBROUTINE ZIPINT
  56. C
  57. C    Set up the whole show
  58. C
  59.     INCLUDE 'LEDFOR.COM/-LI'
  60.     INCLUDE 'BUFFER.COM/-LI'
  61.     BYTE OK,VALID,DEF,SHIP
  62.  
  63.     CALL CHKPAR            ! Make sure LEDFOR is set
  64.     CALL ERRSET(24,,.FALSE.,,.FALSE.)
  65.     CALL ERRSET(39,,.FALSE.,,.FALSE.)
  66.     CALL ERRSET(64,,.FALSE.,.TRUE.,.FALSE.)
  67. C
  68. C    Get the first random number seed
  69. C
  70.     X=SECNDS(0.0)
  71.     I1=INT((X-AINT(X))*1000.0)
  72.  
  73.     WRITE(1,10000)"15
  74. 10000    FORMAT(' ',A1,'Welcome to Multi-Trek')
  75.     IF(UNIV(1,1).EQ.0)GOTO 10102
  76. 10100    WRITE(1,10001)
  77. 10001    FORMAT('$Are you continuing a game ? ')
  78.     CALL YESNO(OK,VALID)
  79.     IF(.NOT.VALID)GOTO 10100
  80.     IF(OK)GOTO 10002
  81. 10102    WRITE(1,10007)
  82. 10007    FORMAT('$Do you want to change the defaults ? ')
  83.     CALL YESNO(DEF,VALID)
  84.     IF(.NOT.VALID)GOTO 10102
  85.     OK=.FALSE.
  86. C
  87. C    Get star density
  88. C
  89.     IF(.NOT.DEF)GOTO 10009
  90. 10110    WRITE(1,10008)
  91. 10008    FORMAT('$Enter the star density of universe in parts
  92.      $ per one hundred (1.6) ')
  93.     CALL GETREL(STARS,OK,0.0,15.0,VALID)
  94.     IF(.NOT.VALID)GOTO 10110
  95. 10009    IF(.NOT.OK)STARS=1.6
  96.     STARS=(100.0-STARS)/100.0
  97. C
  98. C    Get number of bases
  99. C
  100.     IF(.NOT.DEF)GOTO 10010
  101. 10115    WRITE(1,10012)
  102. 10012    FORMAT('$Enter the number of star bases (12) ')
  103.     CALL GETINT(IBASES,OK,0,50,VALID)
  104.     IF(.NOT.VALID)GOTO 10115
  105. 10010    IF(.NOT.OK)IBASES=12
  106. C
  107. C    Get number of random ports
  108. C
  109.     IF(.NOT.DEF)GOTO 10015
  110. 10120    WRITE(1,10016)
  111. 10016    FORMAT('$Enter the number of random jump points (3) ')
  112.     CALL GETINT(N,OK,0,10,VALID)
  113.     IF(.NOT.VALID)GOTO 10120
  114. 10015    IF(.NOT.OK)N=3
  115. C
  116. C    Get cloaking energy drain
  117. C
  118.     IF(.NOT.DEF)GOTO 10075
  119. 10130    WRITE(1,10076)
  120. 10076    FORMAT('$Enter energy drain for cloaking (25.0) ')
  121.     CALL GETREL(CDRAIN,OK,0.0,2000.0,VALID)
  122.     IF(.NOT.VALID)GOTO 10130
  123. 10075    IF(.NOT.OK)CDRAIN=25.0
  124. C
  125. C    Get speed of black hole
  126. C
  127.     IF(.NOT.DEF)GOTO 10079
  128. 10135    WRITE(1,10080)
  129. 10080    FORMAT('$Enter warp speed of "black hole" (3.0) ')
  130.     CALL GETREL(ZW,OK,0.0,10.0,VALID)
  131.     IF(.NOT.VALID)GOTO 10135
  132. 10079    IF(.NOT.OK)ZW=3.0
  133. C
  134. C    Get the second random number seed
  135. C
  136.     X=SECNDS(0.0)
  137.     I2=INT((X-AINT(X))*1000.0)
  138. C
  139. C    Now generate the universe
  140. C
  141.     DO 10025 I=1,100
  142.     DO 10028 J=1,100
  143.     RNDOM=RAN(I1,I2)
  144.     IF(RNDOM.LE.STARS)GOTO 10036
  145.     UNIV(I,J)='*'
  146.     GOTO 10028
  147. 10036    UNIV(I,J)='.'
  148. 10028    CONTINUE
  149. 10025    CONTINUE
  150. C
  151. C    Put in the star bases
  152. C
  153.     DO 10034 I=1,IBASES
  154.     CALL NEWLOC(X,Y,'B')
  155. 10034    CONTINUE
  156. C
  157. C    Put in the hyperspace ports
  158. C
  159.     UNIV(20,25)='H'
  160.     UNIV(20,75)='H'
  161.     UNIV(50,30)='H'
  162.     UNIV(50,70)='H'
  163.     UNIV(80,25)='H'
  164.     UNIV(80,75)='H'
  165. C
  166. C    Put in the mobile "black hole"
  167. C
  168.     CALL NEWLOC(ZX,ZY,'#')
  169. C
  170. C    Put in the random hyper-space ports
  171. C
  172.     DO 10040 I=1,N
  173.     CALL NEWLOC(X,Y,'R')
  174. 10040    CONTINUE
  175. C
  176. C    Put in and initialize the star ships
  177. C
  178.     DO 10055 I=1,8
  179.     SHIP="60+I
  180.     CALL NEWLOC(XCORD(I),YCORD(I),SHIP)
  181.     ACTIVE(I)=.FALSE.
  182.     ALIVE(I)=.FALSE.
  183.     COURSE(I)=90.0
  184.     CLOAK(I)=.TRUE.
  185.     ENERGY(I)=10000.0
  186.     HYPER(I)=3
  187.     IPOD(I)=0
  188.     IT(I)=1
  189.     LAUNCH(I)=-1.0
  190.     PHA(I)=-1.0
  191.     SCORE(I)=0
  192.     SHIELD(I)=0.0
  193.     TORPS(I)=10
  194.     WARP(I)=0.0
  195.     DO 10074 K=1,10
  196.     ISENT(I,K)=0
  197.     TORDIR(I,K)=-1.0
  198.     TORLOC(I,K,1)=1
  199.     TORLOC(I,K,2)=1
  200. 10074    CONTINUE
  201. 10055    CONTINUE
  202. C
  203. C    Initialize the system time
  204. C
  205. 10002    CALL SYSTIM
  206. C
  207. C
  208. C    ** All initializition done by here **
  209. C
  210.     WRITE(1,10084)(TIM(I),I=1,16)
  211. 10084    FORMAT('0Multi-Trek initialized at ',15A1,' ',A1,'m',/,'$>')
  212.     THRU=-1
  213.     RETURN
  214.     END
  215.     SUBROUTINE NEWLOC(X,Y,CHAR)
  216. C
  217. C    Find an empty location in the universe for an object
  218. C    and put it there.
  219. C
  220.     INCLUDE 'LEDFOR.COM/-LI'
  221.     INTEGER*2 IX,IY
  222.     REAL X,Y
  223.     BYTE CHAR
  224.  
  225. 10001    IX=INT(RAN(I1,I2)*100.0)+1
  226.     IF(IX.GT.100)IX=100
  227.     IY=INT(RAN(I1,I2)*100.0)+1
  228.     IF(IY.GT.100)IY=100
  229.     IF(UNIV(IX,IY).NE.'.')GOTO 10001
  230.     X=FLOAT(IX)+0.5
  231.     Y=FLOAT(IY)+0.5
  232.     UNIV(IX,IY)=CHAR
  233.     RETURN
  234.     END
  235.     SUBROUTINE SYSTIM
  236. C
  237. C    Set and update the current time and date
  238. C
  239.     INCLUDE 'LEDFOR.COM/-LI'
  240.     INCLUDE 'BUFFER.COM/-LI'
  241.     INTEGER*2 OLDHR,OLDMN,NEWHR,NEWMN
  242.     BYTE AMPM
  243.     DATA OLDHR,OLDMN /0,0/
  244.  
  245.     CALL TIME(IBUF)
  246.     NEWHR=10*(IBUF(1)-"60)+(IBUF(2)-"60)
  247.     NEWMN=10*(IBUF(4)-"60)+(IBUF(5)-"60)
  248.     IF((OLDMN.EQ.NEWMN).AND.(OLDHR.EQ.NEWHR))GOTO 10001
  249.     TIM(14)=IBUF(4)
  250.     TIM(15)=IBUF(5)
  251.     OLDHR=NEWHR
  252.     OLDMN=NEWMN
  253.     AMPM='a'
  254.     IF(NEWHR.GE.12)AMPM='p'
  255.     IF(NEWHR.GT.12)NEWHR=NEWHR-12
  256.     IF(NEWHR.EQ.0)NEWHR=12
  257.     CALL DATE(IBUF)
  258.     IF(IBUF(1).EQ.'0')IBUF(1)=' '
  259.     IBUF(5)=IBUF(5)+"40
  260.     IBUF(6)=IBUF(6)+"40
  261.     ENCODE(13,10010,TIM)(IBUF(I),I=1,9),NEWHR
  262. 10010    FORMAT(9A1,' ',I2,':')
  263.     TIM(16)=AMPM
  264. 10001    RETURN
  265.     END
  266.     SUBROUTINE MSHIPS
  267. C
  268. C    Move ships - ramming an object costs 100 units (stars cost 200)
  269. C
  270.     INCLUDE 'LEDFOR.COM/-LI'
  271.     BYTE CHAR,SHIP
  272.     INTEGER*2 HYPERX(6),HYPERY(6)
  273.     DATA HYPERX/20,50,80,20,50,80/
  274.     DATA HYPERY/75,70,75,25,30,25/
  275.  
  276.     DO 10001 I=1,8
  277. C    Don't bother unmaned star ships
  278.     IF(.NOT.ALIVE(I))GOTO 10001
  279.  
  280. C    Cloaked ships must pay toll
  281.     IF(.NOT.CLOAK(I))GOTO 10006
  282.     ENERGY(I)=ENERGY(I)-CDRAIN
  283.     WARP(I)=0.0
  284.  
  285. C    Move ships
  286. 10006    IX=INT(XCORD(I))
  287.     IY=INT(YCORD(I))
  288.     SHIP="60+I
  289.     ENERGY(I)=ENERGY(I)-WARP(I)/2
  290.     CALL MOVE(XCORD(I),YCORD(I),X,Y,COURSE(I),WARP(I),CHAR,UNIV)
  291.     KX=INT(X)
  292.     KY=INT(Y)
  293.  
  294. C    We have rammed a ship
  295.     IF(CHAR.GT.'8'.OR.CHAR.LT.'1')GOTO 10014
  296.     K=CHAR-"60
  297.     IF(I.EQ.K)GOTO 10076        ! Wipe out duplicate ships
  298.     WARP(I)=0.0
  299.     WARP(K)=0.0
  300.     CALL SENT(I,9)
  301.     ENERGY(I)=ENERGY(I)-100.0
  302.     IF(.NOT.ALIVE(K))GOTO 10013
  303.     CALL SENT(K,10)
  304.     ENERGY(K)=ENERGY(K)-100.0
  305.     GOTO 10013
  306.  
  307. C    Rammed (docked) a base
  308. 10014    IF(CHAR.NE.'B')GOTO 10020
  309.     CALL SENT(I,1)
  310.     WARP(I)=0.0
  311.     ENERGY(I)=10000.0
  312.     SHIELD(I)=0.0
  313.     TORPS(I)=10
  314.     IF(IPOD(I).NE.2)GOTO 10016
  315.     IF(UNIV(INT(XPOD(I)),INT(YPOD(I))).EQ.'@')
  316.      $    UNIV(INT(XPOD(I)),INT(YPOD(I)))='.'
  317. 10016    IPOD(I)=0
  318.     GOTO 10013
  319.  
  320. C    Hit a star
  321. 10020    IF(CHAR.NE.'*')GOTO 10022
  322.     WARP(I)=0.0
  323.     CALL SENT(I,2)
  324.     ENERGY(I)=ENERGY(I)-200.0
  325.     GOTO 10013
  326.  
  327. C    Hit a torpedo
  328. 10022    IF(CHAR.NE.'+')GOTO 10024
  329.     CALL TFIND(K,KX,KY)
  330.     IF(K.EQ.0)GOTO 10076
  331.     CALL THIT(K,IX,IY,UNIV(IX,IY))
  332.     TORDIR(K,IT(K))=-1.0
  333.     UNIV(KX,KY)='.'
  334.     GOTO 10013
  335.  
  336. C    Hit a hyperspace port
  337. 10024    IF(CHAR.NE.'H')GOTO 10032
  338.     WARP(I)=0.0
  339.     CALL SENT(I,17)
  340.     KX=HYPERX(HYPER(I))
  341.     KY=HYPERY(HYPER(I))
  342. C    Put the ship near the destination port if possible
  343. 10037    CONTINUE
  344.     DO 10052 II=KX-1,KX+1
  345.     DO 10055 IJ=KY-1,KY+1
  346.     IF((II.EQ.IX).AND.(IJ.EQ.IY))GOTO 10036    ! OK to place ship on itself
  347.     IF(UNIV(II,IJ).NE.'.')GOTO 10055
  348.     UNIV(IX,IY)='.'
  349.     UNIV(II,IJ)=SHIP
  350. 10036    XCORD(I)=FLOAT(II)+0.5
  351.     YCORD(I)=FLOAT(IJ)+0.5
  352.     GOTO 10013
  353. 10055    CONTINUE
  354. 10052    CONTINUE
  355. C    If we are here we didn't find an empty spot (very unlikely)
  356.     CALL SENT(I,18)
  357.     GOTO 10013
  358.  
  359. C    Ran into the "black hole" (nice flying)
  360. 10032    IF(CHAR.NE.'#')GOTO 10060
  361.     CALL SENT(I,15)
  362.     CALL RESET(I)
  363.     GOTO 10013
  364.  
  365. C    Hit a random hyperspace port
  366. 10060    IF(CHAR.NE.'R')GOTO 10062
  367.     WARP(I)=0.0
  368.     CALL SENT(I,19)
  369.     CALL NEWLOC(XCORD(I),YCORD(I),SHIP)
  370.     UNIV(IX,IY)='.'
  371.     GOTO 10013
  372.  
  373. C    Bumped into an anti-matter pod
  374. 10062    IF(CHAR.NE.'@')GOTO 10076
  375.     CALL SENT(I,27)
  376.     WARP(I)=0.0
  377.     ENERGY(I)=ENERGY(I)-100.0
  378.     GOTO 10013
  379.  
  380. C    Didn't hit anything
  381. 10076    XCORD(I)=X
  382.     YCORD(I)=Y
  383.     UNIV(IX,IY)='.'
  384.     UNIV(KX,KY)=SHIP
  385.  
  386. C    Check if this guy has juice left
  387. 10013    IF(ENERGY(I).GT.0.0)GOTO 10001
  388.     CALL SENT(I,16)
  389.     CALL RESET(I)
  390. 10001    CONTINUE
  391.     RETURN
  392.     END
  393.     SUBROUTINE MTORPS
  394. C
  395. C    Move all active torpedoes
  396. C
  397.     INCLUDE 'LEDFOR.COM/-LI'
  398.     BYTE CHAR
  399.  
  400.     DO 10001 I=1,8
  401.     DO 10004 K=1,10
  402.     IF(TORDIR(I,K).LT.0.0)GOTO 10004
  403.     IX=INT(TORLOC(I,K,1))
  404.     IY=INT(TORLOC(I,K,2))
  405. C
  406. C    Make sure the torpedo is still there and active
  407. C
  408.     IF(UNIV(IX,IY).NE.'+')GOTO 10006
  409.     CALL MOVE(TORLOC(I,K,1),TORLOC(I,K,2),X,Y,TORDIR(I,K),10.0,CHAR,UNIV)
  410.     KX=INT(X)
  411.     KY=INT(Y)
  412.     UNIV(IX,IY)='.'
  413.     IF(CHAR.EQ.'.')GOTO 10009
  414.     CALL THIT(I,KX,KY,CHAR)
  415. 10006    TORDIR(I,K)=-1.0
  416.     GOTO 10004
  417. 10009    UNIV(KX,KY)='+'
  418.     TORLOC(I,K,1)=X
  419.     TORLOC(I,K,2)=Y
  420. 10004    CONTINUE
  421. 10001    CONTINUE
  422.     RETURN
  423.     END
  424.     SUBROUTINE RESET(WHO)
  425. C
  426. C    Re-incarnate destroyed ships
  427. C
  428.     INCLUDE 'LEDFOR.COM/-LI'
  429.     INTEGER*2 WHO
  430.     BYTE SHIP
  431.  
  432.     CALL SENT(WHO,3)
  433.     ALIVE(WHO)=.FALSE.
  434.     CLOAK(WHO)=.TRUE.
  435.     ENERGY(WHO)=10000.0
  436.     IF(IPOD(WHO).NE.2)GOTO 10001    ! Check for active pod
  437.     IF(UNIV(INT(XPOD(WHO)),INT(YPOD(WHO))).EQ.'@')
  438.      $    UNIV(INT(XPOD(WHO)),INT(YPOD(WHO)))='.'
  439. 10001    IPOD(WHO)=0
  440.     UNIV(INT(XCORD(WHO)),INT(YCORD(WHO)))='.'
  441.     SCORE(WHO)=SCORE(WHO)-1000
  442.     SHIELD(WHO)=0.0
  443.     TORPS(WHO)=10.0
  444.     WARP(WHO)=0.0
  445.     SHIP="60+WHO
  446.     CALL NEWLOC(XCORD(WHO),YCORD(WHO),SHIP)
  447.     RETURN
  448.     END
  449.     SUBROUTINE THIT(I,IX,IY,CHAR)
  450. C
  451. C    Handle torpedo hits
  452. C
  453.     INCLUDE 'LEDFOR.COM/-LI'
  454.     BYTE CHAR
  455.  
  456. C    Torpedo hit on hyper space port
  457.     IF((CHAR.EQ.'H').OR.(CHAR.EQ.'R'))GOTO 10003
  458.  
  459. C    Torpedo hit on ship
  460. 10004    IF((CHAR.LT.'1').OR.(CHAR.GT.'8'))GOTO 10006
  461.     K=CHAR-"60
  462.     IF(.NOT.ALIVE(K))GOTO 10009
  463.     CALL DAMAGE(K,500.0)
  464.     IF(I.EQ.K)GOTO 10007
  465.     SCORE(I)=SCORE(I)+500
  466.     CALL SENT(K,4)
  467.     CALL SENT(I,5)
  468.     IF(ENERGY(K).GT.0.0)GOTO 10003
  469.     CALL RESET(K)
  470.     CALL SENT(I,22)
  471.     SCORE(I)=SCORE(I)+2000
  472.     GOTO 10003
  473.  
  474. C    Hit a ghost ship
  475. 10009    CALL SENT(I,21)
  476.     GOTO 10003
  477.  
  478. C    Hit by his own torp
  479. 10007    CALL SENT(I,32)
  480.     IF(ENERGY(I).GT.0.0)GOTO 10003
  481.     CALL RESET(I)
  482.     GOTO 10003
  483.  
  484. C    Torpedo hit on star
  485. 10006    IF(CHAR.NE.'*')GOTO 10015
  486.     CALL SENT(I,13)
  487.     GOTO 10003
  488.  
  489. C    Torpedo hit on base (real fine shooting)
  490. 10015    IF(CHAR.NE.'B')GOTO 10017
  491.     CALL SENT(I,12)
  492.     SCORE(I)=SCORE(I)-200
  493.     GOTO 10003
  494.  
  495. C    Torpedo hit on torpedo
  496. 10017    IF(CHAR.NE.'+')GOTO 10019
  497.     CALL SENT(I,20)
  498.     UNIV(IX,IY)='.'
  499.     GOTO 10003
  500.  
  501. C    Torpedo hit on anti-matter pod
  502. 10019    IF(CHAR.NE.'@')GOTO 10021
  503.     CALL SENT(I,26)
  504.     GOTO 10003
  505.  
  506. C    Anything else gets destroyed
  507. 10021    UNIV (IX,IY) = '.'
  508. 10003    RETURN
  509.     END
  510.     SUBROUTINE PHASER
  511. C
  512. C    Fire phasers (3 band blast)
  513. C
  514.     INCLUDE 'LEDFOR.COM/-LI'
  515.     INTEGER*2 DX(3),DY(3)
  516.     REAL PHASE
  517.     BYTE CHAR
  518.  
  519.     DO 10001 I=1,8
  520.     IF(PHA(I).LT.0.0)GOTO 10001
  521.     IF(.NOT.ALIVE(I))GOTO 10001
  522.     PHASE=PHA(I)
  523.     PHA(I)=-1.0
  524.     DX(1)=INT(XCORD(I))
  525.     DY(1)=INT(YCORD(I))
  526.  
  527. C    Three char wide beam
  528.     IF(((PHASE.LT.45.0).OR.(PHASE.GE.135.0)).AND.
  529.      $    ((PHASE.LT.225.0).OR.(PHASE.GE.315.0)))GOTO 10006
  530.     DX(2)=DX(1)-1
  531.     DX(3)=DX(1)+1
  532.     DY(2)=DY(1)
  533.     DY(3)=DY(1)
  534.     GOTO 10007
  535.  
  536. 10006    DX(2)=DX(1)
  537.     DX(3)=DX(1)
  538.     DY(2)=DY(1)-1
  539.     DY(3)=DY(1)+1
  540.  
  541. 10007    DO 10010 IZ=2,3
  542.     IF(DX(IZ).GE.101)DX(IZ)=DX(IZ)-100
  543.     IF(DY(IZ).GE.101)DY(IZ)=DY(IZ)-100
  544.     IF(DX(IZ).LT.1)DX(IZ)=DX(IZ)+100
  545.     IF(DY(IZ).LT.1)DY(IZ)=DY(IZ)+100
  546. 10010    CONTINUE
  547.  
  548. C    Now fire from three places
  549.     DO 10019 IZ=1,3
  550.     X1=FLOAT(DX(IZ))+0.5
  551.     Y1=FLOAT(DY(IZ))+0.5
  552.  
  553. C    Shoot ten places (warp 10) and hit the closest target
  554.     DO 10022 IK=1,10
  555.     CALL MOVE(X1,Y1,X,Y,PHASE,10.0,CHAR,UNIV)
  556.     IF(CHAR.NE.'.')GOTO 10023
  557.     X1=X
  558.     Y1=Y
  559. 10022    CONTINUE
  560.  
  561.     GOTO 10049
  562. C    Hit on ship
  563. 10023    IF((CHAR.LT.'1').OR.(CHAR.GT.'8'))GOTO 10031
  564.     K=CHAR-"60
  565.     IF(.NOT.ALIVE(K))GOTO 10034    ! Don't blast a ghost
  566.     IF(K.EQ.I)GOTO 10019        ! Don't blast self
  567.     ENG=900.0/(4.0+SQRT((XCORD(I)-XCORD(K))**2+(YCORD(I)-YCORD(K))**2))
  568.     CALL DAMAGE(K,ENG)
  569.     SCORE(I)=SCORE(I)+INT(ENG)
  570.     CALL SENT(I,6)
  571.     CALL SENT(K,14)
  572.     IF(ENERGY(K).GT.0.0)GOTO 10019
  573.     SCORE(I)=SCORE(I)+2000
  574.     CALL SENT(I,22)
  575.     CALL RESET(K)
  576.     GOTO 10019
  577.  
  578. 10034    CALL SENT(I,21)
  579.     GOTO 10019
  580.  
  581. C    Phaser hit on torpedo
  582. 10031    IF(CHAR.NE.'+')GOTO 10043
  583.     CALL SENT(I,7)
  584.     GOTO 10019
  585.  
  586. C    Phaser hit on star
  587. 10043    IF(CHAR.NE.'*')GOTO 10045
  588.     CALL SENT(I,11)
  589.     GOTO 10019
  590.  
  591. C    Phaser hit on base
  592. 10045    IF(CHAR.NE.'B')GOTO 10047
  593.     CALL SENT(I,12)
  594.     GOTO 10019
  595.  
  596. C    Phaser hit on anti-matter pod
  597. 10047    IF(CHAR.NE.'@')GOTO 10049
  598.     CALL SENT(I,25)
  599.     GOTO 10019
  600.  
  601. C    Missed
  602. 10049    CALL SENT(I,8)
  603. 10019    CONTINUE
  604. 10001    CONTINUE
  605.     RETURN
  606.     END
  607.     SUBROUTINE TORPI
  608. C
  609. C    Fire torpedoes
  610. C
  611.     INCLUDE 'LEDFOR.COM/-LI'
  612.     BYTE CHAR
  613.  
  614.     DO 10001 I=1,8
  615.     IF(LAUNCH(I).LT.0.0)GOTO 10001
  616.     IF(.NOT.ALIVE(I))GOTO 10001
  617.     CALL MOVE(XCORD(I),YCORD(I),X1,Y1,LAUNCH(I),10.0,CHAR,UNIV)
  618.     KX=INT(XCORD(I))
  619.     KY=INT(YCORD(I))
  620.  
  621. C    Make sure it moved out of the firer's square
  622.     IF((KX.NE.INT(X1)).OR.(KY.NE.INT(Y1)))GOTO 10006
  623.     CALL MOVE(X1,Y1,X,Y,LAUNCH(I),10.0,CHAR,UNIV)
  624.     GOTO 10007
  625. 10006    X=X1
  626.     Y=Y1
  627. 10007    IX=INT(X)
  628.     IY=INT(Y)
  629.     IF(CHAR.NE.'.')GOTO 10009
  630.     UNIV(IX,IY)='+'
  631.  
  632. C    Remove old torp (if it exists)
  633.     IF(TORDIR(I,IT(I)).LT.0.0)GOTO 10012
  634.     KX=INT(TORLOC(I,IT(I),1))
  635.     KY=INT(TORLOC(I,IT(I),2))
  636.     IF(UNIV(KX,KY).EQ.'+')UNIV(KX,KY)='.'
  637.  
  638. C    Good launch
  639. 10012    TORLOC(I,IT(I),1)=X
  640.     TORLOC(I,IT(I),2)=Y
  641.     TORDIR(I,IT(I))=LAUNCH(I)
  642.     IT(I)=IT(I)+1
  643.     IF(IT(I).GT.10)IT(I)=1
  644.     GOTO 10010
  645.  
  646. C    Hit something
  647. 10009    CALL THIT(I,IX,IY,CHAR)
  648. 10010    LAUNCH(I)=-1.0
  649. 10001    CONTINUE
  650.     RETURN
  651.     END
  652.     SUBROUTINE DAMAGE(WHO,ENG)
  653. C
  654. C    Calculate damage done
  655. C
  656.     INCLUDE 'LEDFOR.COM/-LI'
  657.     INTEGER*2 WHO
  658.  
  659.     SABS=SHIELD(WHO)/1000.0
  660.     IF(SABS.GT.1.0)SABS=1.0
  661.     ENERGY(WHO)=ENERGY(WHO)-(1.2-SABS)*ENG*8.0
  662.     SHIELD(WHO)=SHIELD(WHO)-SABS*ENG
  663.     IF(SHIELD(WHO).LT.0.0)SHIELD(WHO)=0.0
  664.     RETURN
  665.     END
  666.     SUBROUTINE MOVE(XI,YI,XF,YF,DIR,WARP,CHAR,UNIV)
  667. C
  668. C    Move objects with wrap around
  669. C
  670.     BYTE UNIV(100,100),CHAR
  671.     REAL XI,YI,XF,YF,DIR,WARP
  672.  
  673.     IXI=INT(XI)
  674.     IYI=INT(YI)
  675.     XF=XI+COS(DIR/180*3.1415926)/10.0*WARP
  676.     YF=YI+SIN(DIR/180*3.1415926)/10.0*WARP
  677.     IXF=INT(XF)
  678.     IYF=INT(YF)
  679.  
  680.     IF(IXF.LE.100)GOTO 10010
  681.     IXF=IXF-100
  682.     XF=XF-100.0
  683. 10010    IF(IXF.GE.1)GOTO 10020
  684.     IXF=IXF+100
  685.     XF=XF+100.0
  686. 10020    IF(IYF.LE.100)GOTO 10030
  687.     IYF=IYF-100
  688.     YF=YF-100.0
  689. 10030    IF(IYF.GE.1)GOTO 10040
  690.     IYF=IYF+100
  691.     YF=YF+100.0
  692. 10040    CHAR=UNIV(IXF,IYF)
  693.     IF((IXI.EQ.IXF).AND.(IYI.EQ.IYF))CHAR='.'
  694.     END
  695.     SUBROUTINE TFIND(WHO,IX,IY)
  696. C
  697. C    Find out who should get the credit if some one runs into a torp
  698. C
  699.  
  700.     INCLUDE 'LEDFOR.COM/-LI'
  701.     INTEGER*2 WHO
  702.  
  703.     DO 10001 WHO=1,8
  704.     DO 10004 I=1,10
  705.     IF(TORDIR(WHO,I).LT.0.0)GOTO 10004
  706.     KX=INT(TORLOC(WHO,I,1))
  707.     KY=INT(TORLOC(WHO,I,2))
  708.     IF((IX.EQ.KX).AND.(IY.EQ.KY))GOTO 10003
  709. 10004    CONTINUE
  710. 10001    CONTINUE
  711.     WHO=0
  712. 10003    RETURN
  713.     END
  714.     SUBROUTINE SENT(WHO,NUM)
  715. C
  716. C    Send messages to the players
  717. C
  718.     INCLUDE 'LEDFOR.COM/-LI'
  719.     INTEGER*2 WHO
  720.  
  721.     DO 10001 I=1,10
  722.     IF(ISENT(WHO,I).NE.0)GOTO 10001
  723.     ISENT(WHO,I)=NUM
  724.     GOTO 10002
  725. 10001    CONTINUE
  726.  
  727. C    Message buffer is full so copy it up to keep most recent
  728.     DO 10007 I=1,9
  729.     ISENT(WHO,I)=ISENT(WHO,I+1)
  730. 10007    CONTINUE
  731.     ISENT(WHO,10)=NUM
  732. 10002    RETURN
  733.     END
  734.     SUBROUTINE MHOLE(HOLE)
  735. C
  736. C    Move the "black hole" toward the nearest active ship
  737. C
  738.     INCLUDE 'LEDFOR.COM/-LI'
  739.     BYTE CHAR,HOLE
  740.  
  741.     IF(HOLE)GOTO 10002        ! Cut down extra FPU calculations
  742. C    Find closest ship
  743.     DM=1.6E37
  744.     K=0
  745.     DO 10001 I=1,8
  746.     IF(.NOT.ALIVE(I))GOTO 10001
  747.     D=(XCORD(I)-ZX)**2+(YCORD(I)-ZY)**2    ! Distance squared
  748.     IF(D.GE.DM)GOTO 10001
  749.     DM=D
  750.     K=I
  751. 10001    CONTINUE
  752.  
  753. C    Find direction of closest ship
  754.     IF(K.EQ.0)GOTO 10009
  755.     D=ATAN2((YCORD(K)-ZY),(XCORD(K)-ZX))*180.0/3.1415926
  756.  
  757. 10002    CALL MOVE(ZX,ZY,X,Y,D,ZW,CHAR,UNIV)
  758.     UNIV(INT(ZX),INT(ZY))='.'
  759.  
  760. C    Just munch this junk down
  761.     IF((CHAR.EQ.'.').OR.(CHAR.EQ.'+').OR.(CHAR.EQ.'@'))GOTO 10011
  762.  
  763. C    Caught a ship
  764.     IF((CHAR.LT.'1').OR.(CHAR.GT.'8'))GOTO 10018
  765.     I=CHAR-"60
  766.     IF(.NOT.ALIVE(I))GOTO 10011    ! Don't create new ships
  767.     CALL SENT(I,15)
  768.     CALL RESET(I)
  769.     GOTO 10009
  770.  
  771. C    Swap places with bases, stars, etc.
  772. 10018    UNIV(INT(ZX),INT(ZY))=CHAR
  773. 10011    UNIV(INT(X),INT(Y))='#'
  774.     ZX=X
  775.     ZY=Y
  776. 10009    RETURN
  777.     END
  778.     SUBROUTINE MANTI
  779. C
  780. C    Deal with anti-matter
  781. C
  782.     INCLUDE 'LEDFOR.COM/-LI'
  783.     BYTE CHAR,HOLE
  784.     INTEGER*2 IPX(21),IPY(21)
  785.     PARAMETER POD='@'
  786. C
  787. C    The following data descibes the explosion pattern for
  788. C    anti-matter pods
  789. C
  790.     DATA IPX/-1,0,1,-2,-1,0,1,2,-2,-1,0,1,2,-2,-1,0,1,2,-1,0,1/
  791.     DATA IPY/2,2,2,1,1,1,1,1,0,0,0,0,0,-1,-1,-1,-1,-1,-2,-2,-2/
  792.  
  793.     HOLE=.FALSE.
  794.     DO 10001 I=1,8
  795.  
  796.     IF(IPOD(I).LE.0)GOTO 10001    ! Not launched yet
  797.     IF(IPOD(I).GE.4)GOTO 10001    ! Already detonated
  798.     IF(.NOT.ALIVE(I))GOTO 10001    ! Active pod from a dead ship
  799.  
  800. C    Launch pod
  801. 10005    IF(IPOD(I).NE.1)GOTO 10007
  802.     CALL MOVE(XCORD(I),YCORD(I),X1,Y1,DPOD(I),10.0,CHAR,UNIV)
  803.     KX=XCORD(I)
  804.     KY=YCORD(I)
  805.  
  806. C    Make sure it clears the ship
  807.     IF((KX.NE.INT(X1)).OR.(KY.NE.INT(Y1)))GOTO 10009
  808.     CALL MOVE(X1,Y1,X,Y,DPOD(I),10.0,CHAR,UNIV)
  809.     GOTO 10010
  810. 10009    X=X1
  811.     Y=Y1
  812.  
  813. 10010    IX=INT(X)
  814.     IY=INT(Y)
  815.     IF(CHAR.NE.'.')GOTO 10012
  816.  
  817. C    1 Successul launch
  818.     UNIV(IX,IY)=POD
  819.     XPOD(I)=X
  820.     YPOD(I)=Y
  821.     IPOD(I)=2
  822.     CALL SENT(I,28)
  823.     GOTO 10001
  824.  
  825. C    Blocked launch (good shot)
  826. 10012    CALL SENT(I,23)
  827.     IPOD(I)=0
  828.     GOTO 10001
  829.  
  830. C    2 Pod is on the move
  831. 10007    IF(IPOD(I).NE.2)GOTO 10015
  832.     IX=INT(XPOD(I))
  833.     IY=INT(YPOD(I))
  834.     IF(UNIV(IX,IY).EQ.POD)GOTO 10017
  835.  
  836. C    Pod was destroyed
  837. 10016    CALL SENT(I,24)
  838.     IPOD(I)=4
  839.     GOTO 10001
  840.  
  841. 10017    CALL MOVE(XPOD(I),YPOD(I),X,Y,DPOD(I),5.0,CHAR,UNIV)
  842.     IF((CHAR.NE.'.').AND.(CHAR.NE.'+'))GOTO 10020
  843.     UNIV(IX,IY)='.'
  844.     UNIV(INT(X),INT(Y))=POD
  845.     XPOD(I)=X
  846.     YPOD(I)=Y
  847.     GOTO 10001
  848.  
  849. C    Ran into some object
  850. 10020    IF(RAN(I1,I2).LE.0.5)GOTO 10023
  851.     DPOD(I)=DPOD(I)+90.0
  852.     GOTO 10001
  853. 10023    DPOD(I)=DPOD(I)-90.0
  854.     GOTO 10001
  855.  
  856. C    3 Detonate pod
  857. 10015    IF(IPOD(I).NE.3)GOTO 10001
  858.     IPOD(I)=4
  859.     IX=INT(XPOD(I))
  860.     IY=INT(YPOD(I))
  861.     IF(UNIV(IX,IY).NE.POD)GOTO 10016 ! Pod was destroyed
  862.     CALL SENT(I,29)
  863.     DO 10046 L1=1,21        ! Provide wrap around blast
  864.     KX=IX+IPX(L1)
  865.     IF(KX.GE.101)KX=KX-100
  866.     IF(KX.LT.1)KX=KX+100
  867.     KY=IY+IPY(L1)
  868.     IF(KY.GE.101)KY=KY-100
  869.     IF(KY.LT.1)KY=KY+100
  870.     CHAR=UNIV(KX,KY)
  871.     IF(CHAR.EQ.'.')GOTO 10046
  872.  
  873. C    Don't vaporize hyper ports or star bases
  874. 10047    IF((CHAR.EQ.'H').OR.(CHAR.EQ.'B'))GOTO 10046
  875.  
  876. C    Wiped out another ship
  877. 10045    IF((CHAR.LT.'1').OR.(CHAR.GT.'8'))GOTO 10058
  878.     IZ=CHAR-"60
  879.     IF(.NOT.ALIVE(IZ))GOTO 10050
  880.     CALL SENT(IZ,30)
  881.     CALL RESET(IZ)
  882.     IF(IZ.EQ.I)GOTO 10046        ! No points for blasting self
  883.     SCORE(I)=SCORE(I)+2000
  884.     CALL SENT(I,22)
  885.     GOTO 10046
  886.  
  887. C    Hit was on a ghost ship
  888. 10050    CALL SENT(I,21)
  889.     IF((INT(XCORD(IZ)).EQ.KX).AND.(INT(YCORD(IZ)).EQ.KY))GOTO 10046
  890.     GOTO 10060            ! Ghost ship should't be here
  891.  
  892. C    Zap the black hole
  893. 10058    IF(CHAR.NE.'#')GOTO 10060
  894.     CALL SENT(I,31)
  895.     SCORE(I)=SCORE(I)+1000
  896.     HOLE=.TRUE.
  897.  
  898. C    Erase any other junk
  899. 10060    UNIV(KX,KY)='.'
  900. 10046    CONTINUE
  901. 10001    CONTINUE
  902.  
  903. C    Find a new home for the black hole
  904.     IF(HOLE)CALL NEWLOC(ZX,ZY,'#')
  905.     RETURN
  906.     END
  907.