;***************************************************************************** ; EMAIL.M68 System EMAIL Dispatch Program ; ; Author: DAVE HEYLIGER - AMUS Staff ; ; NOTICE: This is PUBLIC DOMAIN software, FREE to any AMUS member ; ; Functions Provided: ; initialization - sets up user data when program first starts to run ; list mail - LISTs users mail. bright = NEW, dim = ALREADY READ ; list unread - LISTs users UNREAD mail ; read mail - READ NEW or ALREADY READ mail ; read unread - READ UNREAD mail ; delete mail - DELETE NEW or ALREADY READ mail ; delete unread - DELETE UNREAD mail ; send mail - SEND a message to a user ; vue - EDIT a NEW message to SEND with VUE ; file - SAVE a copy of your mail in a FILE in your PPN ; who - lists WHO is on. Bright = ONLINE, dim = OFFLINE ; bulk mail - SEND, DELETE, or CREATE bulk mailing packets ; auto reply - DEFINE or UPDATE AUTO REPLY ; quit - return to AMOS ; ; PROGRAMMER'S NOTES: ; + The AMUS EMAIL Package needs the following programs and files: ; EMAIL.M68 - what you see here ; MALINI.M68 - Program that runs during AMOSL.INI boot ; MAILOP.M68 - MAIL OPerator (SYSOP program, high priority) ; MAILON.M68 - Tracks who's on EMAIL ; MAILOF.M68 - Tracks who's off EMAIL ; WHOSON.M68 - Lists "who's on" your system ; EMAIL.MAN - User's Manual for EMAIL ; EMAIL.OPR - System Operator/programmers guide for EMAIL ; EMAIL.HSH - Hash code totals for the AMUS EMAIL package ; ; + The program was written with EASY MODIFICATION in mind. Therefore, ; "tricks and gizmos" were avoided and readable code the goal. You will ; notice "repeating code blocks", but again, this makes it easier for ; updates etc. ;***************************************************************************** SEARCH SYS ;grab required system files SEARCH SYSSYM SEARCH TRM AUTOEXTERN ;use $ODTIM, so LNKLIT EMAIL VMAJOR=1 ;original by DAVE HEYLIGER VMINOR=0 VEDIT=0 ;program header ; PHDR -1,0,PH$REE!PH$REU ;reentrant,reusable ;variables in user's memory partition ; .OFINI .OFDEF MEMPTR,4 ;^EMAIL.SYS in system memory .OFDEF CURLST,2 ;READ or UNREAD list flag .OFDEF YOU,4 ;yourself (your name) .OFDEF YOULOC,4 ;where you are in sys mem .OFDEF YOUREC,2 ;your record number in .DAT .OFDEF BLKUSR,4 ;number of blocks in EMAIL.USR .OFDEF NAME,4 ;other user name (SEND,UNREAD) .OFDEF THRLOC,4 ;other users loc. in sys mem .OFDEF THRREC,2 ;other user record number .DAT .OFDEF BLKPTR,4 ;pointer into bulk file data .OFDEF IDX,4 ;other guys IDX .OFDEF IDDB,D.DDB ;input DDB (or "one DDB") .OFDEF ODDB,D.DDB ;output DDB (or "another DDB") .OFDEF BLKDDB,D.DDB ;DDB for bulk mailing .OFDEF FB,2 ;first block of EMAIL.DAT .OFDEF FN,4 ;packed filename of msg .OFDEF EF,8. ;most recent edited filename .OFDEF SCRAP,90. ;scrap workspace .OFDEF TITLE,90. ;scrap for bulk title .OFDEF RADBUF,6 ;RAD50 scrap workspace .OFDEF FAKBLK,64. ;"fake" bulk workspace .OFDEF PACPTR,4 ;pointer to "real" bulk data .OFDEF LSTCMD,2 ;last command from bulk edit .OFDEF ASCBUF,8. ;ascii buffer .OFSIZ IMPSIZ ;MACRO definitions ; DEFINE PRTTAB AA,BB ;define PRTTAB (#,#) MOVB #'AA,D1 ;move in left number LSLW D1,#10 ;shift over MOVB #'BB,D1 ;place in next number TCRT ;perform call ENDM DEFINE CLRCTC ;clear control c JOBIDX A6 ;your JCB pointer MOVW #200,D7 ;^C flag value COMW D7 ;complement it ANDW D7,@A6 ;clear ctrlc ENDM DEFINE ONEKEY ;one keystroke on KBD into D1 PUSH A6 ;save used registers JOBIDX A6 ;get JOBIDX MOV JOBTRM(A6),A6 ;get JOBTRM status word ORW #T$IMI,@A6 ;one key entry POP A6 ;restore registers ENDM DEFINE MNYKEY ;many keys on KBD call (A2 ^) PUSH A6 ;save registers PUSH D4 MOVW #T$IMI,D4 ;get flag COMW D4 ;flip bits JOBIDX A6 ;your JCB pointer MOV JOBTRM(A6),A6 ;get JOBTRM status word ANDW D4,@A6 ;reset status word POP D4 ;restore reggies POP A6 ENDM DEFINE NOECHO ;makes keyboard entries "invisible" PUSH A1 ;black box PUSH A6 JOBIDX A6 ;give A6 the JOBIDX MOV JOBTRM(A6),A1 ;A1 points to the Terminal Status Word ORW #T$ECS,@A1 ;second bit now contains a "1" (no echo) POP A6 POP A1 ENDM DEFINE ECHO ;turns ECHO back on for keyboard input PUSH A6 ;black box PUSH A1 PUSH D4 JOBIDX A6 ;get the JOBIDX MOV JOBTRM(A6),A1 ;A1 points to the Terminal Status Word MOVW #T$ECS,D4 ;D4 contains 00000010 COMW D4 ;D4 contains 11111101 ANDW D4,@A1 ;second bit now contains a "0" POP D4 POP A1 POP A6 ENDM DEFINE DTAB ;special prttab function PRINT TAB (D4,D5) PUSH D1 ;black box MOV D4,D1 ;get row LSLW D1,#10 ;move over MOVB D5,D1 ;get column TCRT ;PRINT TAB (D4,D5) POP D1 ENDM DEFINE HOME=PRTTAB 1,10. ;where the cursor lives at EMAIL > DEFINE HOME2=PRTTAB 6,55 ;Bulk Mail Cursor's home DEFINE BRIGHT=PRTTAB -1,12. ;bright intensity terminal output DEFINE DIM=PRTTAB -1,11. ;dim intensity term. output DEFINE OFF=PRTTAB -1,36. ;screen off DEFINE ON=PRTTAB -1,37. ;screen on DEFINE ERASE=PRTTAB -1,10. ;erase to end of screen DEFINE COFF=PRTTAB -1,29. ;cursor off DEFINE CON=PRTTAB -1,28. ;cursor on DEFINE CLRLIN=PRTTAB -1,9. ;clear to end of line ;START OF EMAIL PROGRAM ; ;allow upper and lower case input throughout the program JOBIDX A6 ;upper/lower case allowed MOV JOBTRM(A6),A6 ;hard set this attribute ORW #T$ILC,@A6 ;like so ;various 1st time through setup GETIMP IMPSIZ,A3 ;A3 points to user var base MOVW #1,CURLST(A3) ;default list is mail sent CALL EMINI ;initialize user ONEKEY ;look for one keystroke CALL PASCHK ;check user password w/IDX CALL HEADER ;type out the screen header PRTTAB 1,45. ;tab to here TYPE ;let em know about help HOME ;go home BRIGHT ;bright cursor BR LP ;bypass lower bit 1st time ;The following LOOP is done over and over til you Q uit. ;Every instruction grouping below this LOOP are subroutines! ;Each subroutine has full "on entry: on exit" documentation. ; LOOP: HOME ;cursor to home CLRLIN ;clear to end of line LP: CLRCTC ;clear ctrlc ONEKEY ;reset for LOOPs benefit CALL GETFUN ;get user function into D1 CALL ANALIZ ;analize and act BR LOOP ;loop back to start of LOOP EXIT ;EMAIL INITIALIZATION Subroutine - does all sorts of .INI stuff ; on entry: user requested EMAIL program ; on exit: if user is defined on the system, then ; YOU, YOULOC, YOUREC contain correct values ; MEMPRT points to EMAIL.SYS ; BLKUSR contains number of blocks in EMAIL.DAT ; EF is nulled - no recently edited filename ;--------------------------------------------------------------- EMINI: CALL FNDMEM ;find EMAIL.SYS in sys mem ;get # of blocks in EMAIL.DAT @ 1st block + 508. of EMAIL.USR MOV MEMPTR(A3),A1 ;A1 points into system mem ADD #508.,A1 ;point to block count MOV @A1,BLKUSR(A3) ;save block count ;prompt for a password - must match MAILON accounting CRLF ;output a CRLF NOECHO ;no keystrokes echoed TYPE < Enter EMAIL password: > ;get password KBD ;expects a CR to terminate CTRLC BYEBYE ;if ^C then quit ECHO ;turn on echo LEA A1,SCRAP(A3) ;point to scrap workspace PACK ;pack the password name PACK ;setup name and offset for FNDVAR; look for user & cont. if found LEA A2,SCRAP(A3) ;point to var. to find MOV #4,D4 ;offset setup for FNDVAR sbr CALL FNDVAR ;see if password exists ;if user PASSWORD is not found, quit CMP @A2,#0 ;user found? (A0=0 means no) BNE 10$ ;yup, calculate offsets CRLF ;nope, output a CRLF EXIT ;and quit ;user found, store variables about user and check IDX w/JOB EMAILed 10$: SUB #4,A2 ;point to start of YOU MOV @A2,YOU(A3) ;save YOUr name MOV A2,YOULOC(A3) ;save pointer to you in .SYS MOVW 10(A2),YOUREC(A3) ;store your record number CLRB EF(A3) ;clear most recent edit file CALL PASCHK ;do user IDX's match up??? RTN ;yup - all systems go! ;else PASCHK blows you to dot ;HEADER Subroutine - Creates EMAIL program header ; on entry: EMAIL user has been given go-ahead ; on exit: EMAIL header (menu) is typed to the screen ;----------------------------------------------------------- HEADER: PRTTAB -1,0 ;clear screen LEA A2,MENU ;ascii data of menu TYPECR EMAIL > ;prompt is EMAIL > TYPE < > ;center line below 10$: BRIGHT ;bright output MOVB (A2)+,D1 ;get a character TTY ;type it in reverse DIM ;dim output 20$: MOVB (A2)+,D1 ;get next character TTY ;type out character CMPB @A2,#'- ;delimiter? BEQ 30$ ;yup, don't loop back BR 20$ ;nope, get next character 30$: CMPB 1(A2),#'. ;end of menu bar? (".") BNE 40$ ;nope, get next menu item RTN ;yup, return 40$: INC A2 ;not end of menu, bypass "-" TYPE < > ;space over JMP 10$ ;go to top of sbr MENU: ASCII /List,-Read,-Delete,-Unread,-Vue,-Send,-Bulk,-File,-Who,-Auto,-Quit-./ EVEN ;GET FUNCTION Subroutine - waits for user input of desired function ; on entry: menu typed out, user is prompted, ONEKEY keyboard mode ; on exit: D1 contains keystroke of user function ;------------------------------------------------------------------------ GETFUN: KBD ;get the one keystroke value CTRLC BYEBYE ;^C ends program UCS ;upper case the input RTN ;ANALYZE Subroutine - checks user input, acts according to input ; on entry: D1 contains user function keystoke in upper case ; on exit: function has been determined and executed ;------------------------------------------------------------------- ANALIZ: CMPB D1,#'L ;list? BNE MD ;nope, maybe Delete CALL LSTMAL ;list users mail RTN MD: CMPB D1,#'D ;delete? BNE MR ;nope, maybe Read CALL DELMAL ;delete mail message RTN MR: CMPB D1,#'R ;read? BNE MU ;nope, maybe Unread CALL REDMAL ;read mail message RTN MU: CMPB D1,#'U ;unread? BNE MS ;nope, maybe Send CALL URDMAL ;list unread mail RTN MS: CMPB D1,#'S ;send? BNE MF ;nope, maybe File CALL SNDMAL ;send mail file RTN MF: CMPB D1,#'F ;file? BNE MW ;nope, maybe Who CALL FILMAL ;make a file of a message RTN MW: CMPB D1,#'W ;who? BNE MB ;nope, maybe Bulk CALL WHOMAL ;list users currently on RTN MB: CMPB D1,#'B ;bulk mail send? BNE MA ;nope, maybe Auto CALL BLKMAL ;send bulk mail RTN MA: CMPB D1,#'A ;auto reply? BNE MN ;nope, maybe NEW CALL AUTO ;enter AUTO subroutine RTN MN: CMPB D1,#'V ;Vue? BNE MQ ;nope, maybe QUIT CALL VUEMAL ;create mail file with Vue RTN MQ: CMPB D1,#'Q ;quit? BNE MH ;nope, maybe help JMP BYEBYE ;yup, leave MH: CMPB D1,#'? ;help? BNE INERR ;nope, input error CALL HELP ;yup, help RTN INERR: CALL IE ;input error routine RTN ;LIST MAIL Subroutine - lists out mail in user's mailbox ; on entry: user chose the 'L' option ; on exit: users NEW or ALREADY READ mail listed to screen ;---------------------------------------------------------------- LSTMAL: TYPECR ;finish wording PRTTAB 4,1 ;tab here ERASE ;erase to end of screen MOVW #1,CURLST(A3) ;set current list variable CALL FNDDAT ;setup EMAIL.DAT ;lock your record block til we read in the values (bit set in sysmem) MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock your record block ;open EMAIL.DAT and read your record block OPENR @A4 ;open EMAIL.DAT CALL RYREC ;A1 now points to your record ;record has been read, unlock your particular block, close EMAIL.DAT MOV YOULOC(A3),A0 ;get memory location ADD #12,A0 ;point to semiphore CLRW @A0 ;free record CLOSE @A4 ;close file ;all mail is "far left", see if 1st slot in mailbox non-zero CMP 2(A1),#0 ;any mail??? BNE 10$ ;yup, got some mail TYPE < No messages. Bummer!> ;bummer message RTN ;return ;setup INPUT filespecs - everything except * of DSK0:*.MAL[7,2] 10$: LEA A5,ODDB(A3) ;A5 DDB for each mail msg MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:[7,2] *.MAL CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV #1,D4 ;list count set to at least 1 ;setup message count to check for "full screen" CLR D3 ;D3 holds number of msgs 20$: CMP D3,#6 ;full screen? BNE 25$ ;nope CALL FULSCR ;yup, give em the prompt ;get the "Q" or the "any key" if screen is full (from FULSCR) KBD ;get key CTRLC 50$ ;exit on ^C UCS ;upper case the responce CMPB D1,#'Q ;quit? JEQ 50$ ;yup PRTTAB 4,1 ;tab here ERASE ;clear screen ECHO ;echo back on BRIGHT ;bright output CLR D3 ;clear number of msgs on scrn ;NEW MAIL in bright output, OLD MAIL in dim output 25$: CMPW (A1)+,#1 ;new mail? BNE 30$ ;nope, dim output old stuff BRIGHT ;new mail in bright BR 40$ ;bypass line below 30$: DIM ;old mail in dim ;move in the * of *.MAL, type out letter header contained in *.MAL 40$: MOV (A1)+,ODDB+D.FIL(A3) ;set filename (* of *.MAL) CALL LTRHDR ;type out letter header ;if more mail, do it some more CMP 2(A1),#0 ;more mail? JEQ 50$ ;no more mail INC D3 ;one more message on the scrn INC D4 ;next message number ;warn them if msg number >= 30 (very conservative) CMP D4,#31. ;30 messages? JNE 45$ ;nope - however.... PRTTAB 22.,1 ;yup, tab to here DIM ;dim warning MOV #7,D1 ;get a bell TTY ;beep! TYPECR < Hey! Your mailbox is really FULL! You should delete some of this stuff!> BRIGHT ;back to regular JMP 20$ ;get next message 45$: CMP D4,#41. ;all messages out? JNE 20$ ;nope ;no more mail - reset user 50$: ECHO ;set echo BRIGHT ;bright output RTN ;return ;MAIL EDITOR Subroutine - this just gets you to VUE and back! ; on entry: user chose 'V' as option ; on exit: user has created (or quit) editing new mail msg with VUE. ; Message exists in user PPN (unless Q from within VUE) ;------------------------------------------------------------------------- VUEMAL: DIM ;low intensity HOME ;go home TYPE <6 characters total, CR to cancel.> ;instructions ;see if user has edited a file since EMAIL started LEA A2,EF(A3) ;get most recent filename CMPB @A2,#0 ;filename there? JEQ 1$ ;nope, bypass below ;found a file since EMAIL started, display most recently edited file PRTTAB 1,45. ;tab here TYPE <(Most recently edited file:> ;header TTYL @A2 ;type out filename TYPE <)> ;right paren ;misc functions before VUE prompt, then ask for a filespec 1$: BRIGHT ;restore to bright output MNYKEY ;setup KBD for many keys PRTTAB 4,1 ;move cursor here ERASE ;erase to end of screen PRTTAB 5,5 ;tab to here TYPE ;prompt user for filename 5$: KBD ;get filename CTRLC 40$ ;doesn't want to do this ;if just a CR and no filename, user has "canceled" VUE CMPB @A2,#15 ;just a cr? JEQ 40$ ;yup, didn't follow instructs. ;parse filename with FSPEC and error flags LEA A1,IDDB(A3) ;point to a DDB MOVB #D$ERC!D$BYP,IDDB+D.FLG(A3) ;set D$ERC bit (trap errors) FSPEC @A1,MAL ;get the filename CMPB IDDB+D.ERR(A3),#D$ESPC ;error? JEQ 50$ ;yup CMP IDDB+D.FIL(A3),#0 ;just a ".xxx"? JEQ 50$ ;yup, error MOVW #[MAL],IDDB+D.EXT(A3) ;hardset .MAL just in case ;look in BOX: for duplicate name - must enter unique name! MOVW #[DSK],IDDB+D.DEV(A3) ;DSK0:filename.MAL[7,2] CLRW IDDB+D.DRV(A3) MOVW #3402,IDDB+D.PPN(A3) LEA A4,IDDB(A3) INIT @A4 ;initialize DDB for above LOOKUP @A4 ;is it already in BOX:? JNE 10$ ;nope, AOK MOV #7,D1 ;yup, no dups allowed! TTY ;beep and instruct TYPECR < Darn the luck - someone has already used that filename!> TYPE < Enter another filename, like "GKCW" or something weird.> PRTTAB 5,30. ;tab here CLRLIN ;clear to end of line JMP 5$ ;and let them try another name ;now create an ascii line in memory that has "VUE_filespec"[CRLF]0 10$: LEA A2,SCRAP(A3) ;point to scrap buffer MOVB #'V,(A2)+ ;setup "VUE_" MOVB #'U,(A2)+ MOVB #'E,(A2)+ MOVB #' ,(A2)+ ;get the RAD50 filename from the DDB and convert to ASCII LEA A1,IDDB+D.FIL(A3) ;point to name UNPACK ;get the name UNPACK ;if less than 6 characters, backup 20$: CMPB -(A2),#40 ;space? BEQ 20$ ;nope, get the dot ;finally, move in .MAL extension INC A2 ;found end of filename MOVB #'.,(A2)+ ;move in extention MOVB #'M,(A2)+ ;.MAL MOVB #'A,(A2)+ MOVB #'L,(A2)+ MOVB #15,(A2)+ ;move in CR,LF,0 MOVB #12,(A2)+ CLRB @A2 ;filespec entered is unique, save A3, then VUE filespec 30$: PUSH A3 ;VUE wipes this guy out! PRTTAB 8.,1 ;tab down a few rows LEA A2,SCRAP(A3) ;point to "VUE file" AMOS ;VUE file..... POP A3 ;done with VUE, restore A3 CALL HEADER ;type out the HEADER ;now store the filespec in "most recently edited file" buffer space LEA A2,SCRAP(A3) ;point to "VUE filename" LEA A1,EF(A3) ;point to edited filename ADD #4,A2 ;bypass "VUE_" 33$: CMPB @A2,#'. ;look for the "." BEQ 35$ ;found it MOVB (A2)+,(A1)+ ;store filename, move pointers BR 33$ ;cont. til "." 35$: CLRB @A1 ;set "." to null 40$: BRIGHT ;bright RTN ;and return ;booboo on filespec entry 50$: MOV #7,D1 ;here when didn't follow inst. TTY ;beep and instruct TYPE < Whoops! Looks like an invalid filename to me.> BR 40$ ;and return ;DELETE UNREAD MAIL Subroutine - allows user to delete their unread mail ; on entry: user has chosen 'D' AND current list is UNREAD ; on exit: if UNREAD has the corresp. # to delete, msg is deleted ;--------------------------------------------------------------------------- DELURM: MNYKEY ;look for _#[cr] (D_#[cr]) KBD ;get the message number CTRLC 10$ ;go here on ^C PRTTAB 4,1 ;move cursor here ERASE ;clear out rest of screen BR 20$ ;and bypass RTN on ^C 10$: RTN ;end of DEL routine ;look for D_# - any other input is invalid 20$: CMPB @A2,#40 ;D_# allowed, look for _ BEQ 25$ ;found a space PRTTAB 7,5 ;cursor here MOV #7,D1 ;get bell TTY ;beep TYPE BR 10$ ;go here (RTN) ;space found, assume number after the space; get the number & parse 25$: INC A2 ;bypass space 30$: CLR D1 ;data registers fussy GTDEC ;get the message number in D1 BMI 10$ ;error on users end (no negs) CMP D1,#0 ;another error type (no "0") BEQ 40$ ;so get em out CMP D1,#40. ;no # >40. BLE 50$ ;it's not ;error on number input, give generic msg 40$: PRTTAB 7,5 ;cursor here (illegal input) TYPE JMP 10$ ;go here (RTN) ;message number MIGHT exist. Setup EMAIL.DAT for reading 50$: PUSH D1 ;save msg number on stack CALL FNDDAT ;setup EMAIL.DAT ;before reading your block, lock you record MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock it ;open EMAIL.DAT, read in your block number OPENR @A4 ;open EMAIL.DAT CALL RYREC ;read your record (A1 index) ;get the UNREAD message into FN variable - see if non-zero POP D1 ;retrieve message number PUSH A1 ;save pointer to start of blk ADD #240.,A1 ;point to UNREAD contents DEC D1 ;msg #1 offset is 0, etc.. MULS D1,#4 ;four bytes per message ADD D1,A1 ;point to message record MOV @A1,FN(A3) ;save filename CMP @A1,#0 ;message should be there BNE 60$ ;it is ;message not there - unlock record block, close EMAIL.DAT and return CLOSE @A4 ;it's not, close file MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record POP A1 ;restore stack JMP 40$ ;go here (don't care if gone) ;message there, bump unread msgs to left and then write new data 60$: POP A1 ;point to start of block CALL BUMPUR ;delete message from your rec WRITE @A4 ;write changes ;message deleted from your UNREAD, unlock your record block MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record ;now look for the file in the BOX: account LEA A5,ODDB(A3) ;A5 points to msg DDB MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:*.MAL[7,2] CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV FN(A3),ODDB+D.FIL(A3) ;* of *.MAL INIT @A5 ;initialize DDB LOOKUP @A5 ;mail message there? BEQ 70$ ;yup ;hmmm, file is not there. Produce error message and return TYPE < > ;nope, error message PRNAM ODDB+D.FIL(A3) ;type FILENAME TYPE < is not found - UNREAD FILE NOT FOUND FOR DELETE UNREAD> JMP 10$ ;error msg and then go here ;ok, found the actual file, open it up and get WHO SENT TO 70$: OPENI @A5 ;open file FILINL @A5 ;read FROM: FILINL @A5 ;read TO: MOV D1,NAME(A3) ;save TO: CLOSE @A5 ;that's all we needed ;find this individuals name to get data stats LEA A2,NAME(A3) ;setup for FNDVAR CLR D4 ;similar...(offset is 0) CALL FNDVAR ;find user CMP A2,#0 ;find the guy? BNE 80$ ;yup JMP 10$ ;nope, so return (user gone) ;save the stats, lock THEIR record block and read it 80$: MOV A2,THRLOC(A3) ;save pointer in mem MOV 10(A2),THRREC(A3) ;get there block into var MOV A2,A0 ;get pointer to A0 ADD #12,A0 ;setup for LOCREC CALL LOCREC ;lock record CALL RTREC ;read their record ;look for this file in there NEW mailbox...it's there somewhere CLR D1 ;byte counter 90$: CMM 2(A1),FN(A3) ;found match yet? BEQ 100$ ;yup ADD #6,D1 ;nope, increment byte count ADD #6,A1 ;point to next record BR 90$ ;and look for it ;found the file, bump all stats to the left (overwriting this file) 100$: CALL BUMPYM ;delete the message found WRITE @A4 ;write changes ;file deleted and recorded as so, unlock their block, close and return MOV THRLOC(A3),A0 ;get pointer to mem ADD #12,A0 ;point to semi CLRW @A0 ;free record CLOSE @A4 ;close EMAIL.DAT ;finally, delete the message off of BOX: and return CALL DELBOX ;message erased off of BOX: RTN ;and return ;DELETE MAIL Subroutine - allows user to delete their mail ; on entry: user chose 'D' option and NEW/ALREADY READ mail is cur.list ; on exit: if corresp. # exists, message is deleted ;---------------------------------------------------------------------------- DELMAL: CMPW CURLST(A3),#1 ;LIST is current? BEQ 10$ ;yup CALL DELURM ;nope, delete UNREAD mail RTN ;and return ;setup many input KBD, misc cleanup before routine 10$: MNYKEY ;look for _#[cr] KBD ;get the message number CTRLC 20$ ;go here on ^C PRTTAB 4,1 ;move cursor here ERASE ;clear out rest of screen BR 30$ ;else bypass ^C stuff 20$: RTN ;end of READ routine ;look for D_# by checking for the "_", bypass space if entered 30$: CMPB @A2,#40 ;D_# allowed, look for _ BEQ 35$ ;found a space PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE BR 20$ ;go here 35$: INC A2 ;bypass space ;assume next value is a number, get the number and parse it 40$: CLR D1 GTDEC ;get the message number in D1 BMI 20$ ;error on users end CMP D1,#0 ;another error type BEQ 50$ ;so get em out CMP D1,#40. ;can't be more than this BLE 60$ ;it's not 50$: PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE JMP 20$ ;go here ;setup EMAIL.DAT for input, save the msg number 60$: PUSH D1 ;save msg number CALL FNDDAT ;setup EMAIL.DAT ;lock your record block before you read it in MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock it ;open EMAIL.DAT and read your block number OPENR @A4 ;open EMAIL.DAT CALL RYREC ;read your record (A1 index) ;calculate the message to be deleted, make sure it's there POP D1 ;retrieve message number DEC D1 ;msg #1 offset is 0, etc.. MULS D1,#6 ;six bytes per message ADD D1,A1 ;point to message record CMP 2(A1),#0 ;message should be there BNE 70$ ;it is ;message not there, free your record block and inform user not there CLOSE @A4 ;it's not, close file MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record JMP 50$ ;go here ;make sure the user has read the message 70$: CMPW @A1,#1 ;read it yet?? BNE 80$ ;yes you have MOV #7,D1 ;get a bell TTY TYPE < I'm not going to let you delete a message you haven't READ.> MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record CLOSE @A4 ;close EMAIL.DAT RTN ;and return ;user has read the message, get filename and then "bump" over it 80$: MOV 2(A1),FN(A3) ;get the filename CALL BUMPYM ;bump your mail to the left WRITE @A4 ;write changes ;message deleted, free your block and close EMAIL.DAT 90$: MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record CLOSE @A4 ;close EMAIL.DAT ;delete message off of BOX: and return CALL DELBOX ;erase the file from BOX: RTN ;and return ;BUMP YOUR MAIL Subroutine - bumps all your mail to "the left" ; on entry: A1 points to msg in block needing the delete ; D1 contains number of bytes into record ; on exit: message deleted ;------------------------------------------------------------------------ BUMPYM: PUSH D1 ;save reggies PUSH A1 ;find message, then bump all others on the right to the left 10$: CMP D1,#240. ;end of LIST? BEQ 20$ ;yup MOVW 6(A1),(A1)+ ;bump read/unread flag MOV 6(A1),(A1)+ ;bump filename CMP 2(A1),#0 ;end of files? BEQ 30$ ;yup ADD #6,D1 ;D1 6 more bytes inside rec. BR 10$ ;bump again ;if it is the last message of the 40 allowed, just clear it no bump 20$: CLRW -6(A1) ;must have been msg #40 CLR -4(A1) ;so clear it out ;all done, restore registers 30$: POP A1 ;restore reggies POP D1 RTN ;and return ;READ MAIL Subroutine - allows user to read their mail ; on entry: user chose 'R' option ; on exit: message presented to screen if it exists ;--------------------------------------------------------- ; check which list is current list and branch accordingly REDMAL: CMPW CURLST(A3),#1 ;LIST is current? BEQ 10$ ;yup, bypass below CALL REDURD ;nope, read UNREAD mail RTN ;and return ;misc setup before the actual message reading 10$: MNYKEY ;look for _#[cr] KBD ;get the message number CTRLC 20$ ;go here on ^C PRTTAB 4,1 ;move cursor here ERASE ;clear out rest of screen BR 30$ ;else bypass ^C stuff 20$: RTN ;end of READ routine ;look for the "_" in "R_#" , continue if found, error if not 30$: CMPB @A2,#40 ;R_# allowed, look for _ BEQ 35$ ;found a space PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE BR 20$ ;go here 35$: INC A2 ;bypass space ;assume a number follows space, get it and parse it 40$: CLR D1 GTDEC ;get the message number in D1 BMI 20$ ;error on users end CMP D1,#0 ;another error type BEQ 50$ ;so get em out CMP D1,#40. ;no more than this allowed BLE 60$ ;within range 50$: PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE JMP 20$ ;go here ;save the message number, setup EMAIL.DAT for input 60$: PUSH D1 ;save msg number CALL FNDDAT ;setup EMAIL.DAT ;lock your record block before reading in the record MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock it ;open EMAIL.DAT for processing, read in your record block OPENR @A4 ;open EMAIL.DAT CALL RYREC ;read your record (A1 index) ;calculate the exact location in the block where message exists MOV (SP),D1 ;retrieve message number DEC D1 ;msg #1 offset is 0, etc.. MULS D1,#6 ;six bytes per message ADD D1,A1 ;point to message record CMP 2(A1),#0 ;message should be there BNE 70$ ;it is ;message not found, free record and inform user not there CLOSE @A4 ;it's not, close file MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record POP D1 ;adjust stack JMP 50$ ;go here ;found message, clear the NEW flag - next time dim output, write chgs 70$: CLRW (A1)+ ;clear new flag MOV @A1,FN(A3) ;save filename WRITE @A4 ;write changes ;done reading block, let others update it now if they want MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record ;retrieve the message number and type out the header info in msg POP D4 ;get message number CALL LSTHDR ;header out, find senders name ;we know senders name now, so find them CLR D4 ;setup for FNDVAR LEA A2,NAME(A3) ;simliar.... CALL FNDVAR ;find senders name (A2 index) ;store senders stats and lock their record block (to delete UNREAD) CMP @A2,#0 ;find user? JEQ 80$ ;user deleted, bypass below MOV A2,THRLOC(A3) ;save there sys mem location MOVW 10(A2),THRREC(A3) ;save there record number MOV A2,A0 ;get there mem.loc ADD #12,A0 ;point to there resource CALL LOCREC ;lock there resource ;read in there block, delete the UNREAD message from there record CALL RTREC ;read there record (A1 index) CALL BUMPUR ;delete & bump unread msg WRITE @A4 ;write changes ;UNREAD message has been READ, free there resource, close EMAIL.DAT MOV THRLOC(A3),A0 ;point to there memory loc ADD #12,A0 ;point to the resource CLRW @A0 ;free resource 80$: CLOSE @A4 ;close EMAIL.DAT ;type out the mail message user desires CALL TYPMSG ;type out mail msg RTN ;and return ;READ UNREAD MAIL Subroutine - allows user to read their unread mail ; on entry: user chose 'R' option - UNREAD list is current list ; on exit: message typed to screen if it exists ;---------------------------------------------------------------------- REDURD: MNYKEY ;look for _#[cr] KBD ;get the message number CTRLC 10$ ;go here on ^C PRTTAB 4,1 ;move cursor here ERASE ;clear out rest of screen BR 20$ ;else bypass ^C stuff 10$: RTN ;look for the "_" in "R_#", bypass it if found, error if not found 20$: CMPB @A2,#40 ;R_# allowed, look for _ BEQ 25$ ;found a space PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE BR 10$ ;go here 25$: INC A2 ;bypass space ;assume number to follow, get it and parse 30$: CLR D1 GTDEC ;get the message number in D1 BMI 10$ ;error on users end CMP D1,#0 ;another error type BEQ 40$ ;so get em out CMP D1,#40. ;cant be more than this BLE 50$ ;it's not 40$: PRTTAB 7,5 ;cursor here MOV #7,D1 ;get a bell TTY ;beep TYPE JMP 10$ ;go here ;save the msg number and open EMAIL.DAT for processing 50$: PUSH D1 ;save msg number CALL FNDDAT ;setup EMAIL.DAT ;lock your record block before the read MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock it ;read your record block and then close EMAIL.DAT, free your block OPENR @A4 ;open EMAIL.DAT CALL RYREC ;read your record (A1 index) CLOSE @A4 ;close EMAIL.DAT back up MOV YOULOC(A3),A0 ;get your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free record ;calculate exact location in block where msg exists - see if there MOV (SP),D1 ;retrieve message number DEC D1 ;msg #1 offset is 0, etc.. ADD #240.,A1 ;point to UNREAD area MULS D1,#4 ;four bytes per message ADD D1,A1 ;point to message record CMP @A1,#0 ;message should be there BNE 60$ ;it is POP D1 ;it's not, adjust stack JMP 40$ ;go here (it's not valid #) ;get the filename of the message number - type out the header info 60$: MOV @A1,FN(A3) ;set filename up POP D4 ;set message number up CALL URDHDR ;header out ;if this guy has been deleted, you should best delete this message CLR D4 ;setup for FNDVAR LEA A2,NAME(A3) ;similar... CALL FNDVAR ;find TO's name (A2 index) CMP @A2,#0 ;find user? BNE 70$ ;yup CRLF ;nope, user has been deleted MOV #7,D1 ;get a bell TTY ;beep TYPE < User has been deleted - please Delete this message> BR 80$ ;and clean up ;let them see the message anyway by typing it out 70$: CALL TYPMSG ;type out mail msg 80$: RTN ;and return ;TYPE MESSAGE Subroutine - types out mail message w/ flow control ; on entry: Next FILINB is first valid byte of message in COM format ; A5 indexes the DDB of the file ; on exit: Message typed out, file closed ;------------------------------------------------------------------------- TYPMSG: PUSH D1 ;save reggies PUSH D2 ;setup for "Quit or any key to continue" + misc setup ONEKEY ;setup for flow control 1$: MOV #20,D2 ;allow 14 rows of text PRTTAB 7,1 ;cursor alway starts here ;read file byte-by-byte, flip the bits and type out til screen full 5$: FILINB @A5 ;get next byte TST ODDB+D.SIZ(A3) ;eof? JEQ 40$ ;yup COMB D1 ;nope, complement CMPB D1,#15 ;cr? BEQ 10$ ;yup TTY ;nope, type it out BR 5$ ;do it again 10$: FILINB @A5 ;bypass LF TST ODDB+D.SIZ(A3) ;eof? JEQ 40$ ;yup CRLF ;output a 15,12 DEC D2 ;one less row allowed BNE 5$ ;get next line CALL FULSCR ;screen full, prompt user ;see if Q or any key hit and act accordingly KBD ;get key CTRLC 40$ ;exit on ^C UCS ;upper case the responce CMPB D1,#'Q ;quit? BEQ 40$ ;yup PRTTAB 7,1 ;tab here ERASE ;clear screen BRIGHT ;message is bright ECHO ;echo back on JMP 1$ ;do it again ;if Q or message done typing out, close file and cleanup 40$: CLOSE @A5 ;close up file BRIGHT ;bright cursor ECHO ;echo on POP D2 ;restore, return POP D1 RTN ;BUMP UNREAD Subroutine - seeks out UNREAD message, deletes it, and bumps ; all others "to the left". ; on entry: A1 points to SENDERs data block. ; FN(A3) holds filename of message ; on exit: message deleted, UNREADs bumped ; A1 points to SENDERs data block ;------------------------------------------------------------------------ BUMPUR: PUSH D1 ;save reggies PUSH A1 ;40 UNREAD msgs max, offset into block is 240. MOV #40.,D1 ;number of looks ADD #240.,A1 ;point to unread portion ;scan block for message until found or not - quit on not found 5$: CMM @A1,FN(A3) ;match? BEQ 10$ ;yup ADD #4,A1 ;nope, point to next record DEC D1 ;one less record to scan BNE 5$ ;if not 0, look again BR 30$ ;else UNREAD not found (ok) 10$: CMP D1,#1 ;last record? BNE 20$ ;nope CLR @A1 ;yup, clear it out BR 30$ ;bypass below ;message found, bump all msgs on right left by one slot 20$: MOV 4(A1),(A1)+ ;bump (overwrite) DEC D1 ;one less record to bump CMP @A1,#0 ;all done early? BNE 10$ ;nope ;restore and return 30$: POP A1 ;restore/return POP D1 RTN ;LIST MESSAGE HEADER Subroutine - types out mail message header and records ; Senders name (assumes LIST is current list) ; on entry: FN(A3) contains filename of message to be read ; on exit : SENDERs name found, header typed to screen ; A5 is the DDB index for the message file, next FILINB ; is the first character of the message. ;---------------------------------------------------------------------- LSTHDR: PUSH D1 ;save originals PUSH A1 ;setup DSK0:FILENAME.MAL[7,2] and look for it LEA A5,ODDB(A3) ;A5 points to msg DDB MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:*.MAL[7,2] CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV FN(A3),ODDB+D.FIL(A3) ;* of *.MAL INIT @A5 ;initialize DDB LOOKUP @A5 ;mail message there? BEQ 10$ ;yup ;didn't find it - let em know, clean up and return TYPE < > ;nope, error message PRNAM ODDB+D.FIL(A3) ;type FILENAME TYPE < is not found - LIST COULD NOT FIND FILE IN BOX:> POP A1 ;restore/return POP D1 RTN ;found message, type out the header 10$: PRTTAB 4,1 ;cursor here DIM ;dim report TYPE < From: > ;who from OPENI @A5 ;open up the file FILINL @A5 ;get RAD50 sender LEA A1,RADBUF(A3) ;point A1 to buffer MOV D1,@A1 ;A1 points to sender MOV @A1,NAME(A3) ;store it too CALL TYPNAM ;type out senders name TYPE < Message #> ;show user msg # MOV D4,D1 ;setup for DCVT DCVT 2,OT$TRM!OT$ZER ;type out message number FILINL @A5 ;bypass TO: FILINL @A5 ;bypass DATE FILINL @A5 ;bypass TIME PRTTAB 5,1 ;tab over TYPE ;senders title 20$: FILINB @A5 ;get title COMB D1 ;flip data CMPB D1,#15 ;[CR]? BEQ 30$ ;yup TTY ;nope, type it out BR 20$ ;get next byte 30$: FILINB @A5 ;comply with "on exit" POP A1 ;restore stack/return POP D1 BRIGHT ;back to bright output RTN ;LIST UNREAD MESSAGE HEADER Subroutine - types out mail message header ; (assumes UNREAD list is current list) ; on entry: FN(A3) contains filename of message to be read ; D4 contains message number of unread message ; on exit : A5 is the DDB index for the message file, next FILINB ; is the first character of the message. ;---------------------------------------------------------------------- URDHDR: PUSH D1 ;save originals PUSH A1 ;setup DSK0:FILENAME.MAL[7,2] and look for it LEA A5,ODDB(A3) ;A5 points to msg DDB MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:*.MAL[7,2] CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV FN(A3),ODDB+D.FIL(A3) ;* of *.MAL INIT @A5 ;initialize DDB LOOKUP @A5 ;mail message there? BEQ 10$ ;yup ;didn't find the file - inform and return TYPE < > ;nope, error message PRNAM ODDB+D.FIL(A3) ;type FILENAME TYPE < is not found - LIST UNREAD COULD NOT FIND FILE IN BOX:> POP A1 POP D1 RTN ;found the file, type out the header information 10$: PRTTAB 4,1 ;cursor here DIM ;dim report TYPE < To: > ;who from OPENI @A5 ;open up the file FILINL @A5 ;bypass RAD50 sender FILINL @A5 ;read TO in RAD50 LEA A1,RADBUF(A3) ;point A1 to buffer MOV D1,@A1 ;A1 points to sender MOV @A1,NAME(A3) ;store it too CALL TYPNAM ;type out senders name TYPE < Message # > ;give user message number MOV D4,D1 ;D1 hold count DCVT 2,OT$TRM!OT$ZER ;type out message number FILINL @A5 ;bypass DATE FILINL @A5 ;bypass TIME PRTTAB 5,1 ;tab over TYPE ;senders title 20$: FILINB @A5 ;get title COMB D1 ;flip data CMPB D1,#15 ;[CR]? BEQ 30$ ;yup TTY ;nope, type it out BR 20$ ;get next byte 30$: FILINB @A5 ;comply with "on exit" POP A1 ;restore stack POP D1 BRIGHT ;bright output RTN ;UNREAD MAIL Subroutine - lists out all UNREAD mail in user's box ; on entry: user chose R_# and UNREAD is current list ; on exit: user sees list of all unread messages in header format ;----------------------------------------------------------------------- URDMAL: TYPECR ;finish wording PRTTAB 4,1 ;tab here ERASE ;clear to end of screen MOVW #2,CURLST(A3) ;set unread mail as current CALL FNDDAT ;setup EMAIL.DAT ;lock your record, read in record MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock your record block OPENR @A4 ;open EMAIL.DAT CALL RYREC ;A1 now points to your record ;point to UNREAD section @ 240. bytes into record - see if any UNREAD ADD #240.,A1 ;point to unread portion CMP @A1,#0 ;any unread mail??? BNE GS ;yup, got some unread mail ;all mail has been read that you sent CLOSE @A4 ;close file (no mail) MOV YOULOC(A3),A0 ;get memory location ADD #12,A0 ;point to semiphore CLRW @A0 ;free record TYPE < All of your messages have been read.> ;unread status PRTTAB 1,9. ;tab here CLRLIN ;erase to end of line RTN ;return ;setup count of msgs on the screen - check for full screen GS: MOV #1,D4 ;list count GSUM: CLR D3 ;D3 holds # of msgs on screen DEDA5U: CMP D3,#6 ;screen full? BNE 10$ ;nope CALL FULSCR ;yup, prompt for input ;get the "Q" or the "any key" if screen is full KBD ;get key CTRLC NMUM ;exit on ^C UCS ;upper case the responce CMPB D1,#'Q ;quit? JEQ NMUM ;yup PRTTAB 4,1 ;tab here ERASE ;clear screen CLR D3 ;clear number of msgs on scrn BRIGHT ;bright output ;list out UNREAD mail message headers til all listed 10$: LEA A5,ODDB(A3) ;A5 dedicated MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:[7,2] CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV (A1)+,ODDB+D.FIL(A3) ;set filename CALL URLTHD ;unread letter header CMP @A1,#0 ;more unread mail? BEQ NMUM ;no more unread mail INC D4 ;next message number INC D3 ;screen count incremented BR DEDA5U ;get next unread message ;list done, close file, free record, and return NMUM: CLOSE @A4 ;close EMAIL.DAT MOV YOULOC(A3),A0 ;get memory location ADD #12,A0 ;point to semiphore CLRW @A0 ;free record BRIGHT ECHO RTN ;return ;SEND MAIL Subroutine - sends encoded VUE file to end-user if found. ; Initial file must be in the account you are logged into. ; Sends "encoded" file to the BOX: account - DSK0:[7,2] ; Deletes the initial file after mailing from the user PPN ;---------------------------------------------------------------- SNDMAL: DIM ;instructions are dim PRTTAB -1,5 ;left one column TYPE < Type CR to cancel the SEND> ;instructions CALL MREF ;type out most recent file ;clear rest of screen before sending PRTTAB 4,1 ;clear to end of screen ERASE ;user inputs user, CR means "didn't want to do this" 5$: PRTTAB 5,5 MNYKEY ;reset terminal status word TYPE < TO: > KBD CTRLC LOOP CMPB @A2,#15 ;just a CR? BNE 10$ ;nope, continue CALL RESET ;yup, clean up JMP LOOP ;and goto top ;more than just a CR, get the user into a variable 10$: LEA A1,NAME(A3) ;point to RAD50 workspace PACK ;pack the name PACK ;look for the user - can't send it to just anybody! CLR D4 ;setup for FNDVAR LEA A2,NAME(A3) ; " " " CALL FNDVAR ;look for user CMP @A2,#0 ;find user? BNE GUOS ;yup, get user offsets ;user wasn't found, let them try again PRTTAB 5,15. ;nope, move cursor here CLRLIN ;clear out incorrect entry BR 5$ ;and try again ;user found, record there valid stats GUOS: MOV A2,THRLOC(A3) ;save pointer to user in mem MOVW 10(A2),THRREC(A3) ;store other's record number ADD #14,A2 ;point to IDX slots CMP @A2,#0 ;IDX there? BNE 10$ ;yup, save it ADD #4,A2 ;nope, maybe next slot CMP @A2,#0 ;IDX there? BNE 10$ ;yup, save it ADD #4,A2 ;nope, point to next slot 10$: MOV @A2,IDX(A3) ;store IDX of other guy ;set up to files: file to read (send) and file encripted (sent) DDBS: LEA A4,IDDB(A3) ;A4 points to file to send LEA A5,ODDB(A3) ;A5 points to trans. file ;ask user for the file to send PRTTAB 6,5 ;prompt for filename ERASE ;erase "not found" msg TYPE ;should be .MAL extension ;get the file - don't need to parse cuz LOOKUP won't find garbage FNINP: KBD ;get it CTRLC LOOP ;^C cleans up and back to top CMPB @A2,#15 ;just a CR? BNE 10$ ;nope, continue CALL RESET ;yup, clean up JMP LOOP ;and goto top ;FSPEC traps errors for us... 10$: MOVB #D$ERC!D$BYP,IDDB+D.FLG(A3) ;set D$ERC bit (trap errors) FSPEC @A4,MAL ;get the filename CMPB IDDB+D.ERR(A3),#D$ESPC ;error? BNE 20$ ;nope MOV #7,D1 ;get a bell TTY ;beep TYPE < Whoops! Looks like an invalid filename.> RTN ;and return ;hard set DSK#:PPN of user sending the file into the DDB variable 20$: JOBIDX A6 ;hard set some stats MOVW JOBDEV(A6),IDDB+D.DEV(A3) ;DSK#:[PPN] MOVW JOBDRV(A6),IDDB+D.DRV(A3) MOVW JOBUSR(A6),IDDB+D.PPN(A3) ;look for file entered - see if it exists in BOX: account MOV IDDB+D.FIL(A3),ODDB+D.FIL(A3) ;setup DDB for BOX: account MOVW IDDB+D.EXT(A3),ODDB+D.EXT(A3) INIT @A4 ;initailize input DDB LOOKUP @A4 ;file found? JEQ FNDFIL ;yup PRTTAB 24.,1 ;nope, tab here MOV #7,D1 ;BEEP TTY TYPE < ?file not found - check spelling or create file with VUE > PRTTAB 6,15. ;cursor to filename CLRLIN ;clear out filename MNYKEY ;adjust terminal status word JMP FNINP ;ask for file again ;set file to be sent to BOX: with hard stats - look for duplicates FNDFIL: MOVW #[DSK],ODDB+D.DEV(A3) ;setup DSK0:filename.ext CLRW ODDB+D.DRV(A3) ;"0" MOVW #[MAL],ODDB+D.EXT(A3) ;hardset .MAL extension MOVW #3402,ODDB+D.PPN(A3) ;[7,2] INIT @A5 ;initialize DDB LOOKUP @A5 ;same file exist in BOX:? JNE DUP ;no duplicate mail file MOV #7,D1 ;BEEP TTY TYPECR < ?file found in BOX: account with same name - cannot send> TYPE < Please exit from EMAIL, RENAME the file and reSEND > RTN ;and return ;save the file in FN variable DUP: MOV ODDB+D.FIL(A3),FN(A3) ;save packed filename ;ask the user for a "title" to the message being sent NDMF: PRTTAB 7,8. ;prompt user for a title TYPE MNYKEY ;expect many keystrokes KBD ;get title CTRLC LOOP ;clean up and top on ^C JOBIDX A6 PUSHW JOBUSR(A6) PUSHW JOBDEV(A6) PUSHW JOBDRV(A6) MOVW #[DSK],JOBDEV(A6) MOVW #0,JOBDRV(A6) MOVW #402,JOBUSR(A6) ;before sending the file, record FROM, TO, DATE, TIME GETOL: OPENO @A5 ;and encoded output file MOV YOU(A3),D1 ;store FROM (for LIST) FILOTL @A5 ;store name MOV NAME(A3),D1 ;store TO (for UNREAD) FILOTL @A5 ;write it GDATES D1 ;get the date FILOTL @A5 ;store it GTIMES D1 ;get the time FILOTL @A5 ;store it ;if title entered, write this in the file at this time (bits flipped) 10$: CMPB @A2,#15 ;one liner just CR? BNE 20$ ;nope, user entered 1-liner LEA A2,ONLNER ;yup, get "Untitled" 1-liner 20$: MOV #60.,D5 ;counter for length 25$: MOVB (A2)+,D1 ;get the one liner CMPB D1,#15 ;CR? BEQ OLCRLF ;yup COMB D1 ;flip byte FILOTB @A5 ;write one liner DEC D5 ;one less character to do BNE 25$ ;and do it again if room OLCRLF: MOV #15,D1 ;get the CR COMB D1 ;flip it FILOTB @A5 ;write it MOV #12,D1 ;get a LF COMB D1 ;flip it FILOTB @A5 ;write it ;now send the actual file data over, flipping bits as you send CONFIL: OPENI @A4 ;open original file for input SIT: FILINB @A4 ;get file byte-by-byte TST IDDB+D.SIZ(A3) ;if eof BEQ AEOF ;then branch to at eof COMB D1 ;flip the bit FILOTB @A5 ;write it BR SIT ;still in translation ;file sent, close both files AEOF: CLOSE @A4 ;else close the files CLOSE @A5 ;setup EMAIL.DAT, lock recipients record CALL FNDDAT ;setup EMAIL.DAT SEMIT: MOV THRLOC(A3),A0 ;get there memory location ADD #12,A0 ;point to resource CALL LOCREC ;lock the record ;read their record and display AUTO REPLY to sender OPENR @A4 ;open random file PRTTAB 9.,7 ;where AUTO reply will start LEA A1,NAME(A3) ;point to user name CALL TYPNAM ;type out users name CALL RTREC ;read THEIR record (A1 index) PUSH A1 ;save A1 index ADD #400.,A1 ;point to start of auto TYPE <: > ;setup for auto reply CALL TYPAUT ;type out there auto reply POP A1 ;restore A1 index MOV THRLOC(A3),A0 ;get memory location ADD #12,A0 ;point to semiphore CLRW @A0 ;free record ;online = BRIGHT , offline = DIM DIM ;dim output CMP 2(A0),#0 ;user on-line? BEQ 10$ ;nope TYPE < (on-line)> ;let user know person on line BR 20$ ;bypass below 10$: TYPE < (not on-line)> ;user not on line 20$: BRIGHT ;reset display ;after AUTO reply, update NEW MAIL in their record if space MOV #40.,D2 ;40 records allowed LFFR1: CMP 2(A1),#0 ;found free record? BEQ FFR1 ;yup, A1 points to free space DEC D2 ;one less record space BEQ FBOX ;full mailbox! ADD #6,A1 ;else try next space BR LFFR1 ;look for free record FBOX: MOV #7,D1 ;get a bell TTY ;beep CRLF CRLF TYPECR < ?User MAILBOX full - file NOT sent> CLOSE @A4 ;close EMAIL.DAT DSKDEL @A5 ;erase file sent JOBIDX A6 POPW JOBDRV(A6) POPW JOBDEV(A6) POPW JOBUSR(A6) RTN ;space in user record, record NEW flag and FILENAME FFR1: MOV FN(A3),2(A1) ;store filename MOVW #1,(A1) ;set NEW flag WRITE @A4 ;write new contents ;now lock your SEMIY: MOV YOULOC(A3),A0 ;update your block ADD #12,A0 ;setup for LOCREC CALL LOCREC ;lock record block ;after reading record, unlock your block CALL RYREC ;read your block MOV YOULOC(A3),A0 ;free resource ADD #12,A0 ;we've seen this before... CLRW @A0 ;get to unread portion of data ADD #240.,A1 ;point to UNREAD portion ;look for a free slot (up to 40 allowed) MOV #40.,D2 ;40 records allowed LFFR: CMP @A1,#0 ;found free record? BEQ FFR ;yup, A1 points to free space DEC D2 ;one less record space BEQ FULBOX ;full mailbox! ADD #4,A1 ;else try next space BR LFFR ;look for free record ;if UNREAD full, file sent but not recorded in YOUR UNREAD FULBOX: MOV #7,D1 ;get a bell TTY ;beep CRLF TYPECR < ?User UNREAD mailbox full - file sent but not recorded in UNREAD> BR NC ;bypass below ;found a slot, store the name and close the file FFR: MOV FN(A3),@A1 ;store filename WRITE @A4 ;write new contents NC: CLOSE @A4 ;close the file JOBIDX A6 POPW JOBDRV(A6) POPW JOBDEV(A6) POPW JOBUSR(A6) ;beep the user - "you have new mail!" CALL DINGEM ;inform user of new mail ;finally, erase the files created in your PPN (fn.MAL and fn.BAK only) JOBIDX A6 ;get the user LEA A5,ODDB(A3) ;A5 DDB for PPN filename MOVW #[MAL],ODDB+D.EXT(A3) ;the .MAL extension MOV FN(A3),ODDB+D.FIL(A3) ;the filename MOVW JOBDEV(A6),ODDB+D.DEV(A3) ;set device MOVW JOBDRV(A6),ODDB+D.DRV(A3) ;set drive MOVW JOBUSR(A6),ODDB+D.PPN(A3) ;set PPN INIT @A5 ;initialize LOOKUP @A5 ;find it BNE 10$ ;it's not there - no sweat DSKDEL @A5 ;erase fn.MAL 10$: MOVW #[BAK],ODDB+D.EXT(A3) ;change extension LOOKUP @A5 ;find it BNE 20$ ;it's not there - no sweat DSKDEL @A5 ;erase fn.BAK 20$: MOV #0,EF(A3) ;clear out most recent filename RTN ;and return ;this is the "title" if none provided by the user ONLNER: ASCII / * omitted */ ;default title message BYTE 15,12,0 EVEN ;DING'EM Subroutine - ; "beeps" the user's terminal who just received mail and gives ascii msg ; on entry: file was sent to user ; on exit: "new mail message" and BEEP to user's terminal ;------------------------------------------------------------------------ DINGEM: PUSH A6 ;save reggies PUSH A5 PUSH A4 PUSH A2 PUSH A1 PUSH A0 ;see if the user is on-line MOV IDX(A3),A0 ;there JCB CMP A0,#0 ;on??? BNE 10$ ;yup - see if at dot or running prg JMP 20$ ;bypass below - not on line ;user on-line, see if user is at the dot 10$: LEA A0,JOBSTS(A0) ;get the job status word CLR D4 ;clear data register MOVW @A0,D4 ;D4 holds status of JOB CMPW D4,#^H0202 ;at the dot, tiw? BEQ 15$ ;yup - give em the full treatment CALL BEEPEM ;nope, just give em a beep JMP 20$ ;and bypass below ;"full treatment" - YOU HAVE NEW MAIL, USER 15$: JOBIDX A6 ;this JCB MOV JOBTRM(A6),A5 ;this TB^ PUSH A5 ;save it MOV JOBTRM(A0),A5 ;their TB^ PUSH A5 ;save it LEA A5,JOBTRM(A0) ;address of their TB^ ;detach their terminal, attach it to YOU, send msg, re-attach JLOCK ;---------------------------------------------------------- CLR @A5 ;"detach" their terminal LEA A4,JOBTRM(A6) ;A4 points to this TB^ memory area POP @A4 ;TB^ now is their terminal PUSH @A4 ;and save it too (need it later) LEA A2,MAILMS ;get the mail message TTYL @A2 ;tell them about mail LEA A1,NAME(A3) ;point to RAD50 name CALL TYPNAM ;type out user name CRLF ;and a return and a dot DIM ;simulate AMOS dot TYPE <.> BRIGHT POP @A5 ;attach it back to original owner POP @A4 ;attach OUR original terminal back JUNLOK ;----------------------------------------------------------- 20$: POP A0 ;restore registers POP A1 POP A2 POP A4 POP A5 POP A6 RTN ;the infamous new mail message that we all love so well. MAILMS: BYTE 7 BYTE 15 BYTE 12 ASCII / You have new mail, / BYTE 0 EVEN ;BEEPEM Subroutine - beeps users terminal - no ascii sent, however ; on entry: file was sent to user ; on exit: BEEP to user's terminal ;------------------------------------------------------------------ BEEPEM: JOBIDX A6 ;this JCB MOV JOBTRM(A6),A5 ;this TB^ PUSH A5 ;save it MOV JOBTRM(A0),A5 ;their TB^ PUSH A5 ;save it LEA A5,JOBTRM(A0) ;address of their TB^ ;same as DINGEM above JLOCK ;---------------------------------------------------------- CLR @A5 ;"detach" their terminal LEA A4,JOBTRM(A6) ;A4 points to this TB^ memory area POP @A4 ;TB^ now is their terminal PUSH @A4 ;and save it too (need it later) MOV #7,D1 ;get a bell TTY ;BEEP! POP @A5 ;attach it back to original owner POP @A4 ;attach OUR original terminal back JUNLOK ;----------------------------------------------------------- RTN ;and return ;FIND VARIABLE Subroutine - finds variable in system memory ; on entry: D4 contains array offset of the variable ; A2 points to variable we are searching for ; on exit: IF FOUND ; A2 contains the location in system memory of the variable ; IF NOT FOUND ; A2 points to 0 ;--------------------------------------------------------------------------- FNDVAR: PUSH A1 ;save these guys PUSH D2 PUSH D5 PUSH D1 ;have A1 point to system memory where users "live" MOV MEMPTR(A3),A1 ;A1 points to system memory ADD D4,A1 ;A1 points to correct offset ;pseudo "blocks" in system memory MOV BLKUSR(A3),D5 ;set total number of "blocks" MOV #20.,D2 ;number of scans per "block" ;look for name, return if found with A2 pointing to the location NAMLOP: CMM @A2,@A1 ;compare names BNE NNEY ;Name Not Equal Yet MOV A1,A2 ;return pointer in A2 POP D1 ;restore registers POP D5 POP D2 POP A1 RTN ;and return from subroutine ;didn't find match yet..... NNEY: DEC D2 ;one less user to scan in blk BEQ SNB ;0 = search next block ADD #24.,A1 ;point to next name BR NAMLOP ;continue search ;came to the end of a pseudo "block", get next "block" SNB: DEC D5 ;one less "block" to search BEQ NOMEMU ;no memory user if D5 is 0 MOV #20.,D2 ;reset counter ADD #56.,A1 ;point to start of next "blk" BR NAMLOP ;search again ;come here if looked everywhere and no one there! NOMEMU: MOV #7,D1 ;BEEP TTY DIM ;dim output PRTTAB 24.,25. ;tab here CLRLIN ;clear out old line if there TYPE < ?entry not found> BRIGHT ;bright output MOV #0,@A2 ;set A2 to zero (not found) POP D1 ;restore registers POP D5 POP D2 POP A1 RTN ;and return from subroutine ;PASSWORD CHECK Subroutine - makes sure IDX's match up ; on entry: User has called up EMAIL ; on exit: User has been found to match MAILON records and is returned ; or user mismatched (mistyped) password and returned to dot ;---------------------------------------------------------------------------- PASCHK: PUSH A6 ;save PUSH A0 JOBIDX A6 ;get IDX for this JOB MOV MEMPTR(A3),A0 ;get base of sys mem MOV YOULOC(A3),A0 ;point to user ADD #12.,A0 ;bypass name,pass,rec#,semaph IDCHK: CMP A6,@A0 ;match? JEQ IDMTCH ;yup ADD #4,A0 ;nope, get next IDX CMP A6,@A0 ;match? JEQ IDMTCH ;yup ADD #4,A0 ;nope, get next IDX CMP A6,@A0 ;match? JEQ IDMTCH ;yup MOV #7,D1 ;nope - error TTY CRLF TYPECR < Sorry, but your password does not match the list of users for > TYPECR < this terminal. You must use the MAILON command to record you as the user.> TYPECR < The other possibility is you mis-typed your password. > CRLF EXIT IDMTCH: POP A0 ;restore stack POP A6 RTN ;and return ;WHO'S ON MAIL SYSTEM subroutine - lists all users. ; on entry: "W" ho has been called from EMAIL > ; on exit: EMAIL users typed out; bright = online, dim = offline ;---------------------------------------------------------------------- WHOMAL: PUSH A2 ;save originals PUSH A1 PUSH D2 PUSH D3 PUSH D4 PUSH D5 TYPECR ;finish command PRTTAB 4,1 ;clean up data screen ERASE CLR D2 ;who counter (row counter) ONEKEY ;set for 1 key input MOV MEMPTR(A3),A1 ;A1 points to EMAIL.SYS MOV BLKUSR(A3),D4 ;D4 contains num of "blocks" MOV #8.,D5 ;column counter LN: MOV #20.,D3 ;look 20 times per "block" SCNAME: CMP @A1,#0 ;found a name? JEQ NXTNAM ;nope, try again CMP 12.(A1),#0 ;user on??? BEQ DIMUSR ;nope BRIGHT ;"bright" BR TYPUSR ;type em out DIMUSR: DIM ;"dim" TYPUSR: ADD #4,D2 ;get row MOVB D2,D1 ;setup for TCRT LSLW D1,#10 MOVB D5,D1 ;get column TCRT ;tab here SUB #4,D2 ;get count LEA A2,SCRAP(A3) ;point to buffer PUSH A2 ;save pointer UNPACK ;get name UNPACK CLRB @A2 ;end name w/ a null POP A2 ;retrieve pointer TTYL @A2 ;type it out SUB #4,A1 ;repoint to start of name INC D2 ;counter = counter + 1 CMP D2,#20. ;20 users out? JNE NXTNAM ;nope CLR D2 ;clear row counter ADD #10.,D5 ;create new column CMP D5,#68. ;screen full? JLT NXTNAM ;nope, time for next "block" ;full screen, apply screen control PRTTAB 24,1 ;tab to here OFF ;cursor off ONEKEY ;keystroke to D1 NOECHO ;no keystoke echo TYPE ;prompt KBD ;get keystoke CTRLC ALLOUT ;if ^C then return ECHO ;echo back on MNYKEY ;A2 pointer to KBD data ON ;cursor on PRTTAB 4,1 ;tab to here ERASE ;clean up the screen MOV #8.,D5 ;reset column BR GNB ;and get next block NXTNAM: ADD #24.,A1 ;bypass stats DECD3: DEC D3 ;one less scan to do BEQ GNB ;if 0 get next block JMP SCNAME ;else SCan for NAME GNB: DEC D4 ;one less block to search BEQ ALLOUT ;if 0 all names out ADD #56.,A1 ;point to next "block" JMP LN ;search again ALLOUT: BRIGHT ;bright display (normal) EOWHO: POP D5 ;restore registers POP D4 POP D3 POP D2 POP A1 POP A2 ONEKEY ;etc.. HOME CLRLIN RTN ;BULK MAIL Subroutine - sends one file to a user defined bulk mailing list ; on entry: B was selected by the user ; on exit: User through with bulk mail functions (L, D, E, S, Q) ;------------------------------------------------------------------------- BLKMAL: TYPE CLRCTC ;clear out ^c CALL FNDBLK ;get the bulk mail data MOV A1,BLKPTR(A3) ;save pointer to the data CALL BMLIST ;list bulk mail options ;repeat this loop til user ^C's or Quits.... BMLOOP: HOME2 ;cursor here CLRLIN ;wipe out junk ONEKEY ;keystroke into D1 BRIGHT ;bright input CLRCTC ;clear out ^C KBD ;get the one keystroke value CTRLC 10$ ;^C pops back to EMAIL > UCS ;upper case the input CALL BCHOIC ;analize choice and act BR BMLOOP ;do again (unless Quit) ;^C from this location returns you to EMAIL > 10$: CLRCTC ;clear out control C ADD #4,SP ;fake return (from CALL) RTN ;return to EMAIL > ;BULK MAIL LIST of OPTIONS Subroutine - lists Bulk options ; on entry: User chose the bulk mail option ; on exit: Menu of bulk mail selections output on screen ;------------------------------------------------------------------------ BMLIST: PRTTAB 4,1 ;tab to here ERASE ;erase to end of screen PRTTAB 6,33 ;tab to here TYPE ;prompt user LEA A2,BMENU ;ascii data of menu ;this routine is very similar to HEADER: PRTTAB 4,20 ;tab to here 10$: BRIGHT ;bright output MOVB (A2)+,D1 ;get a character TTY ;type it in reverse DIM ;dim output 20$: MOVB (A2)+,D1 ;get next character TTY ;type out character CMPB @A2,#'- ;delimiter? BEQ 30$ ;yup, don't loop back BR 20$ ;nope, get next character 30$: CMPB 1(A2),#'. ;end of menu bar? (".") BNE 40$ ;nope, get more options RTN ;yup, done here 40$: INC A2 ;not end of menu, bypass "-" TYPE < > ;space over JMP 10$ ;go to top of sbr BMENU: ASCII /List,-Delete,-Edit,-Send,-Quit-./ EVEN ;BCHOIC Subroutine - acts according to user's bulk mail selection ; on entry: Bulk mail menu typed, user prompted for input ; on exit: Users choice selected and acted upon ;----------------------------------------------------------------- BCHOIC: CMPB D1,#'L ;list? BNE BMD ;nope, maybe Delete CALL LSTBLK ;list users mail RTN BMD: CMPB D1,#'D ;delete? BNE BMS ;nope, maybe Send CALL DELBLK ;yup, delete bulk message RTN BMS: CMPB D1,#'S ;send? BNE BMV ;nope, maybe VUE CALL SNDBLK ;yup, send bulk mailing RTN BMV: CMPB D1,#'E ;EDIT BNE BMQ ;nope, maybe Quit CALL EDBLK ;create/edit bulk list RTN BMQ: CMPB D1,#'Q ;quit? BNE BINERR ;nope, bulk input error ADD #4,SP ;yup, phoney return CLOSE @A4 ;close the USER.BLK file RTN ;real return BINERR: CALL BIE ;input error routine RTN ;EDIT BULK PACKET Subroutine - allows user to define a packet of users ; on entry - FNDBLK has been executed ; A1 points to data of USER.BLK packet (file still open) ; on exit - USER.BLK updated (file still open) ;------------------------------------------------------------------- EDBLK: PRTTAB 7,1 ;tab here ERASE ;clean up bottom of screen ;instruct.... DIM PRTTAB 7,1 ;has troubles @ fast speeds TYPECR < This option allows creation of a new bulk packet or packet editing.> TYPECR < Packets may contain any defined EMAIL user for up to 15 users.> ;print out the packets to the screen CALL PRTPAC ;print out the packets ;ask for packet name PN: PRTTAB 13.,20. ;tab here DIM ;instructions in dim TYPECR <6 characters total, CR to cancel> BRIGHT ;make sure we are bright MNYKEY ;look for CRLF on input PRTTAB 14.,18. TYPE KBD ;get packet CTRLC EDOUT ;if ^C then back to BM options ;if just CR, cancel BYP ;bypass blanks CMPB @A2,#15 ;just CR? JEQ EDOUT ;yup ;packet name entered, PACK it, have A5 point to the name LEA A1,RADBUF(A3) ;point to workspace PUSH A1 ;save start address PACK ;pack it PACK POP A5 ;retrieve start address A5!! ONEKEY ;set back to 1 keystroke ;look for packet name (far left) or zero. Also look for full block MOV BLKPTR(A3),A1 ;get pointer to block info CLR D5 ;packet counter 5$: CMP @A1,#0 ;empty space? JEQ 20$ ;yup, put new packet here CMM @A5,@A1 ;nope. Find a match? JEQ 20$ ;yup, edit the packet (A1 ^) INC D5 ;nope. Increment packet count CMP D5,#8. ;all done looking? BEQ 10$ ;if equal, full packet block ADD #64.,A1 ;else point to next packet BR 5$ ;and look again ;come here when all 8 packets have been defined and no more room 10$: MOV #7,D1 ;get a bell TTY ;beep! DIM ;dim output TYPECR < ?Sorry. You cannot create more than 8 bulk mail packets.> RTN ;Room for a packet, A1 points to slot, A5 has the name of the packet ;Copy the packet to a "fake" workspace (in case they chose Quit) 20$: MOV A1,PACPTR(A3) ;save pointer to packet LEA A2,FAKBLK(A3) ;point to "fake" location PUSH A2 ;save starting fake address MOV #16.,D1 ;clear out 16. longwords 25$: MOV (A1)+,(A2)+ ;copy the bulk data DEC D1 ;see if more to do BNE 25$ ;there is more to do POP A1 ;A1 now points to fake packet MOV @A5,@A1 ;"write" packet name to slot ;come here to edit packets. A1 points to packet name and slot 30$: PRTTAB 17.,1 ;tab here and print packet DIM TYPE BRIGHT CALL TYPNAM ;output name (A1 ^ to 1st name) PRTTAB 18.,1 ;tab here and print directions TYPE DIM TYPE
BRIGHT TYPE DIM TYPE BRIGHT TYPE DIM TYPE BRIGHT TYPE DIM TYPE BRIGHT CALL TYPLST ;list out, D4,D5 dedicated MOVB #0,LSTCMD(A3) ;null out last command value ;now get option after option til Quit or Finish (options: A,D,F,Q) HOME3: PRTTAB 17.,50. ;tab here TYPE ;ask for option CALL BEOPT ;get option and act ONEKEY ;adjust keystroke input PRTTAB 17.,57. ;tab here CLRLIN ;clear out last input BR HOME3 ;and repeat ;^C from here does nothing except clear it out EDOUT: CLRCTC ;clear out control C RTN ;and return ;BULK EDIT OPTION Subroutine - gets users edit bulk option ; on entry: A1 points to first free spot in packet they are editing ; on exit: choice selected and acted upon ;------------------------------------------------------------------------ BEOPT: ONEKEY ;just one keystroke into D1 KBD ;get the key CTRLC EDOUT ;^C goes way out UCS ;upper case option CMP D1,#'A ;ADD user? BNE BDEL ;nope, maybe delete CALL AUBLK ;yup, add user RTN ;and return (D4,D5 dedicated) BDEL: CMP D1,#'D ;DELETE user? BNE BFIN ;nope, maybe finish CALL DUBLK ;yup, delete user from bulk RTN BFIN: CMP D1,#'F ;FINISH? BNE BLKQ ;nope, maybe quit CALL BLKFIN ;yup, write changes ADD #4,SP ;fake return RTN ;and return BLKQ: CMP D1,#'Q ;quit? BNE BOERR ;nope ADD #4,SP ;fake return RTN ;return to BMLOOP ;come here on all non-valid entries BOERR: MOV #7,D1 ;get bell TTY ;BEEP! PRTTAB 17.,58. ;tab here CLRLIN ;clear out error JMP BEOPT ;and try again ;DELETE USER from BULK PACKET Subroutine ; on entry: FAKBLK contains copy of packet user wants to edit ; on exit: Possible name(s) deleted, fake packet updated ;------------------------------------------------------------------- DUBLK: CMPB LSTCMD(A3),#0 ;TYPLST ok? BEQ 1$ ;yup ;need to produce most recent listing LEA A1,FAKBLK(A3) ;point to fake packet ADD #4,A1 ;bypass packet name PUSH A1 ;save address of 1st name CALL TYPLST ;type out users POP A1 ;retrieve address of 1st name ;now count the number of users in the packet into D3 1$: MOVB #'D,LSTCMD(A3) ;set last command to "D" LEA A1,FAKBLK(A3) ;point to fake packet ADD #4,A1 ;bypass packet name PUSH A1 ;save 1st name address CLR D3 ;D3 counter 2$: CMP (A1)+,#0 ;no more names? BEQ 3$ ;no more names INC D3 ;name there, count it CMP D3,#15. ;15 names counted? BNE 2$ ;nope, get more 3$: POP A1 ;retrieve 1st name address ;setup DTAB which tabs to (D4,D5) MOV #20.,D4 ;adjust DTAB to start MOV #12.,D5 ;DTAB (20,12) to start ;for each name present, give the user the option of save or delete ONEKEY ;only "Y" or "N" needed 5$: CMP D3,#0 ;any names? BNE 20$ ;yes, bypass below MOV #7,D1 ;nope, can't delete no one TTY ;so beep 10$: RTN ;and return 20$: PRTTAB 24.,20. ;tab here at start of routine CLRLIN ;clear out old message DIM ;output the options (Y/N) TYPE BRIGHT TYPE <(Y or N) > ;tab to name, ask for delete or no delete... 22$: CMP D3,#0 ;any users left? JEQ 10$ ;nope DTAB ;tab to user's first character CALL YESNO ;give em the option (Y/N) CMPB D1,#'Y ;yes? BNE 30$ ;nope, not a Yes, maybe No CALL DELYES ;yup, delete the user 25$: CALL NEXTDT ;adjust DTAB ADD #4,A1 ;point to next user DEC D3 ;one less user in the packet BR 22$ ;do it again 30$: CMPB D1,#'N ;no? BEQ 25$ ;yup, adjust DTAB and thats it MOV #7,D1 ;nope, get a bell TTY ;beep BR 22$ ;and try again ;DELETE YES Subroutine - deletes a user from a packet ; on entry: A1 points to user needing deletion in FAKBLK ; on exit: User "deleted", all other users "bumped" to the left ;----------------------------------------------------------------------- DELYES: LEA A2,FAKBLK(A3) ;point to workspace ADD #60.,A2 ;point to last slot of w.s. CMP A1,A2 ;at end point? BNE 10$ ;nope CLR @A1 ;yup TYPE < > ;"erase" name ADD #4,SP ;fake return (from the CALL) RTN ;real return (last name done) 10$: PUSH A1 ;save slot TYPE < > ;"erase" name 15$: MOV 4(A1),(A1)+ ;bump left CMP A1,A2 ;at last slot? BNE 15$ ;nope CLR @A1 ;yup POP A1 ;retrieve slot SUB #4,A1 ;one less person in packet RTN ;done with bump ;NEXT DTAB Subroutine ; on entry: D4,D5 hold "old" DTAB value ; on exit: D4,D5 updated ;----------------------------------------------- NEXTDT: ADD #10.,D5 ;column increment CMP D5,#62. ;row done? BEQ 10$ ;yup RTN 10$: MOV #12.,D5 ;new column INC D4 ;new row CMP D4,#23. ;all done? BNE 20$ ;nope ADD #4,SP ;fake return (from the CALL) 20$: RTN ;real return ;YES/NO Subroutine ; on entry: User has been prompted for Y/N ; on exit: D1 contains value of responce ;------------------------------------------------ YESNO: NOECHO ;no echo KBD ;get responce ECHO ;back to normal CTRLC YNOUT ;egnor ^C UCS ;upper case input RTN ;and return YNOUT: CLRCTC ;clear out ^C ADD #8.,SP ;fake return RTN ;real return ;BULK FINISH Subroutine ; on entry: User has possibly edited or created a packet ; on exit: The new information is WRITTEN to the disk (via A4) ;---------------------------------------------------------------------- BLKFIN: LEA A1,FAKBLK(A3) ;point to workspace CMP 4(A1),#0 ;clean? (must have 1 name) BEQ 20$ ;yup, just return MOV #32.,D1 ;nope, "write" 32 words... MOV PACPTR(A3),A2 ;A2 points to "real" block 5$: MOVW (A1)+,(A2)+ ;"write" data DEC D1 ;one less word to write BNE 5$ ;still more to do WRITE @A4 ;actual disk write 20$: RTN ;no more, return ;TYPE LIST Subroutine - types out list in bulk packet 5X3 format ; on entry: A1 points to first name in bulk packet (fake or real) ; on exit : D4 holds row, D5 holds column of next user, D3 row counter ; A1 points to first free spot for up to 15 spots ;--------------------------------------------------------------------------- TYPLST: PRTTAB 20.,1 ;tab here ERASE ;clear rest of screen COFF ;cursor off MOV #20.,D4 ;set row/column registers 5$: MOV #12.,D5 ;start at (21,5) CLR D3 ;loop counter (3 rows max) ;do this first time check only once 10$: CMP @A1,#0 ;name there? BNE 20$ ;yup, type out user CON ;cursor on RTN ;else return (DTAB setup now) ;name found, type it out and adjust row/column 20$: DTAB ;tab to D4,D5 CALL TYPNAM ;type out name A1 points to INC D3 ;one more in the row CMP D3,#5 ;5 on the row? BNE 30$ ;nope INC D4 ;yup, new row CMP D4,#23. ;full packet? BNE 5$ ;nope, continue CON ;yup, cursor on RTN ;and return 30$: ADD #10.,D5 ;column increase BR 10$ ;and go here ;ADD USER to BULK Subroutine - Adds name to bulk packet (FAKBLK) ; on entry: A1 points to first free space in record ; D4,D5 hold row/column of input; D3 holds loop count ; on exit: New name added to FAKE packet, A1, D4, D3, D5 updated ;---------------------------------------------------------------------- AUBLK: CMPB LSTCMD(A3),#0 ;TYPLST ok? BEQ 1$ ;yup, don't retype names CMPB LSTCMD(A3),#'A ;TYPLST ok? BEQ 1$ ;yup ;need to retype packet list (possible previous delete action) LEA A1,FAKBLK(A3) ;point to fake packet ADD #4,A1 ;point to names in packet CALL TYPLST ;type out users ;see if packet is full 1$: MOVB #'A,LSTCMD(A3) ;set last command CMP D4,#23. ;full packet? BNE 5$ ;nope MOV #7,D1 ;yup, get a bell TTY ;beep! PRTTAB 24.,30. ;tab here CLRLIN ;clear out old message DIM ;dim output TYPE ;error message BRIGHT ;return normal output RTN ;and return ;room for name, give instructions 5$: PRTTAB 24.,30. ;tab here CLRLIN ;clear out old message DIM ;dim instructions TYPE ;provide instructions BRIGHT ;back to bright input ;now get the name MNYKEY ;many keystroke input DTAB ;tab here KBD ;get name CTRLC AUERR ;go here if ctrlc ;if just CR, don't do anything CMPB @A2,#15 ;cr? BNE 6$ ;nope RTN ;yup, just return ;find the name if there... 6$: PUSH A1 ;save free slot in packet PACK ;and pack the name PACK MOV @SP,A2 ;setup for FNDVAR PUSH D4 ;save row CLR D4 ;offset into array CALL FNDVAR ;find user (maybe) ;don't allow yourself in the packet! CMM @A2,YOU(A3) ;you? BNE 7$ ;nope MOV #7,D1 ;get a bell TTY ;beep! PRTTAB 24.,30. ;tab here DIM ;error message TYPE BRIGHT BR 8$ ;go here ;if name not there, tell them so... 7$: CMP @A2,#0 ;find em? BNE 10$ ;yup 8$: POP D4 ;nope, error DTAB ;retab CLRLIN ;clear outname POP A1 ;retrieve slot CLR @A1 ;clear it RTN ;and return ;name found, "write" it to the block 10$: PRTTAB 24.,30. ;first tab here CLRLIN ;and clear out instruction POP D4 ;retrieve old D4 POP A1 ;retrieve slot pointer CALL NODUPS ;no duplicates allowed ADD #4,A1 ;point to next slot INC D3 ;increment loop count CMP D3,#5 ;last in row? BNE 20$ ;nope CLR D3 ;yup, clear loop counter INC D4 ;and row location CMP D4,#23. ;full? BNE 15$ ;nope RTN ;yup, return ;if not full, get set for next name 15$: MOV #12.,D5 ;and reset column placement RTN ;adjust column location 20$: ADD #10.,D5 ;increment column count RTN ;and return ;^C quits you from ADD mode AUERR: CLRCTC ;clear out control c PRTTAB 24.,30. ;tab here CLRLIN ;clear out instructions RTN ;and return ;NO DUPLICATE Subroutine - looks for identical names in a packet ; on entry: A1 points to name that is being added in fake packet ; on exit: A1 updated to next slot, name "written" if no dupes ;---------------------------------------------------------------------- NODUPS: PUSH A1 ;save name pointer LEA A0,FAKBLK(A3) ;point to workspace ADD #4,A0 ;bypass packet name 10$: CMP A1,A0 ;at new name? BNE 20$ ;nope POP A1 ;yup, retrieve slot RTN ;return w/no dupes 20$: CMM (A0)+,@A1 ;compare for match BNE 10$ ;no match yet POP A1 ;adjust stack PRTTAB 24.,30. ;dupe found CLRLIN ;clear out old message DIM ;dim error message MOV #7,D1 ;same ol' bell TTY ;beep! TYPE ;message BRIGHT ;normal output DTAB ;retab CLRLIN ;clear out error ADD #4,SP ;fake return RTN ;real return ;ERROR 99$: MOV #7,D1 ;here when didn't follow inst. TTY ;beep and instruct TYPE < Whoops! Looks like an invalid filename to me.> JMP BMLOOP ;and return to BM options ;DELETE BULK MAIL PACKET Subroutine ; on entry: User chose the D option from the Bulk Mail prompt ; on exit: Packet name deleted from USER.BLK if confirmed ;-------------------------------------------------------------------- DELBLK: PRTTAB 7.,1 ERASE ;clean up screen CALL PRTPAC ;print out packets PRTTAB 10.,20. ;tab here MOV BLKPTR(A3),A1 ;point to bulk data TYPE MNYKEY ;multiple keystrokes KBD ;get packet CTRLC DBOUT ;quit if ^C ;CR does nothing CMPB @A2,#15 JEQ DBOUT ;if just CR then nothing ;create packet name from input PUSH A1 ;save pointer to block LEA A1,RADBUF(A3) ;point to workspace PUSH A1 ;save start location PACK ;create packet name PACK POP A5 ;retrieve start location in A5 POP A1 ;retrieve block data ;now look for packet - have A1 point to it if found 10$: CLR D4 ;D4 is counter 20$: CMM @A5,@A1 ;found match? BEQ 40$ ;yup ADD #64.,D4 ;nope, generate offset CMP D4,#512. ;looked everywhere? BEQ 30$ ;yup, can't find this packet ADD #64.,A1 ;nope, get next location BR 20$ ;and look again ;looked everywhere, packet does not exist 30$: MOV #7,D1 ;get a bell TTY ;beep! PRTTAB 24.,30. ;tab here CLRLIN ;clear out old message DIM TYPE ;error message and return BRIGHT RTN ;found packet, double check (A1 points to location) 40$: PRTTAB 12.,15. ;tab here BRIGHT TYPECR CRLF PUSH A1 ;TYPACK destroys these PUSH D4 CALL TYPACK ;type out packet POP D4 POP A1 ONEKEY PRTTAB 17.,20. ;tab here BRIGHT TYPE KBD CTRLC DBOUT ;^C quits UCS ;upper case input CMP D1,#'Y ;Yes? BEQ 50$ ;yup RTN ;nope ;user wants this packet gone, bump all packets to the left 50$: CMP D4,#448. ;see if at last packet BEQ 60$ ;yup MOV #16.,D3 ;nope, 16 longwords need move MOV A1,A2 ;A2 points where A1 points ADD #64.,A2 ;A2 points to next packet 55$: MOV (A2)+,(A1)+ ;move in packet data DEC D3 ;one less move to do BNE 55$ ;do it again ADD #64.,D4 ;one less packet to do BR 50$ ;do this again ;last packet will always be nulls 60$: MOV #16.,D3 ;16 longwords 65$: CLR (A1)+ ;clear em out DEC D3 ;one less to clear BNE 65$ ;still more moves to do WRITE @A4 ;write changes DBOUT: CLRCTC ;clear out ^C RTN ;and return ;SEND BULK MAIL Subroutine - sends one message to many users (a biggie!) ; on entry: User chose Send from Bulk Mail Option ; USER.BLK file still open via A4 ; File in PPN exists that you created w/ VUE ; on exit: Copies of your message sent to defined user packet ; File deleted from PPN if .MAL extension ; USER.BLK still open via A4 ;-------------------------------------------------------------------- SNDBLK: PRTTAB 8.,1 ;tab to here ERASE ;clean up screen CALL PRTPAC ;type out packets ;get the packet containing the names to send to PRTTAB 11.,6 ;tab here DIM ;instruct TYPE <6 characters total, CR to cancel> PRTTAB 12.,10. ;tab here MNYKEY ;A2 keyboard index BRIGHT ;high intensity TYPE ;prompt for packet KBD ;get the information CTRLC SNDERR ;here on control c ;see if just a CR (this is same as cancel) CMPB @A2,#15 ;cr? JEQ SNDERR ;yup, abort ;PACK the packet name LEA A1,RADBUF(A3) ;point to workspace PUSH A1 ;save start address PACK ;generate name PACK POP A1 ;retrieve start address ;look for packet match 8 times MOV BLKPTR(A3),A0 ;A0 points to packets MOV #8.,D2 ;loop counter 10$: CMM @A1,@A0 ;match? JEQ PM ;yup, packet match ADD #64.,A0 ;nope, point to next packet DEC D2 ;one less packet to look for BNE 10$ ;and look again ;packet not found, error PRTTAB 24.,30. ;tab here DIM ;error in dim CLRLIN ;clear out old message MOV #7,D1 ;bell TTY ;beep TYPE ;error message BRIGHT ;normal intensity JMP SNDERR ;go here ;packet matched! A0 points to the packet name. Move users to workspace PM: LEA A1,FAKBLK(A3) ;point to packet workspace ADD #4,A0 ;bypass packet name MOV #15.,D2 ;15 users to move 10$: MOV (A0)+,(A1)+ ;move in the users DEC D2 ;one less user to do BNE 10$ ;if not done, repeat ;make sure packet has all current users LEA A1,FAKBLK(A3) ;point to packet workspace MOV #15,D0 ;counter 11$: CMP @A1,#0 ;end of packet? JEQ 15$ ;yup CLR D4 ;setup for FNDVAR PUSH @A1 ;save user name MOV A1,A2 ;copy to A2 for FNDVAR CALL FNDVAR ;look for user CMP @A2,#0 ;find the guy? BEQ 12$ ;nope, error in packet POP @A1 ;retrieve stack value ADD #4,A1 ;point to next user DEC D0 ;one less user to parse BNE 11$ ;still parse if not done BR 15$ ;end of list 12$: POP @A1 ;get user name PRTTAB 18.,10 ;tab here TYPE LEA A2,SCRAP(A3) ;point to workspace PUSH A2 ;save start location UNPACK ;create name UNPACK CLRB @A2 POP A2 ;point to name TTYL @A2 ;type out name TYPE < from packet> RTN ;error message and return ;proceed to get the filename to send to the users 15$: PRTTAB 13.,24. ;tab here TYPE ;prompt for filename KBD ;get it CTRLC RN ;here on ^C CMPB @A2,#15 ;see if just CR JEQ RN ;yup, abort send ;no need to parse, FSPEC will do this for us LEA A4,BLKDDB(A3) ;A4 dedicated input filespec MOVB #D$ERC!D$BYP,BLKDDB+D.FLG(A3) ;set D$ERC bit (trap errors) FSPEC @A4,MAL ;get the filename CMPB BLKDDB+D.ERR(A3),#D$ESPC ;error? BNE 17$ ;nope MOV #7,D1 ;get a bell TTY ;beep TYPE < Whoops! Looks like an invalid filename.> JMP RN ;reopen USER.BLK ;make sure this file is there 17$: INIT @A4 ;buffer space LOOKUP @A4 ;there? BEQ 20$ ;yup MOV #7,D1 ;nope TTY ;beep! DIM ;dim output PRTTAB 24.,15. TYPE BRIGHT ;back to bright JMP RN ;hard set DSK#:PPN of user sending the file into the DDB variable 20$: JOBIDX A6 ;hard set some stats MOVW JOBDEV(A6),BLKDDB+D.DEV(A3) ;DSK#:[PPN] MOVW JOBDRV(A6),BLKDDB+D.DRV(A3) MOVW JOBUSR(A6),BLKDDB+D.PPN(A3) ;now get the title into SCRAP PRTTAB 14.,27. ;tab here TYPE ;prompt for title KBD ;wait for entry CTRLC REOPEN ;go here on ^C CRLF ;screen control PRTTAB 7.,1 ;tab here ERASE ;clean up screen LEA A1,TITLE(A3) ;point to workspace MOV #88.,D2 ;max of 90. characters 25$: CMPB @A2,#15 ;at CRLF? BEQ 30$ ;yup MOVB (A2)+,(A1)+ ;move in byte DEC D2 ;one less character BNE 25$ ;still not done 30$: MOVB #15,(A1)+ ;move in CRLF MOVB #12,@A1 JOBIDX A6 PUSHW JOBDEV(A6) PUSHW JOBDRV(A6) PUSHW JOBUSR(A6) MOVW #[DSK],JOBDEV(A6) MOVW #0,JOBDRV(A6) MOVW #402,JOBUSR(A6) ;initialize for user-by-user sending CLR D0 ;counter/offset value ;repeat: get a user and send the file until packet complete NXTUSR: LEA A1,FAKBLK(A3) ;point to start of users LEA A2,NAME(A3) ;point to name buffer LEA A4,BLKDDB(A3) ;point to bulk filespec CMP D0,#60. ;all done? JEQ RL ;yup ADD D0,A1 ;nope, point to user MOV (A1)+,@A2 ;get the user CMP @A2,#0 ;end of list? JEQ RL ;yup, all done! CLR D4 ;setup for FNDVAR CALL FNDVAR ;look for this guy CMP @A2,#0 ;find the user? BNE FUIP ;found user in packet UNFE: ADD #4,D0 ;else get next user JMP NXTUSR ;repeat ;found the user in the packet, get there stats FUIP: MOV A2,THRLOC(A3) ;save pointer to user in mem MOVW 10(A2),THRREC(A3) ;store other's record number ADD #14,A2 ;point to IDX slots CMP @A2,#0 ;IDX there? BNE 5$ ;yup, save it ADD #4,A2 ;nope, maybe next slot CMP @A2,#0 ;IDX there? BNE 5$ ;yup, save it ADD #4,A2 ;nope, point to next slot 5$: MOV @A2,IDX(A3) ;store IDX of other guy ;set file to be sent to BOX: via a "random file generator" CALL RFG ;create random filename MOV ODDB+D.FIL(A3),FN(A3) ;save filename ;ok, send the file, dude! OPENO @A5 ;and encoded output file MOV YOU(A3),D1 ;store FROM (for LIST) FILOTL @A5 ;store name MOV NAME(A3),D1 ;store TO (for UNREAD) FILOTL @A5 ;write it GDATES D1 ;get the date FILOTL @A5 ;store it GTIMES D1 ;get the time FILOTL @A5 ;store it ;if title entered, write this in the file at this time (bits flipped) LEA A2,TITLE(A3) ;point to title 10$: CMPB @A2,#15 ;one liner just CR? BNE 20$ ;nope, user entered 1-liner LEA A2,ONLNER ;yup, get "Untitled" 1-liner 20$: MOV #60.,D5 ;counter for length 25$: MOVB (A2)+,D1 ;get the one liner CMPB D1,#15 ;CR? BEQ 30$ ;yup COMB D1 ;flip byte FILOTB @A5 ;write one liner DEC D5 ;one less character to do BNE 25$ ;and do it again if room 30$: MOV #15,D1 ;get the CR COMB D1 ;flip it FILOTB @A5 ;write it MOV #12,D1 ;get a LF COMB D1 ;flip it FILOTB @A5 ;write it ;now send the actual file data over, flipping bits as you send INIT @A4 ;create block buffer space LOOKUP @A4 ;find the file BEQ 35$ ;found it TYPECR RTN ;no file found, return 35$: OPENI @A4 ;open original file for input 40$: FILINB @A4 ;get file byte-by-byte TST BLKDDB+D.SIZ(A3) ;if eof BEQ 50$ ;then branch to at eof COMB D1 ;flip the bit FILOTB @A5 ;write it BR 40$ ;still in translation ;file sent, close both files 50$: CLOSE @A4 ;else close the files CLOSE @A5 ;setup EMAIL.DAT, lock recipients record CALL FNDDAT ;setup EMAIL.DAT MOV THRLOC(A3),A0 ;get there memory location ADD #12,A0 ;point to resource CALL LOCREC ;lock the record ;read their record and display AUTO REPLY to sender OPENR @A4 ;open random file CRLF ;simulate return TYPE < > ;tab over LEA A1,NAME(A3) ;point to user name CALL TYPNAM ;type out users name CALL RTREC ;read THEIR record (A1 index) PUSH A1 ;save A1 index ADD #400.,A1 ;point to start of auto TYPE <: > ;setup for auto reply CALL TYPAUT ;type out there auto reply POP A1 ;restore A1 index MOV THRLOC(A3),A0 ;get memory location ADD #12,A0 ;point to semiphore CLRW @A0 ;free record ;online = BRIGHT , offline = DIM BD: DIM ;dim output CMP 2(A0),#0 ;user on-line? BEQ 10$ ;nope TYPE < (on-line)> ;let user know person on line BR 20$ ;bypass below 10$: TYPE < (not on-line)> ;user not on line 20$: BRIGHT ;reset display ;after AUTO reply, update NEW MAIL in their record if space MOV #40.,D2 ;40 records allowed 30$: CMP 2(A1),#0 ;found free record? BEQ 50$ ;yup, A1 points to free space DEC D2 ;one less record space BEQ 40$ ;full mailbox! ADD #6,A1 ;else try next space BR 30$ ;look for free record ;user mailbox full, can't send this person the message. 40$: MOV #7,D1 ;get a bell TTY ;beep TYPECR CLOSE @A4 ;close EMAIL.DAT DSKDEL @A5 ;erase file sent ADD #4,D0 ;one less user to do JMP NXTUSR ;do next user ;space in user record, record NEW flag and FILENAME 50$: MOV FN(A3),2(A1) ;store filename MOVW #1,(A1) ;set NEW flag WRITE @A4 ;write new contents ;now lock your MOV YOULOC(A3),A0 ;update your block ADD #12,A0 ;setup for LOCREC CALL LOCREC ;lock record block ;read in your block, unlock it after read CALL RYREC ;read your block MOV YOULOC(A3),A0 ;free resource ADD #12,A0 ;we've seen this before... CLRW @A0 ;scan unread portion of record and record data ADD #240.,A1 ;point to UNREAD portion MOV #40.,D2 ;40 records allowed 60$: CMP @A1,#0 ;found free record? BEQ 80$ ;yup, A1 points to free space DEC D2 ;one less record space BEQ 70$ ;full mailbox! ADD #4,A1 ;else try next space BR 60$ ;look for free record ;come here if your unread buffer is full 70$: MOV #7,D1 ;get a bell TTY ;beep TYPECR BR 90$ ;bypass below 80$: MOV FN(A3),@A1 ;store filename WRITE @A4 ;write new contents 90$: CLOSE @A4 ;close the file CALL DINGEM ;inform user of new mail ADD #4,D0 ;one less user to do JMP NXTUSR ;still more to do (?) ;RANDOM FILE GENERATOR Subroutine - generates a "random file name" ; on entry: true ; on exit: A5 points to DDB that has random file name, BOX: PPN etc ;-------------------------------------------------------------------------- RFG: LEA A5,ODDB(A3) ;point to output DDB GTIMES D2 ;get system time MOV D2,D3 ;copy to D3 AND #^H0FF,D2 ;get seconds into D2 AND #^H0FF000000,D3 ;get minutes into D3 MSB SWAP D3 ;move minutes into MSBW MOVB D2,D3 ;move seconds into LSBW MOV D3,D1 ;place number into D1 LEA A2,ODDB+D.FIL(A3) ;want result into filespec PUSH A2 ;save location for PACK MOV A2,A1 ;copy location for PACK DCVT 0,OT$MEM ;decimal filename created POP A2 ;point to filename PACK ;create RAD50 name of file PACK MOVW #[MAL],ODDB+D.EXT(A3) ;set extension MOVW #[DSK],ODDB+D.DEV(A3) ;set BOX: specs MOVW #0,ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) INIT @A5 ;create buffer space LOOKUP @A5 ;file already there? BEQ RFG ;yup, try it again (time dif) RTN ;nope, AOK filename ;finally, erase the files created in your PPN (fn.MAL and fn.BAK only) RL: LEA A4,BLKDDB(A3) ;A4 DDB for PPN filename CMPW BLKDDB+D.EXT(A3),#[MAL] ;was it a .MAL file? BNE REOPEN ;nope LOOKUP @A4 ;find it BNE 10$ ;it's not there - no sweat DSKDEL @A4 ;erase fn.MAL 10$: MOVW #[BAK],BLKDDB+D.EXT(A3) ;change extension LOOKUP @A4 ;find it BNE 20$ ;it's not there - no sweat DSKDEL @A4 ;erase fn.BAK 20$: MOV #0,EF(A3) ;clear out most recent filename REOPEN: JOBIDX A6 POPW JOBUSR(A6) POPW JOBDRV(A6) POPW JOBDEV(A6) RN: CALL FNDBLK SNDERR: CLRCTC ;clear control C RTN ;return to bulk mail option ;LIST BULK Subroutine - lists defined bulk mailing packets ; on entry: A1 points to bulk data block, packets packed far left ; on exit: users packets have been displayed ;----------------------------------------------------------------------- LSTBLK: PRTTAB 7,1 ;tab here ERASE ;clear below ;now list out the packet and the names inside CLR D5 ;counter CLR D3 ;D3 holds non blank packet # MOV BLKPTR(A3),A1 ;point to bulk data block 10$: CRLF ;adjust cursor CMP @A1,#0 ;packet? BNE 20$ ;yup, don't return yet JMP 40$ ;nope, message and return ;packet found, output packet information 20$: CALL TYPACK ;packet done, point to next one 30$: INC D5 ;one less packet to do CMP D5,#8. ;all done? BEQ 40$ ;yup ADD D2,A1 ;else point to next packet CMP D4,#9. ;look at user count JPL 10$ ;if more than 8, no crlf CRLF ;blank line between packets JMP 10$ ;and do it again ;see if any packets on screen, inform them if no packets are defined 40$: CMP D3,#0 ;all blank? BNE 50$ ;nope, just return PRTTAB 10.,26 ;yup, tab here DIM ;dim output MOV #7,D1 ;get a bell TTY ;beep! TYPE 50$: RTN ;TYPE PACKET Subroutine ; on entry: A1 points to the packet to be typed to the screen ; on exit: Packet typed, name in bright, users in dim for up to 2 rows ;---------------------------------------------------------------------------- TYPACK: BRIGHT ;packet name in bright CALL TYPNAM ;type it out DIM ;names in dim output MOV #60.,D2 ;offset calculator CLR D4 ;counter of names 22$: CMP @A1,#0 ;end of list? JEQ 30$ ;yup CMP D4,#15. ;all names out? JEQ 30$ ;yup INC D3 ;non blank slot found CMP D4,#8. ;first row done? BNE 24$ ;nope CRLF ;yup, crlf TYPE < > ;space over 24$: TYPE < > ;space over CALL TYPNAM ;type it out INC D4 ;name count incremented SUB #4,D2 ;shrink offset JMP 22$ ;and get next guy 30$: RTN ;BULK INPUT ERROR Subroutine - error on input, key invalid ;---------------------------------------------------------- BIE: PUSH D1 ;save register MOV #7,D1 ;get a bell TTY ;ding the user HOME2 ;move cursor home MOV #40,D1 ;get a space TTY ;clear last key HOME2 ;move cursor home POP D1 ;restore register RTN ;and return ;PRINT PACKET Subroutine ; on entry: FNDBLK has been executed ; on exit: All packet NAMES have been displayed to the screen ;-------------------------------------------------------------------- PRTPAC: CRLF ;one blank line TYPE ;setup BRIGHT ;packets in bright output CLR D5 ;packet counter CLR D3 ;0 if no packets MOV BLKPTR(A3),A1 ;A1 points to bulk packet data 10$: CMP @A1,#0 ;packet there? BEQ 20$ ;nope PUSH A1 ;save this address CALL TYPNAM ;type out packet name TYPE < > ;space over INC D3 ;non zero, packet found POP A1 ;retrieve address 20$: INC D5 ;one less space to look CMP D5,#8. ;all done? BEQ 30$ ;yup ADD #64.,A1 ;nope, get next slot BR 10$ ;look for next packet 30$: CMP D3,#0 ;zero if no packets BNE PPRTN ;not zero, continue below TYPECR ;zero, no packets found PPRTN: RTN ;MOST RECENTLY EDITED FILE Subroutine ; on entry: true ; on exit: if user has edited a file, file is displayed for them ;------------------------------------------------------------------------ MREF: LEA A2,EF(A3) ;get most recent filename CMPB @A2,#0 ;filename there? BEQ 1$ ;nope PRTTAB 1,45. ;tab here TYPE <(Most recently edited file:> TTYL @A2 ;type out filename TYPE <)> ;right paren 1$: BRIGHT ;restore bright RTN ;and return ;AUTO REPLY Subroutine - update and/or check auto reply ; on entry: User chose "A"uto from EMAIL > ; on exit: User's auto reply displayed w/ possible update ;---------------------------------------------------------------- AUTO: DIM ;instructions in dim PRTTAB -1,5 ;back one column TYPE < Type CR to cancel update> ;give instructions BRIGHT ;back to bright CALL FNDDAT ;setup EMAIL.DAT ;read in your record from EMAIL.DAT MOV YOULOC(A3),A0 ;setup to lock your record ADD #12,A0 ;point to semiphore CALL LOCREC ;lock your block OPENR @A4 ;open EMAIL.DAT CALL RYREC ;read your record (A1) MOV YOULOC(A3),A0 ;point to your mem loc ADD #12,A0 ;point to semiphore CLRW @A0 ;free resource ;point A1 to auto reply data ADD #400.,A1 ;point to AUTO space PRTTAB 4,1 ;tab here ERASE ;erase to end of screen ;type out auto reply PRTTAB 5,2 ;tab here TYPE ;header CALL TYPAUT ;type out auto PRTTAB 7,2 ;tab here TYPE ;prompt CALL RECAUT ;record auto reply ;after possible update, clear out junk PRTTAB 6,1 ;tab here ERASE ;clear to end of screen PRTTAB 5,17. ;tab here CALL TYPAUT ;type out new msg CLRLIN ;erase to end of line ;all done CLOSE @A4 ;close file PRTTAB 1,9. ;set to top CLRLIN RTN TYPE AUTO REPLY Subroutine - types out an auto reply ; on entry: block has been read, A1 point to start of AUTO reply ; on exit: message typed out on screen where cursor is at ; A1 points to the start of it ;-------------------------------------------------------------------- TYPAUT: PUSH A1 ;save it REPOUT: CMPB @A1,#0 ;end of reply? BEQ EOAR ;end of auto reply MOVB (A1)+,D1 ;get character COMB D1 ;flip bits TTY ;type it out BR REPOUT ;get next char or end EOAR: POP A1 ;restore it RTN ;RECORD AUTO REPLY Subroutine - records auto reply ; on entry: A1 points to start of buffer where AUTO lives ; on exit AUTO recorded, block written, A1 points to auto reply ;---------------------------------------------------------------------- RECAUT: PUSH A2 ;save originals PUSH D2 ;counter PUSH D1 PUSH A1 ;points to start of auto msg ;setup keyboard input MNYKEY ;terminal attributes CLR D2 ;clear counter KBD ;get auto CTRLC 30$ ;no change on ctrlc ;egnor CR (cancel) CMPB @A2,#15 ;just a CR? BEQ 30$ ;yup, no change ;something entered, get it into your record block (up to 52 chars) 5$: MOVB (A2)+,D1 ;store byte by byte COMB D1 MOVB D1,(A1)+ INC D2 ;counter incremented CMP D2,#52. ;end of buffer? (this is max) BNE 10$ ;nope CLRB @A1 ;set the null to mark the end BR 20$ ;bypass below (egnor rest) ;terminate auto reply w/ null 10$: CMPB @A2,#15 ;end of AUTO? BNE 5$ ;nope CLRB @A1 ;yup, set null ;write the new auto reply message 20$: MOV YOULOC(A3),A0 ;setup to lock your record ADD #12,A0 ;point to semiphore CALL LOCREC ;lock your block WRITE @A4 ;store new contents MOV YOULOC(A3),A0 ;point to your mem loc ADD #12,A0 ;point to semiphore CLRW @A0 ;free resource ;and return 30$: POP A1 POP D1 POP D2 ;restore POP A2 ;restore stack ONEKEY ;set attributes RTN ;all done ;FIND MEMORY Subroutine - finds EMAIL.SYS in system memory ; on entry: true ; on exit: if EMAIL.SYS found, MEMPTR contains pointer ; if not found - error message and quit ;-------------------------------------------------------------------------- FNDMEM: PUSH A0 ;save this guy PUSH A2 ;and this one too PUSH A4 ;and even this on LEA A2,SYSFIL ;point to ascii file LEA A0,SCRAP(A3) ;A0 points to buffer area FILNAM @A0 ;create filename SRCH @A0,A4 ;A4 will contain mem pointer BEQ OKSRCH ;search found EMAIL.USR MOV #7,D1 ;get a bell TTY ;beep TYPECR < ?EMAIL.SYS not installed.> EXIT OKSRCH: MOV A4,MEMPTR(A3) ;save the pointer POP A4 ;restore registers POP A2 POP A0 RTN ;and return SYSFIL: ASCII /EMAIL.SYS/ EVEN ;FIND DATA FILE Subroutine - initialize file if found, quit if not ; on entry: true ; on exit: EMAIL.DAT setup in DDB pointed to by A4 (if found) ;-------------------------------------------------------------------- FNDDAT: MOVW #[EMA],IDDB+D.FIL(A3) ;setup random file EMAIL.DAT MOVW #[IL ],IDDB+D.FIL+2(A3) MOVW #[DAT],IDDB+D.EXT(A3) MOVW #[DSK],IDDB+D.DEV(A3) CLRW IDDB+D.DRV(A3) MOVW #3402,IDDB+D.PPN(A3) LEA A4,IDDB(A3) INIT @A4 LOOKUP @A4 BEQ 10$ ;found DSK0:EMAIL.DAT[7,2] MOV #7,D1 ;get a bell TTY ;beep TYPECR < ?EMAIL.DAT not found> EXIT 10$: MOVW IDDB+D.REC+2(A3),FB(A3) ;save first block of EMAIL.DAT RTN ;LOCK RECORD Subroutine - locks a data record when in use ; on entry: A0 points to the correct word to lock ; on exit: record is locked and owned by user ;-------------------------------------------------------- LOCREC: JLOCK ;----------------------------------------------------------- CMPW @A0,#0 ;resource free? BEQ FRT ;yup JUNLOK ;---- ;nope SLEEP #100. ;delay BR LOCREC ;try again FRT: MOVW #1,@A0 ;set semiphore, U own record JUNLOK ;----------------------------------------------------------- RTN ;FILE Subroutine - makes a file of a message in current PPN ; on entry: user selected F from EMAIL > ; on exit: file created in PPN with user defined filespec ;---------------------------------------------------------------- FILMAL: MNYKEY ;input needs a [cr] TYPE ;finish "file" message PRTTAB 4,1 ;tab to here ERASE ;erase to end of screen ;ask for the LIST message number and parse MOVW #1,CURLST(A3) ;hardset the current list PRTTAB 5,5 ;cursor here TYPE ;prompt KBD ;wait for entry GTDEC ;get number into D1 BMI 10$ ;error on a negitive number CMP D1,#0 ;another error BEQ 10$ ;so inform them so CMP D1,#40. ;max message number BLE 20$ ;if less than max, continue ;user mis-entered a valid message number - give error and return 10$: PRTTAB 7,5 ;tab to here MOV #7,D1 ;get a bell TTY ;beep TYPE RTN ;err msg and return ;user entered a valid message number - find message in EMAIL.DAT 20$: PUSH D1 ;save message number CALL FNDDAT ;find EMAIL.DAT ;locate your record block, lock it and read it MOV YOULOC(A3),A0 ;get your memory location ADD #12,A0 ;point to your resource CALL LOCREC ;lock it while you read OPENR @A4 ;open EMAIL.DAT CALL RYREC ;and read in your record ;find the message filename and make sure message was READ POP D1 ;get message number DEC D1 ;msg #1 is really msg #0 etc. MULS D1,#6 ;calculate offset ADD D1,A1 ;point to the message CMPW @A1,#0 ;NEW flag cleared? BEQ 30$ ;yup, half-way done with check ;don't let them save to a file if not read PRTTAB 7,5 ;tab to here MOV #7,D1 ;get a bell TTY ;beep TYPE ;come here if any error occurs in FILMAL 25$: MOV YOULOC(A3),A0 ;point to your mem. loc. ADD #12,A0 ;point to your resource CLRW @A0 ;free your record RTN ;seek out file 30$: CMP 2(A1),#0 ;filename non-zero? BNE 35$ ;non zero so AOK PRTTAB 7,5 ;tab here MOV #7,D1 ;get a bell TTY ;beep TYPE BR 25$ ;unlock and return ;setup the input DDB from BOX: 35$: LEA A5,IDDB(A3) ;A5 points to msg DDB MOVW #[DSK],IDDB+D.DEV(A3) ;DSK0:*.MAL[7,2] CLRW IDDB+D.DRV(A3) MOVW #3402,IDDB+D.PPN(A3) MOVW #[MAL],IDDB+D.EXT(A3) MOV 2(A1),IDDB+D.FIL(A3) ;* of *.MAL INIT @A5 ;initialize DDB LOOKUP @A5 ;mail message there? BEQ 40$ ;yup ;didn't find the file - inform and return TYPE < > ;nope, error message PRNAM IDDB+D.FIL(A3) ;type FILENAME TYPE < is not found - FILE ROUTINE COULD NOT FIND FILE IN BOX:> JMP 25$ ;unlock and return ;message DDB setup, give instructions for file to create 40$: HOME ;go here DIM ;dim instructions TYPE <6 characters total, CR to cancel.> BRIGHT ;back to bright input PRTTAB 6,5 ;tab to here TYPE ;prompt ;now get the filespec and look for "cancel" KBD ;get the input CTRLC 25$ ;forget it! CMPB @A2,#15 ;just a [cr]? = cancel JEQ 25$ ;yup ;let FSPEC parse for us LEA A4,ODDB(A3) ;use this DDB for parsing MOVB #D$ERC!D$BYP,ODDB+D.FLG(A3) ;set D$ERC bit (trap errors) FSPEC @A4,LST ;get the filename CMPB ODDB+D.ERR(A3),#D$ESPC ;error? JEQ 70$ ;yup CMP ODDB+D.FIL(A3),#0 ;just a ".xxx"? JEQ 70$ ;another error ;file parsed AOK, provide user stats too JOBIDX A6 ;get this user MOVW JOBDEV(A6),ODDB+D.DEV(A3) ;hardset (memory is cluttered) MOVW JOBDRV(A6),ODDB+D.DRV(A3) ;device and drive now set MOVW JOBUSR(A6),ODDB+D.PPN(A3) ;[PPN] set ;see if filename.lst exists - hope not INIT @A4 ;initialize DDB LOOKUP @A4 ;look for it BNE 60$ ;not there, good! PRTTAB 8.,5 ;else tab here TYPE ;part of error message PRNAM ODDB+D.FIL(A3) ;the filename TYPE < - file already exists!> ;the rest of the message JMP 25$ ;unlock and return ;file not in user PPN, time for the transfer 60$: OPENI @A5 ;open input file from BOX: OPENO @A4 ;and output file in PPN CALL MAKFIL ;make a file out of the msg ;all done making the file, unlock the user record and clean up CLOSE @A5 ;close the files CLOSE @A4 JMP 25$ ;unlock and return ;come here if directions not followed 70$: MOV #7,D1 ;here when didn't follow inst. TTY ;beep and instruct TYPE < Whoops! Looks like an invalid filename to me.> JMP 25$ ;and return ;READ YOUR RECORD Subroutine - reads your block from EMAIL.DAT ; on entry: EMAIL.DAT open and A4 points to it ; on exit: A1 points to the start of the block in the buffer ;------------------------------------------------------------------ RYREC: PUSH D4 MOVW FB(A3),D4 ;get block "0" ADDW YOUREC(A3),D4 ;calculate your block number MOVW D4,IDDB+D.REC+2(A3) ;set it READ @A4 ;read the block MOV IDDB+D.BUF(A3),A1 ;point to start of block POP D4 RTN ;and return ;READ THEIR RECORD Subroutine - read their block from EMAIL.DAT ; on entry: EMAIL.DAT open - A4 is index ; on exit: A1 points to start of block read in buffer ;---------------------------------------------------------------- RTREC: PUSH D4 MOVW FB(A3),D4 ;calculate your block number ADDW THRREC(A3),D4 MOVW D4,IDDB+D.REC+2(A3) ;set block number to read READ @A4 ;read the block MOV IDDB+D.BUF(A3),A1 ;point to start of block POP D4 RTN ;LETTER HEADER Subroutine - types out header of list mail ; on entry: A5 is set up for DSK0:{filename}[7,2] in ODDB ; D4 contains count ; on exit: header information displayed ;-------------------------------------------------------------------- LTRHDR: PUSH A1 PUSH D1 INIT @A5 ;initialize ODDB LOOKUP @A5 ;it better exsist! BEQ 10$ ;yes it does TYPE < > PRNAM ODDB+D.FIL(A3) ;file.ext TYPE < is not found - FILE NOT FOUND IN LETTER HEADER SUBROUTINE> CRLF CRLF POP D1 POP A1 RTN 10$: MOV D4,D1 ;get binary number DCVT 2,OT$TRM!OT$ZER ;type out message number TYPE <. From: > LEA A1,RADBUF(A3) ;for TYPNAM OPENI @A5 ;open file for input FILINL @A5 ;get who sent MOV D1,@A1 ;A1 holds packed name CALL TYPNAM ;type out name TYPE < Postmark: > PUSH D3 ;$ODTIM uses all these PUSH D4 PUSH D5 PUSH A2 FILINL @A5 ;bypass TO (used in UNREAD) FILINL @A5 ;get date MOV D1,D3 ;setup for $ODTIM FILINL @A5 ;get time MOV D1,D4 CLR D5 MOV #-1,D5 MOV #0,A2 ;clear out A2 (user term) CALL $ODTIM ;what we wanted!!! POP A2 ;restore registers POP D5 POP D4 POP D3 CRLF ;screen control TYPE < Title: > ;space over BRIGHT ;title always bright 20$: FILINB @A5 ;get Title COMB D1 CMPB D1,#15 ;CR? BEQ EOTITL ;yup, end of title TTY ;type out character BR 20$ EOTITL: CLOSE @A5 CRLF ;screen control CRLF POP D1 ;adjust stack POP A1 RTN ;UNREAD LETTER HEADER Subroutine - types out header of unread mail ; on entry: A5 is set up for DSK0:{filename}[7,2] in ODDB ; D4 contains count ; on exit: header information displayed ;-------------------------------------------------------------------- URLTHD: PUSH A1 PUSH D1 INIT @A5 ;initialize ODDB LOOKUP @A5 ;it better exsist! BEQ 10$ ;yes it does TYPE < > PRNAM ODDB+D.FIL(A3) ;file.ext TYPE < is not found - FILE NOT FOUND IN UNREAD LETTER HEADER SBR> POP D1 ;restore/return POP A1 RTN 10$: MOV D4,D1 ;get binary number DCVT 2,OT$TRM!OT$ZER ;type out message number TYPE <. To: > ;who it was sent to LEA A1,RADBUF(A3) ;for TYPNAM OPENI @A5 ;open file for input FILINL @A5 ;bypass YOUR name FILINL @A5 ;get THEIR name MOV D1,@A1 ;A1 holds packed name CALL TYPNAM ;type out name TYPE < Postmark: > ;time/date info PUSH D3 ;$ODTIM uses all these PUSH D4 PUSH D5 PUSH A2 FILINL @A5 ;get date MOV D1,D3 ;setup for $ODTIM FILINL @A5 ;get time MOV D1,D4 ;save it in D4 CLR D5 MOV #-1,D5 MOV #0,A2 ;clear out A2 (user term) CALL $ODTIM ;what we wanted!!! POP A2 ;restore POP D5 POP D4 POP D3 CRLF ;screen control TYPE < Title: > ;space over for title 20$: FILINB @A5 ;get Title COMB D1 ;flip byte CMPB D1,#15 ;CR? BEQ 30$ ;yup, end of title TTY ;nope, type out character BR 20$ ;get next char 30$: CLOSE @A5 ;close file CRLF ;2 blank lines CRLF POP D1 ;adjust stack/return POP A1 RTN ;RESET Subroutine - resets terminal to "start" ; on entry: true ; on exit: screen cleared, setup like "start" ;-------------------------------------------- RESET: PRTTAB 4,1 ;move cursor here ERASE ;erase to end of screen HOME ;cursor to EMAIL > CLRLIN ;erase to end of line RTN ;and return ;MAKE FILE Subroutine - makes a file of a mail message in user PPN ; on entry: A5 is DDB for input file in BOX: ; A4 is DDB for output file in user PPN ; BOTH files are open and ready to go ; on exit: file is created in user PPN ;------------------------------------------------------------------- MAKFIL: PUSH A2 ;save reggies PUSH D2 ;let the user know what you are making PRTTAB 8.,5 ;tab here TYPE ;part of the msg PRNAM ODDB+D.FIL(A3) ;type out the file.lst ;setup From: MOVB #'F,D1 FILOTB @A4 MOVB #'r,D1 FILOTB @A4 MOVB #'o,D1 FILOTB @A4 MOVB #'m,D1 FILOTB @A4 MOVB #':,D1 FILOTB @A4 ;now get the name of the sender LEA A1,RADBUF(A3) ;point to some space FILINL @A5 ;get the name MOV D1,@A1 ;save name in RADBUF LEA A2,SCRAP(A3) ;get some workspace UNPACK ;convert name to ASCII UNPACK LEA A2,SCRAP(A3) ;repoint to start MOV #6,D2 ;move in 6 character name 5$: MOVB (A2)+,D1 ;get a byte FILOTB @A4 ;write it to the file DEC D2 ;one less character BNE 5$ ;do this til zero MOV #15,D1 ;output a crlf FILOTB @A4 MOV #12,D1 FILOTB @A4 ;now setup Postmark: MOV #'P,D1 ;type out Postmark: FILOTB @A4 MOV #'o,D1 FILOTB @A4 MOV #'s,D1 FILOTB @A4 MOV #'t,D1 FILOTB @A4 MOV #'m,D1 FILOTB @A4 MOV #'a,D1 FILOTB @A4 MOV #'r,D1 FILOTB @A4 MOV #'k,D1 FILOTB @A4 MOV #':,D1 FILOTB @A4 FILINL @A5 ;bypass TO (used in UNREAD) LEA A2,ODDB(A3) ;A2 to point to output file PUSH D3 ;save these guys PUSH D4 PUSH D5 CLR D5 ;clear longword MOV #^B1000001011110110,D5 ;setup flags for correct output FILINL @A5 ;get the date MOV D1,D3 ;setup for output FILINL @A5 ;get the time MOV D1,D4 ;setup for output PUSH A5 ;save file pointers PUSH A4 CALL $ODTIM ;output result to file POP A4 ;restore file pointers POP A5 POP D5 ;adjust stack POP D4 POP D3 MOV #15,D1 ;output a crlf FILOTB @A4 MOV #12,D1 FILOTB @A4 ;now set up Title: MOV #'T,D1 ;output Title: FILOTB @A4 MOV #'i,D1 FILOTB @A4 MOV #'t,D1 FILOTB @A4 MOV #'l,D1 FILOTB @A4 MOV #'e,D1 FILOTB @A4 MOV #':,D1 FILOTB @A4 ;and then output the title to the file 10$: FILINB @A5 ;get a character COMB D1 ;flip it CMPB D1,#15 ;cr? BEQ 20$ ;yup, title done except cr FILOTB @A4 ;nope, output the character BR 10$ ;and get the next one ;output chars byte by byte til eof 20$: FILOTB @A4 ;output the cr MOV #12,D1 ;output a lf FILOTB @A4 MOV #15,D1 ;output a cr FILOTB @A4 25$: FILINB @A5 ;now do byte by byte til eof COMB D1 ;flip it TST IDDB+D.SIZ(A3) ;eof? BEQ 30$ ;yup FILOTB @A4 ;nope, write it BR 25$ ;and get next char ;hit eof - clean up 30$: POP D2 ;fix stack POP A2 RTN ;and return ;TYPE NAME Subroutine - types out users name ; on entry: A1 points to RAD50 name ; on exit : name typed out ;------------------------------------------- TYPNAM: PUSH A2 ;save register LEA A2,SCRAP(A3) ;point to scrap space UNPACK ;generate name UNPACK CLRB @A2 ;null end char LEA A2,SCRAP(A3) ;repoint TTYL @A2 ;type it out POP A2 ;restore/return RTN ;DELELTE MAIL FROM BOX: Subroutine - deletes file off of DSK0:[7,2] ; on entry: user chose D_# option, FN is non-blank ; on exit: FN is deleted from BOX: ;------------------------------------------------------------------ DELBOX: PUSH A6 ;save reggies PUSH A5 ;save original LOG location JOBIDX A6 ;get your IDX PUSHW JOBUSR(A6) ;save PPN PUSHW JOBDEV(A6) ;and device PUSHW JOBDRV(A6) ;and drive ;set new LOG location to BOX: to bypass protection violation MOVW #[DSK],JOBDEV(A6) ;set device MOVW #0,JOBDRV(A6) ;set drive MOVW #3402,JOBUSR(A6) ;move in [7,2] ;fill DDB with file to be deleted, then delete it if there LEA A5,ODDB(A3) ;A5 DDB for BOX: filename MOVW #[DSK],ODDB+D.DEV(A3) ;DSK0:[7,2] *.MAL CLRW ODDB+D.DRV(A3) MOVW #3402,ODDB+D.PPN(A3) MOVW #[MAL],ODDB+D.EXT(A3) MOV FN(A3),ODDB+D.FIL(A3) ;the filename INIT @A5 ;initialize LOOKUP @A5 ;find it BNE 10$ ;it's not there - no sweat DSKDEL @A5 ;erase it (was found) ;restore current LOG and registers, then return 10$: JOBIDX A6 ;restore current log POPW JOBDRV(A6) POPW JOBDEV(A6) POPW JOBUSR(A6) POP A5 ;restore reggies POP A6 RTN ;and return ;FULL SCREEN Subroutine - prompts for "Q" or "any key" to continue ;----------------------------------------------------------------- FULSCR: CRLF ;blank line NOECHO ;echo off BRIGHT ;bright output TYPE < Q> ;Q of Quit in bright DIM ;end of screen, dim TYPE ;finish part of msg BRIGHT ;back to bright TYPE ;more of the message DIM ;back to dim TYPE ;end of message RTN ;and return ;INPUT ERROR Subroutine - error on input, key invalid ;----------------------------------------------------- IE: PUSH D1 ;save register MOV #7,D1 ;get a bell TTY ;ding the user HOME ;move cursor home MOV #40,D1 ;get a space TTY ;clear last key HOME ;move cursor home POP D1 ;restore register RTN ;and return BYEBYE: PRTTAB -1,0 EXIT ;FIND BULK FILE Subroutine - finds USER.BLK file in BOX: ; on entry: USER.BLK might or might not exist ; on exit: USER.BLK exists, A1 points to start of block ;-------------------------------------------------------------- FNDBLK: LEA A4,IDDB(A3) ;point to a DDB MOV YOU(A3),IDDB+D.FIL(A3) ;set USER MOVW #[BLK],IDDB+D.EXT(A3) ;set .BLK MOVW #[DSK],IDDB+D.DEV(A3) ;set DSK0:[7,2] MOVW #0,IDDB+D.DRV(A3) MOVW #3402,IDDB+D.PPN(A3) INIT @A4 ;create buffer space LOOKUP @A4 ;found it? BEQ 10$ ;yup, open it and read it JOBIDX A6 PUSHW JOBUSR(A6) PUSHW JOBDRV(A6) PUSHW JOBDEV(A6) MOVW #402,JOBUSR(A6) MOVW #0,JOBDRV(A6) MOVW #[DSK],JOBDEV(A6) ;create USER.BLK for USER if file not there MOVW #1,IDDB+D.ARG+2(A3) ;nope, get 1 block DSKCTG @A4 ;create random file OPENR @A4 ;open file READ @A4 ;read in the block MOV IDDB+D.BUF(A3),A1 ;point to block of file MOV #128.,D4 ;do this 128 times... 5$: CLR (A1)+ ;clear the block DEC D4 ;one less lword to clear BNE 5$ ;still more to do WRITE @A4 ;write the new file JOBIDX A6 POPW JOBDEV(A6) POPW JOBDRV(A6) POPW JOBUSR(A6) BR 15$ ;bypass read below ;USER.BLK exists, read the file 10$: OPENR @A4 ;open USER.BLK file READ @A4 ;get the block 15$: MOV IDDB+D.BUF(A3),A1 ;point to block of file RTN ;HELP Subroutine - types out help, that's it ;------------------------------------------- HELP: PRTTAB 4,1 ;tab here ERASE ;clear to end of screen CRLF ;5,1 TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR TYPECR RTN END .