C C C ********************************************** C * * C * SUBROUTINE TO CHECK STATUS OF PRISONER * C * * C ********************************************** C SUBROUTINE PRISON(TEST1,IX) C COMMON/PERS /NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) C DIMENSION IU(4),DAT(3) C REAL*8 PNAME,PSWRD,PSWRD8 LOGICAL TEST1 LOGICAL*1 BUFFER(65),NAME1 C IX=0 IRNK=IRNK+1 IF(IRNK.GE.0)GOTO 400 II=0 JJ=0 DO 17 I=1,INT(SECNDS(0.)/100.) RX=RAN(II,JJ) 17 CONTINUE CALL SETRNK(-1,PRANK,1) XYR=ABS(FLOAT(IRNK))+RAN(II,JJ) TYPE 341,NAME1 341 FORMAT(1X/1X,'SORRY ENSIGN ',16A1,', but you are currently a priso &ner doing') OPEN(UNIT=1,NAME='[200,200]STARFLEET.DAT',TYPE='OLD',READONLY, &SHARED) REWIND 1 READ(1,301,ERR=360)N,N 301 FORMAT(I2,1X,I2) NS=NG+30 310 READ(1,311,END=360)NUM 311 FORMAT(I2) IF(NUM.NE.NS)GOTO 310 320 READ(1,321,END=350)NUM,BUFFER 321 FORMAT(I2,1X,65A1) IF(NUM.NE.NS)GOTO 350 CALL CROP(BUFFER,65) TYPE 331,BUFFER 331 FORMAT(1X,65A1) GOTO 320 360 TYPE 361 361 FORMAT(1X,'Hard labor in Penal Colony 13 on the planet Hades.') 350 TYPE 351,XYR 351 FORMAT(1X,'You still have',F6.2,' years of your sentence left to &serve.') 13 CALL CLOSE(1) C ENTRY UPDTPF(IX) !UPDATE PERSONNEL FILE C CALL RUNMCR('[200,200]STARFLEET.NAM',22,'U') OPEN(UNIT=1,NAME='[200,200]STARFLEET.NAM',TYPE='OLD',FORM= &'UNFORMATTED',ERR=999) OPEN(UNIT=2,TYPE='SCRATCH',FORM='UNFORMATTED') N=0 370 READ(1,END=14,ERR=14)PNAME,PSWRD8,IS,IR,NM,AV,IU N=N+1 IF(N.NE.NPL)GOTO 380 IR=IRNK IS=NSHP DO 24 I=1,4 IU(I)=IUIC(I) 24 CONTINUE IF(NG.NE.0)GOTO 380 NM=NG AV=AVGTOT 380 WRITE(2)PNAME,PSWRD8,IS,IR,NM,AV,IU GOTO 370 14 REWIND 1 REWIND 2 390 READ(2,END=15)PNAME,PSWRD8,IS,IR,NM,AV,IU WRITE(1)PNAME,PSWRD8,IS,IR,NM,AV,IU GOTO 390 15 CALL CLOSE(1) CALL CLOSE(2) IF(IRNK.GE.0)RETURN IX=34 RETURN 400 TYPE 401,NAME1 401 FORMAT(1X/1X,'** GREETINGS ENSIGN '16A1' - You have completed your & sentence.'/1X, &'Welcome back to civilization. Your application to be reinstated'/ &1X,'into Star Fleet has been approved, but you must return to'/1X, &'the Academy for refresher courses. We sincerely hope that you'/ &1X,'have learned your lesson, and now realize the folly of'/1X, &'turning against the Federation. Next time thing''s won''t be so'/ &1X,'easy on you.') IRNK=0 NG=0 TEST1=.TRUE. IX=13 CALL STRDAT(DAT) CALL RUNMCR('[200,200]FLEET.MSG',15,'U') OPEN(UNIT=1,NAME='[200,200]FLEET.MSG',TYPE='OLD',ACCESS='APPEND', &ERR=999) WRITE(1,121,ERR=998)DAT,NAME1 121 FORMAT(1X,'** MESSAGE FROM FLEET OPERATIONS, SFC (',2A4,A1,'):'/ &1X,'ENSIGN ',16A1,' HAS SERVED THE REQUIRED SENTENCE'/ &1X,'AND HAS BEEN RELEASED FROM THE PENAL COLONY.') 998 CALL CLOSE(1) 999 RETURN END C C C ********************************************* C * * C * SUBROUTINE TO DISPLAY STAR FLEET NEWS * C * * C ********************************************* C SUBROUTINE SFNEWS(TEST) C LOGICAL TEST LOGICAL*1 IMAGE(71),ANS C CALL RUNMCR('[200,200]STARFLEET.NWS',22,'U') OPEN(UNIT=1,NAME='[200,200]STARFLEET.NWS',TYPE='OLD',SHARED, &READONLY,ERR=35) N=0 NPAGE=1 10 READ(1,11,END=53,ERR=53)IMAGE 11 FORMAT(71A1) IF(TEST)GOTO 55 IF(IMAGE(1).EQ.'*')GOTO 10 IF(IMAGE(1).EQ.'/')GOTO 53 CALL CROP(IMAGE,71) TYPE 21,IMAGE 21 FORMAT(1X,71A1) IF(IMAGE(1).EQ.'-' .AND. IMAGE(40).EQ.'-')N=N+1 IF(N.LT.2)GOTO 10 N=0 NPAGE=NPAGE+1 TYPE 31 31 FORMAT(1X,'*** HIT TO CONTINUE, ENTER "X" TO EXIT ***') READ(5,41,ERR=10)ANS 41 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.'X')GOTO 53 TYPE 51,NPAGE 51 FORMAT(1H1,T20,'STAR FLEET NEWS',15X,'Page',I3/) GOTO 10 55 IF(IMAGE(1).NE.'*')GOTO 53 TYPE 61,(IMAGE(I),I=2,10) 61 FORMAT(/1X,'Latest issue of STAR FLEET NEWS is dated ',9A1) 53 CALL CLOSE(1) 35 RETURN END C C C ************************************* C * * C * STAR FLEET ACADEMY SUBROUTINE * C * * C ************************************* C SUBROUTINE SFA(TEST1) C COMMON/PERS /NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) C DIMENSION DAT(3) C REAL*8 PSWRD LOGICAL TEST1,TLSSN LOGICAL*1 NAME1,IMAGE(71),ANS C 90 TYPE 91,NAME1 91 FORMAT(/1X'*** WELCOME TO STAR FLEET ACADEMY, CADET ',16A1,' ***') GOTO 26 C ENTRY LESSON(ANS,IER) C NSL=0 IF(ANS.EQ.'1')NSL=1 IF(ANS.EQ.'2')NSL=2 IF(IER.EQ.1)RETURN IF(NSL.EQ.0)IER=1 IF(IRNK.GT.1 .OR. NSL.LT.2 .OR. NG.GT.0)GOTO 26 TYPE 581 581 FORMAT(1X,'SORRY, BUT YOU ARE NOT QUALIFIED FOR LESSON 2 YET.') RETURN 26 OPEN(UNIT=1,NAME='[200,200]STARFLEET.SFA',TYPE='OLD',READONLY, &SHARED,ERR=999) 1 NL=0 TLSSN=.TRUE. IF(NSL.EQ.0)NSL=NG+1 100 READ(1,101,ERR=590,END=590)NL,IMAGE 101 FORMAT(I1,71A1) IF(IRNK.EQ.0 .AND. NL.NE.1)GOTO 590 IF(NL.NE.NSL)GOTO 100 CALL CROP(IMAGE,71) IF(IMAGE(1).NE.'.')GOTO 110 TYPE 601,' LESSON' 601 FORMAT(10X,'** HIT TO CONTINUE',A7,' **') READ(5,121,ERR=110)ANS 121 FORMAT(A1) 110 TYPE 111,(IMAGE(I),I=2,71) 111 FORMAT(1X,70A1) GOTO 100 590 TYPE 591 591 FORMAT(/10X,'** THIS LESSON IS CONCLUDED **') 999 CALL CLOSE(1) RETURN END