;
; -----> v3.13						Sept 15, 1984
;
; -----> For udate history and current version info please see the file
;	 EMX-DOC.HIS
;
;-----------------------------------------------------------------------
;
; EMX.MAC - by Simon Ewins
;
; This is the signon/mail module for the EMX series of RBBS (RCPM) pro-
; grams.
;
; ==> v2.30 upgrades include all mods and suggestions by Harry Kaemmerer
;	    and Mark Howard, as well as suggestions by many users!
;
;-----------------------------------------------------------------------
;
; Originally written between 12/16/83 & 01/15/84, and first implemented
; as v1.0 in January 1984 on EMX RCP/M Toronto, Ontario, Canada by Simon
; Ewins, Toronto, Ontario, Canada.  Data:  (416) 484-9663 (EMX RCPM)
;
;-----------------------------------------------------------------------
;
; This file is designed to be assembled with M80 and L80.
;
;-----------------------------------------------------------------------
;
	.Z80
	ASEG
	ORG	100H
;
	JP	START
;
;-----------------------------------------------------------------------
;
; The two bytes for the version and revision must be here, right after
; the first 3 byte jump....
;
;-----------------------------------------------------------------------
;
VER::	DB	3		; Version
VERR::	DB	13		; Revision
;
;
; Include header storage area, strings and equates
;
	INCLUDE	EMXHDR.MAC	; Header info (switches etc.)
;
; Include clock routines
;
	INCLUDE	GETTIM.MAC	; Clock read routine...
;
; Version message
;
VMSG::	DB	CR,LF,LF.'E-MX v',0
;
;
; My credit!  (Turn it on or off but please leave it here) (!)
;
AUTHOR::DB	' (c)1984 Simon J. Ewins',CR,LF,0
;
;-----------------------------------------------------------------------
;
; Start of program
;
;-----------------------------------------------------------------------
;
START::	LD	A,0CDH
	LD	(0),A		; Disable ^c
;
	LD	HL,0		; Set up local stack
	ADD	HL,SP
	LD	(CCPSTK),HL	; Saving old one
	LD	SP,STACK
;
; Call to GETTIM at this time does nothing... It is here so that the
; user may use GETTIM to perform custom routines and any patching that
; is required by his specific system.
;
	CALL	GETTIM		; Ontime run of SUB to get logon time
	CALL	ENDEMX		; Returns HL-> last byte of file
	LD	A,0FFH		; Flag byte for message routines
	LD	(HL),A
	INC	HL		; This is start of the message storage buffer
	LD	(MSG),HL	; The next defines the message space for use
				; When entering a message
	LD	DE,MSGBUF	; Messages must be multiples of 64 then...
	ADD	HL,DE		; This become the start of general buffer
	LD	(MSGARR),HL	;
	LD	A,(SYSDRV)	; Log into where the system files are
	LD	E,A
	LD	C,LOGDRV
	CALL	BDOS
	LD	A,(SYSUSR)
	LD	E,A
	LD	C,LOGUSR
	CALL	BDOS
;
; Get INDEX information from disk and store it im memory for later
;
CALLER::LD	HL,INDEX	; Point to index name
	CALL	OPEN		; Open file
	LD	HL,NDXLEN	; Length of record
	LD	(RRSZ),HL	; Set into buffer
	LD	HL,0		; Set record number
	CALL	GET		; Get record
	CALL	CLOSE		; Close file
	LD	HL,IDATEF	; Move from buffer
	LD	DE,IDATE	; To storage
	LD	BC,NDXLEN	; This many bytes
	LDIR			; Move record
;
; Clear mail 'called' flag so that if signon is skipped we jump from
; 'mail' to CP/M instead of running ENTRCPM.
;
	XOR	A
	LD	(MCALL),A	; Mail section check for cp/m exit
	LD	(NUSR),A	; Clear new user flag
	LD	A,(TRIES)	; Set number of tries for getnme
	LD	(TRIED),A	; To maximum allowed
;
; Check if we are to get caller's information or go to the mail section.
; Mail is entered by simply loading signon and checking the reentr byte
; therefore BYE must reset (REENTR) to 0 when the caller leaves.  (Or a
; 'shadow' file called bye that updates and then runs the real BYE.)
;
	LD	A,(REENTR)	; See if signed on already
	CP	1		; 1=yes, 0=no (0 set by bye at reentr:)
	JP	Z,MAIL		; Already signed on, so run mail
;
; Check for whether hard-copy wanted (function handled by bye)
;
	LD	A,(HRDLOG)	; See if hard-copy wanted (in index file)
	LD	(HARDON),A	; 1=yes, 0=no (store in bye)
;
; Get today's date and place it in index area, checking for first caller
; of the day so we can update files if it is.
;
	CALL	CDATE		; Make string a 3 byte binary number
	CALL	CTIME		; Make time string a binary number
	LD	A,(IDATE+1)	; Get last day someone called
	LD	B,A		; Move to b
	LD	A,(BDATE+1)	; Get today's day
	CP	B		; Same?
	JR	Z,MVDATE	; Yes so skip this...
	LD	A,1
	LD	(SDONE+1),A	; Set flag for update
;
MVDATE::LD	IX,BDATE	; Point to binary date
	LD	IY,IDATE	; And date storage area
	LD	A,(IX)		; Get month
	LD	(IY),A		; Store it
	LD	A,(IX+1)	; Get day
	LD	(IY+1),A	; Store it
	LD	A,(IX+2)	; Get year
	LD	(IY+2),A	; Store it
;
; See if WELCOME file present and if so type it
;
	LD	A,(WELON)
	OR	A
	JP	Z,VCSTRT	; Welcome not there or not wanted
;
; WELCOME wanted (and present) so type it. this type routine does not
; use the random file buffer(s), rather it has it's own sequential read
; routine and uses the default DMA at 80h.
;
	LD	HL,WELCOM
	CALL	OPEN		; Open text file
	LD	DE,DMA		; Set DMA
	LD	C,SETDMA
	CALL	BDOS		; Using BDOS call
;
TYPE1::	LD	BC,80H		; Set character position
;
TYPE2::	LD	A,C
	CP	80H		; End of buffer yet?
	JR	C,TYPE3
	PUSH	HL
	PUSH	BC
	LD	DE,FCB
	LD	C,READB		; Read block
	CALL	BDOS
	POP	BC
	POP	HL
	JR	NZ,WELCLS
	LD	C,0		; Reset character count
	LD	HL,TBUFF
;
TYPE3::	LD	A,(HL)		; Type block
	AND	7FH
	CP	EOF
	JR	Z,WELCLS
	CP	CR
	JR	Z,TYPE4
	CP	LF
	JR	Z,TYPE4
	CP	TAB
	JR	Z,TYPE5
	CALL	ECHOT
	INC	B		; Increment tab
	JR	TYPE6
;
TYPE4::	CALL	ECHOT
	LD	B,0		; Reset tab
	JR	TYPE6
;
TYPE5::	LD	A,' '
	CALL	ECHOT		; Tab becomes spaces
	INC	B
	LD	A,B
	AND	7
	JR	NZ,TYPE5
;
TYPE6::	INC	C
	INC	HL
	PUSH	HL
	PUSH	BC
	CALL	GETCH
	POP	BC
	POP	HL
	CP	'S'-40H
	CALL	Z,PAUSE
	CP	ESC
	JR	Z,WELCLS
	JR	TYPE2
;
ECHOT::	CALL	ECHO
	RET
;
WELCLS::CALL	CLOSE
	JR	VCSTRT		; Done
;
PAUSE::	PUSH	HL
	PUSH	BC
	CALL	GETCH
	POP	BC
	POP	HL
	JR	Z,PAUSE
	RET
;
; Check for version number and credits print
;
VCSTRT::LD	A,(VERSION)	; See if we are to print version message
	OR	A
	JR	Z,START0	; If 0 then not wanted
	LD	HL,VMSG		; Wanted, so point at message
	CALL	PRINTM
	LD	HL,(VER)	; L=version, h=revision
	CALL	PVER		; Then print number.revision
;
START0::LD	A,(CREDITS)	; How about author's credit?
	OR	A
	JR	Z,GETNME	; If 0 then not wanted
	LD	HL,AUTHOR	; Point to message
	CALL	PRINTM
;
; Get caller's name.  Name must be in form :: first last.  Iinitials are
; not permitted.  There is a check done for extra spaces or any other
; nonsense that makes it more difficult to deal with later.
;
GETNME::LD	A,(TRIED)	; Get attempts
	DEC	A		; Less one
	JP	Z,PASOUT	; Too many attempts
	LD	(TRIED),A	; Still some left so store new value
;
	CALL	PRINT
	DB	CR,LF
	DB	'Enter your FIRST & LAST names:'
	DB	CR,LF
	DB	'______________________________<<--',BEL,CR,0
	LD	B,30		; Input length
	LD	C,20H		; Force caps (c=0 for no caps)
	XOR	A		; Echo on
	LD	(COUNT+1),A	; Clear msb of character count
	LD	D,A		; No word-wrap
	CALL	INPUT
	CP	0
	JP	Z,GETNME
	LD	(COUNT),A
	LD	C,1		; Assume one character
;
LOOP::	LD	A,(HL)		; Get character
	CP	0
	JP	Z,NMERR
	CP	' '
	JR	Z,GOTSEP
	CP	'A'
	JP	C,NMERR		; Must be between A & Z
	CP	'Z'+1
	JP	NC,NMERR
	INC	HL
	INC	C		; Bump character count
	JR	LOOP
;
GOTSEP::LD	A,C		; A=count
	CP	2		; Ensure at least two char before delimiter
	JP	C,NMERR
	LD	A,','
	LD	(HL),A		; Make seperater a comma
	LD	(SPACE),HL	; Save address for later
	INC	HL		; Reset pointer to character after delimiter
	LD	C,1		; Set counter
;
LOOP00::LD	A,(HL)		; Loop again for second name
	CP	0
	JR	Z,GOTEND
	CP	'A'
	JR	C,NMERR
	CP	'Z'+1
	JR	NC,NMERR
	INC	HL
	INC	C		; Bump count
	JR	LOOP00
;
GOTEND::LD	A,C		; Get delimiter position
	CP	2		; Last name needs more than 1 charaacter
	JP	C,NMERR		; Name entered incorrectly
