C C C ********************************** C * * C * TRACTOR BEAM SUBROUTINE * C * * C ********************************** C SUBROUTINE TRACBM(TDELIV,TMINBK,TMRTVR,MR,MC) COMMON QUAD(8,8),SECT(10,10),NGAL(8,8),K(7,5),STATUS(13),R1,C1,R,C &,H1,POW,SHLD(5),NTORP,A,B,H(7),N1,N2,N3,N4,N5,N6,II,JJ,RANK,ITR(4) COMMON/MISC1/ICAPV(5),M1,M2,DATE,DLN,BEARNG,NCAS(2),CMD,IG2,NPRIS, &IBELL COMMON/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) COMMON/SYMBL/DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR(10,10) COMMON/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/OBJCTS/D9,S9,E9,K9,B9,R9,M9 COMMON/ALPHA/ALPH(30) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,DLN,CMD INTEGER D9,E9,S9,B9,R9,RBAS,CBAS,STBS REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB,TARGET,ASTAR,STBASE LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TDAMC,TESTM,TESTL,TESTW,TEST1,TLOOS,TBALEN,TALSD,TINTRD, &TDELIV,TESTBT,TESTMT,TMINBK,TESTST,TEST,TMOVE,TMRTVR LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,ALPH,ANS,SHIP DATA STBASE,ASTAR/'STARBASE','THE STAR'/ C RAD(ANG)=ANG*0.017453293 DIST(IA,IB,IR,IC)=SQRT(FLOAT((IA-IR)**2+(IB-IC)**2)) C IF(STATUS(10).GE.0.)GOTO 59 TDAMC=.TRUE. CALL DAMCON(10,10,TDAMC) RETURN 59 IF(.NOT.TINTRD .OR. ITR(4).NE.1)GOTO 62 CALL DAMCON(10,97,.FALSE.) RETURN C ENTRY AUTRET(TDELIV,TMINBK,TMRTVR,MR,MC) C 62 TESTM=.FALSE. TESTL=.FALSE. TEST1=.FALSE. TESTBT=.FALSE. TESTST=.FALSE. TESTMT=.FALSE. TDELIV=.FALSE. TMINBK=.FALSE. IFATE=0 MR=0 MC=0 PI=3.1415927 10 TYPE 11 11 FORMAT(/1X,'TRACTOR BEAM CONTROL') WRITE(3,11) IF(.NOT.TALTOW)GOTO 65 220 TYPE 221 221 FORMAT(1X,'Is Tractor Beam to be switched off? ',$) 230 READ(5,231,ERR=220)ANS 231 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(14))GOTO 90 IF(ANS.NE.ALPH(25))GOTO 220 TBOFF=.TRUE. RETURN 90 TYPE 91 91 FORMAT(1X'Incapable of using tractor beam on more than one object' &) WRITE(3,91) GOTO 60 65 IF(TMRTVR)GOTO 67 20 TYPE 21 21 FORMAT(1X,'Target Sector? ',$) 30 READ(5,31,ERR=20)IR,IC 31 FORMAT(2I3) IF(IR.GE.1 .AND. IR.LE.10 .AND. IC.GE.1 .AND. IC.LE.10)GOTO 1 40 TYPE 41 41 FORMAT(1X,'** ILLEGAL TARGET SECTOR') 4000 WRITE(3,41) GOTO 60 1 GOTO(50,37,40,2,37,2,44),SECT(IR,IC)+1 50 TYPE 51,IR,IC 51 FORMAT(1X,'No object in Sector',I3,',',I3) 5000 WRITE(3,51)IR,IC 60 TYPE 61 61 FORMAT(1X,'*** COMMAND CANCELLED ***') TMRTVR=.FALSE. RETURN 37 IF(SECT(IR,IC).EQ.B9)TESTBT=.TRUE. IF(TESTBT .AND. COND.EQ.DCKD)GOTO 40 IF(TESTBT)TARGET=STBASE IF(SECT(IR,IC).NE.S9)GOTO 53 TESTST=.TRUE. TARGET=ASTAR IRS=IR ICS=IC 53 ANGL=RAD(ANGLE(IR,IC,A,B)) IR=A IC=B GOTO 8 67 DISM=50. DO 69 IR1=1,10 DO 66 IC1=1,10 IF(SECTOR(IR1,IC1).NE.'+')GOTO 66 DISX=DIST(A,B,IR1,IC1) IF(DISX.GE.DISM)GOTO 66 DISM=DISX IR=IR1 IC=IC1 66 CONTINUE 69 CONTINUE IF(DISM.LT.50.)GOTO 420 TYPE 411 411 FORMAT(/1X,'** UNABLE TO LOCK ONTO ANY MINES **') WRITE(3,411) GOTO 60 420 TYPE 421,IR,IC 421 FORMAT(1X,'TRACTOR BEAM TARGETED FOR MINE IN SECTOR',I3,',',I3) WRITE(3,421)IR,IC 44 TESTMT=.TRUE. ANGL=RAD(ANGLE(A,B,IR,IC)) GOTO 8 2 DO 3 NA=1,7 IF(IR.EQ.K(NA,1) .AND. IC.EQ.K(NA,2))GOTO 4 3 CONTINUE GOTO 50 4 KR=K(NA,1) KC=K(NA,2) IF(K(NA,3).LT.100)GOTO 29 70 TYPE 71 71 FORMAT(1X,'Alien vessel is not disabled - tractor beam ineffective &') WRITE(3,71) GOTO 60 72 IF(COND.NE.DCKD)GOTO 110 29 IPREQ=DIST(A,B,IR,IC)*20.+0.0001 IF(TESTBT)IPREQ=DIST(A,B,RBAS,CBAS)*20.+0.0001 IF(TESTST)IPREQ=DIST(A,B,IRS,ICS)*20.+0.0001 IF(TESTMT)IPREQ=DIST(A,B,IR,IC)*5.+0.0001 IF(TESTBT .OR. TESTST .OR. TESTMT)GOTO 14 IF(IPREQ.LT.POW)GOTO 6 80 TYPE 81,IPREQ 81 FORMAT(1X,'Insufficient power available for tractor beam lock-on'/ &1X,'Power required is',I5,' units') WRITE(3,81)IPREQ GOTO 60 6 ANGL=RAD(ANGLE(A,B,KR,KC)) 8 DO 13 I=0,20 XI=I IR1=XI*-SIN(ANGL)+0.5+FLOAT(IR)+0.0001 IC1=XI*COS(ANGL)+0.5+FLOAT(IC)+0.0001 IF(TESTL)GOTO 15 IF(IR1.GT.10 .OR. IR1.LT.1 .OR. IC1.GT.10 .OR. IC1.LT.1)GOTO 100 IF(TESTBT .OR. TESTST)GOTO(13,49,13,110,29,110,12),SECT(IR1,IC1)+1 IF(TESTMT)GOTO(13,110,29,110,72,110,12),SECT(IR1,IC1)+1 GOTO(13,110,14,9,63,9,12),SECT(IR1,IC1)+1 9 IF(IR1.EQ.KR .AND. IC1.EQ.KC)GOTO 13 GOTO 110 12 IF(IR1.NE.IR .OR. IC1.NE.IC)TESTM=.TRUE. GOTO 13 15 IF(IR1.GT.10 .OR. IR1.LT.1 .OR. IC1.GT.10 .OR. IC1.LT.1)GOTO 39 IF(TESTBT)GOTO(42,17,13,17,45,17,46),SECT(IR1,IC1)+1 IF(TESTST)GOTO(42,52,13,17,17,17,46),SECT(IR1,IC1)+1 IF(TESTMT)GOTO(42,17,45,17,73,17,46),SECT(IR1,IC1)+1 GOTO(16,17,22,17,17,17,23),SECT(IR1,IC1)+1 52 IF(IR1.EQ.IRS .AND. IC1.EQ.ICS)GOTO 45 GOTO 17 46 M2=M2-1 SECT(IR1,IC1)=D9 SECTOR(IR1,IC1)=DOT IF(TESTMT)GOTO 360 42 IF((TESTBT .OR. TESTST) .AND. I*20.GE.IPREQ)GOTO 43 IF(TESTMT .AND. I*5.GE.IPREQ)GOTO 43 16 IR2=IR1 IC2=IC1 13 CONTINUE IF(TESTL)IFATE=4 100 TYPE 101 101 FORMAT(1X,$) WRITE(3,101) IF(IFATE.EQ.4)GOTO 190 GOTO 120 49 IF(TESTST .AND. IR1.EQ.IRS .AND. IC1.EQ.ICS)GOTO 29 63 IF(SECT(IR1,IC1).EQ.B9 .AND. COND.EQ.DCKD)GOTO 14 110 TYPE 111 111 FORMAT(1X,'OBJECT IN WAY - ',$) WRITE(3,111) IF(IFATE.EQ.1)GOTO 190 120 TYPE 121 121 FORMAT(1H+,'Tractor beam failed to lock on target') WRITE(3,121) 68 IF(.NOT.TMRTVR)GOTO 60 IF(TESTW)GOTO 60 SECTOR(IR,IC)=';' GOTO 67 130 TYPE 131 131 FORMAT(1X,'PHOTON TORPEDO MINE IN WAY - ',$) WRITE(3,131) 180 TYPE 181 181 FORMAT(1H+,'Is command confirmed? ',$) 140 READ(5,141,ERR=130)ANS 141 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(25))GOTO 18 IF(ANS.EQ.ALPH(14))GOTO 68 IF(TESTM)GOTO 130 IF(TESTW)GOTO 170 GOTO 60 18 IF(TESTM)TESTM=.FALSE. 14 IF(TESTW)GOTO 390 IF(TESTM)GOTO 130 IF(.NOT.TALERT .OR. COND.EQ.RED)GOTO 58 IF(SHLD(5).EQ.0)GOTO 55 210 TYPE 211 211 FORMAT(/1X,'DEFENSIVE SHIELDS LOWERED') WRITE(3,211) POW=POW+SHLD(5) DO 35 I=1,5 SHLD(I)=0 35 CONTINUE 58 NS=0 IF(TESTST)CALL FDSHLD(NS,TEST,IRS,ICS,A,B) IF(TESTBT)CALL FDSHLD(NS,TEST,RBAS,CBAS,A,B) IF(NS.EQ.0)CALL FDSHLD(NS,TEST,IR,IC,A,B) IF(.NOT.TEST)GOTO 54 NS2=NS+1 IF(NS2.EQ.5)NS2=1 IF(SHLD(NS).NE.0 .AND. SHLD(NS2).EQ.0)NS=NS2 NS1=NS2 IF(NS2.EQ.NS)NS1=NS1-1 IF(NS2.GT.NS .OR. (NS2.EQ.1 .AND. NS.EQ.4))NS1=NS 54 IF(SHLD(NS).EQ.0)GOTO 55 170 TYPE 171,NS 171 FORMAT(1X'*** WARNING - SHIELD',I2,' MUST BE LOWERED TO OPERATE TR &ACTOR BEAM ***'/1X,$) WRITE(3,171)NS TESTW=.TRUE. GOTO 180 390 TYPE 391,NS 391 FORMAT(/1X,'DEFENSIVE SHIELD',I2,' LOWERED') WRITE(3,391)NS POW=POW+SHLD(NS) SHLD(5)=SHLD(5)-SHLD(NS) SHLD(NS)=0 IF(TEST)CALL ADJUST(NS,NS1) 55 IF(.NOT.TMRTVR .AND. TESTMT)GOTO 300 IF(TESTMT)GOTO 160 IF(.NOT.TESTBT .AND. .NOT.TESTST)GOTO 160 240 TYPE 241,TARGET,IPREQ 241 FORMAT(1X,'POWER REQUIRED TO DRAW SHIP ENTIRE DISTANCE TO ',A8,' I &S',I4,' UNITS') WRITE(3,241)TARGET,IPREQ GOTO 270 300 TYPE 301,IPREQ 301 FORMAT(1X,'Power required to draw mine entire distance to ship is' &,I4,' units') WRITE(3,301)IPREQ 270 TYPE 271,POW 271 FORMAT(1X,'Power available:',I5,' units') WRITE(3,271)POW 250 TYPE 251 251 FORMAT(1X,'POWER ALLOCATED TO TRACTOR BEAM? ',$) 260 READ(5,261,ERR=250)APOW 261 FORMAT(F10.0) IF(APOW.EQ.0.)GOTO 60 IF(APOW.GT.FLOAT(POW))GOTO 270 IPREQ=APOW 160 TYPE 161 161 FORMAT(1X,'TRACTOR BEAM LOCKED ON TARGET - OPERATION INITIATED'/) WRITE(3,161) CALL PAUSE(2) IF(IPREQ.GT.POW)IPREQ=POW POW=POW-IPREQ TESTL=.TRUE. IF(TESTBT .OR. TESTMT .OR. TESTST)GOTO 38 IF(SECT(KR,KC).EQ.R9)TEST1=.TRUE. 38 SECT(IR,IC)=D9 SECTOR(IR,IC)=DOT GOTO 8 39 IF(.NOT.TESTBT)GOTO 17 IFATE=4 GOTO 43 73 IF(COND.NE.DCKD)GOTO 17 45 IFATE=5 IF(TESTMT)IFATE=6 43 IF(TESTMT)GOTO 47 A=IR2 B=IC2 R=A C=B SECT(A,B)=E9 SECTOR(A,B)=SHP GOTO 48 47 SECT(IR2,IC2)=M9 SECTOR(IR2,IC2)=MINE 48 GOTO(280,110,280,280,100,290,330),IFATE+1 280 TYPE 281 281 FORMAT(1X,'Allocated power consumed - tractor beam switched off') WRITE(3,281) IF(TESTMT)GOTO 320 IF(TESTBT)DISTAN=DIST(A,B,RBAS,CBAS) IF(TESTST)DISTAN=DIST(A,B,IRS,ICS) 310 TYPE 311,A,B,TARGET,DISTAN 311 FORMAT(1X,'New position:',I3,',',I3,8X,'Distance to ',A8,':',F7.1, &' units') WRITE(3,311)A,B,TARGET,DIST(A,B,RBAS,CBAS) GOTO 56 320 TYPE 321,IR2,IC2,DIST(A,B,IR2,IC2) 321 FORMAT(1X,'New position of mine:',I3,',',I3,4X,'Distance from ship &:',F7.1,' units') WRITE(3,321)IR2,IC2,DIST(A,B,IR2,IC2) GOTO 56 290 TYPE 291,TARGET 291 FORMAT(1X,'SHIP HAS DRAWN ALONGSIDE ',A8,' - Tractor beam switched & off') WRITE(3,291)TARGET IF(.NOT.TESTST)GOTO 56 370 TYPE 371 371 FORMAT(/1X,'ANYONE FOR A ROASTED STARSHIP?') WRITE(3,371) GOTO 56 330 TYPE 331,IPREQ 331 FORMAT(1X,'MINE HAS BEEN DRAWN ALONGSIDE SHIP - power used:',I4, +' units') WRITE(3,331)IPREQ C IF(ICHAR.NE."0)GOTO 60 IF(TMRTVR)GOTO 64 400 TYPE 401 401 FORMAT(1X,'DO YOU WISH IT BROUGHT ABOARD? ',$) 340 READ(5,341,ERR=330)ANS 341 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(14))GOTO 350 IF(ANS.NE.ALPH(25))GOTO 330 64 TMINBK=.TRUE. MR=IR2 MC=IC2 GOTO 56 350 TYPE 351,IR2,IC2 351 FORMAT(1X,'Mine set in Sector',I3,',',I3) WRITE(3,351)IR2,IC2 GOTO 56 17 IF(SECT(IR1,IC1).EQ.B9 .AND. COND.EQ.DCKD)GOTO 22 IFATE=1 IF(TESTBT .OR. TESTMT)GOTO 43 GOTO 24 22 IFATE=2 24 IF(NA.GT.6 .OR. TEST1)GOTO 25 SECT(IR2,IC2)=K9 SECTOR(IR2,IC2)=KLIN ICAPV(4)=0 TARGET=KL GOTO 19 25 SECT(IR2,IC2)=R9 SECTOR(IR2,IC2)=ROM ICAPV(4)=1 TARGET=RM 19 ICAPV(1)=IR2 ICAPV(2)=IC2 IF(ICAPV(5).EQ.1)GOTO 32 ICAPV(3)=K(NA,3) ICAPV(5)=0 TEST1=.FALSE. IF(K(NA,4).EQ.2)ICAPV(5)=2 IF(K(NA,4).NE.1)GOTO 34 TEST1=.TRUE. ICAPV(5)=1 34 DO 33 I=1,5 K(NA,I)=0 33 CONTINUE 32 IF(IFATE.EQ.1)GOTO 110 IF(COND.EQ.DCKD)GOTO 36 200 TYPE 201,TARGET,IR2,IC2,IPREQ 201 FORMAT(1X,A8,'VESSEL SECURED IN TOWING POSTION - Sector',I3,',', &I3/1X,'Power used:',I4,' UNITS') WRITE(3,201)TARGET,IR2,IC2,IPREQ TALTOW=.TRUE. CALL FDSHLD(NS1,TEST,IR2,IC2,A,B) IF(TEST)CALL ADJUST(NS,NS1) 36 IF(COND.EQ.DCKD)TDELIV=.TRUE. IF(TEST1 .OR. ICAPV(5).EQ.1)GOTO 56 IF(TARGET.EQ.KL)GOTO 26 TROM1=.FALSE. GOTO 27 26 QUAD(R1,C1)=QUAD(R1,C1)-100 NGAL(R1,C1)=QUAD(R1,C1) N3=N3-1 IF(TROM1)GOTO 56 27 IF(N3.EQ.0 .AND. COND.NE.DCKD)COND=GRN GOTO 56 23 M2=M2-1 SECT(IR1,IC1)=D9 SECTOR(IR1,IC1)=DOT K(NA,1)=IR1 K(NA,2)=IC1 IF(K(NA,4).EQ.2)TALSD=.FALSE. CALL ALMOVE(.FALSE.,.TRUE.,NA) GOTO 56 360 TYPE 361,IR1,IC1 361 FORMAT(1X,'2 mines destroyed in Sector',I3,',',I3,' - ',$) WRITE(3,361)IR1,IC1 M2=M2-1 POW=FLOAT(POW)+FLOAT(IPREQ)*(DIST(A,B,IR1,IC1)/DIST(A,B,IR,IC)) 190 TYPE 191 191 FORMAT(1H+,'TARGET LOCK-ON LOST') WRITE(3,191) GOTO 60 56 IF(COND.EQ.GRN)RETURN IF(TMRTVR .AND. RAN(II,JJ).GT.0.5)RETURN CALL HITS IF(TDEST .OR. TDISAB)RETURN DO 57 I=1,7 CALL ALMOVE(TMOVE,.FALSE.,I) 57 CONTINUE RETURN END