PROGRAM MAIL
C+
C FIRST EDITION: SEPTEMBER 14, 1978
C
C
C SEPTEMBER 14, 1978 - ADDED FILE COMMAND
C
C SEPTEMBER 15, 1978 - CHANGED SIZE OF RECORDS IN MAIL FILE
C 	ADDED REPEAT COMMAND
C
C SEPTEMBER 18, 1978 - ADDED REPLY COMMAND
C
C SEPTEMBER 25, 1978 - ADD USERS COMMAND
C
C OCTOBER 6, 1978 - ADD BREAK COMMANDS TO MESSAGE INPUT
C COMMANDS ARE >FILE AND >REPEAT
C-
	IMPLICIT INTEGER (A-Z)
	PARAMETER MLUN=1,MSG=3,TTY=2
	PARAMETER READC=1,SENDC=2,HOLDC=3,ACKC=4,REMOVC=5
	PARAMETER CLEARC=6,FILEC=7,RPEATC=8,DELETC=9,HELPC=10
	PARAMETER REPLYC=11,USERC=12
	PARAMETER MAXCMD=13
	PARAMETER RECLEN=32
	PARAMETER BREAKC='>'
	LOGICAL*1 OVER,MATCH,NOMAIL,EOF
	INTEGER RECORD(RECLEN)
	INTEGER USER(4),TESTER(4),SENDNM(4)
	LOGICAL*1 DAT(9),TIM(8),USRNAM(12),FNAME(30),SNDNAM(12)
	LOGICAL*1 SUBJCT(72),LINE(72)
	REAL COMMND
	LOGICAL*1 CMMNDB(4)
	EQUIVALENCE (COMMND,CMMNDB)
	REAL CMMNDS(MAXCMD)
C+
C OVER TESTS FOR ENTRY NUMBERS OVER LIMIT
C-
	OVER() = MENTNO.GT.NENTRY
C
C NOTE THAT LAST ENTRY IN "CMMNDS" IS ALWAYS BLANK
	DATA CMMNDS(MAXCMD)/'    '/
	DATA CMMNDS(READC)/'READ'/,CMMNDS(SENDC)/'SEND'/
	DATA CMMNDS(HOLDC)/'HOLD'/,CMMNDS(ACKC)/'ACKN'/,
	1    CMMNDS(REMOVC)/'RECE'/,CMMNDS(FILEC)/'FILE'/
	DATA CMMNDS(RPEATC)/'REPE'/,CMMNDS(DELETC)/'DELE'/
	DATA CMMNDS(HELPC)/'HELP'/,CMMNDS(REPLYC)/'REPL'/
	DATA CMMNDS(USERC)/'USER'/
	DATA CMMNDS(CLEARC)/'?!@+'/
C
C FORMATS
C
101	FORMAT(A4)
102	FORMAT(Q,72A1)

	CALL ASNLUN(TTY,'TI',0)
	CALL SETDEF
	CALL GETUSR(USRNAM)
	CONVERT-USER-TO-RAD50
	OPEN-MAIL-FILE
	MATCH = .FALSE.
	DO (I=1,4) TESTER(I) = USER(I)
	COMPARE-NAMES
	WHEN (MATCH) WRITE(TTY,1)
	ELSE WRITE(TTY,2)
1	FORMAT('0<<< YOU HAVE MAIL >>>')
2	FORMAT('0NO MAIL')
	EOF = .FALSE.
	REPEAT UNTIL (EOF)
	WRITE(TTY,3)
3	FORMAT('$Command: (Type HELP for help) ')
	READ(TTY,101,END=999) COMMND
	SELECT-COMMAND-INDEX
	SELECT (COMIND)
	(READC)
	READ-MESSAGES
	FIN
	(SENDC) SEND-MESSAGE
	(CLEARC) CLEAR-MESSAGES
	(USERC) LIST-USERS
	(OTHERWISE) WRITE(TTY,4)
	FIN
4	FORMAT(' Input "SEND","READ","USERS" or ^Z')
	UNLESS(.TRUE.)