;
; Got a valid name (first last) so store it with , instead of the space
; in LASTCALR file buffer.
;
	LD	BC,(COUNT)
	LD	HL,INBUF
	LD	DE,LSTCLR+18	; Move name to last caller buffer
	LDIR
	LD	A,CR
	LD	(DE),A
	INC	DE
	LD	A,LF
	LD	(DE),A		; Crlf at end of user info
	INC	DE
	LD	A,1AH		; End-of-file marker
	LD	(DE),A
	LD	HL,(SPACE)	; Get delimiter position in buffer
	LD	A,' '
	LD	(HL),A		; Make it a space
	LD	HL,INBUF
	LD	DE,UNAME
	LD	BC,30		; Move name to storage
	LDIR
	JR	SEEK		; Now we see if we can find caller in file
;
; If space not found then probably didn't enter two names or entered
; initial, period or none A-Z character
;
NMERR::	CALL	PRINT
	DB	CR,LF
	DB	'FIRST & LAST name required.',CR,LF,BEL
	DB	'No initials, punctuation or middle name.',0
	JP	GETNME
;
; Open users file for search, initialize arguments
;
SEEK::	CALL	PRINT
	DB	CR,LF
	DB	'Wait...',0
	LD	HL,USERS	; Point to user filename
	CALL	OPEN		; Open users file
	LD	HL,USRLEN	; Length of record
	LD	(RRSZ),HL
	LD	HL,(IUSRC)	; Number records
;
; Loop to read users file and attempt match
;
RDUSRS::CALL	GET
	LD	B,30
	LD	HL,UNAMEF
	LD	DE,INBUF
	CALL	MATCH
	CP	0
	JP	Z,FNDUSR	; Match so process
	LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,NEWUSR
	JP	RDUSRS		; No, keep going
;
; Found user so process info
;
FNDUSR::LD	A,(ACCESSF)
	CP	1		; Banned?
	JP	Z,BAN		; (if user deleted this is caught later)
	LD	HL,(RRNO)
	LD	(TMPREC),HL	; Set record number
	JP	PASS
;
; User access=1 means banned from access so dump
;
BAN::	CALL	PRINT
	DB	CR,LF,LF
	DB	'System is busy....',CR,LF
	DB	'Please try again later.',0
	JP	ERROR
;
; Couldn't find name in file, so must be new user.  Make sure there is
; space in file and if not then dump.
;
NEWUSR::CALL	CLOSE
	LD	HL,(IUSER)	; Get number of users
	LD	DE,(USRS)	; Get max number allowed
	AND	A		; Clear carry
	SBC	HL,DE		; Hl less?
	JP	C,NUOK		; Ok
	LD	HL,NONME	; No, see if spelled okay
	CALL	PRINTM		; Ask question
;
TYPOW::	CALL	GETCH
	JR	Z,TYPOW
	CALL	CAPS
	CP	'Y'
	JR	Z,FULL
	CP	'N'
	JP	Z,NOPE		; Print NO message then start all over.
	JR	TYPOW
;
FULL::	CALL	PRINT
	DB	'Yes.'
	DB	CR,LF,LF
	DB	'Sorry, database is FULL.  Please try again tomorrow.',0
	JP	ERROR
;
NOPE::	LD	HL,NOPE1
	CALL	PRINTM
	JP	VCSTRT
;
NOPE1::	DB	'No.',CR,LF,0
;
NONME::	DB	CR,'                  ',CR,LF
	DB	'Name not found.   ',CR,LF
	DB	'Check your spelling, is it correct? ',0
;
; Space available, check for CP/M knowledge (password in EMXSUBS)
;
NUOK::	LD	HL,NONME
	CALL	PRINTM
;
TYPOW1::CALL	GETCH
	JR	Z,TYPOW1
	CALL	CAPS
	CP	'Y'
	JR	Z,NERD
	CP	'N'
	JP	Z,NOPE		; Print NO message then start all over.
	JR	TYPOW1
;
NERD::	CALL	PRINT
	DB	'Yes.'
	DB	CR,LF,0
	LD	A,(KNOWON)	; See if we are using this question
	OR	A
	JP	Z,CP		; Nope so skip this
;
NERD0:	LD	HL,NRDQUS	; Point to question
	CALL	PRINTM
	LD	B,10		; Length
	LD	C,20H		; Force caps
	XOR	A		; Echo on
	LD	D,A		; No auto-return
	CALL	INPUT		; Get location
	CP	0
	JP	Z,NERD0		; Not so easy! try again....
	LD	DE,NRDANS
	LD	B,10		; Length to match
	CALL	MATCH
	CP	0
	JP	Z,NONERD	; Got it
	CALL	PRINT
	DB	CR,LF
	DB	'Sorry, incorrect.',CR,LF
	DB	'There is nothing of interest here for '
	DB	'non-CP/M users.',CR,LF
	DB	'Try one of the message oriented BBS''s.',0
	JP	ERROR		; Say bye-bye
;
; Either uses CP/M or reads a lot of books!
;
NONERD::CALL	PRINT
	DB	CR,LF
	DB	'We only have to do that once!',0
;
; Find where caller is from (new users)
;
CP::	CALL	PRINT
	DB	CR,LF
	DB	'Where are you calling from?'
	DB	CR,LF
	DB	'____________________<<--',CR,0
	LD	B,20		; Length
	LD	C,20H		; Caps
	XOR	A		; Echo on
	LD	D,A		; No word-wrap
	CALL	INPUT		; Get location
	CP	0
	JP	Z,CP
	LD	DE,CITPRV
	LD	BC,20
	LDIR			; And save in memory
	CALL	PRINT
	DB	CR,LF,LF,'You are ',0
	LD	HL,UNAME
	LD	B,30
	CALL	PRINTL
	CALL	PRINT
	DB	'.',CR,LF
	DB	'From ',0
	LD	HL,CITPRV
	LD	B,20
	CALL	PRINTL
	CALL	PRINT
	DB	'.',CR,LF
	DB	'Is this correct? ',0
;
WAIT::	CALL	GETCH		; See if char there
	JP	Z,WAIT		; No so wait more
	CALL	CAPS
	CP	'Y'		; Yes?
	JP	Z,YNEW
	CP	'N'		; No?
	JR	NZ,WAIT		; If neither then wait more
	LD	HL,NOMSG	; Must be no
	CALL	PRINTM
	JP	VCSTRT
;
YESMSG::DB	'Yes',0
NOMSG::	DB	'No',CR,LF,LF,0
;
PSL6::	CALL	PRINT
	DB	CR,LF
	DB	'Must be at least 6 characters.',BEL,0
	JR	PS
;
YNEW::	LD	HL,YESMSG
	CALL	PRINTM
;
NULLQ::	CALL	PRINT
	DB	CR,LF
	DB	'How many nulls do you need (0-50)? ',0
	LD	B,3
	LD	A,0
	LD	D,A
	LD	C,A
	CALL	INPUT
	OR	A
	JR	NZ,CNULL
	XOR	A
	JR	NULDN
;
CNULL::	LD	(CNVRT0+1),A	; Set number characters to convert
	PUSH	HL
	POP	IX		; Pointer to ix
	CALL	CNVRT0		; Make string binary number
	LD	A,L
	AND	A		; Clear carry
	LD	DE,51
	PUSH	HL
	SBC	HL,DE
	POP	HL
	JR	NC,NULLQ	; Over 50 so no good
	LD	A,L
;
NULDN::	LD	(NNULL),A
;
	LD	A,(TRIES)
	LD	(TRIED),A
;
; Allow selection of password
;
PS::	LD	A,(TRIED)
	DEC	A
	JP	Z,PASOUT
	LD	(TRIED),A
	CALL	PRINT
	DB	CR,LF
	DB	'Select a password (6-10 characters):'
	DB	CR,LF
	DB	'__________<<--',CR,0
	LD	B,10		; Length
	LD	C,20H		; Caps
	XOR	A		; Echo on
	LD	D,A		; No word-wrap
	CALL	INPUT		; Get password
	CP	6
	JP	C,PSL6		; Must be 6 characters long minimum
	LD	DE,PSWORD
	LD	BC,10
	LDIR			; And save in memory
;
; Set values for new user into place
;
	LD	HL,0
	LD	(TMESON),HL	; Set times on to 0
	LD	(DNLDS),HL	; Clear number downloads
	LD	(UPLDS),HL	; Clear number uploads
	LD	A,1		; Gets bumped to 2 before saving
	LD	(ACCESS),A	; Set access to new user
				; (access=0=deleted)
				; (access=1=banned)
	LD	(NUSR),A	; Flag new user so we bump access by 1
				; And run special new user file
	XOR	A
	LD	(MFLAG),A	; Clear mail waiting flag
	LD	(INITAR),A	; Goes to user 0 after signing on
	LD	(TRMCDE),A	; No terminal defined yet (dumb assumed)
	LD	(TOTTME),A	; Set 0 time used today so far
	LD	HL,(IUSER)
	INC	HL		; Since new user, bump count and...
	LD	(IUSER),HL	; Save bumped # users
	CALL	PRINT
	DB	CR,LF
	DB	'Wait...',0
	LD	HL,USERS
	CALL	OPEN		; Open file
	LD	HL,USRLEN
	LD	(RRSZ),HL	; Size of each record
	LD	HL,(IUSRC)	; Get start record number
;
; Check users file for deleted user so that we can use the space and
; therefore not make the file grow this time.
;
FULP::	CALL	GET
	LD	A,(ACCESSF)	; See if free
	CP	0
	JP	Z,FNDFRE	; Yes
	LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,NUREC		; Yes
	JP	FULP
;
; No free space so set up new record info
;
NUREC::	LD	HL,(IUSRC)	; Bump number records for index
	INC	HL
	LD	(IUSRC),HL
	LD	(RRNO),HL	; Set new record
;
; Got free space so set this guy into old deleted user's space.
;
FNDFRE::LD	HL,(RRNO)	; Get record number
	LD	(TMPREC),HL	; And store it temporarily
	JP	UPDATE		; Update index and user files
;
GMORN::	DB	'Good morning, ',0
GAFT::	DB	'Good afternoon, ',0
GEVE::	DB	'Good evening, ',0
MONTH::	DB	'Jan'
	DB	'Feb'
	DB	'Mar'
	DB	'Apr'
	DB	'May'
	DB	'Jun'
	DB	'Jul'
	DB	'Aug'
	DB	'Sep'
	DB	'Oct'
	DB	'Nov'
	DB	'Dec'
