; BOARD.DBL TENNY "ELECTRONIC BULLETIN BOARD" MESSAGE MAILING SYSTEM ; COMPILE BOARD=BOARD.DBL ; LINK AS BOARD.TSD=BOARD,XDATE,XPRT,XINP ; BUILD AS BOARD.COM ; PROGRAMMER RON TENNY 2/1/83 ; COMMENTS See the 'BOARD.TXT' file for instruction on this program .INCLUDE 'SRC:COM.DBL' .INCLUDE 'SRC:BOARD.FD' PROC (1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .INCLUDE 'SRC:INI.DBL' ;INITIALIZATION ROUTINE DISPLAY (TT,BELL,HOME,CLEAR,'BOARD TENNY ELECTRONIC BULLETIN BOARD',CRLF,LF,'Please wait .. ') ;----------------------------- FIND OUT WHO THIS TERMINAL IS ASSIGNED TO ----------------------------------------------------- XCALL TNMBR (TERM) ;GET TERMINAL NUMBER OPEN (6,I,'FIL:BOARD.FIL') ;OPEN THE FILE OF TERMINAL NAME ASSIGNMENTS ONERROR BL ;LOOP IF RECORD LOCKED BL, READS (6,NAMES,DONE) ;SCAN FOR TERMINAL IF (NCODE.EQ.';') GOTO BL ;A COMMENT LINE, SKIP IT INCR LINE ;BUMP THE TERMINAL LINE COUNTER IF (LINE.LT.TERM) GOTO BL ;WE HAVEN'T REACHED THE TERMINAL USER YET CLOSE 6 ;FALL THRU & CLOSE THE NAME FILE WHEN AT PROPER USER OFFERROR ;----------------------------------------------------------------------------------------------------------------------------- TEST, DISPLAY (TT,DIS,34,32,'Good day, I think your name is: ',NAME & ,CRLF,LF,'Enter Your password: up arrow to quit') XCALL FLAGS ('01011000') ;RUBOUT,NO ECHO TRC = 'A0523030608' XCALL XINP IF (TCHAR.EQ.3) STOP 'EXE:MENU' ;UP ARROW TO END BOARD PASWD = INPUT XCALL FLAGS ('01001000') ;RUBOUT,ECHO OPEN (1,SI,'ISM:BOARD.ISM') ;DON'T USE XOPEN TO AVOID MULTI-TERMINAL INIITAL LOCK UP BINIT = NCODE ;GET THE OPERATORS INITIALS BEGIN, ONERROR BEGIN READ (1,BHEAD,BINIT) ;GET THE HEADER RECORD FOR THIS OPERATOR OFFERROR IF (PASWD.EQ.BPSWD) GOTO CLEAR ;THEIR "HOME" TERMINAL, DON'T BOTHER WITH THEIR CODE DISPLAY (TT,CRLF,LF,'Enter your initials code here: ') READS (TT,BINIT) RT, ONERROR DONE ;ATTEMPT TO READ THEIR HEADER, QUIT IF A BAD READ READ (1,BHEAD,BINIT) OFFERROR IF (PASWD.NE.BPSWD) STOP 'EXE:MENU' ;SEE IF THEIR PASSWORD MATCHES, IF NOT BOUNCE ;---------------------------------------------------------------------------------------------------------------- CLEAR, CLOSE 1 DISPLAY (TT,HOME,CLEAR,'BOARD TENNY ELECTRONIC BULLETIN BOARD',CRLF,LF,LF & ,' What do you want to do ',BINIT,'?',CRLF,LF & ,' -1-Send a message to a group or user ',CRLF,LF & ,' -2-Review messages sent to me',CRLF,LF & ,' -3-Review (delete) messages I have sent',CRLF,LF,LF & ,' Selection choice: up arrow to end') TRC = 'N1333010102' XCALL XINP IF (TCHAR.EQ.3) GOTO DONE ;UP ARROW TO QUIT DISPLAY (TT,CRLF,LF) OPT = DECMA GOTO (SEND,REVIEW,REVDEL,DONE) ,OPT ;BRANCH TO PROCEDURE SELECTED ;----------------------------------------------------------------------------------------------------------------------- ;----------------------------------------------------------------------------------------------------------------------- ; REVIEW MESSAGES THAT THE USER HAS CLEARANCE FOR ;----------------------------------------------------------------------------------------------------------------------- ;----------------------------------------------------------------------------------------------------------------------- REVIEW, DISPLAY (TT,DIS,34,32,CLEAR) OPEN (1,SI,'ISM:BOARD.ISM') ;OPEN IN INPUT MODE ONLY GCODE = 'ALL' ONERROR REVIEW READ (1,GHEAD,GCODE) ;GET THE "ALL" HEADER RECORD DES = GDESC ;LOAD THE GROUP DESCRIPTION WRITES (TT,DISPL) WRITES (TT,BLNK) ;----------------------------------------------------------------------------------------------------------------------- ; READ THE GENERAL INFO MESSAGES TO "ALL" ;----------------------------------------------------------------------------------------------------------------------- ALL, LINE = 0 RALL, ONERROR RALL READS (1,BLINE,GROUP) ;START READING THE "ALL" GENERAL INFORMATIONAL MESSAGES OFFERROR IF (BCODE.NE.'ALL') GOTO GROUP ;"ALL" TEXT FINISHED MDATE = BDATE(3,6),'ZX/XX' MTIME = BTIME,'ZX:XX:XX' MDAYS = BDAYS MFROM = BFROM WRITES (TT,FRO) WRITES (TT,BLNK) LALL, INCR LINE ;BUMP UP LINE COUNTER IF (LINE.GT.8) GOTO ACK WRITES (TT,BTEXT(LINE)) ;WRITE TEXT LINE TO THE TERMINAL GOTO LALL ;GET NEXT ONE ACK, DISPLAY (TT,CRLF,'Type: E (end), Q (quit), P (print), S (skip "all" messages), C/R to continue. ') READS (TT,OK) IF (OK.EQ.'E') GOTO CLEAR IF (OK.EQ.'Q') GOTO DONE IF (OK.EQ.'P') CALL PRINT DISPLAY (TT,UP) IF (OK.NE.'S') GOTO ALL ;----------------------------------------------------------------------------------------------------------------------- ; READ THE GROUP MESSAGES WHICH USER IS CLEARED FOR ;----------------------------------------------------------------------------------------------------------------------- GROUP, GRPCN = 0 DISPLAY (TT,UP,BLANK,CRLF) NGRP, INCR GRPCN IF (GRPCN.GT.5) GOTO GETPRI ;DON'T DISPLAY THE 6 TH GROUP (ALL), WE DID IT FIRST GCODE = BGRP (GRPCN) IF (GCODE.EQ.' '.OR.GCODE.EQ.'...') GOTO NGRP ;NO PERMISSION IN THIS NEXT GROUP, GOTO NEXT ONE RG, ONERROR RG READ (1,GHEAD,GCODE) ;GET THE GROUP HEADER RECORD DES = GDESC ;LOAD THE GROUP DESCRIPTION WRITES (TT,DISPL) WRITES (TT,BLNK) ;----------------------------------------------------------------------------------------------------------------------- RGRP, ONERROR RGRP READS (1,BLINE,GETPRI) ;START READING THE GROUP MESSAGES IF (BCODE.EQ.'ZZZ') GOTO GETPRI ;REACHED THE END IF (BCODE.NE.BGRP(GRPCN)) GOTO NGRP ;FINISHED WITH THIS GROUP LINE = 0 MDATE = BDATE(3,6),'ZX/XX' MTIME = BTIME,'ZX:XX:XX' MDAYS = BDAYS MFROM = BFROM WRITES (TT,FRO) WRITES (TT,BLNK) LGRP, INCR LINE IF (LINE.GT.8) GOTO GCK ;DONE WITH RECORD GET NEXT IN THE SAME GROUP WRITES (TT,BTEXT(LINE)) GOTO LGRP GCK, DISPLAY (TT,CRLF,'Type: E (end), Q (quit), P (print), S (skip groups), C/R to continue. ') READS (TT,OK) IF (OK.EQ.'E') GOTO CLEAR IF (OK.EQ.'Q') GOTO DONE IF (OK.EQ.'P') CALL PRINT DISPLAY (TT,UP) IF (OK.NE.'S') GOTO RGRP ;----------------------------------------------------------------------------------------------------------------------- ; READ THE USERS PRIVATE MESSAGES ;----------------------------------------------------------------------------------------------------------------------- GETPRI, GCODE = BINIT RP, ONERROR RP READ (1,GHEAD,GCODE) ;GET THE PRIVATE MESSAGE HEADER RECORD DES = GDESC ;LOAD THE GROUP DESCRIPTION WRITES (TT,DISPL) WRITES (TT,BLNK) DISPLAY (TT,'C/R to continue ') READS (TT,OK) ;----------------------------------------------------------------------------------------------------------------- CLOSE 1 XCALL FLAGS ('11001000') ;ENABLE CONT C,STOP,RUBOUT OPEN (1,SU,'ISM:BOARD.ISM') ;REOPEN IN UPDATE SO USER CAN DELETE HIS MESSAGES ONERROR ERR READ (1,GHEAD,GCODE) ;RE-READ THE PRIVAT HEADER RPRIV, ONERROR ERR LINE = 0 READS (1,BLINE,CLEAR) ;START READING THE PRIVATE MESSAGES OFFERROR IF (BCODE.NE.BINIT) GOTO CLEAR ;END OF THE USERS MESSAGES DISPLAY (TT,UP) MDATE = BDATE(3,6),'ZX/XX' MTIME = BTIME,'ZX:XX:XX' MDAYS = BDAYS MFROM = BFROM WRITES (TT,FRO) WRITES (TT,BLNK) LPRIV, INCR LINE IF (LINE.GT.8) GOTO MORE WRITES (TT,BTEXT(LINE)) GOTO LPRIV MORE, DISPLAY (TT,BELL,CRLF,'Type: E (end), Q (quit), P (print), K (kill), C/R to continue. ') READS (TT,OK) IF (OK.EQ.'E') GOTO CLEAR IF (OK.EQ.'Q') GOTO DONE IF (OK.EQ.'P') CALL PRINT IF (OK.EQ.'K') READ (1,BLINE,BKEY) ;THE VAX REQUIRES THIS RE-READ BEFORE A DELETE IF (OK.EQ.'K') DELETE (1,BKEY) GOTO RPRIV ;----------------------------------------------------------------------------------------------------------------------- ;----------------------------------------------------------------------------------------------------------------------- ; SEND MESSAGES TO ALL GROUPS, ONE GROUP OR AN INDIVIDUAL USER ;----------------------------------------------------------------------------------------------------------------------- ;----------------------------------------------------------------------------------------------------------------------- SEND, CLOSE 1 XCALL FLAGS ('01001000') ;RUBOUT DISPLAY (TT,DIS,34,32,CLEAR,'Select from the following to send your message to.',CRLF,LF & ,' -1- Owners -2- Managers',CRLF & ,' -3- Sales staff -4- Office staff',CRLF & ,' -5- Warehouse staff -6- "ALL" the above groups',CRLF & ,' -7- An individual system user',CRLF,LF,' Selection choice: up arrow to finish') CODE, BLINE = ;CLEAR THE MESSAGE AREA TRC = 'N1028010102' XCALL XINP IF (TCHAR.EQ.3) GOTO CLEAR ;UP ARROW TO BAIL OUT OF SENDING MESSAGES IF (DECMA.LE.0.OR.DECMA.GT.7) GOTO SEND ;BAD OPTION SELECTED XCALL FLAGS ('11001000') ;ENABLE CONT C,STOP,RUBOUT OPEN (1,SU,'ISM:BOARD.ISM') ;RE-OPEN IN UPDATE MODE BCODE = GRPA (DECMA) IF (DECMA.EQ.7) GOTO IND DAYS, DISPLAY (TT,DIS,44,41,'Select the number of days your message is to run: ') TRC = 'N1361010203' XCALL XINP DAYS = DECMA LOAD, BDATE(1,2) = DATE(5,6) ;BEGIN THE LOAD OF DATE, TIME, DAYS & SENDER BDATE(3,6) = DATE(1,4) BTIME = TIME BDAYS = DAYS BFROM = BINIT TEXT, DISPLAY (TT,DIS,43,32,' Type text here, 8 lines max. C/R past lines unused. ',BLANK,CRLF,BLANK) XCALL FLAGS ('11001010') ;ENABLE CONT C,STOP,RUBOUT,U/L LINE = 0 LINE, INCR LINE A1 = LINE DISPLAY (TT,DIS,44+LINE,32,'Line ',A1,' ') TRC = 'A1310006064' ROW = ROW + LINE XCALL XINP BTEXT (LINE) = INPUT IF (LINE.LT.8) GOTO LINE ;FILL ALL 8 ELEMENTS OF ARRAY WRITE, ONERROR WRITE ;LOOP IN CASE SOME ONE ELSE HAS RECORD LOCKED STORE (1,BLINE,BKEY) ;WRITE OUT THE TEXT RECORD OFFERROR XCALL FLAGS ('11001000') ;ENABLE CONT C,STOP,RUBOUT CLOSE 1 GOTO CLEAR ;------------------------------------------------------------------------------------------------------------------ IND, DISPLAY (TT,DIS,43,41,'Enter the individuals code you want to mail to: ',CLEAR) TRC = 'A1261020304' XCALL XINP ;----------------------------- FIND OUT WHO THIS TERMINAL IS ASSIGNED TO ----------------------------------------------------- OPEN (6,I,'FIL:BOARD.FIL') ;OPEN THE FILE OF TERMINAL ASSIGNMENTS ONERROR INDL ;LOOP IF RECORD LOCKED INDL, READS (6,NAMES,BADNAM) ;SCAN FOR TERMINAL, IF EOF REACHED QUIT, NOT IN TABLE IF (NCODE.EQ.';') GOTO INDL ;A COMMENT LINE, SKIP IT IF (NCODE.NE.INPUT) GOTO INDL ;NOT A MATCH OF INITIALS CODE CLOSE 6 ;FALL THRU ON A MATCH & CLOSE THE NAME FILE OFFERROR BCODE = INPUT ;GOOD CODES FALL THRU DAYS = 99 ;DEFAULT DAYS FOR PERSONAL MESSAGES GOTO LOAD ;START TO LOAD THE MESSAGE TO THE USER BADNAM, CLOSE 6 ONERROR CODES ;LOOP IF RECORD LOCKED OPEN (6,I,'FIL:BOARD.FIL') ;OPEN THE FILE OF TERMINAL ASSIGNMENTS DISPLAY (TT,DIS,45,32) ;POSITION CURSOR Y = 0 CODES, READS (6,NAMES,CODEND) ;SCAN THE NAME FILE IF (NCODE.EQ.';' .OR. NCODE.EQ.' ') GOTO CODES ;A COMMENT LINE, SKIP IT INCR Y IF (Y .EQ. 1) DISP(6,36) = NAMES ;LOAD THE FIRST HALF OF THE DISPLAY LINE IF (Y .EQ. 1) GOTO CODES ;GET THE SECOND ONE DISP(46,76) = NAMES ;LOAD THE SECOND HALF OF THE DISPLAY LINE WRITES (TT,DISP) ;DISPLAY 2 NAME CODES Y = 0 ;RE-SET THE COUNTER GOTO CODES ;LOOP BACK FOR MORE CODEND, CLOSE 6 OFFERROR SLEEP 2 ;GIVE THEM TIME TO READ THE DISPLAY GOTO IND ;LET THEM RETRY THE CODE ENTRY ;--------------------------------------------------------------------------------------------------------------------------------- ;----------------------------------------------------------------------------------------------------------------------- PRINT, PLINE = 1 DISPLAY (TT,DIS,54,32,'Select output device: (OPA0:) ',BLANK) READS (TT,DEV) IF (DEV.EQ.'TT:') DEV = 'TT' ;NO COLONS ALLOWED IN 'TT' IF (DEV.EQ.' ') DEV = 'OPA0:' ;DEFAULT DEVICE IS THE OP CONSOLE OPEN (LP,O:P,DEV) ;OPEN THE DEVICE SELECTED WRITES (LP,DISPL) WRITES (LP,BLNK) PL, WRITES (LP,BTEXT(PLINE)) ;WRITE TEST FROM ARRAY OUT TO PRINTER INCR PLINE IF (PLINE.LE.8) GOTO PL ;IF MORE TEXT AND NOT AT END OF ARRAY GET NEXT ELEMENT WRITES (LP,BLNK) CLOSE LP ;CLOSE PRINTER CHANNEL RETURN ;----------------------------------------------------------------------------------------------------------------------- REVDEL, CLOSE 1 XCALL FLAGS ('10001000') OPEN (1,SU,'ISM:BOARD.ISM') ;OPEN THE FILE IN UPDATE MODE KILL0, DISPLAY (TT,DIS,34,32,CLEAR,LF,LF,' Please wait while I find the messages you sent .. ') KILL1, ONERROR KILL1 READS (1,BLINE,CLEAR) ;START READING EVERY LINE IF (BFROM.EQ.'***'.OR.BFROM.EQ.'ZZZ') GOTO KILL1 ;IT IS A HEADER, OR A TRAILER NOT A MESSAGE ;----------------------- this line gives owners with clearance code of 1 authority to read/delete EVERYONES mail ------------- ; IF ((BFROM.NE.BINIT).AND.(BCLR.NE.1)) GOTO KILL1 ;NOT A MESSAGE SENT BY THIS USER OR NOT OWNER CLEARANCE ;------------------------------------------------------------------------------------------------------------------------------ ;----------------------- this line allows only the sender to read/delete HIS OWN mail ---------------------------------------- IF (BFROM.NE.BINIT) GOTO KILL1 ;NOT A MESSAGE SENT BY THIS USER ;------------------------------------------------------------------------------------------------------------------------------ OFFERROR LINE = 0 KILL2, INCR LINE DISPLAY (TT,DIS,39+LINE,42,BTEXT(LINE)) ;WE NOW HAVE A USER MESSAGE SO DISPLAY IT IF (LINE.LT.8) GOTO KILL2 ;DISPLAY ALL 8 LINES OF TEXT KILLOK, A5 = BDATE(3,6),'ZX/XX' A2 = BDAYS DISPLAY (TT,DIS,50,42,'FROM: ',BFROM,' TO: ',BCODE,' SENT: ',A5,' DAYS: ',A2, & DIS,53,42,'Do you want to delete this message? (N) ') READS (TT,OK) IF (OK.EQ.'Y') READ (1,BLINE,BKEY) ;THE VAX REQUIRES A RE-READ BEFORE A DELETE IF (OK.EQ.'Y') DELETE (1,BKEY) GOTO KILL0 ;----------------------------------------------------------------------------------------------------------------------- ERR, XCALL ERROR (ERNO,ERLN) IF (ERNO.EQ.40) SLEEP 2 IF (ERNO.EQ.40) GOTO RPRIV INPUT = ERNO DISPLAY (TT,CRLF,'ERROR: ',INPUT(1,4),BELL,CRLF) DONE, CLOSE 1 IF (BCHA.EQ.' ') STOP 'EXE:MENU' ;NO CHAIN SELECTED, GOT TO THE MENU BCHAIN(5,10) = BCHA ;TAKE THE CHAIN NAME FROM THE USERS FILE STOP BCHAIN