999	EOF = .TRUE.
	FIN
	FIN
	CLOSE(UNIT=MLUN)
	CALL EXIT

	TO CLEAR-MESSAGES
	OPEN-MAIL-FILE
	CLOSE (UNIT=MLUN,DISPOSE='DELETE')
	FIN
	TO COMPARE-NAMES
	REPEAT UNTIL (MATCH .OR. OVER())
	GET-RECORD
	COMPARE-WITH-TESTER
	FIN
	IF (OVER()) MATCH = .FALSE.
	FIN
	TO COMPARE-WITH-TESTER
	MATCH = .TRUE.
	DO (I=1,4)
	IF (TESTER(I).NE.RECORD(ENTPTR+I)) MATCH = .FALSE.
	FIN
	FIN
	TO CONVERT-USER-TO-RAD50 CALL IRAD50(12,USRNAM,USER)
	TO CONVERT-SENDER-TO-RAD50 CALL IRAD50(12,SNDNAM,SENDNM)
	TO CREATE-FILE-MENTNO
	MAKE-FNAME-MENTNO
	CLOSE(UNIT=MSG)
	OPEN (UNIT=MSG,TYPE='NEW',NAME=FNAME,CARRIAGECONTROL='LIST')
	WRITE-POSTMARK
	FIN
	TO DISPLAY-MESSAGE
	LINENO = 0
	WHILE (.TRUE.)
	READ(MSG,102,END=99,ERR=99) N,LINE
	LINENO = LINENO+1
	SELECT (LINENO)
	(1)
	DO (I=1,12) SNDNAM(I) = LINE(I)
	WRITE(TTY,23) (LINE(I),I=1,N)
23	FORMAT(' From: ',72A1)
	FIN
	(2)
	DO (I=1,N)
	SUBJCT(I) = LINE(I)
	FIN
	WRITE(TTY,21) (LINE(I),I=1,60)
21	FORMAT(' Subject: ',60A1/)
	FIN
	(OTHERWISE) WRITE(TTY,22) LINE
	FIN
22	FORMAT(' ',72A1)
	FIN
