C C C *********************************** C * * C * SUBROUTINE TO END GAME * C * * C *********************************** C SUBROUTINE FINISH(DLN,TM,RATING,TSTAT,TAMES,TLOG) 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,IDLN,BEARNG,NCAS(2),CMD,IG2,NPRIS &,IBELL COMMON/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN COMMON/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/ALPHA/ALPH(30) COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) 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 DIMENSION BACKUP(3) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,CMD REAL*8 KL,RM,GRN,RED,DCKD,COND,DISAB,DEST,SCOND(2),PSWRD,FILEID LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TLOOS LOGICAL TSTAT,TBALEN,TALSD,TINTRD,TBOSS,TAMES,TLOG LOGICAL*1 EE,EE1,ENDB,ENDS,ANS,ALPH,IMAGE(72),SHIP,PRANK(13),NAME1 DATA ENDB,ENDS/1H ,1HS/ C IF(TSTAT)GOTO 40 TSTAT=.FALSE. TNEW=.FALSE. IF(TDISAB .OR. TDEST)GOTO 36 IF(TLOST .OR. TOVER)GOTO 40 C IRANK=AMOD(RANK*100.,100.)+0.0001 CALL SETRNK(IRNK,PRANK,1) IF(TWON)GOTO 21000 IF(TTMOUT)GOTO 37 GOTO 60 21000 WRITE(3,21001) 21001 FORMAT(//1X,72(1H*)) 22000 WRITE(3,22001) 22001 FORMAT(/1X,'Communication Received from Star Fleet Command:'/) 10 TYPE 11,PRANK,NAME1 11 FORMAT(/1X,'CONGRATULATIONS ',13A1,1X,16A1,'!' /1X, &'MISSION ACCOMPLISHED.') WRITE(3,11)PRANK,NAME1 46 IF(TOVER)GOTO 40 TM=DATE-SDATE UTM=TM IF(TDEST .OR. TDISAB)UTM=DLN-TM DROM=NROMD DBAS=NBASD BRES=NRESC FRES=NFRES CAPAL=NCAPAL PRTKN=NPRTKN RATING=50.*(EXP(-UTM/DLN)+FLOAT(N5-N4)/FLOAT(N5))*1.02**DROM* &1.1**BRES*0.7**DBAS*0.85**FRES*1.03**CAPAL*1.0005**PRTKN IF(TDEST .OR. TDISAB)RATING=RATING*0.5 IF(N4.EQ.N5 .AND. TM.LE.1.)RATING=0.0 EE=ENDS EE1=ENDS IF(N5-N4.EQ.1)EE=ENDB IF(TM.EQ.1.)EE=ENDB 20 TYPE 21,N5-N4,EE,TM,EE1 21 FORMAT(1X'YOU HAVE DESTROYED OR CAPTURED',I4,' ALIEN',A1,' IN',F8. &3,' STARDATE',A1) 2000 WRITE(3,21)N5-N4,EE,TM,EE1 N2=0 IF(NROMD.EQ.0)GOTO 300 EE=ENDB IF(NROMD.GT.1)EE=ENDS 110 TYPE 111,NROMD,EE 111 FORMAT(1X,'INCLUDING',I3,' ROMULAN',A1,'.') WRITE(3,111)NROMD,EE 300 TYPE 301,NRESC,NFRES,NCAPAL,NPRTKN 301 FORMAT(1X, &'The following statistics have been noted by Star Fleet Command:'/ &3X,'NUMBER OF STARBASES RESCUED',T52,':',I6/ &3X,'NUMBER OF FAILURES TO RESCUE STARBASES',T52,':',I6/ &3X,'NUMBER OF ENEMY VESSELS DELIVERED TO STARBASES',T52,':',I6/ &3X,'NUMBER OF ENEMY PRISONERS DELIVERED',T52,':',I6) WRITE(3,301)NRESC,NFRES,NCAPAL,NPRTKN 2 IF(NBASD.EQ.0)GOTO 30 EE=ENDB IF(NBASD.GT.1)EE=ENDS 120 TYPE 121,NBASD,EE 121 FORMAT(1X,'UNFORTUNATELY YOU HAVE DESTROYED',I3,' STARBASE',A1/1X, &'A COURT OF INQUIRY WILL INVESTIGATE YOUR ACTIONS ',$) 12000 WRITE(3,121)NBASD,EE IF(TDEST .OR. TDISAB)GOTO 150 140 TYPE 141 141 FORMAT(1H+,'WHEN YOU RETURN.') 14000 WRITE(3,141) GOTO 160 150 TYPE 151 151 FORMAT(1H+,1X) 15000 WRITE(3,151) 160 TYPE 161 161 FORMAT(1X,'ALSO, YOUR RATING HAS BEEN REDUCED TO REFLECT YOUR STUP &IDITY.') 16000 WRITE(3,161) 30 TYPE 31,RATING,RANK 31 FORMAT(/1X,'YOUR EFFICIENCY RATING WAS',F7.2,' % AT RANK',F5.0) 3000 WRITE(3,31)RATING,RANK 23000 WRITE(3,21001) IF(RATING.LE.100.)GOTO 240 IF(TBOSS)GOTO 260 250 TYPE 251 251 FORMAT(/1X,24('*'),' DON''T GET COCKY, KID! ',24('*')/1X'YOUR UN &BELIEVABLY HIGH RATING IS OBVIOUSLY DUE TO A BUG IN THE PROGRAM!') 25000 WRITE(3,251) CALL PAUSE(4) GOTO 240 260 TYPE 261 261 FORMAT(/1X,'ANOTHER BRILLIANT DISPLAY OF STRATEGY AND CUNNING SIR! &'/1X,'IT''S ALWAYS A PLEASURE TO HAVE YOU ABOARD GRAND ADMIRAL.') 26000 WRITE(3,261) CALL PAUSE(2) 240 TYPE 241,AFILE(3) 241 FORMAT(/1X,'YOUR LOG FILES ("AUTOLOG or CAPTLOG") HAVE THE SEQUENC &E NUMBER OF ',A4/1X'PLEASE DELETE YOUR LOG FILE(S) WHEN FINISHED W &ITH THEM') TSTAT=.TRUE. RETURN 40 TYPE 41 41 FORMAT(/1X,'DO YOU WANT A NEW MISSION? ',$) 50 READ(5,51,ERR=40)ANS 51 FORMAT(A1) CALL CAPMSK(ANS,1) ISTP=0 IF(ANS.EQ.'N')ISTP=1 IF(ANS.NE.'Y')GOTO 1 TNEW=.TRUE. TSTAT=.FALSE. CALL CLOSE(4) GOTO 6 1 IF(ANS.NE.'N')GOTO 40 IF(TLOST)ISTP=2 IF(TLOST)GOTO 6 60 TYPE 61 61 FORMAT(1X'CONTINUE OR STOP? ',$) 70 READ(5,71,ERR=60)ANS 71 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.NE.'S')GOTO 14 ISTP=2 IF(TWON .OR. TLOST)GOTO 14 IF(TDEST .OR. TDISAB)GOTO 14 IF(CMD.NE.13)GOTO 14 STOP 14 IF(ISTP.NE.1)GOTO 6 IF(ANS.NE.'C')GOTO 60 IF(CMD.EQ.13)RETURN TWON=.FALSE. TNEW=.FALSE. TSTAT=.FALSE. TOVER=.TRUE. IDLN=10000 6 IF(TAMES)GOTO 9 IF(NPL.GT.2)CALL RUNMCR('BACKUP',6,'D') 9 FILEID='AUTOLOG' GOTO 180 8 FILEID='CAPTLOG' 180 TYPE 181,FILEID 181 FORMAT(/1X,'Do you want your ',A7,' file deleted? ',$) READ(5,51,ERR=180)ANS CALL CAPMSK(ANS,1) IF(ANS.EQ.'N')GOTO 12 IF(ANS.NE.'Y')GOTO 180 CALL RUNMCR(FILEID,7,'D') 12 IF(FILEID.EQ.'CAPTLOG')GOTO 7 IF(TLOG)GOTO 8 7 IF(ISTP.EQ.2)STOP IF(ISTP.EQ.1)TAMES=.TRUE. RETURN 36 TLOST=.TRUE. IF(SHLD(5).GE.0)GOTO 38 270 TYPE 271 271 FORMAT(/1X,'***** ALL SHIELDS HAVE BEEN PENETRATED AND DESTROYED * &****') 27000 WRITE(3,271) 38 SCOND(1)=DISAB(1) SCOND(2)=DISAB(2) IF(TDISAB)GOTO 290 SCOND(1)=DEST(1) SCOND(2)=DEST(2) 290 TYPE 291 291 FORMAT(/1X,'YOU SCREWED UP.') WRITE(3,291) CALL PAUSE(3) 80 TYPE 81,SHIP,SCOND 81 FORMAT(//1X,'********** ',16A1,1X,A8,A1,'! **********'/) 8000 WRITE(3,81)SHIP,SCOND IF(.NOT.TDISAB)GOTO 5 TYPE 281,SHIP 281 FORMAT(/1X,'THE ',16A1,' IS A LIFELESS HULK DRIFTING IN SPACE') WRITE(3,281)SHIP GOTO 46 5 IF(.NOT.TSLFDS)GOTO 46 IF(COND.NE.RED)GOTO 170 IF(STATUS(5).GE.0.)GOTO 3 IF(POW.LE.0 .AND. GASP.LT.0.25)GOTO 4 IF(SHLD(5).GE.H1)GOTO 170 IF(POW.LE.50)GOTO 4 IF(STATUS(3).GE.0.)GOTO 170 IF(POW.GE.125)GOTO 170 GOTO 4 3 IF(POW+SHLD(5).GE.H1)GOTO 170 IF(POW.LE.50)GOTO 4 IF(STATUS(3).GE.0.)GOTO 170 IF(POW.GE.125)GOTO 170 4 IF(NBASD.NE.0)GOTO 46 130 TYPE 131,PRANK,NAME1 131 FORMAT(1X'YOUR GALLANT SACRIFICES IN DEFENSE OF THE FEDERATION'/1X &'HAVE MADE YOU AND YOUR CREW HEROES THROUGHOUT THE'/1X'UNITED FEDE &RATION OF PLANETS, AND YOU, ',13A1,1X,16A1,' HAVE BEEN AWARDED'/ &1X,'THE FEDERATION DEFENSE CROSS WITH GOLD STAR.') 13000 WRITE(3,131)PRANK,NAME1 OPEN(UNIT=1,NAME='[200,200]STARFLEET.PRO',TYPE='OLD', &ACCESS='APPEND',FORM='UNFORMATTED',SHARED,ERR=46) WRITE(1,ERR=13)NPL,AFILE(4),-IRNK,-8,0. 13 CALL CLOSE(1) GOTO 46 170 TYPE 171 171 FORMAT(1X'YOUR SELF-DESTRUCTION HAS BEEN DETERMINED TO HAVE BEEN U &NNECESSARY.'/) 17000 WRITE(3,171) GOTO 46 37 TLOST=.TRUE. 90 TYPE 91,PRANK 91 FORMAT(//1X,'********** YOU HAVE FAILED, ',13A1,'! **********'/) 9000 WRITE(3,91)PRANK EE=ENDB IF(N4.GT.1)EE=ENDS 100 TYPE 101,N4,EE 101 FORMAT(1X,'TIME HAS EXPIRED WITH ',I3,' ALIEN VESSEL',A1,' LEFT TO & DESTROY.'/1X'THE ABILITY OF THE FEDERATION TO STOP THE ENEMY FLEE &T HAS BEEN'/1X'ENDANGERED BY YOUR FAILURE. YOU WILL BE DEMOTED ON &RETURN TO A'/1X,'SPACE TUG COMMANDER!'/) 10000 WRITE(3,101)N4,EE GOTO 46 END C C C ******************************************* C * * C * SUBROUTINE TO RECORD FAILED MISSION * C * * C ******************************************* C SUBROUTINE FAIL(SQNUM) C 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/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) C DIMENSION DAT(3),SDATE(3) C REAL*8 PSWRD LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD LOGICAL TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO, &TBOSS LOGICAL*1 NAME1 C CALL STRDAT(SDATE) OPEN(UNIT=1,NAME='[200,200]FINMIS.DAT',TYPE='OLD', &FORM='UNFORMATTED',READONLY,SHARED,ERR=1) 10 READ(1,END=1,ERR=1)NP,SNUM,DAT,N IF(NP.NE.NPL)GOTO 10 IF(SNUM.NE.SQNUM)GOTO 10 C IF(DAT(1).NE.SDATE(1) .OR. DAT(2).NE.SDATE(2))GOTO 10 GOTO 2 1 CALL CLOSE(1) OPEN(UNIT=1,NAME='[200,200]FINMIS.DAT',TYPE='OLD', &ACCESS='APPEND',FORM='UNFORMATTED',SHARED,ERR=2) IFATE=0 IF(TDEST)IFATE=1 IF(TDISAB)IFATE=2 IF(TTMOUT)IFATE=3 IF(TSLFDS)IFATE=4 WRITE(1)NPL,SQNUM,SDATE,IFATE 2 CALL CLOSE(1) RETURN END C C C ************************************************** C * * C * SUBROUTINE STORE CUMULATIVE GAME STATISTICS * C * * C ************************************************** C SUBROUTINE STATS(TM,RATING) 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/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN COMMON/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) COMMON/TESTS2/TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO, &TBOSS DIMENSION DATEM(3),DAT(3) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H REAL*8 KL,RM,GRN,RED,DCKD,COND,DISAB,DEST,PSWRD LOGICAL TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TBOSS LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD,TEST LOGICAL*1 SHIP,NAME1,ANS,DUMMY(4) C IF(NPL.GT.2)GOTO 1 10 TYPE 11 11 FORMAT(/1X,'DO YOU WANT THIS RECORDED IN THE STATISTICS FILE? ',$) READ(5,21,ERR=10)ANS 21 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.'N')RATING=-(RATING+1.) IF(RATING.LT.0.)RETURN IF(ANS.NE.'Y')GOTO 10 1 CALL STRDAT(DATEM) IF(RANK.LT.FLOAT(IRNK))GOTO 7 OPEN(UNIT=1,NAME='[200,200]FINMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',READONLY,SHARED,ERR=7) TEST=.FALSE. 40 READ(1,END=2,ERR=6)NP,SQNUM,DAT,N IF(NP.NE.NPL)GOTO 40 IF(SQNUM.NE.AFILE(3))GOTO 40 CALL CLOSE(1) IF(TEST)GOTO 3 OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',READONLY,SHARED,ERR=7) TEST=.TRUE. GOTO 40 2 CALL CLOSE(1) IF(.NOT.TEST)GOTO 8 50 TYPE 51 51 FORMAT(/1X,'** MISSION ALREADY ON RECORD - THESE RESULTS NOT & RECORDED **') WRITE(3,51) RATING=-(RATING+1.) RETURN 8 OPEN(UNIT=1,NAME='[200,200]FINMIS.DAT',TYPE='OLD', &ACCESS='APPEND',FORM='UNFORMATTED',SHARED) IFATE=0 IF(TDEST)IFATE=1 IF(TDISAB)IFATE=2 IF(TTMOUT)IFATE=3 IF(TSLFDS)IFATE=4 WRITE(1)NPL,AFILE(3),DATEM,IFATE CALL CLOSE(1) 3 OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD', &FORM='UNFORMATTED',SHARED,ERR=7) OPEN(UNIT=2,TYPE='SCRATCH',FORM='UNFORMATTED') 60 READ(1,END=4)NP,SQNUM,DAT,N IF(NP.EQ.NPL .AND. SQNUM.EQ.AFILE(3))GOTO 60 WRITE(2)NP,SQNUM,DAT,N GOTO 60 4 REWIND 1 REWIND 2 80 READ(2,END=5)NP,SQNUM,DAT,N WRITE(1)NP,SQNUM,DAT,N GOTO 80 5 CALL CLOSE(2) 6 CALL CLOSE(1) 7 CALL RUNMCR('[200,200]STAT.DAT',17,'U') OPEN(UNIT=1,NAME='[200,200]STAT.DAT',TYPE='OLD',ACCESS='APPEND', &FORM='UNFORMATTED',SHARED,ERR=999) IR=RANK IDEST=0 IF(TDEST .OR. TDISAB)IDEST=1 ENCODE(4,71,DUMMY)AFILE(3) 71 FORMAT(A4) DO 9 I=1,4 IF(DUMMY(I).EQ."0)DUMMY(I)=' ' 9 CONTINUE DECODE(4,71,DUMMY)DUM CALL STRDAT(DATEM) 30 WRITE(1,ERR=90)DUM,DATEM,SHIP,IR,TM,N5-N4,IDEST,NROMD, &RATING,NPL GOTO 999 90 TYPE 91,AFILE(3),DATEM,SHIP,IR,TM,N5-N4,IDEST,NROMD,RATING,NPL 91 FORMAT(/1X,'XXXX DEBUG - STATS:'/ &1X,A4,1X,3A4,16A1,I5,F6.1,3I4,F6.1,I4) 999 CALL CLOSE(1) RETURN END