C C C ******************************************** C * * C * SUBROUTINE TO SAVE GAME IN PROGRESS * C * * C ******************************************** C SUBROUTINE SAVE(TDAMC,TLOG,DLN,TAMES) 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/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/ALPHA/ALPH(30) COMMON/SHIPS/SHIPSN(16,30),DECKS(24) 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 COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN DIMENSION BACKUP(3) INTEGER SECT,QUAD,R1,C1,R,C,H1,POW,SHLD,A,B,H,RBAS,CBAS,STBS INTEGER D9,S9,E9,B9,R9,CMD 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, &TDAMC,TBALEN,TALSD,TINTRD,TBOSS,TLOG,TRENEG,TSLAP,TSHOOT,TBAN LOGICAL TAMES LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,ALPH,SHIP,SHIPSN, &ANS,YES,NO,IFILE(40),NAME1,TEMP(16,27) EQUIVALENCE (TEMP(1,1),SHIPSN(1,1)) DATA YES,NO/'Y','N'/ C IF(.NOT.TAMES .AND. CMD.NE.14)GOTO 80 10 TYPE 11 11 FORMAT(1X,'DO YOU WANT TO SAVE THE GAME? ',$) 20 READ(5,21,ERR=10)ANS 21 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.YES)GOTO 50 IF(ANS.NE.NO)GOTO 10 60 TYPE 61 61 FORMAT(1X,'*** COMMAND CANCELLED ***') RETURN 50 TYPE 51 51 FORMAT(/1X,'ENTER FILENAME:'/1X,'FILE>',$) DO 888 I=1,40 IFILE(I)="0 888 CONTINUE 70 READ(5,71,ERR=50,END=60)NC,IFILE 71 FORMAT(Q,40A1) CALL FDBSET(1,'UNKNOWN') CALL ASSIGN(1,IFILE,NC) GOTO 2 80 ENCODE(12,81,BACKUP)AFILE(3) 81 FORMAT('BACKUP.',A3,';1') OPEN(UNIT=1,NAME=BACKUP,TYPE='UNKNOWN',FORM='UNFORMATTED') 2 REWIND 1 30 WRITE(1)QUAD,SECT,NGAL,K,STATUS,R1,C1,R,C,H1,POW,SHLD,NTORP,A,B,H, &N1,N2,N3,N4,N5,N6,II,JJ,RANK,SHIP,ICAPV,M1,M2,DATE,IDLN,BEARNG, &NCAS,NBAS,RBAS,CBAS,STBS,NBASRM,NKDESB,KLATK,NBASD,NRESC,NFRES, &NROMD,NCAPAL,NPRTKN,DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,COND, &KL,RM,GRN,RED,DCKD,DEST,DISAB,D9,S9,E9,K9,B9,R9,M9,ALPH,TEMP, &DECKS,TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TBOSS, &NPROB,L5,L8,GASP,SDATE,TLOOS,TBALEN,TALSD,CMD,ITASK,IG2,NPRIS,DLN, &TDAMC,TLOG,AFILE,CFILE,ITR,TINTRD,IBELL,DTLSTH,TRENEG,TSLAP,TSHOOT &,TBAN,NPL CALL CLOSE(1) IF(CMD.NE.14)RETURN DO 1 I=1,40 IF(IFILE(I).EQ.'.')GOTO 3 1 CONTINUE ENCODE(4,91,IFILE(NC+1)) 91 FORMAT('.DAT') 3 CALL CROP(IFILE,40) 40 TYPE 41,IFILE 41 FORMAT(1X,'GAME HAS BEEN SAVED UNDER "',40A1,'"'/) 4000 WRITE(3,41)IFILE STOP END C C C ******************************************** C * * C * SUBROUTINE TO RESTORE PREVIOUS GAME * C * * C ******************************************** C SUBROUTINE RESUME(TDAMC,TLOG,DLN) 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/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/ALPHA/ALPH(30) COMMON/SHIPS/SHIPSN(16,30),DECKS(24) 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 COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN DIMENSION IFILE(20),DAT(3),IU(4) INTEGER SECT,QUAD,R1,C1,R,C,H1,POW,SHLD,A,B,H,RBAS,CBAS,STBS INTEGER D9,S9,E9,B9,R9,CMD REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB,PSWRD,WORDS8(2) LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TLOOS, &TDAMC,TBALEN,TALSD,TINTRD,TBOSS,TLOG,TRENEG,TSLAP,TSHOOT,TBAN LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,ALPH ,SHIP,SHIPSN LOGICAL*1 IMAGE(72),NAME1,TEMP(16,27),PRANK(13) EQUIVALENCE (TEMP(1,1),SHIPSN(1,1)) C 30 TYPE 31 31 FORMAT(/1X,'ENTER FILE NAME OF STORED GAME:'/1X,'FILE>',$) 50 READ(5,51,ERR=30,END=9999)NC,IFILE 51 FORMAT(Q,20A2) CALL FDBSET(1,'OLD') CALL ASSIGN(1,IFILE,NC) REWIND 1 10 READ(1,ERR=60) QUAD,SECT,NGAL,K,STATUS,R1,C1,R,C,H1,POW,SHLD, &NTORP,A,B,H,N1,N2,N3,N4,N5,N6,II,JJ,RANK,SHIP,ICAPV,M1,M2,DATE, &IDLN,BEARNG,NCAS,NBAS,RBAS,CBAS,STBS,NBASRM,NKDESB,KLATK,NBASD, &NRESC,NFRES,NROMD,NCAPAL,NPRTKN,DOT,STAR,SHP,KLIN,BASE,ROM,MINE, &SECTOR,COND,KL,RM,GRN,RED,DCKD,DEST,DISAB,D9,S9,E9,K9,B9,R9,M9, &ALPH,TEMP,DECKS,TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC, &TALTOW,TBOFF,TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN, &THELLO,TBOSS,NPROB,L5,L8,GASP,SDATE,TLOOS,TBALEN,TALSD,CMD,ITASK, &IG2,NPRIS,DLN,TDAMC,TLOG,AFILE,CFILE,ITR,TINTRD,IBELL,DTLSTH, &TRENEG,TSLAP,TSHOOT,TBAN,NP REWIND 1 IF(NP.EQ.NPL)GOTO 20 TYPE 81,NAME1 81 FORMAT(/1X,'SORRY, ',16A1,', BUT THIS IS NOT YOUR MISSION.') CALL CLOSE(1) STOP 20 CLOSE(UNIT=1,DISP='DELETE') IF(NPL.LE.2)GOTO 1 IF(RANK.LT.FLOAT(IRNK))GOTO 1 CALL RUNMCR('[200,200]FINMIS.DAT',19,'U') OPEN(UNIT=1,NAME='[200,200]FINMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',READONLY,SHARED,ERR=2) 190 READ(1,END=2)NP,SNUM,DAT,N IF(NP.NE.NPL .OR. SNUM.NE.AFILE(3))GOTO 190 CALL CLOSE(1) CALL RUNMCR('[200,200]OUTMIS.DAT',19,'U') OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',READONLY,SHARED,ERR=2) 100 READ(1,END=2)NP,SNUM,DAT,N IF(NP.NE.NPL .OR. SNUM.NE.AFILE(3))GOTO 100 CALL CLOSE(1) NG=ISIGN(NG+1,NG) XNG=IABS(NG) IF(NG.GT.5)XNG=5. AVRTNG=(AVGTOT*(XNG-1.)+0.0)/XNG CALL RUNMCR('[200,200]STARFLEET.NAM',22,'U') OPEN(UNIT=1,NAME='[200,200]STARFLEET.NAM',TYPE='UNKNOWN',FORM= &'UNFORMATTED',ERR=2) OPEN(UNIT=2,TYPE='SCRATCH',FORM='UNFORMATTED') N=0 120 READ(1,END=3,ERR=5)WORDS8,ISN,IR,ING,AVR,IU N=N+1 IF(N.NE.NPL)GOTO 130 IR=IRNK ING=NG AVR=AVRTNG DO 12 I=1,4 IU(I)=IUIC(I) 12 CONTINUE 130 WRITE(2)WORDS8,ISN,IR,ING,AVR,IU GOTO 120 3 REWIND 1 REWIND 2 140 READ(2,END=5,ERR=5)WORDS8,ISN,IR,ING,AVR,IU WRITE(1,ERR=5)WORDS8,ISN,IR,ING,AVR,IU GOTO 140 5 CALL CLOSE(1) CALL CLOSE(2) OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',ERR=4) OPEN(UNIT=2,TYPE='SCRATCH',FORM='UNFORMATTED') 110 READ(1,END=6,ERR=6)NP,SNUM,DAT,N IF(NP.EQ.NPL .AND. SNUM.EQ.AFILE(3))GOTO 110 WRITE(2)NP,SNUM,DAT,N GOTO 110 6 REWIND 1 REWIND 2 150 READ(2,END=7,ERR=7)NP,SNUM,DAT,N WRITE(1)NP,SNUM,DAT,N GOTO 150 7 CALL CLOSE(1) CALL CLOSE(2) 4 CALL RUNMCR('[200,200]FLEET.MSG',15,'U') OPEN(UNIT=1,NAME='[200,200]FLEET.MSG',TYPE='OLD',ACCESS='APPEND', &ERR=8) CALL STRDAT(DAT) CALL SETRNK(IRNK,PRANK) CALL CROP(NAME1,16) WRITE(1,161)DAT,PRANK,NAME1,NPL,AFILE(3) 161 FORMAT(1X,'*** MESSAGE FROM FLEET OPERATIONS, SFC (',2A4,A1,'):'/ &1X,13A1,1X,16A1,' (SF',I3,') violated Star Fleet Regulations'/1X, &'by attempting to resume an aborted failed mission (#',A3,').'/1X, &'Promotion standing was updated with 0% rating and BACKUP was'/1X, &'deleted. Fleet Operations out.') 8 CALL CLOSE(1) TYPE 171 171 FORMAT(1X,'*** COMMUNICATION FROM STAR FLEET COMMAND:'/5X, &'You have been found in violation of Star Fleet Regulations'/5X, &'by aborting a failed mission in a vain attempt to prevent'/5X, &'it from being reported to SFC. As a result, a rating of'/5X, &'0.0% is being added to your record for this mission.'/5X, &'Your BACKUP file has also been deleted, and SFHQ has been'/5X, &'notified of this matter. DO NOT LET IT HAPPEN AGAIN,'/5X, &'OR YOU MAY BE COURTMARTIALED.') STOP 2 CALL CLOSE(1) 1 CALL RUNMCR(AFILE,16,'U') OPEN(UNIT=3,NAME=AFILE,TYPE='OLD',ACCESS='APPEND',ERR=70) IF(.NOT.TLOG)GOTO 40 CALL RUNMCR(CFILE,16,'U') OPEN(UNIT=1,NAME=CFILE,TYPE='OLD',ACCESS='APPEND',ERR=70) WRITE(1,91,ERR=70) CALL CLOSE(1) 40 TYPE 41,SHIP,RANK,AFILE(3),R1,C1 41 FORMAT(/1X,'YOUR PREVIOUS MISSION HAS BEEN RESUMED'//1X,'YOU ARE C &OMMANDING THE STARSHIP CRUISER ',16A1/1X,'AT RANK:',F7.0//1X, &'YOUR MISSION SEQUENCE NUMBER IS ',A4//1X,'QUADRANT:',I3,',',I3/) WRITE(3,41,ERR=70)SHIP,RANK,AFILE(3),R1,C1 RETURN 60 TYPE 61 61 FORMAT(/1X,'*** ERROR ENCOUNTERED IN TRYING TO READ FILE ***'/1X,' &CHECK THAT FILE EXISTS ON PRESENT UIC, AND ITS LENGTH IS 4 BLKS') CALL CLOSE(1) 9999 STOP 70 TYPE 71,AFILE 71 FORMAT(/1X,'*** ERROR ENCOUNTERED IN USING PREVIOUS LOG FILES &***'/1X,'PREVIOUS FILE NAME: ',4A4/1X,'A NEW FILE IS BEING SET UP &UNDER THE SAME NAME.') CALL CLOSE(3) OPEN(UNIT=3,NAME=AFILE,TYPE='NEW') REWIND 3 WRITE(3,71)AFILE CALL CLOSE(3) IF(.NOT.TLOG)GOTO 1 OPEN(UNIT=1,NAME=CFILE,TYPE='NEW') REWIND 1 WRITE(1,91) 91 FORMAT(2X) CALL CLOSE(1) GOTO 1 END