;
; If existing user we end up here to get password (3 tries)
;
PASS::	LD	A,(ACCESSF)	; Found name but check if this
	CP	0		; Guy has been deleted once first
	JP	Z,NEWUSR
	LD	A,(TRIES)	; Get tries allowed + 1
	LD	(TRIED),A	; Set countdown
;
; Now get the password
;
PS2::	LD	A,(TRIED)
	DEC	A
	JP	Z,PASOUT	; Too many tries
	LD	(TRIED),A
	CALL	PRINT
	DB	CR
	DB	'Password: ',0
	LD	B,10		; Length
	LD	C,20H		; Caps
	LD	A,1		; Set echo off
	LD	D,0		; No word-wrap
	CALL	INPUT
	CP	0
	JP	Z,PS2
	LD	DE,PSWORDF	; Match to password on file
	LD	B,10
	CALL	MATCH
	CP	0
	JP	NZ,PASERR
	CALL	PRINT
	DB	'Ok.'
	DB	CR,LF
	DB	'Wait...',0
	LD	HL,UNAMEF
	LD	DE,UNAME
	LD	BC,USRLEN
	LDIR			; Move user info to memory
;
; Valid user (new or existing) so update all elements of files
;
UPDATE::LD	IX,LASTON
	LD	IY,IDATE	; See if same day as last day on-line
	CALL	DATDIF		; And if not then 0 out total time today
	LD	A,H		; See if same day (0 difference)
	OR	L
	JR	Z,NOREST	; No time-total reset
	XOR	A
	LD	(TOTTME),A	; Reset byte to 0 for a new day
;
; Now we have to run through code to check for auto-bump...
;
; Code to bump user access level if today is not the same as last day
; day on. bumps a 2 to a 3 , -- level 5 or greater must be set by
; operator using maintenance routines.
;
NOREST::LD	A,(NUSR)
	CP	1		; If new user then bump to level 2
	JR	Z,BLEV
	LD	A,(ACCESS)
	CP	2
	JR	C,BMPDON	; If access<2 then no bump
	CP	3
	JR	NC,BMPDON	; If access>3 then no auto-bump
;
; Potential is here for a bump
;
	LD	IY,IDATE	; Today's date
	LD	IX,LASTON	; Get last date on here
	CALL	DATDIF		; See if this is same day as last call
	LD	A,H
	OR	L		; 0?
	JR	Z,BMPDON	; Same day so skip next
;
BLEV::	LD	A,(ACCESS)	; Get access level
	INC	A		; Bump 2->3
	LD	(ACCESS),A	; Save new level
	CP	3		; Level 3 now?
	JR	Z,MP3		; Yes, set usr/drv maps for 3
	LD	DE,USMP2
	LD	HL,DRMP2
	JR	SETMAP
;
MP3::	LD	DE,USMP3
	LD	HL,DRMP3
;
SETMAP::PUSH	DE
	POP	IX		; Userarea pointer in ix
	LD	IY,USRMP
	LD	A,(IX)
	LD	(IY),A
	LD	A,(IX+1)
	LD	(IY+1),A	; Move map to user area
	PUSH	HL
	POP	IX		; Drive pointer to ix
	LD	IY,DRVMP
	LD	A,(IX)
	LD	(IY),A
	LD	A,(IX+1)
	LD	(IY+1),A	; To user area
;
BMPDON::LD	A,1		; Set flag, indicate signed-on
	LD	(REENTR),A
	LD	IX,USRMP	; Point to user map in user record
	LD	IY,USRMAP	; Address in hi mem
	LD	A,(IX)
	LD	(IY),A
	LD	A,(IX+1)
	LD	(IY+1),A
	LD	IX,DRVMP	; Drive map in user record
	LD	IY,DRVMAP	; And address to store at
	LD	A,(IX)
	LD	(IY),A
	LD	A,(IX+1)
	LD	(IY+1),A
;
; Now update the rest of the information before we write the record
;
	LD	HL,(TMESON)
	INC	HL
	LD	(TMESON),HL	; Bump times on
	LD	HL,(TMPREC)	; Get user record number
	LD	(USREC),HL	; And move it to 'permanent' storage
	LD	A,(BSPEED)	; Read baudrate this time on and
	LD	(BDCDE),A	; Store it in user record
	LD	A,(NNULL)	; Read number nulls needed
	LD	(NULLS),A	; And store it in hi mem
	LD	A,(TRMCDE)	; Get terminal code
	LD	(TCODE),A	; And store in hi mem
	LD	HL,(DNLDS)	; Get number downloads
	LD	(DNLOADS),HL	; Address to store at
	LD	HL,(UPLDS)	; Number of uploads
	LD	(UPLOADS),HL	; Address to store at
	LD	HL,UNAME
	LD	DE,UNAMEF
	LD	BC,USRLEN
	LDIR			; Move info to buffer
	LD	IY,IDATE
	LD	IX,LASTONF	; Set today as last date on in the
	LD	A,(IY)		; Buffer ONLY, since we need last laston
	LD	(IX),A		; For stats printout that comes next...
	LD	A,(IY+1)
	LD	(IX+1),A
	LD	A,(IY+2)
	LD	(IX+2),A
;
; Now we write the user's record...
;
	LD	A,1
	LD	(WRTLOC),A	; Tell bye we are writing to disk
	LD	HL,USERS
	CALL	OPEN
	LD	HL,USRLEN
	LD	(RRSZ),HL	; Set record size
	LD	HL,(USREC)	; Get record number
	CALL	PUT
	CALL	CLOSE
;
; And then write the index...
;
	LD	HL,(ICALL)
	INC	HL		; Bump # callers
	LD	(ICALL),HL
	LD	HL,IDATE
	LD	DE,RNDBUF
	LD	BC,NDXLEN
	LDIR			; Move index info to buffer
	LD	HL,INDEX	; Convert filename to fcb
	CALL	OPEN
	LD	HL,NDXLEN	; Length of index record
	LD	(RRSZ),HL
	LD	HL,0
	CALL	PUT
	CALL	CLOSE
;
; Now set time and date into lastcalr file, write file for other pro-
; grams to access and then we're almost done.
;
	LD	DE,LSTCLR
	LD	HL,DATE
	LD	BC,8
	LDIR
	LD	A,','
	LD	(DE),A		; Format= hh:mm:ss,
	INC	DE
	LD	HL,TIME
	LD	BC,8
	LDIR
	LD	A,','
	LD	(DE),A		; Format= mm/dd/yy,
	LD	HL,LSTCLR
	LD	DE,RNDBUF
	LD	BC,LSTLEN
	LDIR			; Move info to random buffer
	LD	HL,LASTCAL
	CALL	OPEN		; Open file
	LD	HL,LSTLEN
	LD	(RRSZ),HL	; Set length of record
	LD	HL,0
	CALL	PUT		; Write to record 0
	CALL	CLOSE
	XOR	A
	LD	(WRTLOC),A	; Not writing anymore
;
; Okay, show what's going on and enter mail section if there is any
; waiting, else drop into CP/M.
;
	CALL	PRINT
	DB	CR,LF,LF,0
	CALL	GETTIM
	CALL	CTIME		; Get binary time
	LD	A,(BTIME)
	CP	12		; Is it morning?
	JR	NC,HELLO1
	LD	HL,GMORN	; Yes, say good morning
	JR	HELLO0
;
HELLO1::CP	18
	JR	NC,HELLO2
	LD	HL,GAFT		; Say good afternoon
	JR	HELLO0
;
HELLO2::LD	HL,GEVE		; Say good evening
;
HELLO0::CALL	PRINTM
	CALL	PRINT
	DB	'it''s ',0
	LD	HL,TIME
	CALL	PRINTM
	CALL	PRINT
	DB	' hours, ',0
	CALL	CDATE
	LD	A,(BDATE)
	LD	DE,3		; Length of each entry in table
	LD	H,0
	LD	L,A		; HL=index
	CALL	MLDL		; HL=offset
	LD	DE,MONTH-3	; Start of table less index
	ADD	HL,DE		; HL=address for this month
	LD	B,3
	CALL	PRINTL
	CALL	PRINT
	DB	' ',0
	LD	A,(BDATE+1)
	LD	H,0
	LD	L,A
	CALL	PB2ASC
	CALL	PRINT
	DB	', 19',0
	LD	A,(BDATE+2)
	LD	H,0
	LD	L,A
	CALL	PB2ASC
	CALL	PRINT
	DB	'.',CR,LF,LF
	DB	'You are caller.....: ',0
	LD	HL,(ICALL)
	CALL	PB2ASC
	CALL	PRINT
	DB	CR,LF
	DB	'System users.......: ',0
	LD	HL,(IUSER)
	CALL	PB2ASC
	CALL	PRINT
	DB	CR,LF
	DB	'Your signons.......: ',0
	LD	HL,(TMESON)
	CALL	PB2ASC
;
	LD	A,(NUSR)	; If new user skip next message
	OR	A
	JR	NZ,NSKP0
	CALL	PRINT
	DB	CR,LF
	DB	'Last signon was....: ',0
	LD	A,(LASTON)
	LD	DE,3		; Length of each entry in table
	LD	H,0
	LD	L,A		; Hl=index
	CALL	MLDL		; Hl=offset
	LD	DE,MONTH-3	; Start of table less index
	ADD	HL,DE		; Hl=address for this month
	LD	B,3
	CALL	PRINTL
	CALL	PRINT
	DB	' ',0
	LD	A,(LASTON+1)
	LD	H,0
	LD	L,A
	CALL	PB2ASC
	CALL	PRINT
	DB	', 19',0
	LD	A,(LASTON+2)
	LD	H,0
	LD	L,A
	CALL	PB2ASC
;
NSKP0::	LD	A,(ACCESS)
	SUB	2		; Make base 0 (0 & 1 never get here)
	LD	DE,ACTBLEN	; Length of each entry in table
	LD	H,0
	LD	L,A		; Hl=access level
	CALL	MLDL		; Hl=offset
	LD	DE,ACC2		; Start of table
	ADD	HL,DE		; Hl=address for this access level
;
; Set bye values based on access table and user's file
;
	LD	A,(HL)		; Get maximum drive
	LD	(MXDRV),A	; Set it
	INC	HL
	LD	A,(HL)		; Get maximum user area
	LD	(TMXUSR),A	; Set it temporarily
	INC	HL		; Point to minutes allowed on-line