99	CONTINUE
	FIN
	TO GET-RECORD
	MENTNO = MENTNO+1
	UNLESS (OVER())
	WHEN (NENTNO.GE.NPEREC)
	READ(MLUN'KEYVAR,END=1999) (RECORD(I),I=1,NWRDRC)
C
C FOLLOWING LINE IS END OF FILE BRANCH
C DO SOMETHING WHEN YOU GET AROUND TO IT, ED
C
1999	CONTINUE
	NENTNO = 1
	ENTPTR = 0
	FIN
	ELSE
	ENTPTR = ENTPTR+ENTSIZ
	NENTNO = NENTNO+1
	FIN
	FIN
	FIN
	TO LIST-USERS
	OPEN-PDSUPF
	WRITE(2,72)
72	FORMAT(/)
	DO (J=1,NENTRY)
	GET-RECORD
	CALL R50ASC(12,RECORD(ENTPTR+1),SNDNAM)
71	FORMAT($,'+'12A1,3X)
73	FORMAT('+'12A1/)
	WHEN (MOD(J,5).EQ.0) WRITE(2,73) SNDNAM
	ELSE WRITE(2,71) SNDNAM
	FIN
	WRITE(2,72)
	FIN
	TO MAKE-FNAME-MENTNO
	ENCODE(20,31,FNAME) MENTNO
31	FORMAT('DM0:[1,200]',I5,'.MSG')
	FNAML = 0
	DO (I=1,20)
	UNLESS (FNAME(I).EQ.' ')
	FNAML = FNAML+1
	FNAME(FNAML) = FNAME(I)
	FIN
	FIN
	FNAME(FNAML+1) = 0
	FIN
	TO OPEN-FILE-MENTNO
	MAKE-FNAME-MENTNO
	CLOSE(UNIT=MSG)
	OPEN(UNIT=MSG,TYPE='OLD',NAME=FNAME,SHARED,ERR=6999)
	UNLESS (.TRUE.)
6999	WRITE(TTY,61)
61	FORMAT(' ERROR IN READING MESSAGE FILE - ENTRY WILL BE DELETED')
	REMOVE-ENTRY
	FIN
	FIN
	TO OPEN-MAIL-FILE
2998	CLOSE(UNIT=MLUN)
	NWRDRC = 16
	NPEREC = 1
	OPEN (UNIT=MLUN,NAME='DM0:[1,200]MAILFILE.DAT',TYPE='OLD',
	1  ACCESS='DIRECT',FORM='UNFORMATTED',RECORDSIZE=NWRDRC/2,
	2  ASSOCIATEVARIABLE=KEYVAR,ERR=2999,SHARED)
	READ(MLUN'1) (RECORD(I),I=1,NWRDRC)
	ENTSIZ = NWRDRC/NPEREC
	NENTRY = RECORD(1)
	MENTNO = 0
	NENTNO = NPEREC+1
	UNLESS (.TRUE.)
2999	CONTINUE
	OPEN (UNIT=MLUN,NAME='DM0:[1,200]MAILFILE.DAT',TYPE='NEW',
	1  ACCESS='DIRECT',FORM='UNFORMATTED',RECORDSIZE=NWRDRC/2,
	2 ASSOCIATEVARIABLE=KEYVAR,MAXREC=40)
	DO (I=1,NWRDRC) RECORD(I) = 0
	WRITE(MLUN'1) (RECORD(I),I=1,NWRDRC)
	GO TO 2998
	FIN
	FIN
	TO OPEN-PDSUPF
	CLOSE(UNIT=MLUN)
	NWRDRC = 32
	OPEN (UNIT=MLUN,NAME='DK0:[1,100]PDSUPF.DAT',TYPE='OLD',SHARED,
	1READONLY,ACCESS='DIRECT',RECORDSIZE=16,ASSOCIATEVARIABLE=KEYVAR)
	READ(MLUN'1) (RECORD(I),I=1,NWRDRC)
	NENTRY = RECORD(2)-RECORD(1)+1
	NPEREC = 8
	ENTSIZ = 4
	NENTNO = NPEREC+1
	MENTNO = 0
	FIN
	TO PREPARE-REPLY
	CLOSE(UNIT=MSG,DISPOSE='DELETE')
	CONVERT-SENDER-TO-RAD50
	DO (I=1,4) RECORD(ENTPTR+I) = SENDNM(I)
	IF (ENTSIZ.GT.4)
	DO (I=5,ENTSIZ) RECORD(ENTPTR+I) = 0
	FIN
	RE-WRITE-RECORD
	CREATE-FILE-MENTNO
	WRITE(MSG,12) (SUBJCT(I),I=1,60)
12	FORMAT(' Reply to:',60A1)
	FIN

	TO READ-MESSAGES
	OPEN-MAIL-FILE
	NOMAIL = .TRUE.
	UNTIL (OVER())
	DO (I=1,4) TESTER(I) = USER(I)
	COMPARE-NAMES
	IF (MATCH)
	NOMAIL = .FALSE.
	OPEN-FILE-MENTNO
	DISPLAY-MESSAGE
	REPEAT UNTIL (MATCH)
	MATCH = .TRUE.
	WRITE(TTY,5)
5	FORMAT('$Disposition? ')
	READ(TTY,101,END=999) COMMND
	SELECT-COMMAND-INDEX
	IF (COMIND.EQ.DELETC) COMIND = REMOVC
	SELECT (COMIND)
	(HOLDC) CONTINUE
	(ACKC)
	PREPARE-REPLY
	WRITE(MSG,13)
13	FORMAT(' Acknowledged')
	CLOSE (UNIT=MSG)
	FIN
	(REMOVC)
	CLOSE(UNIT=MSG,DISPOSE='DELETE')
	REMOVE-ENTRY
	FIN
	(FILEC)
	WRITE(TTY,14)
14	FORMAT('$Copy to File: ')
	READ(2,102,END=999) N,FNAME
	FNAME(N+1) = 0
	CLOSE(UNIT=TTY)
	CALL ASNLUN(TTY,'SY',0)
	OPEN(UNIT=TTY,TYPE='NEW',NAME=FNAME,CARRIAGECONTROL='LIST')
	REWIND MSG
	DISPLAY-MESSAGE
	MATCH = .FALSE.
	CLOSE(UNIT=TTY)
	CALL ASNLUN(TTY,'TI',0)
	FIN
	(RPEATC)
	REWIND MSG
	DISPLAY-MESSAGE
	MATCH = .FALSE.
	FIN
	(REPLYC)
	PREPARE-REPLY
	SEND-TEXT
	FIN
	(OTHERWISE)
	WRITE(TTY,6)
6	FORMAT(' Respond with "HOLD", "ACKN"owledge, "RECE"ived,'/
	1  '    "FILE", "REPE"at, or ^Z')
	MATCH = .FALSE.
	FIN
	FIN
	FIN
	FIN
	FIN
	IF (NOMAIL) WRITE(TTY,2)
	FIN

	TO REMOVE-ENTRY
	DO (I=1,ENTSIZ) RECORD(ENTPTR+I) = 0
	RE-WRITE-RECORD
	FIN
	TO RE-WRITE-RECORD
	I = KEYVAR-1
	WRITE(MLUN'I) (RECORD(I),I=1,NWRDRC)
	FIN
	TO SELECT-COMMAND-INDEX
	COMIND = 0
	REPEAT UNTIL (COMIND.EQ.MAXCMD .OR. COMMND.EQ.CMMNDS(COMIND))
	COMIND = COMIND+1
	FIN
	FIN

	TO SEND-MESSAGE
	WRITE(TTY,51)
51	FORMAT('$To? ')
	READ(TTY,102,END=999) N,SNDNAM
	CONVERT-SENDER-TO-RAD50
	DO (I=1,4) TESTER(I) = SENDNM(I)
	OPEN-PDSUPF
	COMPARE-NAMES
	WHEN (.NOT.MATCH)
	WRITE(TTY,52)
52	FORMAT(' *** MAIL - Indicated user does not exist ***')
	FIN
	ELSE
	WRITE(TTY,53)
53	FORMAT('$Subject: ')
	READ(TTY,102,END=999) N,SUBJCT
	OPEN-MAIL-FILE
	DO (I=1,4) TESTER(I) = 0
	COMPARE-NAMES
	IF (OVER())
	WHEN (NENTNO.LT.NPEREC) ENTPTR = ENTPTR+ENTSIZ
	ELSE
	KEYVAR = KEYVAR+1
	NENTNO = 1
	ENTPTR = 0
	DO (I=1,NWRDRC) RECORD(I) = 0
	FIN
	FIN
	CREATE-FILE-MENTNO
	WRITE(MSG,54) SUBJCT
54	FORMAT(72A1)
	SEND-TEXT
	DO (I=1,4) RECORD(ENTPTR+I) = SENDNM(I)
	IF (ENTSIZ.GT.4)
	DO (I=5,ENTSIZ) RECORD(ENTPTR+I) = 0
	FIN
	RE-WRITE-RECORD
	IF (MENTNO.GT.NENTRY)
	DO (I=1,NWRDRC) RECORD(I) = 0
	RECORD(1) = MENTNO
	WRITE(MLUN'1) (RECORD(I),I=1,NWRDRC)
	FIN
	WRITE(2,56) SNDNAM
56	FORMAT(' [',12A1,' - sent]'/)
	FIN
	FIN
	TO SEND-TEXT
	WRITE(TTY,55)
55	FORMAT(' Enter text of message.  End with ^Z')
	WHILE (.TRUE.)
	READ(TTY,102,END=599) N,LINE
	WHEN (LINE(1).EQ.BREAKC)
	DO (I=1,4) CMMNDB(I) = LINE(I+1)
	SELECT-COMMAND-INDEX
	SELECT (COMIND)
	(FILEC)
	WRITE(TTY,57)
57	FORMAT('$Get message from file ')
	READ(TTY,102) N,FNAME
	FNAME(N+1) = 0
	CLOSE(UNIT=TTY)
	CALL ASNLUN(TTY,'SY',0)
	OPEN(UNIT=TTY,NAME=FNAME,TYPE='OLD',READONLY,SHARED,ERR=598)
	UNLESS (.TRUE.)
598	CALL ASNLUN(TTY,'TI',0)
	FIN
	FIN
	(RPEATC)
	OPEN-FILE-MENTNO
	DISPLAY-MESSAGE
	CLOSE(UNIT=MSG)
	OPEN(UNIT=MSG,NAME=FNAME,ACCESS='APPEND',TYPE='OLD')
	FIN
	(HELPC)
	WRITE(TTY,58)
58	FORMAT(' "Break" commands are ">FILE" and ">REPEat"')
59	FORMAT(' The character ">" as the first character in a line'/
	1 ' indicates a special or "break" command to MAIL'/
	2 ' For further information on this feature type ">HELP"')
	FIN
	(OTHERWISE) WRITE(TTY,59)
	FIN
	FIN
	 ELSE WRITE(MSG,54) LINE
	FIN
599	CONTINUE
	CLOSE(UNIT=MSG)
	CLOSE(UNIT=TTY)
	CALL ASNLUN(TTY,'TI',0)
	FIN
	TO WRITE-POSTMARK
	CALL DATE(DAT)
	CALL TIME(TIM)
	WRITE(MSG,41) USRNAM,DAT,TIM
41	FORMAT(12A1,20X,'Postmark: ',9A1,1X8A1)
	FIN

	END