C C C ************************************************** C * * C * M E S S * C * PROGRAM TO WRITE DAY MESSAGE FOR STARFLEET * C * WRITTEN BY TREVOR SORENSEN * C * * C ************************************************** C DIMENSION DATEM(3),TIMEM(2),ISN(2),IPRL(6) REAL*8 PASSWD,INPUT LOGICAL TEDIT,TINSER,TPASS LOGICAL*1 IMAGE(72),IMAGE2(72),DUMMY(8),END C DATA DATEM,TIMEM/3*4H ,2*4H / DATA INPUT,PASSWD,DUMMY/2*' ',8*' '/,IEFN,IPRL(2)/1,72/ C TYPE 11 11 FORMAT(//1X,'*** MESS - PROGRAM TO WRITE DAY-MESSAGE FOR STARFLEET & ***'/) TPASS=.FALSE. 1 OPEN(UNIT=1,NAME='[200,200]STARFLEET.MSG',TYPE='UNKNOWN',SHARED, &FORM='UNFORMATTED') 2 REWIND 1 TEDIT=.FALSE. 20 TYPE 21 21 FORMAT(/1X,'COMMAND? ',$) READ(5,31,ERR=20)ICMD 31 FORMAT(A2) IF(ICMD.EQ.'CA' .OR. ICMD.EQ.'ST')GOTO 999 IF(ICMD.EQ.'LI')GOTO 110 IF(ICMD.NE.'NE')GOTO 20 IF(TPASS)GOTO 220 TYPE 41 41 FORMAT(1X,'ENTER PASSWORD: ',$) CALL GETADR(IPRL(1),INPUT) CALL WTQIO("1020,5,IEFN,,ISB,IPRL) DUMMY(1)="123 DUMMY(2)="106 DUMMY(3)="110 DUMMY(4)="121 DECODE(8,1001,DUMMY)PASSWD 1001 FORMAT(A8) IF(INPUT.EQ.PASSWD)GOTO 12 TYPE 61 61 FORMAT(/1X,'*** IMPOSTERS ARE NASTY PEOPLE !!! ***') STOP 12 TPASS=.TRUE. 220 TYPE 221 221 FORMAT(1X,'NEW MESSAGE (ENTIRE) OR EDIT OLD? ',$) READ(5,31,ERR=220)ICMD IF(ICMD.EQ.'CA' .OR. ICMD.EQ.'ST')GOTO 20 IF(ICMD.EQ.'NE')GOTO 70 IF(ICMD.NE.'ED')GOTO 220 TYPE 241 241 FORMAT(/1X,'INSTRUCTIONS FOR EDIT MODE:'/1X, &T5,'INPUT (AFTER *)',T35,'PURPOSE'/1X, &T5,15(1H-),T35,7(1H-)/1X, &T10,'',T25,'NO CHANGE'/1X, &T7,'',T25,'REPLACE CURRENT LINE WITH '/1X, &T11,'D',T25,'DELETE CURRENT LINE'/1X, &T11,'I',T25,'INSERT NEW LINE'/1X, &T11,'EX',T25,'EXIT EDIT MODE') TEDIT=.TRUE. OPEN(UNIT=2,TYPE='SCRATCH',FORM='UNFORMATTED') GOTO 3 280 WRITE(2)IMAGE REWIND 1 READ(1)IMAGE TINSER=.FALSE. 8 DO 7 I=1,72 IMAGE(I)=' ' IMAGE2(I)=' ' 7 CONTINUE IF(TINSER)GOTO 270 290 READ(1,END=100)IMAGE 250 TYPE 131,IMAGE 260 TYPE 261 261 FORMAT(1X,'*',$) 270 READ(5,271,ERR=260)NC,IMAGE2 271 FORMAT(Q,72A1) TINSER=.FALSE. IF(IMAGE2(1).EQ.'D' .AND. NC.EQ.1)GOTO 290 IF(IMAGE2(1).EQ.'I' .AND. NC.EQ.1)TINSER=.TRUE. IF(NC.EQ.2 .AND. IMAGE2(1).EQ.'E' .AND. IMAGE2(2).EQ.'X') &GOTO 320 IF(TINSER)GOTO 4 IF(NC.GT.72)NC=72 DO 4 I=1,NC IF(IMAGE2(I).NE.' ')GOTO 300 4 CONTINUE WRITE(2)IMAGE IF(TINSER)GOTO 8 GOTO 290 300 WRITE(2)IMAGE2 GOTO 290 320 TYPE 321 321 FORMAT(1X,'[EXIT]') 9 WRITE(2)IMAGE READ(1,END=5)IMAGE GOTO 9 5 REWIND 1 REWIND 2 310 READ(2,END=6)IMAGE WRITE(1)IMAGE GOTO 310 6 CALL CLOSE(2) GOTO 2 70 TYPE 71 71 FORMAT(1X,'ENTER MESSAGE:'/) DO 3 I=1,72 IMAGE(I)=' ' 3 CONTINUE CALL TIME(TIMEM) CALL DATE(DATEM) 140 ENCODE(72,141,IMAGE,ERR=170)TIMEM,DATEM 141 FORMAT('MESSAGE ENTERED:',3X,2A4,3X,3A4) IF(TEDIT)GOTO 280 GOTO 90 170 TYPE 171 171 FORMAT(1X,'*** ERROR ENCOUNTERED IN ENCODE ***') 80 READ(5,81,ERR=70)IMAGE 81 FORMAT(72A1) IF(IMAGE(1).EQ.'/')GOTO 99 90 WRITE(1)IMAGE GOTO 80 100 TYPE 101 101 FORMAT(/1X,'* MESSAGE COMPLETED'/) IF(TEDIT)GOTO 5 GOTO 1 110 TYPE 111 111 FORMAT(1X,'CURRENT MESSAGE:'/) REWIND 1 120 READ(1,END=2)IMAGE 130 TYPE 131,IMAGE 131 FORMAT(1X,72A1) GOTO 120 99 CALL CLOSE(1) GOTO 100 999 CALL CLOSE(1) STOP END