;
; This code checks to see if the user has any time left today.
;
; NOTE: The update of the time used so far on a day is done by BYEMX.MAC
;	If you are not using BYEMX be sure to set TOT in EMXHDR to 0 to
;	skip this code.....
;
	LD	A,(TOT)		; See if we want to check total time used
	OR	A		; 1=yes
	JP	Z,NOTOT		; 0=no check wanted
;
	LD	A,(TOTTME)	; Get total time on-line today
	LD	B,A
	LD	A,(HL)		; Get max time allowed per day
	CP	B		; See if total used exceeds max allowed
	JR	Z,OVRLIM	; If equal then drop
	JP	C,OVRLIM	; If over then drop
;
	SUB	B		; Subtract total today and the ...
	JP	STOTME		; Time allowed is difference so set it
;
OVRLIM::CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'You have exceeded your daily maximum time allowed.'
	DB	CR,LF
	DB	'Please wait until tommorrow to call again .....',CR,LF,0
	JP	ERROR
;
NOTOT:; LD	A,(HL)		; Get minutes allowed on-line
STOTME:;LD	(MINON),A	; Save either (adjusted or not) time allowed
	LD	A,(ACCESS)	; Sleepy caller time-out=access level in minutes
				; Unless this is the sysop
	CP	9		; Check and see if sysop
	JP	NZ,NSYSOP	; No not sysop, must be regular user
	LD	A,(MINON)	; Must be sysop, he gets minon for timeout
;
NSYSOP::LD	(TOVAL),A	; And minutes to log-off if inactive caller
	LD	A,(ACCESS)	; Get access byte again
	LD	(LOCK),A	; And load in for restricted .com files etc.
	ADD	A,ASCII		; Add in ascii offset (make it an acii char.)
	LD	(ASCACC),A	; And place in ascii access location in bye
	CALL	PRINT
	DB	CR,LF
	DB	'Time allowed.......: ',0
	LD	A,(MINON)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
	CALL	PRINT
	DB	' minutes.',0
;
; Check to see if any mail waiting
;
	LD	A,(MFLAG)
	CP	1
	JR	Z,GMAIL
	JR	DONE
;
; Got some mail so jump to mail section. we clear the version and
; credits switches first so that they aren't read a second time.
;
GMAIL::	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'==>> You have messages waiting for you <<=='
	DB	CR,LF,0
	LD	A,1
	LD	(MCALL),A	; Flag that we need to come back
	DEC	A		; Clear version and credits flags
	LD	(VERSION),A	; Since we got them at signon
	LD	(CREDITS),A
	JP	MAIL
;
; Either no mail waiting or has been read so we are ready to run the
; file named at 'ENTRY'.  If new user then we run file at 'NENTRY'.
;
DONE::	CALL	PRINT
	DB	CR,LF,LF
	DB	'Press <RETURN>',0
;
DONWT::	CALL	GETCH
	JP	Z,DONWT
	CP	CR
	JP	NZ,DONWT	; Not carriage return
;
; Check for whether to update USERS/MSGINDEX files (every (updat)th call)
;
SDONE::	LD	A,0		; In-code mod for update
	OR	A
	CALL	NZ,UPD25	; Update if not zero
;
; Update INDEX
;
	CALL	PRINT
	DB	CR
	DB	'Standby, updating files....',0
	LD	A,1
	LD	(WRTLOC),A
	LD	HL,INDEX
	CALL	OPEN		; Open file
	LD	HL,IDATE
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR			; Move index to buffer
	LD	HL,NDXLEN
	LD	(RRSZ),HL	; Set record length
	LD	HL,0		; And record number
	CALL	PUT		; And write record
	CALL	CLOSE
	LD	A,(TMXUSR)	; Set max user area
	LD	(MXUSR),A
	XOR	A
	LD	(WRTLOC),A	; Not writing anymore
	LD	A,(NUSR)	; This a new user?
	OR	A
	JR	Z,NOTNEW
	LD	DE,NENTRY	; New users get file named at nentry
	JP	CPM
;
NOTNEW::LD	A,(ACCESS)	; See if this user is =>5
	CP	5		; If not then = 0
	JR	C,NOTSP		; So not special
	LD	A,(SPON)	; Switch is on??
	OR	A		; 0=no
	JR	Z,NOTSP		; 1=yes
;
	LD	DE,SPENTRY	; Get special file
	JP	CPM
;
NOTSP::	LD	DE,ENTRY	; Gets regular entry file
	JP	CPM
;
PASERR::CALL	PRINT
	DB	'Incorrect.'
	DB	CR,LF,0
	JP	PS2
;
PASOUT::CALL	PRINT
	DB	CR,LF,LF
	DB	'Too many tries...',0
	JP	ERROR
;
; USER and MSGINDEX file cleanup.  Deletes any records that are over
; (DELLEV) days old.  (DELLEV) is determined from a read of byte 4 of
; the access level table for current access level.  Banned users
; (access 1) are not deleted nor are any that have a 0 in byte 4 of
; their access level table.  (Usually this is access level 5 and up.)
;
UPD25::	LD	IX,(MSGARR)	; Get pointer to array area
	PUSH	IX		; And save it
	XOR	A		; Mark end of current array
	LD	(IX),A
	LD	(IX+1),A	; With 2 nulls
	CALL	PRINT
	DB	CR,LF
	DB	'Standby, updating system...',0
	LD	HL,USERS
	CALL	OPEN
	LD	A,1
	LD	(WRTLOC),A	; Set bye flag
	LD	HL,USRLEN	; Length of record
	LD	(RRSZ),HL
	LD	HL,(IUSRC)	; Number records
	INC	HL		; Force rec no + 1
	LD	(RRNO),HL	; To record # counter
;
SRTLP::	LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD252	; Yes
	CALL	GET
	LD	A,(ACCESSF)
	SUB	2		; Set base
	LD	DE,ACTBLEN	; Length of each entry in table
	LD	H,0
	LD	L,A		; Hl=access level
	CALL	MLDL		; Hl=offset
	LD	DE,ACC2+3	; Start of table + offset to byte wanted
	ADD	HL,DE		; Hl=address for this access level
;
; HL --> days inactivity is tolerated
;
	LD	A,(HL)
	LD	(DELLEV),A	; A=days to deletion
	LD	IY,IDATE	; Today's date
	LD	IX,LASTONF	; Last time this record active
	CALL	DATDIF		; Compare dates
	LD	A,(DELLEV)	; Get # days to deleteion
	OR	A		; 0=no delete
	JR	Z,SRTLP		; Don't delete this guy
	LD	D,0
	LD	E,A		; Days tolerated to de
	AND	A		; Clear carry
	SBC	HL,DE		; Hl(inactivity) > de(tolerated)?
	JP	Z,SRTLP		; Equal so...
	JP	C,SRTLP		; Okay so don't delete
	LD	A,(MAILF)	; See if mail was waiting for him
	CP	1		; And if so set flags for deleting mail
	JR	NZ,NOM		; If not then skip next
	LD	HL,UNAMEF	; Move user name to array
	POP	DE		; Get current array pointer
	LD	BC,30		; Length to move
	LDIR			; Name now added to message delete list
	PUSH	DE		; And save it (now updated)
;
NOM::	XOR	A
	LD	(ACCESSF),A	; Delete user
	LD	HL,(IUSER)
	DEC	HL
	LD	(IUSER),HL	; Updated user count
	LD	HL,(RRNO)	; Get record
	CALL	PUT
	JR	SRTLP
;
UPD252::CALL	CLOSE
	POP	IX		; Get back end of array (if existing)
	XOR	A		; And null 2 bytes to mark end
	LD	(IX),A
	LD	(IX+1),A
	LD	IX,(MSGARR)	; See if we have any mail to delete
	LD	A,(IX)
	LD	B,(IX+1)
	OR	B		; If first 2 bytes are 0 then none
	JP	Z,UPD254	; None, so quit
	LD	HL,MSGINDEX
	CALL	OPEN
	LD	HL,MNDXLEN	; Length of record
	LD	(RRSZ),HL
	LD	HL,(IMNDX)	; Number records
	INC	HL
	LD	(RRNO),HL	; To record # counter
;
SRTLP2::LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD253	; Yes
	CALL	GET
	LD	DE,(MSGARR)	; Get start of array
	PUSH	DE		; Save it
;
DELOP::	LD	HL,MTOF		; Point to name message is 'to'
	LD	B,30		; Length to match
	CALL	MATCH		; Is message to deleted user?
	CP	0
	JR	Z,DELOP1	; Yes, so kill it
	POP	DE		; No so...
	LD	HL,30		; Point to next name in array
	ADD	HL,DE
	EX	DE,HL		; Pointer in de
	PUSH	DE
	POP	IX
	LD	A,(IX)
	LD	B,(IX+1)
	OR	B
	JP	Z,SRTLP2	; No more names, check if more messages
	PUSH	DE		; Save new pointer and see if deletion needed
	JR	DELOP
;
DELOP1::POP	DE		; Unjunk stack
	LD	HL,0
	LD	(MNUMF),HL	; Delete message
	LD	HL,(RRNO)
	CALL	PUT
	JP	SRTLP2
;
UPD253::CALL	CLOSE
;
UPD254::XOR	A		; To clear update flag
	LD	(WRTLOC),A	; And bye flag
	RET
;
; Program ends up in this section if mail is waiting for an user.
;
; If 'mail' is called from the CCP then this is the entry point this is
; determined by reading byte labelled 'REENTR' somewhere in memory. if
; REENTR=0 then the signon routines are entered.  If REENTR=1 then pro-
; gram jumps here after setting the stack.
;
;-----------------------------------------------------------------------
;
; EMX.MAC by Simon Ewins
;
; (c)1984  --  All rights reserved.
;
;-----------------------------------------------------------------------
;
MAIL::	LD	A,(VERSION)	; Want version message?
	OR	A
	JR	Z,MAIL0		; Nope
	LD	HL,VMSG		; Yes, so print version number
	CALL	PRINTM
	LD	HL,(VER)	; L=version, l=revision
	CALL	PVER		; Print version.revision
;
MAIL0::	LD	A,(CREDITS)
	OR	A
	JR	Z,MAIL1		; No credits wanted either
	LD	HL,AUTHOR
	CALL	PRINTM		; Show who wrote this
;
MAIL1::	LD	A,(ASCACC)	; Get status byte
	LD	(STATUS),A	; Save for mail return
	LD	A,'9'		; Temp. no limit so caller does not time out
	LD	(ASCACC),A	; Set it for now
