C C C ************************************************************ C * * C * SUBROUTINE TO SEE IF ANY STARBASES ARE UNDER ATTACK * C * * C ************************************************************ C SUBROUTINE BASTAK 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/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH COMMON/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN 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/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/TESTS2/TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO, &TBOSS COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) 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,PSWRD LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TLOOS, &TBALEN,TALSD,TINTRD,TBOSS,TRENEG,TSLAP,TSHOOT,TBAN LOGICAL TEST1,TEST2,TEST3,TEST4 LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP,NAME1, &PRANK(13) C IF(.NOT.TSLAP .AND. TRENEG)GOTO 190 IF(.NOT.TSHOOT)GOTO 1 IF(N6.NE.0)CALL FITEBK(N6,.FALSE.,.FALSE.,.FALSE.) TSHOOT=.FALSE. RETURN 1 N=1 TEST1=.FALSE. TEST2=.FALSE. TEST3=.FALSE. TEST4=.FALSE. IF(TRESC)GOTO 12 RX=RAN(II,JJ) DO 2 I=1,NBAS IF(STBS(I,1).EQ.0)GOTO 2 IF(STBS(I,4).EQ.1)GOTO 3 IF(I.EQ.N6)GOTO 2 IF(QUAD(STBS(I,1),STBS(I,2)).GE.300 .AND. RX.LE.0.1 .AND. RANK.GT. &2.)GOTO 10 2 CONTINUE IF(N6.NE.0)CALL FITEBK(N6,TEST2,TEST3,TEST4) IF(TEST4)GOTO 18 RETURN 10 TYPE 11,I,STBS(I,1),STBS(I,2) 11 FORMAT(/1X,'*** EMERGENCY COMMUNICATION FROM STAR FLEET COMMAND:'/ &5X,'STARBASE',I2,' IN QUADRANT ',I2,',',I2,$) 1000 WRITE(3,11)I,STBS(I,1),STBS(I,2) NGAL(STBS(I,1),STBS(I,2))=QUAD(STBS(I,1),STBS(I,2)) 6 GOTO(40,50,60),N 40 TYPE 41,IBELL 41 FORMAT(1H+,A1,' IS UNDER ATTACK'/5X,'BY KLINGON BATTLE FLEET. ABOR &T CURRENT ACTION'/5X,'AND GO TO AID OF STARBASE. UNCERTAIN OF HOW &'/5X,'LONG STARBASE CAN HOLD OUT.'/) 4000 WRITE(3,41)"0 STBS(I,4)=1 NKDESB=0 DO 13 J=1,5 KLATK(J)=500 13 CONTINUE 22 RETURN 3 IF(I.EQ.N6)GOTO 8 NN=QUAD(STBS(I,1),STBS(I,2))/100 IF(NN.GE.1)GOTO 9 14 STBS(I,4)=0 TEST1=.TRUE. GOTO 70 9 GOTO(19,22,22,19,19,19,22,23,19,19,19,22,22,22,22),CMD 23 GOTO(19,22,19,19,22,22,19,22,22,19),ITASK 19 DO 5 J=1,NN 4 IHIT=RAN(II,JJ)*300. IF(IHIT.LT.50)GOTO 4 STBS(I,3)=STBS(I,3)-IHIT IF(STBS(I,3).GE.0)GOTO 7 N=2 GOTO 10 7 IF(STBS(I,3)/100.GE.25 .OR. TBASLO)GOTO 5 N=3 TBASLO=.TRUE. 5 CONTINUE IF(N.EQ.3)GOTO 10 TEST2=.TRUE. IF(.NOT.TBASLO)CALL FITEBK(I,TEST2,TEST3,TEST4) IF(.NOT.TEST3)RETURN NN=NN-1 IF(NN.LT.3)GOTO 14 GOTO 70 50 TYPE 51,DEST 51 FORMAT(1H+,' HAS BEEN ',A8,A1,'.'/5X'RESUME YOUR NORMAL MISSION.') 5000 WRITE(3,51)DEST TBASLO=.FALSE. TWARN=.FALSE. THELLO=.FALSE. IR=STBS(I,1) IC=STBS(I,2) QUAD(IR,IC)=QUAD(IR,IC)-10 NGAL(IR,IC)=QUAD(IR,IC) STBS(I,1)=0 NBASRM=NBASRM-1 NFRES=NFRES+1 IF(IR.NE.R1 .OR. IC.NE.C1)RETURN N6=0 SECT(RBAS,CBAS)=D9 SECTOR(RBAS,CBAS)=DOT RETURN 8 IF(TWARN .AND. THELLO)GOTO 15 18 STSHBS=FLOAT(STBS(I,3))/100. IF(.NOT.TEST4 .AND. THELLO .AND. STSHBS.GE.25)GOTO 15 20 TYPE 21,N6 21 FORMAT(/1X,'** COMMUNICATION FROM STARBASE',I2,':') WRITE(3,21)N6 IF(TEST4 .OR. THELLO)GOTO 80 30 TYPE 31,SHIP,STSHBS 31 FORMAT(5X,'Welcome to our quadrant, ',16A1,'.'/5X,'Sorry about the & reception. Hope you can help us out.'/5X,'Our shield strength is ¤tly',F6.1,'%. We have been'/5X,'able to destroy ',$) WRITE(3,31)SHIP,STSHBS IF(NKDESB.NE.0)GOTO 140 130 TYPE 131 131 FORMAT(1H+,'none',$) WRITE(3,131) GOTO 150 140 TYPE 141,NKDESB 141 FORMAT(1H+,I4,$) WRITE(3,141)NKDESB 150 TYPE 151 151 FORMAT(1H+,' of the attacking Klingon vessels.'/) WRITE(3,151) THELLO=.TRUE. RETURN 15 CALL FITEBK(N6,TEST2,TEST3,TEST4) IF(TRESC)GOTO 12 RETURN 80 TYPE 81,IBELL,STSHBS,SHIP 81 FORMAT(5X,A1,'Shield strength down to',F6.1,'% - SITUATION **CRITI &CAL**.'/5X,'Cannot hold out much longer. We have to conserve all'/ &5X,'power for shields, thus no longer able to engage enemy.'/5X,'I &t''s up to you ',16A1,'.') WRITE(3,81)"0,STSHBS,SHIP TWARN=.TRUE. RETURN 60 TYPE 61,IBELL 61 FORMAT(1H+,A1,' IS AT LESS THAN 25% SHIELD STRENGTH.'/5X,'SITUATIO &N CRITICAL. IMPERATIVE THAT YOU ENGAGE ENEMY FLEET AT ONCE.'/) WRITE(3,61)"0 TWARN=.TRUE. RETURN 12 NRESC=NRESC+1 TRESC=.FALSE. 70 TYPE 71 71 FORMAT(/1X,'** COMMUNICATION FROM STAR FLEET COMMAND:') WRITE(3,71) IF(TEST3)GOTO 160 TWARN=.FALSE. THELLO=.FALSE. IF(TEST1)GOTO 100 90 TYPE 91,N6 91 FORMAT(5X,'Congratulations on successful rescue of Starbase',I2,'! &'/5X,'This will reflect well in your service record.') WRITE(3,91)N6 GOTO 110 100 TYPE 101,STBS(I,1),STBS(I,2) 101 FORMAT(5X,'Enemy has ceased attack on Starbase in Quadrant',I2,',' &,I2,'.') WRITE(3,101)STBS(I,1),STBS(I,2) 110 TYPE 111 111 FORMAT(5X,'You may now resume your normal mission.') WRITE(3,111) IF(TEST1)RETURN C CALL SETRNK(IRNK,PRANK,1) 120 TYPE 121,SHIP 121 FORMAT(5X,'KEEP UP THE GOOD WORK, ',16A1,'!'/) WRITE(3,121)SHIP RETURN 160 TYPE 161,I,STBS(I,1),STBS(I,2) 161 FORMAT(5X,'Starbase',I2,' in Quadrant',I2,',',I2,' has just destro &yed'/5X,'one of the attacking Klingon vessels.',$) WRITE(3,161)I,STBS(I,1),STBS(I,2) IF(.NOT.TEST1)GOTO 180 170 TYPE 171,I 171 FORMAT(1H+,' The enemy'/5X,'has ceased the attack on Starbase',I2, &'.') WRITE(3,171)I GOTO 110 180 TYPE 181 181 FORMAT(1X/) WRITE(3,181) RETURN 190 TYPE 191,SHIP 191 FORMAT(/1X'*** COMMUNICATION FROM STAR FLEET COMMAND:'/5X,'YOUR AC &T OF TREACHERY HAS FORCED US TO LABEL'/5X,'YOU AS A POSSIBLE RENEG &ADE STARSHIP, ',16A1,'.'/5X,'ALL STARBASES HAVE BEEN WARNED AND OR &DERED TO'/5X,'DEFEND THEMSELVES AGAINST YOU IF NECESSARY.') WRITE(3,191)SHIP TSLAP=.TRUE. RETURN END C C C ********************************************* C * * C * SUBROUTINE FOR STARBASE TO FIGHT BACK * C * * C ********************************************* C SUBROUTINE FITEBK(NB,TEST2,TEST3,TEST4) 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/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH 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/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN 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,ACOND(2),DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD,TEST2,TEST3,TEST4 LOGICAL TRENEG,TSLAP,TSHOOT,TDEAD,TBAN LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP C IF(TSHOOT)GOTO 8 TEST3=.FALSE. IF(.NOT.TEST2)GOTO 3 1 IHIT=RAN(II,JJ)*300. IF(IHIT.LT.50)GOTO 1 2 NA=INT(RAN(II,JJ)*5.)+1 IF(NA.GT.5 .OR. KLATK(NA).EQ.0)GOTO 2 KLATK(NA)=KLATK(NA)-IHIT STBS(NB,3)=STBS(NB,3)-50 IF(KLATK(NA).GT.0)RETURN KLATK(NA)=0 NKDESB=NKDESB+1 TEST3=.TRUE. GOTO 4 3 IF(STBS(NB,3)/100.LT.25)RETURN GOTO(6,7,7,7,6,6,7,7,6,7,7,7,7,7,7),CMD 6 CLOSE=0.0 NA=0 DO 5 J=1,5 IF(K(J,1).EQ.0 .OR. K(J,3).LT.100 .OR. K(J,4).EQ.1)GOTO 5 DIST=SQRT(FLOAT((RBAS-K(J,1))**2+(CBAS-K(J,2))**2)) IF(NA.NE.0 .AND. DIST.GT.CLOSE)GOTO 5 CLOSE=DIST NA=J 5 CONTINUE IF(CLOSE.EQ.0.0)RETURN IHIT=100./(0.1*CLOSE) K(NA,3)=K(NA,3)-IHIT 10 TYPE 11,IHIT,K(NA,1),K(NA,2),NB 11 FORMAT(1X,I4,' UNIT HIT ON KLINGON IN SECTOR',I3,',',I3,' BY STAR &BASE',I2) WRITE(3,11)IHIT,K(NA,1),K(NA,2),NB STBS(NB,3)=STBS(NB,3)-50 IF(STBS(NB,3)/100.LT.25)TEST4=.TRUE. IF(K(NA,3).GE.100)RETURN ACOND(1)=DEST(1) ACOND(2)=DEST(2) IF(K(NA,3).GT.0)ACOND(1)=DISAB(1) IF(K(NA,3).GT.0)ACOND(2)=DISAB(2) 20 TYPE 21,ACOND 21 FORMAT(/1X,'**** KLINGON VESSEL ',A8,A1,' ****') 2000 WRITE(3,21)ACOND IF(ACOND(1).EQ.DISAB(1))RETURN SECT(K(NA,1),K(NA,2))=D9 SECTOR(K(NA,1),K(NA,2))=DOT K(NA,1)=0 IF(K(NA,4).EQ.2)TALSD=.FALSE. N3=N3-1 IF(.NOT.TROM1 .AND. COND.EQ.RED .AND. N3.EQ.0)COND=GRN IF(TROM1 .OR. N3.GT.0)GOTO 4 IF(STBS(NB,4).EQ.0)GOTO 4 STBS(NB,4)=0 TEST4=.FALSE. TRESC=.TRUE. 4 IR=STBS(NB,1) IC=STBS(NB,2) QUAD(IR,IC)=QUAD(IR,IC)-100 NGAL(IR,IC)=QUAD(IR,IC) N5=N5-1 N4=N4-1 7 RETURN 8 N=RAN(II,JJ)*10.+1. IF(N.GT.3)GOTO 8 TYPE 31,N6 31 FORMAT(/1X,'*** COMMUNICATION FROM STARBASE',I2,':') WRITE(3,31)N6 GOTO(40,50,60),N 40 TYPE 41,SHIP 41 FORMAT(5X,'Sorry, ',16A1,' but you leave us'/5X,'no choice but to &retaliate.') WRITE(3,41)SHIP GOTO 9 50 TYPE 51 51 FORMAT(5X,'YOU TREACHEROUS SWINE! SEE HOW YOU LIKE'/5X,'SOME OF YO &UR OWN MEDICINE BACK.') WRITE(3,51) GOTO 9 60 TYPE 61,SHIP 61 FORMAT(5X,'We were ready for your treachery, ',16A1,'.'/5X,'As ord &ered by Star Fleet Command, we will'/5X,'defend ourselves against &you.') WRITE(3,61)SHIP 9 DIST=SQRT(FLOAT((RBAS-A)**2+(CBAS-B)**2)) IHIT=100./(0.1*DIST) CALL PAUSE(3) TYPE 71,IHIT,SHIP,N6 71 FORMAT(/1X,I4,' UNIT HIT ON ',16A1,' BY STARBASE',I2) WRITE(3,71)IHIT,SHIP,N6 TBAN=.TRUE. TDEAD=.FALSE. CALL ALHITS(.FALSE.,0,RBAS,CBAS,TDEAD) RETURN END