C C C ****************************************** C * * C * SUBROUTINE TO WRITE PROGRAM HEADER * C * AND DAY MESSAGE * C * * C ****************************************** C SUBROUTINE HEADER C DIMENSION GDATE(3) C LOGICAL*1 IMAGE(72) C CALL DATE(GDATE) 10 TYPE 11,GDATE 11 FORMAT(1H1,18X,'***** S T A R F L E E T *****',15X,3A4/20X, &'VERSION: 1.1 - 21 NOV. 1981'/20X'Written by TREVOR SORENSEN'//) C CALL FDBSET(1,'READONLY') CALL ASSIGN(1,'[200,200]STARFLEET.MSG') REWIND 1 20 READ(1,ERR=1,END=1)IMAGE CALL CROP(IMAGE,72) 30 TYPE 31,IMAGE 31 FORMAT(1X,72A1) GOTO 20 1 CALL CLOSE(1) C RETURN END C C ********************************************************* C * * C * SUBROUTINE TO OBTAIN DESIRED SET UP FOR NEW GAME * C * * C ********************************************************* C SUBROUTINE SETUP(TRESUM,TLOG,NS,NGAM,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/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/SYMBL/DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR(10,10) COMMON/SHIPS/SHIPSN(16,30),DECKS(24) COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) DIMENSION GDATE(3),NRANK(10) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H REAL*8 COND,KL,RM,GRN,RED,DCKD,DEST,DISAB,SHPSN8(2,30),PSWRD LOGICAL TRESUM,TLOG,TDEFLT,TEST,TAMES LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,ANS,YES,NO,BLA,D LOGICAL*1 IMAGE(72),SHIP,SHIPSN,DUMMY(16),PRANK(13),NAME1,DUM(8) EQUIVALENCE (IMAGE(1),DUMMY(1)),(SHIP(1),DUM(1)) DATA SHPSN8/'CONSTELL','ATION II','CONSTITU','TION','ENTERPRI','SE &','EXCALIBU','R','EXETER',' ','FARRAGUT',' II','HOOD',' ','INTREPI &D',' II','LEXINGTO','N','POTEMKIN',' ','VALIANT','II','YORKTOWN',' & ','ARI',' ','BONHOMME',' RICHARD','DEFIANT',' ','EAGLE',' ','EL &DORAD','O','ENDEAVOU','R','ESSEX',' ','EXCELSIO','R','HORNET',' ' &,'LAFAYETT','E','MERRIMAC',' ','MONITOR',' ','SARATOGA',' ','TORI' &,' ','WASP',' ','PRINCE O','F WALES','CORAL SE','A','GRAF ZEP' &,'PELIN'/ DATA II,JJ,GDATE/2*0,3*' '/ DATA BLA,YES,NO,D/' ','Y','N','D'/ C DO 5 I=1,INT(SECNDS(0.)/100.) RX=RAN(II,JJ) 5 CONTINUE 310 TYPE 311 311 FORMAT(/1X,'Do you wish to exit the program now [ to continue] +? ',$) READ(5,301,ERR=310)ANS TAMES=.FALSE. CALL CAPMSK(ANS,1) IF(ANS.EQ.'Y')STOP IF(IRNK.LT.6)TYPE 321 321 FORMAT(/1X, +'If you lose the carrier signal or the game while playing,'/1X, &'you can resume the same game by using the file name:'/1X, &'"BACKUP.***", where "***" is the sequence number of your game.') 20 TYPE 21 21 FORMAT(/1X,'NOTE: Default options (when alone is hit) are in &[ ]'/7X,'For a completely default game, enter "D" for the first qu &estion.'/7X,'If you want to specify Rank of default game, enter & Rank after'/7X'the "D". If you want a Captain''s Log, also enter & "L" after'/7X,'the "D".' &//1X,'Do you want to resume a previously saved game [NO]? ' &,$) 30 READ(5,31,ERR=20)NC,IMAGE 31 FORMAT(Q,72A1) TDEFLT=.FALSE. IF(NC.EQ.0)GOTO 150 CALL CAPMSK(IMAGE,NC) TEST=.FALSE. N=0 ANS=IMAGE(1) IF(ANS.NE.'D' .OR. NC.EQ.1)GOTO 18 DO 17 I=1,NC IF(IMAGE(I).EQ.'L')TLOG=.TRUE. IF(IMAGE(I).EQ.',' .OR. IMAGE(I).EQ.' ')GOTO 17 MASK=IMAGE(I).AND."100 IF(MASK.EQ."100)GOTO 17 TEST=.TRUE. N=N+1 DUMMY(N)=IMAGE(I) 17 CONTINUE IF(.NOT.TEST)GOTO 18 DECODE(N,61,DUMMY,ERR=18)RANK 61 FORMAT(F10.0) 18 IF(ANS.EQ.D)TDEFLT=.TRUE. IF(TDEFLT)GOTO 15 IF(ANS.EQ.NO .OR. ANS.EQ.BLA)GOTO 150 IF(ANS.NE.YES)GOTO 20 TRESUM=.TRUE. RETURN 150 TYPE 151 151 FORMAT(/1X,'Do you need instructions [NO]? ',$) 160 READ(5,141,ERR=150)ANS CALL CAPMSK(ANS,1) IF(ANS.EQ.NO .OR. ANS.EQ.BLA)GOTO 12 IF(ANS.NE.YES)GOTO 150 170 TYPE 171 171 FORMAT(/1X,'THAT''S TOO BAD!') CALL PAUSE(3) 800 TYPE 801 801 FORMAT(1X,'*** WARNING - THEY ARE VERY LONG (45MIN.@300BAUD)'/1X, &'IF YOU''RE AT AMES, YOU CAN GET THEM ON THE VERSATEC'/1X, &'BY DOING "PIP LP:=[200,200]STARFLEET.INS" and "[200,200]UPDATE.INS &"'/1X,'DO YOU STILL WANT THEM WRITTEN TO YOUR CRT? ',$) READ(5,141,ERR=800)ANS CALL CAPMSK(ANS,1) IF(ANS.NE.'Y')GOTO 12 CALL FDBSET(1,'READONLY') CALL ASSIGN(1,'[200,200]STARFLEET.INS') REWIND 1 300 READ(1,301,ERR=99,END=99)IMAGE 301 FORMAT(72A1) TYPE 121,IMAGE 121 FORMAT(1X,72A1) GOTO 300 99 CALL CLOSE(1) 12 IF(IRNK.LT.4)GOTO 15 70 TYPE 71 71 FORMAT(/1X,'The following Federation Starship Cruisers are availab &le:'/) OPEN(UNIT=1,NAME='[200,200]SHIPS.NAM',TYPE='OLD',READONLY) 50 READ(1,301,ERR=2,END=2)IMAGE CALL CROP(IMAGE,72) TYPE 121,IMAGE GOTO 50 2 CALL CLOSE(1) 80 TYPE 81 81 FORMAT(/1X,'Enter number of your Starship [RANDOM]? ',$) 90 READ(5,91,ERR=80)NS 91 FORMAT(I3) IF(NS.LT.0 .OR. NS.GT.30)GOTO 80 15 IF(TDEFLT .AND. IRNK.GE.6)NS=NSHP IF(IRNK.EQ.1)GOTO 13 IF(NS.NE.0)GOTO 7 N=0 6 NS=INT(RAN(II,JJ)*30.)+1 N=N+1 IF(NS.GT.30 .OR. (NS.EQ.1 .AND. N.EQ.1))GOTO 6 IF(NS.EQ.1 .AND. RAN(II,JJ).LE.0.5)GOTO 6 7 DO 4 I=1,30 100 ENCODE(16,101,DUMMY)(SHPSN8(J,I),J=1,2) 101 FORMAT(2A8) DO 3 J=1,16 SHIPSN(J,I)=DUMMY(J) IF(J.NE.16 .AND. DUMMY(J).EQ."40 .AND. DUMMY(J+1).EQ."40)SHIPSN(J, &I)="0 IF(J.EQ.16 .AND. DUMMY(J).EQ."40)SHIPSN(J,I)="0 IF(I.EQ.NS)SHIP(J)=SHIPSN(J,I) 3 CONTINUE 4 CONTINUE GOTO 14 13 CALL A8TOA1('REPUBLIC',DUM) CALL CROP(SHIP,16) TYPE 11,SHIP 11 FORMAT(/1X,'While in the Academy, you will use the Starship Cruise &r ',16A1,','/1X,'which has been assigned as a Cadet Training vess &el.') NS=0 14 SHP=SHIP(1) IF(TDEFLT)GOTO 8 130 TYPE 131 131 FORMAT(/1X,'Do you want a Captain''s Log kept [NO]? ',$) 140 READ(5,141,ERR=130)ANS 141 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.YES)TLOG=.TRUE. IF(TLOG)GOTO 19 IF(ANS.NE.NO .AND. ANS.NE.BLA)GOTO 130 19 IF(IRNK.LE.1)GOTO 8 210 TYPE 211 211 FORMAT(/1X,'Enter Mission Rank (1-easy to 10-hard)[MAX.RANK]? ',$) 220 READ(5,221,ERR=210)RANK 221 FORMAT(F10.0) 8 IRANK=IRNK IF(IRNK.EQ.0)IRANK=1 IF(IRNK.EQ.11)IRANK=10 IF(RANK.EQ.0.)RANK=IRANK IF(RANK.LT.0. .OR. RANK.GT.10.)GOTO 210 IF(RANK.LE.FLOAT(IRANK))GOTO 9 CALL SETRNK(IRANK,PRANK,0) 230 TYPE 231,PRANK,NAME1,IRANK 231 FORMAT(/1X,'Sorry ',13A1,1X,16A1,', but you are only qualified'/1X, &'for a maximum Mission Rank of',I3) CALL PAUSE(2) IF(IRANK.GT.1)GOTO 210 RANK=1. 9 IF(IRNK.NE.11)RANK=RANK+FLOAT(IRANK)*.01 IF(IRNK.EQ.11)RANK=RANK+.11 IF(NPL.LE.2)GOTO 999 IF(IRNK.LT.INT(RANK))GOTO 190 OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD',FORM= &'UNFORMATTED',READONLY,SHARED) 500 READ(1,END=999,ERR=999)NP,SQNUM,GDATE,N IF(NP.NE.NPL)GOTO 500 CALL CLOSE(1) CALL SETRNK(IRNK,PRANK,1) TYPE 501,PRANK,SQNUM 501 FORMAT(1X,'SORRY ',13A1,', BUT STAR FLEET COMMAND''S RECORDS' &/1X,'SHOW THAT YOU HAVE NOT COMPLETED YOUR PREVIOUSLY ASSIGNED' &/1X,'MISSION (#',A3'). THIS MUST BE COMPLETED BEFORE A NEW ONE' &/1X,'OF THE SAME LEVEL CAN BE ASSIGNED. HOWEVER, YOU MAY CHOOSE' &/1X,'A LOWER RANK MISSION IF YOU WANT.') GOTO 310 999 CALL CLOSE(1) 190 TYPE 191,RANK 191 FORMAT(1X,'Your Mission Rank will be',F5.0) CALL PAUSE(2) RETURN END