;
	LD	HL,USERS
	CALL	OPEN		; Get user info to memory
	LD	HL,USRLEN
	LD	(RRSZ),HL	; Set record length
	LD	HL,(USREC)	; Get this user's record number
	CALL	GET		; Get user's info and move it to memory
	LD	HL,UNAMEF
	LD	DE,UNAME
	LD	BC,USRLEN
	LDIR
	CALL	CLOSE		; Close users file
	LD	A,(MFLAG)	; Determine whether mail read yet and
	LD	(READ),A	; Set flag 0=mail read, 1=not read yet
	CP	1		; If set to 1 then go directly to read
	JP	Z,READM		; Go...
;
MENU::	XOR	A
	LD	(PFLAG),A	; Public messages flag
	LD	(ALLFLG),A	; Message sent to 'all'
	CALL	PRINT
	DB	CR,LF,LF
	DB	'R)ead,  E)nter,  P)ublic messages,  Q)uit to CP/M  ? ',0

;
MENU1::	CALL	GETCH
	JR	Z,MENU1
	CALL	CAPS
	CP	'A'
	JR	C,MENU1
	CP	'Z'+1
	JR	NC,MENU1
	CALL	ECHO
	CP	'Q'
	JP	Z,KILLM
	CP	'R'
	JP	Z,READM
	CP	'E'
	JP	Z,POSTM
	CP	'P'
	JP	Z,PMAIL
	JP	MENU
;
READM::	XOR	A
	LD	(PFLAG),A	; Clear public flag
	LD	A,(MFLAG)	; Verify mail is waiting
	CP	1
	JP	Z,READMP
	CALL	PRINT
	DB	CR,LF,LF
	DB	'No messages for you.',CR,LF,0
	JP	MENU
;
; Common entry point for all reads... public or private
;
READMP::LD	DE,(MSGARR)	; Point to messages table
	PUSH	DE
	CALL	PRINT
	DB	CR,LF
	DB	'Stand by...',0
	LD	HL,MSGINDEX
	CALL	OPEN
	LD	HL,MNDXLEN	; Record length
	LD	(RRSZ),HL
	LD	HL,(IMNDX)	; Number of records
;
; Read message INDEX loop and make decisions about whether to display
; based on user's name and current function (public, private)
;
MRDLP::	CALL	GET
	LD	A,(PFLAG)	; See if this is public read
	CP	1
	JP	NZ,MRDLP1	; No, so check user's name
	LD	HL,MTOF		; Yes, so check for message to 'all'
	LD	DE,ALLMSG
	LD	B,4
	CALL	MATCH
	JP	MRDLP2
;
MRDLP1::LD	HL,MTOF		; See if to user
	LD	DE,UNAME
	LD	B,30
	CALL	MATCH
;
MRDLP2::CP	0		; Yes?
	JP	NZ,BMPREC	; No
	LD	A,(MNUMF)
	CP	0		; Message deleted?
	JP	NZ,MRDLP3	; No
	LD	A,(MNUMF+1)
	CP	0		; Maybe
	JP	Z,BMPREC	; Yes
;
MRDLP3::LD	HL,MNUMF	; No
	POP	DE		; Get current pointer
	LD	BC,MTABLEN
	LDIR			; Save message info
	PUSH	DE		; New pointer
;
BMPREC::LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,MRDLP	; Yes
	CALL	CLOSE
	POP	IY		; Get pointer to end of array
	XOR	A		; Mark end of array
	LD	(IY),A
	LD	(IY+1),A
	CALL	PRINT
	DB	CR,'               ',CR,LF,0
;
PMSGS::	LD	IY,(MSGARR)	; Point to table
	LD	HL,MESSAGES
	CALL	OPEN		; Open messages file
	LD	HL,MSGLEN
	LD	(RRSZ),HL	; Set record length
PMLOP1::LD	A,(IY)		; See if at end of array
	CP	0
	JP	NZ,PM01
	LD	A,(IY+1)
	CP	0
	JP	Z,NOMOR		; At end so quit
;
; Display subject of message about to be displayed
;
PM01::	INC	IY		; Message number on entry then..
	INC	IY		; Points to date (month)
	INC	IY		; (day)
	INC	IY		; (year)
	INC	IY		; Points to number records
	LD	A,(IY)
	LD	B,A		; Number of records
	PUSH	BC		; Save it
	INC	IY		; Points to starting record number
	LD	A,(IY)		; Get starting record number
	LD	L,A		; Into hl
	INC	IY
	LD	A,(IY)
	LD	H,A
	LD	(RRNO),HL	; And random param block
	INC	IY		; Now points to subject
	CALL	PRINT
	DB	CR,LF
	DB	'==> Subject: ',0
	PUSH	IY
	POP	HL
	LD	B,26
	CALL	PRINTL
	CALL	PRINT
	DB	CR,LF
	DB	'    R)ead, S)kip, Q)uit ? ',0
;
PMWT::	CALL	GETCH
	JR	Z,PMWT
	CALL	CAPS
	CP	'R'
	JP	Z,PMGO
	CP	'S'
	JP	Z,PMSKP
	CP	'Q'
	JR	Z,PMQT
	JR	PMWT
;
PMQT::	CALL	PRINT
	DB	CR,LF,0
	JP	MENU
;
; Display message
;
PMGO::	CALL	ECHO
	XOR	A
	LD	(READ),A	; Clear messages read flag
	PUSH	IY
	POP	HL
	LD	DE,26		; Get passed subject
	ADD	HL,DE		; And point to next index
	PUSH	HL
	POP	IY		; Next message info address in iy
	POP	BC		; Recover line count
	LD	DE,(MSG)	; Point to start of buffer
;
PMLOP2::PUSH	BC		; Save counter
	LD	HL,(RRNO)
	PUSH	DE		; Save buffer address
	CALL	GET
	POP	DE		; Get buffer address
	LD	HL,RNDBUF
	LD	BC,64		; Move to message buffer
	LDIR			; De=next buffer address
	LD	HL,(RRNO)
	INC	HL		; Next line (record)
	LD	(RRNO),HL
	POP	BC		; Get counter
	DJNZ	PMLOP2		; Done?
	CALL	LIST		; List the message to screen
	JP	PMLOP1		; Get next mesage, if any
;
; No more mail so quit
;
NOMOR::	CALL	CLOSE
	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'No more.'
	DB	CR,LF,0
	JP	MENU
;
; Skip to next message
;
PMSKP::	PUSH	IY
	POP	HL
	LD	DE,26		; Get passed subject
	ADD	HL,DE		; And point to next index
	PUSH	HL
	POP	IY
	POP	BC		; Clear stack
	JP	PMLOP1
;
; Post mail to another user
;
SYSSTR::DB	'SYSOP',0	; Used as 'from' when name not wanted
;
POSTM::	XOR	A
	LD	(SYSBYT),A	; Clear sysop personal message byte
	LD	A,(ALLLV)	; See if access allows public messages
	LD	B,A
	LD	A,(ACCESS)
	CP	B
	JR	C,GETTO		; Access less than alllv so skip next
	CALL	PRINT
	DB	CR,LF,LF
	DB	'Is this to be a public message? ',0
;
PMWAIT::CALL	GETCH
	JP	Z,PMWAIT
	CALL	CAPS
	CP	'Y'
	JP	Z,PUB
	CALL	PRINT
	DB	'No',0
	LD	A,(ACCESS)	; See if this is sysop
	CP	9
	JR	NZ,GETTO	; No, so skip this bit
	CALL	PRINT
	DB	CR,LF
	DB	'Use your N)ame or S)ysop ? ',BEL,0
;
PMW0::	CALL	GETCH
	JP	Z,PMW0
	CALL	CAPS
	CP	'N'
	JR	Z,PMWDON
	CP	'S'
	JR	NZ,PMW0
;
PMWDON::LD	(SYSBYT),A	; Store answer
	CALL	ECHO		; And show it
;
GETTO::	CALL	PRINT
	DB	CR,LF,LF
	DB	'Message to? (use <cr> to exit)',CR,LF
	DB	'______________________________<<--',CR,0
	LD	C,20H
	LD	B,30
	XOR	A		; Echo on
	LD	D,A		; Clear wrap flag
	CALL	INPUT
	CP	0
	JP	Z,MENU
	LD	HL,INBUF
	LD	DE,MTOTMP
	LD	BC,30
	LDIR			; Save message 'to'
;
; If message was to 'sysop' then substitute name at label 'Sysop' as
; message 'to' name
;
	LD	HL,INBUF	; Point to input
	LD	DE,SYSSTR	; See if to 'sysop'
	LD	B,6
	CALL	MATCH
	CP	0
	JP	NZ,POSTM2	; Not 'sysop' so search for entry
	LD	HL,SYSOP	; Was 'sysop' so move name at label
	LD	DE,MTOTMP	; 'sysop' to mto stuff
	LD	BC,30
	LDIR
;
POSTM2::CALL	PRINT
	DB	CR,LF
	DB	'Checking user file...',0
	LD	HL,USERS
	CALL	OPEN
	LD	HL,USRLEN	; Record length
	LD	(RRSZ),HL
	LD	HL,(IUSRC)	; Number of records
;
PMLP::	CALL	GET
	LD	A,(ACCESSF)	; See if active
	CP	0
	JP	Z,PBPREC	; Not active
	LD	HL,UNAMEF	; See if to user
	LD	DE,MTOTMP
	LD	B,30
	CALL	MATCH
	CP	0
	JP	Z,GOTIT
;
PBPREC::LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,PMLP		; Yes
	CALL	CLOSE		; Close
	CALL	PRINT
	DB	CR
	DB	'User not found, check your spelling.',0
	JP	POSTM
;
GOTIT:	CALL	CLOSE
	LD	HL,(RRNO)
	LD	(MTOREC),HL	; Save record number for later
	CALL	PRINT
	DB	'  Found.',0
	JP	ENTER
;
PUB::	CALL	PRINT
	DB	'Yes',CR,LF,0
	LD	HL,MTOTMP
	LD	BC,29
	XOR	A
	LD	(HL),A
	LD	DE,MTOTMP+1
	LDIR			; Clear message 'to' field
	LD	HL,ALLMSG
	LD	DE,MTOTMP
	LD	BC,4
	LDIR			; Move 'ALL' to buffer
	LD	A,1
	LD	(ALLFLG),A	; Set message to 'all' flag
;
ENTER::	CALL	PRINT
	DB	CR,LF
	DB	'What is the subject?',CR,LF
	DB	'__________________________<<--',CR,0
	LD	C,20H
	LD	B,26
	XOR	A		; Set input flags
	LD	D,A
	CALL	INPUT
	LD	DE,MSUBTMP
	LD	HL,INBUF
	LD	BC,26
	LDIR			; Save subject
	CALL	PRINT
	DB	CR,LF,LF
	DB	'You are allowed ',0
	LD	HL,MSGBUF
	CALL	PB2ASC		; Show max message length
	CALL	PRINT
	DB	' characters in this message.'
	DB	CR,LF
	DB	'Use a carriage return only at the end of a paragraph.'
	DB	CR,LF
	DB	'--> Use a . in column 1 to exit the message system.....'
	DB	CR,LF,LF
	DB	'Enter text...',BEL,CR,LF,LF,0
	XOR	A
	LD	HL,0		; Ready to 0 buffers
	LD	(COLUMN),A	; Current column number
	LD	IX,(MSG)	; Point to start of buffer
	LD	BC,MSGBUF	; Get length of buffer
;
; Add any special delete characters here
;
DEL	EQU	7FH		; 'normal' del key
DELOS	EQU	1FH		; ^- on the os-1
;
MSGLOP::PUSH	BC
	PUSH	IX		; Save count and buffer
;
MLP::	XOR	A
	LD	(WFLG),A	; Clear word-wrap flag
;
MLP0::	CALL	GETCH
	JR	Z,MLP0		; No character so keep waiting
	CP	'.'		; Command char if column=0
	JP	Z,COMCHR	; Check it out
	CP	CR
	JP	Z,CRLF
	CP	BS
	JP	Z,BCKSPC
	CP	DEL
	JP	Z,BCKSPC
	CP	DELOS		; Add any delete characters needed here
	JP	Z,BCKSPC
	CP	' '
	JP	Z,CHKSPC	; If space then check for word wrap
	CP	' '+1
	JP	C,MLP0		; Must be a printable character
	CP	'~'+1
	JP	NC,MLP0
;
; Got printable character, show it and add to buffer
;
ENTCHR::POP	IX		; Get buffer position
	POP	BC		; Get counter
	DEC	BC
	PUSH	AF
	LD	A,B
	OR	C		; At end of space yet?
	JP	Z,ENDBUF	; Process end of entry
	POP	AF
	LD	(IX),A		; Add to buffer
	PUSH	AF		; Save character
;
WFLG	EQU	$+1
;
	LD	A,0
	OR	A
	JR	NZ,E1		; 0=not word-wrap so echo
	POP	AF
	PUSH	AF		; For later pop
	PUSH	IX		; Save pointer in case bios uses ix
	CALL	ECHO		; Show character
	POP	IX
;
E1::	POP	AF		; Balance stack
	INC	IX
	XOR	A
	LD	(IX),A		; Float a 0 at end of message
	LD	(CRS),A		; Total cr in a row
	LD	A,(COLUMN)
	INC	A		; Bump column count
	CP	80		; At maximum?
	JR	C,NEWCOL	; Not yet
	XOR	A
;
NEWCOL::LD	(COLUMN),A
	JP	MSGLOP		; Get next
;
CHKSPC::LD	A,(COLUMN)
	CP	64		; <<<==== word-wrap at linelength-15
	LD	A,' '		; In case < 64
	JP	C,ENTCHR	; Less than 64 is still okay
	CALL	PRINT
	DB	CR,LF,0		; Print crlf but store space
	XOR	A
	LD	(COLUMN),A	; Reset column count
	INC	A
	LD	(WFLG),A	; Set word-wrap flag for no-print char
	LD	A,' '		; Get back space
	JP	ENTCHR		; Store it
;
CRLF::	POP	IX
	POP	BC
	DEC	BC
	PUSH	AF
	LD	A,B
	OR	C
	JP	Z,ENDBUF
	POP	AF
	LD	(IX),A
	PUSH	IX
	CALL	ECHO
	POP	IX
	INC	IX
	LD	A,LF
	CALL	ECHO
	XOR	A
	LD	(COLUMN),A
	LD	(IX),A		; Float a 0 at end of message
	LD	A,(CRS)		; Bump # cr in a row
	INC	A		; And if over 3 then quit
	LD	(CRS),A
	CP	4
	JP	NC,EXITCR	; Over 3 cr so quit entering...
	JP	MSGLOP
;
EXITCR::PUSH	BC
	PUSH	IX		; Keep stack happy
	JP	EXIT0
;
BCKSPC::POP	IX
	POP	BC
	DEC	IX
	LD	A,(IX)
	INC	IX
	CP	0FFH		; Start of buffer
	JP	Z,MSGLOP	; Can't back up
	LD	A,(COLUMN)
	DEC	A		; Next lower column is 0?
	CP	0FFH
	JP	Z,MSGLOP	; Can't be before start of line
	LD	(COLUMN),A	; Save new column
	XOR	A		; Float a 0 at end of message
	LD	(IX),A
	DEC	IX
	INC	BC
	PUSH	BC
	PUSH	IX
	CALL	PRINT
	DB	8,' ',8,0	; Backspace one
	POP	IX
	POP	BC
	JP	MSGLOP
;
ENDBUF::POP	AF		; Clear stack
	INC	BC		; Re-align counter
	PUSH	BC		; Save it
	PUSH	IX		; Save again
	XOR	A
	LD	(IX),A		; Set end of message
	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'++ Buffer Full ++',0
	JP	EXIT0
;
; Got a '.' so if in column 0 then treat as command character
;
COMCHR::LD	A,(COLUMN)
	OR	A
	JP	Z,COMYES	; Not 0 so treat as real character
	LD	A,'.'
	JP	ENTCHR
;
COMYES::POP	IX
	LD	(IX),A		; Set end of message
	PUSH	IX		; Save again
	CALL	GETCH		; Kill any stray character after the .
;
EXIT0::	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'S)ave, E)dit, L)ist, A)bort, C)ontinue ? ',0
;
EXIT1::	CALL	GETCH
	JR	Z,EXIT1
	CALL	CAPS
	CP	'L'
	JP	Z,LISTE		; Actual list is a subroutine this will call it
	CP	'C'
	JP	Z,CONT
	CP	'A'
	JP	Z,MENU
	CP	'S'
	JP	Z,SAVE
	CP	'E'
	JP	Z,EDIT
	JP	EXIT1
;.....
;
EBUF::	DS	65		; Edit string buffer
RBUF::	DS	65		; Replacement string buffer
ELEN::	DB	0		; Length of old string
RLEN::	DB	0		; Length of new string
NEWFRE::DW	0		; Temp storage
DIFF::	DW	0		; Ditto
COLUMN::DB	0		; Current column counter
CRS::	DB	0		; Carriage return counter
;
EDIT::	CALL	ECHO
	XOR	A		; Clear edit buffers
	LD	HL,EBUF
	LD	(HL),A
	LD	DE,EBUF+1
	LD	BC,129
	LDIR
	CALL	PRINT
	DB	CR,LF,LF
	DB	'Use a ^ to represent a carriage return...'
	DB	CR,LF
	DB	'Enter old string: ',0
	XOR	A
	LD	C,A
	LD	D,A
	LD	B,64
	CALL	INPUT
	OR	A
	JP	Z,EXIT0
	LD	(ELEN),A	; Save length
	LD	C,A
	LD	B,0
	LD	HL,INBUF
	LD	DE,EBUF
	LDIR			; Move search edit string to buffer
	CALL	PRINT
	DB	CR,LF
	DB	'Enter new string: ',0
	XOR	A
	LD	C,A
	LD	D,A
	LD	B,64
	CALL	INPUT
	LD	(RLEN),A	; Save length
	OR	A
	JR	Z,CHKSTR	; If no replacement then skip move
	LD	C,A
	LD	B,0
	LD	HL,INBUF
	LD	DE,RBUF
	LDIR			; Move new string into place
;
; Replace any ^ characters with <cr>
;
CHKSTR::LD	HL,EBUF
	LD	B,130
;
CRLOP::	LD	A,(HL)
	CP	'^'
	JR	NZ,NCR
	LD	A,CR
	LD	(HL),A
;
NCR::	INC	HL
	DJNZ	CRLOP		; Do til all characters checked
	LD	HL,EBUF		; Point to search string
	LD	DE,(MSG)	; And message start
;
SELOP::	LD	A,(DE)
	CP	(HL)
	JP	Z,SELOP0
	INC	DE		; Next in buffer
	LD	A,(DE)
	OR	A		; At end?
	JP	NZ,SELOP	; Not yet so try again
	JP	NOSTR		; String not found
;
SELOP0::PUSH	DE
	PUSH	HL		; Save current positions
;
SELOP1::INC	HL
	INC	DE
	LD	A,(HL)		; At end of edit string yet?
	OR	A
	JP	Z,SELOP2	; Got a match
	LD	A,(DE)
	CP	(HL)
	JP	Z,SELOP1
	POP	HL
	POP	DE
	INC	DE		; Point to next in buffer
	JP	SELOP		; Go look some more
;
SELOP2::POP	HL		; Get rid of junk
	PUSH	DE		; Save end of found string
	LD	A,(ELEN)
	LD	B,A
	LD	A,(RLEN)
	CP	B		; Compare lengths of strings
	JP	Z,REQU
	JP	C,RLESS
;
; __________________________________________
; | while all the message routines use the |
; | stack, this  section in  particular is |
; | EXTREMELY stack intensive..  use a LOT |
; | of	care  if  you  change ANY of this. |
; ------------------------------------------
;
; These routines enter with stack as:
;
; top  - end of found string
; next - start of found string
; next - current pos in buffer
; next - characters remaining in buffer
;
RGTR::	SUB	B
	LD	E,A
	LD	D,0		; De=diff
	LD	(DIFF),DE	; Need later
	POP	IY		; Get end
	POP	BC		; Get start
	POP	IX		; Get current
	POP	HL		; Get chars left
	PUSH	HL		; And restore them
	PUSH	IX		; And current
	PUSH	BC		; And start
	PUSH	IY		; And end
	AND	A		; Clear carry
	SBC	HL,DE		; Hl must be > de
	JP	C,LNGSTR	; Too long so abort
	LD	(NEWFRE),HL	; Save characters free for later
	PUSH	IX		; End of buffer
	POP	HL		; In hl
	PUSH	HL
	ADD	HL,DE		; New end in hl
	EX	DE,HL		; De=move to
	POP	HL		; Hl=move from
	PUSH	IY
	POP	BC		; Bc=end of found string
	PUSH	HL		; Save move from
	AND	A		; Clear carry
	SBC	HL,BC		; Hl=# characters to move
	INC	HL		; Need one more moved
	PUSH	HL
	POP	BC		; Bc=count
	POP	HL		; Hl=move from
	LDDR			; Move back to open space up
	POP	HL		; Don't need end anymore
	POP	DE		; Move to
	LD	HL,RBUF		; From here
	LD	A,(RLEN)
	LD	C,A
	LD	B,0		; This many
	LDIR
	POP	IX
	POP	BC
	LD	HL,(NEWFRE)
	PUSH	HL		; Save new characters remaining
	PUSH	IX		; And current pos in buffer
	POP	HL		; To hl
	LD	DE,(DIFF)
	ADD	HL,DE
	PUSH	HL		; Save new position on stack
	JP	EXIT0
;
RLESS::	LD	A,(RLEN)
	OR	A
	JR	Z,RL0		; If 0 then we are deleteing so skip first move
	LD	C,A
	LD	B,0
	POP	HL		; Get end of found string
	POP	DE		; Get start of found string
	PUSH	HL		; Need end later
	LD	HL,RBUF
	LDIR			; Move new string to old position
	JR	RL1		; Skip next unless no replacement string
RL0::	POP	HL		; End of found string
	POP	DE
	PUSH	HL		; For next pop
RL1::	POP	HL		; Move from here (de set from ldir or rl0)
	POP	BC		; Get current buffer position
	PUSH	BC		; Save again
	PUSH	DE		; Save end of old string (in buffer)
	PUSH	HL		; Save start of string to move up (in buffer)
	AND	A		; Clear carry
	PUSH	HL
	PUSH	BC		; Reverse bc and hl
	POP	HL
	POP	BC
	SBC	HL,BC		; Hl=characters to move less one
	INC	HL		; Re-align
	PUSH	HL
	POP	BC		; Count
	POP	HL		; From
	POP	DE		; To
	LDIR			; Move rest of string up
	LD	A,(RLEN)
	LD	B,A
	LD	A,(ELEN)
	SUB	B
	LD	E,A
	LD	D,0		; De=diff
	POP	IX
	POP	HL		; Get characters left
	ADD	HL,DE		; Update count
	PUSH	HL		; Save it
	PUSH	IX
	POP	HL		; Get current position
	AND	A
	SBC	HL,DE		; Update
	PUSH	HL
	JP	EXIT0
;
REQU::	LD	A,(RLEN)
	LD	C,A
	LD	B,0
	POP	DE		; Don't need end of found string address
	POP	DE		; Get start of found string
	LD	HL,RBUF
	LDIR			; Move new string into buffer
	JP	EXIT0
;
LNGSTR::POP	HL
	POP	HL		; Clear stack
	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'Replacement string too long.',0
	JP	EXIT0
;
NOSTR::	CALL	PRINT
	DB	CR,LF,LF,BEL
	DB	'Old string not found...',0
	JP	EXIT0
;
CONT::	CALL	ECHO
	CALL	PRINT
	DB	CR,LF,LF,BEL,0
	POP	IX
	POP	BC
	DEC	BC		; Buffer full when 1 byte left (!)
	LD	A,B
	OR	C		; See if at end of buffer
	INC	BC		; Re-align counter
	JP	Z,NOCONT	; Nope, so go
	PUSH	BC
	PUSH	IX
	CALL	PRINT
	DB	'Continue entering text...'
	DB	CR,LF,LF,0
	POP	IX
	POP	BC
	JP	MSGLOP		; Go for it...
;
NOCONT::PUSH	BC
	PUSH	IX
	CALL	PRINT
	DB	'Cant''t continue, at end of buffer.',CR,LF
	DB	'Use E)dit to delete from and change message...',0
	JP	EXIT0
;
LISTE::	CALL	ECHO
	CALL	LIST
	JP	EXIT0
;
LIST::	CALL	PRINT
	DB	CR,LF,LF,0
	XOR	A
	LD	(COLUMN),A	; Set column counter
	LD	HL,(MSG)	; Point to buffer
;
LSTLOP::LD	A,(HL)
	OR	A
	RET	Z		; 0=end
	CP	1		; 1 is used as a pad char for first 2 records
	JR	Z,LSTSKP	; And to allow easy conversion of old messages
	CP	CR		; Carriage return?
	CALL	Z,LSTCR
	CP	' '		; Space?
	CALL	Z,LSTWRP	; See if wrap time
	CALL	ECHO		; Echo character
	CALL	GETCH		; See if we want to pause / restart
	CALL	NZ,LSTPSE	; Yes
	INC	HL
	LD	A,(COLUMN)	; Update current column
	INC	A
	CP	80		; At end of line?
	JR	C,LST0		; Nope
	XOR	A		; Yep so reset
;
LST0::	LD	(COLUMN),A
	JR	LSTLOP
;
LSTSKP::INC	HL		; Point at next character
	JR	LSTLOP		; And check it out
;
LSTWRP::LD	A,(COLUMN)
	CP	64		; <<<=== wrap point at linelength-15
	LD	A,' '		; In case
	RET	C		; Less so return
	XOR	A
	LD	(COLUMN),A	; Reset column count
	LD	A,CR
	CALL	ECHO		; Do carriage return
	LD	A,LF		; Get linefeed
	RET			; And return to print it
;
LSTCR::	CALL	ECHO		; Do <cr>
	XOR	A
	LD	(COLUMN),A	; Reset counter
	LD	A,LF		; Return to print linefeed
	RET
;
LSTPSE::CALL	GETCH		; Wait for another character
	JR	Z,LSTPSE	; Wait...
	RET			; Back to the farm...
;
SAVE::	CALL	ECHO
	POP	IX
	POP	BC		; Must clear stack first
	LD	HL,MSGBUF	; Get max characters allowed
	AND	A		; Clear carry
	SBC	HL,BC		; Hl=number characters in message
	INC	HL		; Plus one
	LD	DE,64
	LD	C,0FFH		; Set up quotient
;
DLOP::	INC	C
	AND	A		; Clear carry
	SBC	HL,DE		; Divide by 64 to get number of lines
	JR	NC,DLOP
	ADD	HL,DE		; Remainder back in hl
	LD	A,C		; Get number of lines
	INC	A		; Bump # lines by one for 'from' info
	INC	A		; And one for 'to' and time/date
	LD	(LINES),A
	LD	A,H
	OR	L		; If any remainder then need extra line
	JR	Z,NOREM
	LD	A,(LINES)
	INC	A
	LD	(LINES),A	; Save new value
;
NOREM::	CALL	PRINT
	DB	CR,LF
	DB	'Updating index, message and user files...',0
	LD	A,1
	LD	(WRTLOC),A
	LD	A,(ALLFLG)	; See if this is to 'all' or a user
	CP	1
	JR	Z,ALLSKP	; Yes so skip next
;
; Set flag in 'to' user's record so he's bumped to mail next signon
;
	LD	HL,USERS
	CALL	OPEN		; Read 'to' user into buffer
	LD	HL,USRLEN
	LD	(RRSZ),HL
	LD	HL,(MTOREC)	; Record # saved when we searched for 'to' user
	CALL	GET
	LD	A,1		; Flag mail waiting
	LD	(MAILF),A	; And write record back
	LD	HL,(RRNO)	; Get record number
	CALL	PUT		; And write record back
	CALL	CLOSE
;
; Message is to 'ALL' so we don't have to flag a user's record, just see
; if space is free in the message INDEX and, if so, use it, else we will
; extend messages file with a new record.
;
ALLSKP::LD	HL,MSGINDEX
	CALL	OPEN		; Search for free message space
	LD	HL,MNDXLEN	; Record length
	LD	(RRSZ),HL
	LD	HL,(IMNDX)	; Number of records
;
MERDLP::CALL	GET
	LD	A,(MNUMF)
	CP	0		; Message deleted?
	JP	NZ,BMPRC	; No
	LD	A,(MNUMF+1)
	CP	0		; Maybe
	JP	NZ,BMPRC	; No
	LD	A,(MBLKF)	; Yes, so....
	LD	B,A		; See if also
	LD	A,(LINES)	; Same message length?
	CP	B
	JP	Z,WRITE		; Yes
;
BMPRC::	LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,MERDLP	; Yes
;
; Have to open new record for message in MSGINDEX so set up for it
;
	LD	HL,(IMRNM)
	LD	(MSTRF),HL	; Set message record number
	LD	A,(LINES)
	LD	(MBLKF),A	; & number lines (records)
	LD	D,0
	LD	E,A
	ADD	HL,DE		; Calc new record start
	LD	(IMRNM),HL	; And store in INDEX
	LD	HL,(IMNDX)	; And bump number records in index
	INC	HL
	LD	(IMNDX),HL
	LD	(RRNO),HL	; Set record number in buffer
;
; Now write the MSGINDEX record # determined above
;
WRITE::	LD	HL,(IMNXT)	; Get next message number
	LD	(MNUMF),HL	; Make it this message
	LD	HL,MTOTMP
	LD	DE,MTOF
	LD	BC,30
	LDIR			; Set message 'to' field
	LD	IY,IDATE
	LD	IX,MDATF	; And date
	LD	A,(IY)
	LD	(IX),A
	LD	A,(IY+1)
	LD	(IX+1),A
	LD	A,(IY+2)
	LD	(IX+2),A
	LD	DE,MSUBF
	LD	HL,MSUBTMP
	LD	BC,26
	LDIR			; Set subject field
	LD	HL,(RRNO)
	CALL	PUT
	CALL	CLOSE		; Msgindex closed
;
; Now update INDEX information
;
	LD	HL,(MSTRF)	; Get record number for first line
	LD	(STRTMP),HL	; Save it for later
	LD	HL,(IMNXT)
	INC	HL
	LD	(IMNXT),HL	; Update next message number
	LD	HL,INDEX
	CALL	OPEN
	LD	HL,NDXLEN
	LD	(RRSZ),HL
	LD	HL,IDATE	; Update index info
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	LD	HL,0
	CALL	PUT
	CALL	CLOSE		; Index closed
;
; And finally, write each 64 byte line to sequential records
;
	LD	HL,MESSAGES
	CALL	OPEN
	LD	HL,MSGLEN
	LD	(RRSZ),HL
	LD	HL,(STRTMP)	; Set record number for first line
	LD	(RRNO),HL
;
; Now we create the first two records which are the message header with
; time/date, to/from, subject stuff
;
	CALL	GETTIM		; Get date/time string
	LD	HL,MSG1		; Move first of header to buffer
	LD	DE,RNDBUF
	LD	BC,6
	LDIR
	LD	HL,TIME		; And time string
	LD	BC,8
	LDIR
	LD	A,','
	LD	(DE),A
	INC	DE
	LD	A,' '
	LD	(DE),A
	INC	DE
	LD	HL,DATE		; And date string
	LD	BC,8
	LDIR
	LD	A,'.'
	LD	(DE),A
	INC	DE
	LD	A,CR
	LD	(DE),A
	INC	DE
	LD	HL,MSG2		; Next header bit
	LD	BC,6
	LDIR
	LD	HL,MTOTMP	; Who to
	LD	BC,30
	LDIR
	LD	A,CR
	LD	(DE),A
	CALL	STRIP		; Waste the nulls
	LD	HL,(RRNO)	; Get record #
	CALL	PUT		; And write it
;
; Clear buffer for next
;
	XOR	A
	LD	HL,RNDBUF
	LD	(HL),A
	LD	DE,RNDBUF+1
	LD	BC,63
	LDIR
;
; Now get 'from' name and move into place
;
	LD	HL,MSG3
	LD	DE,RNDBUF
	LD	BC,6
	LDIR			; Move characters before 'from' name
	PUSH	DE		; Save next buffer address
;
; See if this is Sysop and if he wants his name or 'SYSOP' used as
; 'from' string
;
	LD	HL,UNAME	; Move name to random buffer
	LD	DE,SYSOP	; Unless from name at label 'sysop'
	LD	B,30
	CALL	MATCH		; See if so...
	CP	0
	JR	NZ,NOTSYS	; No, not sysop so store user's name
;
SYSBYT	EQU	$+1		; In-code modification
;
	LD	A,0		; Is sysop, does he want to use his name?
	CP	'N'
	JR	Z,NOTSYS	; Wanted to use his name
	LD	HL,SYSSTR	; Wants to store 'sysop' as name
	LD	BC,6
	JR	ISSYS
;
NOTSYS::LD	HL,UNAME	; Get user's name
	LD	BC,30
;
ISSYS::	POP	DE		; Get buffer address back
	LDIR			; Move users name
	LD	A,CR
	LD	(DE),A		; Last carriage return
	INC	DE
	LD	(DE),A		; Twice
	CALL	STRIP		; Get rid of nulls
	LD	HL,(RRNO)
	INC	HL
	CALL	PUT		; Write second record
	LD	HL,(RRNO)
	INC	HL
	LD	(RRNO),HL	; Save updated record number
	LD	IY,(MSG)	; Point to message
	LD	A,(LINES)
	DEC	A		; Less 2 for time/date stuff ...
	DEC	A		; That has already been written
	LD	B,A		; Set up counter
;
WRTLP::	PUSH	BC
	PUSH	IY
	POP	HL
	LD	DE,RNDBUF
	LD	BC,MSGLEN
	LDIR
	PUSH	HL
	POP	IY
	LD	HL,(RRNO)
	CALL	PUT
	LD	HL,(RRNO)
	INC	HL
	LD	(RRNO),HL
	POP	BC
	DJNZ	WRTLP
	CALL	CLOSE
	CALL	PRINT
	DB	CR,LF,0
	JP	MENU
;
; Take the nulls out of the record being written to MESSAGES.EMX.  This
; is only needed on the first 2 records which contain data moved from
; other areas that use nulls to pad the fields...
;
STRIP::	LD	HL,RNDBUF	; Start of buffer
	LD	B,MSGLEN	; Length of each message record
;
STRIP0::LD	A,(HL)		; Get character
	OR	A		; Is it a null?
	JR	NZ,STRIP1	; Not 0
	INC	A		; Yes, so change 0 to 1
;
STRIP1::LD	(HL),A		; Save character
	INC	HL		; Next character
	DJNZ	STRIP0		; Do entire buffer
	RET			; Done
;.....
;
; Header data strings...
;
MSG1::	DB	'Left  '	; 6 characters before time/date
MSG2::	DB	'For   '	; 6 characters before who to
MSG3::	DB	'From  '	; 6 characters before who from
;.....
;
; Reading all bulletins so set flag to public
;
PMAIL::	LD	A,1
	LD	(PFLAG),A	; Set public flag
	JP	READMP
;
;
; Exit mail, killing all messages to current user first
;
KILLM::	LD	A,(MFLAG)	; See if mail was waiting
	CP	1
	JP	NZ,MEXIT	; No so skip killing old msgs
	LD	A,(ACCESS)	; If sysop then no matter if read or not
	CP	9
	JR	Z,SKILL
	LD	A,(READ)	; Mail waiting, has it been read yet?
	CP	1
	JP	Z,KILWRN	; Has not been read yet so warn user
;
SKILL::	LD	A,(ACCESS)	; Is this sysop?
	CP	9
	JR	NZ,KILLM1	; No so skip question...
	CALL	PRINT
	DB	CR,LF,LF
	DB	'Kill current messages to you? ',0
;
SKILLW::CALL	GETCH
	JR	Z,SKILLW
	CP	CR
	JR	Z,SKN
	JR	C,SKILLW	; Eliminate backspace etc.
	CALL	CAPS
	CP	'Y'
	JR	Z,SKY
	CALL	ECHO
;
SKN::	LD	A,1		; No delete wanted so set flag
	LD	(SYSDEL),A	; And skip kill routine
	JP	MEXIT
;
SKY::	CALL	ECHO
	XOR	A		; Yes, kill old messages so set flag
	LD	(SYSDEL),A	; And kill...
;
KILLM1::LD	A,1		; Mail read, so kill the old messages
	LD	(WRTLOC),A
	LD	IY,MNUMF	; Point to message number field
	CALL	PRINT
	DB	CR,LF
	DB	'Killing old messages...',0
	LD	HL,MSGINDEX
	CALL	OPEN
	LD	HL,MNDXLEN	; Record length
	LD	(RRSZ),HL
	LD	HL,(IMNDX)	; Number of records
;
KILMLP::CALL	GET
	LD	HL,MTOF		; See if to user
	LD	DE,UNAME
	LD	B,30
	CALL	MATCH
	CP	0
	JP	NZ,KBPREC	; No
	XOR	A
	LD	(IY),A
	LD	(IY+1),A	; Set to message # 0
	LD	HL,(RRNO)
	CALL	PUT
;
KBPREC::LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,KILMLP	; Yes
	CALL	CLOSE
;
; Killing done, if required, so exit mail, rewriting index with new
; message counts etc., and clearing mail waiting flag in user's record.
;
MEXIT::	LD	HL,INDEX	; Rewrite the INDEX file
	CALL	OPEN
	LD	HL,NDXLEN
	LD	(RRSZ),HL
	LD	HL,IDATE
	LD	DE,RNDBUF
	LD	BC,NDXLEN	; Move index info to buffer and
	LDIR			; We're ready to write
	LD	HL,0
	CALL	PUT		; Write it
	CALL	CLOSE
	LD	A,(SYSDEL)	; Avoid reset of mail flag
	OR	A		; See if sysop and no msg-kill
	JR	NZ,SDEL		; 1=no delete wanted
	LD	HL,USERS	; Open users file
	CALL	OPEN
	LD	HL,USRLEN
	LD	(RRSZ),HL
	LD	HL,(USREC)
	CALL	GET
	XOR	A		; Clear mail waiting flag
	LD	(MAILF),A
	LD	(MFLAG),A	; In memory as well
	LD	HL,(RRNO)
	CALL	PUT
	CALL	CLOSE
;
SDEL::	XOR	A		; Reset bye flag
	LD	(WRTLOC),A
	CALL	PRINT
	DB	CR,LF,0
	LD	A,(STATUS)	; Set mail return status
	LD	(ASCACC),A	; And reset it now
	LD	A,(MCALL)
	CP	1
	JP	Z,SDONE		; Got here via signon
	LD	A,(ALTON)	; Want file ran?
	OR	A
	JR	Z,NMF
	LD	DE,ALTFILE	; Run alternate file
	JP	CPM
;
NMF::	LD	DE,0		; Got here via mail, no file to print
	JP	CPM		; Do exit to cpm and return user to his area
;
KILWRN::CALL	PRINT
	DB	CR,LF,LF
	DB	'WARNING: You have not read your mail yet.'
	DB	CR,LF
	DB	'         Old messages will be destroyed.'
	DB	CR,LF,LF
	DB	'Exit anyway? ',BEL,0
;
WRNWT::	CALL	GETCH
	JP	Z,WRNWT
	CALL	CAPS
	CP	'Y'
	JP	NZ,MENU		; Must enter N to exit
	JP	KILLM1		; Wants to quit so destroy old mail
;
; Stack area
;
	  DS	128
;
STACK::	  DW	0H
CCPSTK::  DW	0H		; Stack storage
SPACE::	  DW	0H		; Temporary storage
COUNT::	  DW	0H		; Temporary storage
STATUS::  DB	0		; Temporary storage of user flag
TMPREC::  DW	0		; Storage for user record number
TRIED::	  DB	0		; Tries at password
NUSR::	  DB	0		; New user flag
TMXUSR::  DB	0		; Temp storage for max userarea used at exit
DELLEV::  DB	0		; Store byte 4 from table here
PFLAG::	  DB	0		; Public message read flag
ALLFLG::  DB	0		; Public message send flag
LINES::	  DB	0		; Line count for message entry
MTOREC::  DW	0		; Record # of user message is being sent to
STRTMP::  DW	0		; Starting record number for message
MTOTMP::  DS	30		; Name of user a message is being sent to
MSUBTMP:: DS	26		; Subject of message being sent
SYSDEL::  DB	0		; Flag no-kill by sysop
READ::	  DB	0H		; Mail read flag
MCALL::	  DB	0H		; Routine entered from signon flag
MSG::	  DW	0		; Message entry storage starts after
				; Linked ENXSYBS,REL file
MSGARR::  DW	0		; Storage for message pointers
;
	  END