TITLE	'PMSG.MAC v5.00				October 09/90'

; Filename	PMSG50.MAC
; Author	Bob Kramer
; Language	Z-80 Assembler
; Last Update	Oct 09/90
; By		Ian Cottrell

; PMSG is based on code from PBYE and PNOTE and is used as part of:

;		The Public Bulletin Board System
;		Author: Ian Cottrell
;			44 Lindhurst Cres
;			Ottawa, ON, Canada
;			K2G 0T7
;			The Information Centre RCP/M
;			(613) 952-2289 (300/1200/2400)
;------------------------------------------------------------------

;	PBBS represents many hours of design,  coding and debugging.
;	However,  I do not believe in SHAREWARE.   So,	if you	find
;	PBBS  of  value to you and wish to pay for it in  some	way,
;	please consider a small contribution ($50 suggested) to your
;	local  Cancer Society in both of our names (thus creating  a
;	new  class of software - charityware!).   Then send a little
;	note telling me what you did and we will both feel good!  In
;	any case,  please share this program with others, it is free
;	and no form of remuneration may be accepted by anyone except
;	its author.

; Version 4.50 - April 17th 1989 - Initial public release of PMSG
; Version 5.00 - October 9th 1990

;-------------------------------------------------------------------------
; NOTE: This file MUST be linked to PBBSUBS.REL
;-------------------------------------------------------------------------
; Program starts here
;-------------------------------------------------------------------------

	INCLUDE	PBBSEQU.HDR	; PBBS configuration equates

	 IF	M80		; M80
	.Z80			; Needed for M80

	 IF	LINK80
	CSEG
	 ELSE
	ASEG
	ORG	100H
	 ENDIF			; LINK80
	 ENDIF			; M80

	JP	START		; Jump around header and data

Z3IDEN:	DB	'Z3ENV'		; Z3 Identifier
Z3TYPE:	DB	1		; Z3 Environment (external)
Z3EADR:	DW	0000		; Z3 Environment (address)
Z3LOAD:	DW	0000		; Z3 load address

; Version name, date and levels

VNAME:	DB	'PMSG '		; Name
	DB	'Relese v ',0	; Status

VER:	DB	5		; Version
VERR:	DB	00		; Revision

VERDAT:	DB	90		; Year
	DB	10		; Month
	DB	09		; Day

AUTHOR:	DB	CR,LF,'  by:  Robert W. Kramer III',CR,LF,0

	INCLUDE	PBBSDB.HDR	; PBBS configuration strings, etc

	INCLUDE	BDOSHDR.MAC	; Time and date conversions

; Preserve CPM stack, initialize new one for this program

START:	LD	(CCPSTK),SP	; Save the return address
	LD	SP,STACK	; Install our stack

; Check for BYE presence

	LD	E,241
	LD	C,BEXIST
	CALL	BDOS		; See if BYE5 is active
	CP	77
	JR	Z,CBBS		; If so, go check for PBBS operation
	CALL	PRINT		; Else, abort
	DB	CR,LF,'BYE5 not available, aborting...',CR,LF,0
	JP	REXIT2		; Go restore stack and exit

CBBS:	LD	A,(REENTR)	; Get re-entry byte
	OR	A		; See if set
	JR	NZ,CHKDU	; If yes, go start program
	CALL	PRINT		; Else, abort
	DB	CR,LF,'PBBS not active - Aborting',CR,LF,0
	JP	REXIT2		; Go restore stack and exit

; Save current drive/user

CHKDU:	LD	E,0FFH
	LD	C,LOGUSR
	CALL	BDOS		; Get current user
	LD	(OLDUSR),A	; Save it
	LD	(MSGUSR),A	; Also make it default user
	LD	C,25
	CALL	BDOS		; Get current drive
	LD	(OLDDRV),A	; Save it
	LD	(MSGDRV),A	; Also make it default drive

; Everything ok, let's begin

BEGIN:	CALL	PVER		; Go print version number

	 IF	CREDITS
	LD	HL,AUTHOR
	CALL	PRINTM		; Go print author's name
	 ELSE
	CALL	PCRLF
	 ENDIF			; CREDITS

	CALL	ENDPBS		; Returns HL-> last byte of file
	LD	(HL),0FFH	; Flag byte for message routines
	INC	HL		; Start of the message storage buffer
	LD	(MSG),HL
	LD	DE,MSGBUF+128	; Messages are multiples of 64
	ADD	HL,DE		; Start of general buffer
	LD	(HL),0		; Mark general buffer start
	INC	HL
	LD	(MSGARR),HL

; Save CPM default command line buffer (set up by ZMD with message upload
; drive/user/filename).

	LD	HL,80H		; Point to default DMA buffer
	LD	A,(HL)		; Get length of command tail
	LD	B,A		;  and save it for count down
	OR	A		; Zero?
	JP	Z,PMAINT	; If so, run as PNOTE
	INC	HL		; Else, point to first byte
	LD	A,(HL)		; Get first character in filename
	CP	' '		; From command processor?
	JR	NZ,CHKDU1	; If not, set up by ZMD

; Check for call for help

CHKHLP:	INC	HL		; Else, point to 1st character in command tail
	LD	A,(HL)		;  and get it
	CP	'?'		; Did they want help?
	JP	Z,HELP		; If yes, give it to them
	CP	'/'		; Else, alternate request for help?
	JP	Z,HELP		; If yes, give it to them
	CP	' '		; Else, from command processor?
	JR	NZ,CHKDU1	; If not, set up by ZMD

	 IF	ZCPR3
	PUSH	HL		; Save HL
	LD	HL,(ZWHL)	; Wheel address
	LD	A,(HL)		; Wheel value
	POP	HL		; Restore HL
	 ELSE
	LD	A,(WHEEL)	; Get wheel value
	 ENDIF

	OR	A		; Wheel on?
	JP	Z,WEXIT		; Normal users can't use in local mode, so exit
	DEC	B		; Adjust length counter

; Check for possible drive/user specification

CHKDU1:	PUSH	HL		; Save command tail position
	PUSH	BC		; Save count
	LD	DE,DUSAVE	; Destination buffer
	LD	C,4		; Drive/user is 4 characters maximum 'B15:'

CHKDU2:	LD	A,(HL)		; Get character
	CP	' '+1		; Space or return?
	JP	C,DUDON		; Yes, all done
	LD	(DE),A		; Else store it in DUSAVE
	INC	HL		; Increment to next argument
	INC	DE		; Increment DUSAVE
	CP	':'		; Was it a colon?
	JR	Z,CHKDU4	; Yes, was drive/user requested
	DEC	B		; One less to get
	DEC	C		; One less to put
	JR	NZ,CHKDU2	; Loop until a colon or C=0
	JP	DUDON		; No drive/user specified

; Drive/user specified.  Check validity and log in.

CHKDU4:	EXX			; Save new pointer/counter
	POP	BC		; Get stack straight - discard original
	POP	HL
	EXX			; Get new pointer/counter back
	PUSH	HL		; Save a copy of them (start of filename)
	PUSH	BC
	LD	HL,DUSAVE	; Point to specified drive/user
	LD	A,(HL)		; Get 1st character
	CP	'9'+1		; Is it an ASCII number 0-9?
	JR	C,CHKDU6	; Yes, process user area
	CP	'A'-1
	JR	C,CHKDU5	; Satisfied with current drive
	SUB	'A'
	LD	(MSGDRV),A
	INC	HL		; Get 2nd character

CHKDU5:	LD	A,(HL)
	CP	':'
	JR	Z,CHKDU8	; Colon for drive only, no user number
	CALL	CKNUM		; Check if numeric

CHKDU6:	SUB	'0'		; Convert ASCII to binary
	LD	(MSGUSR),A	; Save it
	INC	HL		; Get 3rd character if any
	LD	A,(HL)
	CP	':'
	JR	Z,CHKDU7
	LD	A,(MSGUSR)
	CP	1		; Is first number a '1'?
	JR	Z,CHK6A
	OR	A		; Zero?
	JP	NZ,ILLDU
	LD	A,(HL)
	CALL	CKNUM
	SUB	'0'
	JR	CHK6B

CHK6A:	LD	A,(HL)
	CALL	CKNUM
	SUB	38

CHK6B:	LD	(MSGUSR),A
	INC	HL		; Get 4th (and last character) if any
	LD	A,(HL)
	CP	':'
	JP	NZ,ILLDU

; Log the new drive/user

CHKDU7:	LD	A,(MSGUSR)
	LD	E,A
	LD	C,LOGUSR	; Set to requested user area
	CALL	BDOS

CHKDU8:	LD	A,(MSGDRV)	; Get drive
	LD	E,A
	LD	C,LOGDRV	; Set to requested drive
	CALL	BDOS

; Check for no filename

DUDON:	POP	BC
	POP	HL
	CALL	MOVFCB
	LD	A,(PMSFCB+1)	; Get first character
	CP	' '		; Any there?
	JR	NZ,GOTNM	; Yes, all done
	LD	A,(PMSFCB+9)	; Else get first character in extent
	CP	' '		; Space also?
	JP	Z,NOFNM		; No, we have a filename

; Set the drive to default drive in FCB and open file and read first record

GOTNM:	LD	DE,80H		; Set DMA to TBUF
	LD	C,SETDMA
	CALL	SPBDOS
	XOR	A
	LD	(PMSFCB),A	; Set drive to default
	LD	(PMSFCB+12),A
	LD	(PMSFCB+32),A	; Set record # to 0
	LD	DE,PMSFCB
	LD	C,15		; Open file
	CALL	SPBDOS
	INC	A		; Open ok?
	JP	Z,NOFILE	; No
	LD	DE,PMSFCB
	LD	C,FREAD		; Read first record
	CALL	SPBDOS
	OR	A		; Read ok?
	JP	NZ,MTFILE	; No, have an empty file
	CALL	PRINT		; We're going as fast as we can...
	DB	'   [ Working... ] ',0

; Message file open.  Buffer at 80H contains 1 record (128 bytes) of the
; message file upload.	Strip all high bits to pure ASCII text.
; Initialize counter/pointer first time through only.

	LD	HL,80H		; Start of read buffer
	CALL	STPRTY		; Strip record of high bits (Saves HL)
	LD	BC,128		; Search count

; Now search for start of message header (first colon).  FNDMSG is returned
; to after each message is processed.  HL will contain pointer to current
; byte in buffer and BC contains the number of bytes left in buffer

FNDMSG:	LD	A,':'		; Search character
	LD	(HDSRCH),A	; Tell NXTRCD routine we're searching for
				; a message header so if EOF we abort.
FINDTO:	CPIR			; Block compare with increment
	CALL	PO,NXTRCD	; No match this record get another one
	JR	NZ,FINDTO	;  and continue searching

; Next nonspace character is start of receiver's name

FNDTO1:	LD	A,' '		; Search for a space
	CPI			; Compare with increment
	CALL	PO,NXTRCD	; No more bytes left, refresh buffer
	JR	Z,FNDTO1	; Keep going until first nonspace character

; Determine length of receiver's name

	DEC	HL
	INC	BC		; CPI was one ahead of us
	LD	DE,MTOTMP	; Message routine's receiver name buffer

FNDTO2:	LD	A,(HL)		; Get character
	CALL	CAPS		; Convert to uppercase
	CP	' '		; Valid character?
	JR	C,FNDSUB	; If less than a space, all done
	LD	(DE),A		; Else, put it in receiver's name buffer
	INC	HL		; Increment source,
	INC	DE		;  and destination
	DEC	C		;   and decrement counter
	CALL	Z,NXTRCD	; No more bytes left, refresh buffer
	JR	FNDTO2

; Now search for message subject (second colon)

FNDSUB:	LD	A,':'		; Character to match
	CPIR			; Block compare with increment
	CALL	PO,NXTRCD	; No more bytes left, refresh buffer
	JR	NZ,FNDSUB	; No match, continue searching

; Next nonspace character is start of message subject

FNDSB1:	LD	A,' '		; Character to match
	CPI			; Compare with increment
	CALL	PO,NXTRCD	; No more bytes left, refresh buffer
	JR	Z,FNDSB1	; Skip all spaces

; Message subject length in E.	Transfer to SUBJECT: buffer.

	DEC	HL		; CPI is one ahead of us, so back up
	INC	BC		; Adjust count
	LD	DE,MSBTMP	; Message routine's subject buffer

FNDSB2:	LD	A,(HL)		; Get character
	CP	' '		; Printable character?
	JR	C,FNDLF		; Not printable, must be done
	LD	(DE),A		; Put it in subject buffer
	INC	HL		; Increment source to next character
	INC	DE		;  and destination
	DEC	C		;   and decrement counter
	CALL	Z,NXTRCD	; No more bytes left, refresh buffer
	JR	FNDSB2		; Loop til done

; Skip nonprintable characters to start of message

FNDLF:	LD	A,LF		; Character to match
	CPIR			; Block compare with increment
	CALL	PO,NXTRCD	; No more bytes left, refresh buffer
	JR	NZ,FNDLF	;  and keep going until end of line
	LD	(MSGTXT),HL	; Save start of message
	XOR	A
	LD	(HDSRCH),A	; Indicate we found a message header
	LD	A,(GOTIND)	; Have we gotten INDEX stuff yet?
	OR	A
	JP	NZ,CMNT		; Yes, then skip this
	INC	A
	LD	(GOTIND),A	; Else we did now
	JR	PMGMNT		; Skip setting mode flag

; Get index information from the disk and store it in memory for later.

PMAINT:	LD	A,0FFH		; 0FFH indicates PNOTE operation
	LD	(MODE),A	; Save flag
	LD	HL,SYSOP	; Sysop's name
	LD	DE,MTOTMP	; Message receiver
	LD	BC,30		; Length
	LDIR			; Copy sysop name to receiver buffer

PMGMNT:	LD	E,SYSDRV
	LD	C,LOGDRV
	CALL	SPBDOS		; Log to the drive
	LD	E,SYSUSR
	LD	C,LOGUSR	; Log to the user area
	CALL	SPBDOS
	CALL	IOPEN		; Open index file
	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

; Check BYE's disk log feature

MAINT:
	 IF	DSKLOG
	LD	E,0FFH		; Ask for status
	LD	C,SDSKLOG	; BYE DISKLOG status request
	CALL	SPBDOS
	CP	77		; 77 says "NO is set in BYE5"
	JR	Z,MAINT1	; Exit with no change to the flag
	LD	A,(DSKFLG)	; See if DISK LOG is on now
	OR	A
	JR	Z,MAINT1	; If not, exit
	LD	E,0		; Now turn off the DISKLOG in BYE5
	LD	C,SDSKLOG	; BYE DISKLOG status request
	CALL	SPBDOS
	 ENDIF

MAINT1:	CALL	GETTIM		; Get date/time
	CALL	UOPEN		; Open the users file
	LD	HL,(USREC)	; Reset the user record number in HL
	CALL	GET		; Get record into buffer
	CALL	CLOSE		;  and close the file
	LD	HL,AVAILF	; Save it for callers file update
	LD	DE,AVAIL
	LD	BC,USRLEN
	LDIR

CMNT:	LD	A,(ACESS)	; Get access level
	CP	ALLLV		; See if allowed to send public msgs
	JR	NC,CMNTB	; Access > ALLLV, so allow public
	LD	A,1		; Else, force private
	LD	(PFLAG),A

; Set the user's preferred terminal width for writing, reading messages.

CMNTB:	CALL	GETUSR		; Get 'receiver' user record
	JP	Z,CMNTE		; Found user
	LD	A,(MODE)
	OR	A		; Message mode?
	JP	NZ,NTSYS	; If not, can't find sysop
	CALL	PCRLF		; Else, print CR,LF
	CALL	SHOHDR		; Display next header
	CALL	PCRLF		; Pretty up display
	LD	HL,MTOTMP	; Point to next user name
	CALL	PRINTN
	CALL	PRINT
	DB	BEL,' - User Record Not Found '
	DB	'- Abort this message? (y/N) ',0
	CALL	DEFNO		; Get an answer (default = NO)
	CP	1		; Yes?
	JP	Z,ABXIT2	; If so, abort
	CALL	GETTO		; Else, get receiver's name

CMNTE:	CALL	PRINT		; Else, clear line
	DB	CR
	DB	'               ',0
	XOR	A		; Reset
	LD	(CRS),A		;  Consecutive CR counter
	LD	(COLUMN),A	;  Current column number
	LD	(LSTLN),A	;  Last line routine
	LD	(PNTCHR),A	;  Printable character flag
	LD	(SPCSTR),A	;  No space found flag
	LD	HL,0		; Also clear buffers
	LD	IX,(MSG)	; Point to start of buffer
	LD	BC,MSGBUF	; Get length of buffer
	LD	A,(MODE)	; Get mode of operation flag
	OR	A		; Are we running as PMSG?
	JP	NZ,PNOTE	; If not, run as PNOTE

; Add any special delete characters here.

DEL	EQU	7FH		; 'normal' delete key
DELOS	EQU	1FH		; ^- on the OS-1

MSLOP:	LD	A,(GETFLG)
	OR	A
	JR	Z,KEYIN
	PUSH	BC		; Save bytes left in MSGBUF
	CALL	GTNCH		; Get character from message text upload
	POP	BC		; Restore bytes left in MSGBUF
	JR	GOTNXT

KEYIN:	PUSH	BC		; Save bytes left in MSGBUF
	CALL	GETCH		; Get character from keyboard
	POP	BC		; Restore bytes left in MSGBUF

GOTNXT:	AND	7FH		; Remove any parity
	CP	BS		; Normal backspace?
	JP	Z,BCKSPC	; If yes, exit
	CP	DEL		; Delete key used for backspace?
	JP	Z,BCKSPC	; If yes, exit
	CP	DELOS		; Special backspace key of some sort?
	JP	Z,BCKSPC	; If yes, exit
	CP	TAB		; Tab key to jump ahead on line?
	JP	Z,CHKTAB	; If yes, exit
	CP	' '		; Space character?
	JP	Z,CHKSPC	; If yes, exit, show we got one
	CP	CR		; New line requested?
	CALL	Z,CRLF		; If yes, display CR-LF both
	CP	26		; End of file?
	JR	NZ,MSLOP0
	LD	A,1
	LD	(CRS),A
	JP	CRLF

MSLOP0:	CP	' '+1
	JR	C,MSLOP		; Must be a printable character
	CP	'~'+1
	JR	NC,MSLOP
	LD	(PNTCHR),A	; Set printable character flag

MSLOP1:	CALL	ENTCHR
	JR	MSLOP

; Got printable character, add to buffer, then show it.  First, see if
; if any room is left in the buffer, to continue the message.

ENTCHR:	PUSH	AF		; Save the character
	DEC	BC		; Buffer has a '0' to terminate
	LD	A,B		; Check MSP of buffer length
	OR	A		; Less than 255 characters available?
	JR	NZ,ENTCH0	; Nope, continue
	OR	C		; Check LSP of buffer length
	JP	Z,ENDBUF	; If Buffer is empty now, exit
	CP	150		; Under 150 characters left to go?
	CALL	C,LSTLN		; If yes, warn user one time only

; Now check to see if line length would be exceeded.

ENTCH0:	LD	A,(LENG)	; Get user's maximum line length
	DEC	A		; Adjust
	LD	D,A		; Save for test
	LD	A,(COLUMN)	; Now get current column
	CP	D		; Check maximum line length
	JP	C,ENTCH7	; If less, can continue normally
	LD	A,(SPCSTR)	; Else, had any space characters yet?
	OR	A
	JR	NZ,ENTCH1	; If yes, exit
	POP	AF		; Set the stack correctly
	JR	ENTCH6		; No space char. yet, beep and exit

; Line will be too long, so remove characters from buffer back to last
; printing character in previous word, store temporarily, insert CR-LF
; then place the characters on next line and continue.

ENTCH1:	LD	HL,TBUFF	; Point to temporary buffer
	LD	(HL),0		; Zero first character in buffer

; Next store current typed character into temporary buffer, if a space,
; handle as CRLF unless no printing characters are on the line yet.

	POP	AF		; Get typed character back
	CP	' '		; See if it was a space
	JR	NZ,ENTCH2	; If not, exit
	LD	A,(PNTCHR)	; See if printing character yet
	OR	A
	JR	Z,ENTCH6	; No, beep and ignore
	LD	A,' '		; Restore the character
	CALL	ENTCH8		; Enter the space into the message
	JP	TURNUP		; Now turn up a new line

ENTCH2:	INC	HL		; Next TBUFF position
	LD	(HL),A		; Store typed character temporarily

; Now get into the message buffer and pick off characters back to end of
; previous word.  Store into temporary buffer, quit if a space character.

ENTCH3:	INC	HL		; Next TBUFF position
	DEC	IX		; Previous message buffer address
	LD	A,(IX)		; Get the character from message buffer
	CP	' '		; See if a space character, yet
	JR	Z,ENTCH4	; If yes, exit
	CP	'-'		; Accomodate hyphenated words
	JR	Z,ENTCH4	; Exit and turn up a new line
	LD	(HL),A		; Store the character temporarily
	PUSH	BC		; Save pointers
	PUSH	HL
	PUSH	IX
	CALL	PRINT
	DB	BS,' ',BS,0	; Remove it from the display
	POP	IX		; Restore pointers
	POP	HL
	POP	BC
	JR	ENTCH3		; Keep looping until space char. found

; Found a space character or hyphen.

ENTCH4:	INC	IX		; Position to first printing character
	CALL	TURNUP		; Display a new line on CRT

; Now start replacing characters from temporary buffer to next line.

ENTCH5:	DEC	HL		; Get previous temp. buffer position
	LD	A,(HL)		; Get the character there
	OR	A		; End?
	RET	Z		; If yes, done
	CALL	ENTCH8		; Else, display and enter the character
	JR	ENTCH5		; Continue until done

; Line will be too long with this character and no spaces have been sent
; yet, so can't use auto-wrap at this point.  Beep and wait for a <ret>
; or backspace to some other character.

ENTCH6:	PUSH	BC		; Save counter
	CALL	PRINT		; Sound off as can't continue at present
	DB	BEL,0
	POP	BC
	RET			; Return for next character

ENTCH7:	POP	AF		; Get the character back

ENTCH8:	LD	(IX),A		; Add to buffer
	PUSH	IX		; In case BIOS uses IX
	PUSH	BC
	LD	B,A
	LD	A,(GETFLG)
	OR	A
	LD	A,B
	POP	BC
	CALL	Z,ECHO		; Show character
	POP	IX		; Restore the IX value
	INC	IX		; Increment it for next character
	LD	A,(COLUMN)	; Get current position on line
	INC	A
	LD	(COLUMN),A
	XOR	A		; In meanwhile, zero it just in case
	LD	(IX),A		; Float a 0 at end of message
	LD	(CRS),A		; Reset the consecutive CR count
	RET

BCKSPC:	LD	A,(COLUMN)	; Get current column
	OR	A		; At beginning?
	JP	Z,MSLOP		; If yes, can't backspace
	DEC	A		; Else, does this
	LD	(COLUMN),A	;  backspace go to left margin?
	JR	NZ,BCKSP1	; If not, exit
	LD	(PNTCHR),A	; Else, reset printable character flag
	LD	(SPCSTR),A	;  and no space found flag
	INC	A
	LD	(CRS),A		; Set the consecutive CR count

BCKSP1:	DEC	IX		; Move the buffer pointer back one
	LD	(IX),0		; Float a 0 at end of message
	INC	BC
	PUSH	BC		; Save pointers
	PUSH	IX
	CALL	PRINT
	DB	BS,' ',BS,0	; Backspace one
	POP	IX		; Restore pointers
	POP	BC
	JP	MSLOP		; Continue

; Check for a tab, expand up to 8 spaces if yes, quit prior to end of
; line.

CHKTAB:	LD	A,(LENG)	; Get user's maximum line length
	DEC	A		; Adjust
	LD	D,A		; Save for test
	LD	A,(COLUMN)	; Now get current column
	CP	D		; Check maximum line length
	JP	NC,MSLOP	; If less, can continue normally
	PUSH	AF		; Save current column
	LD	A,D		; Retrieve user's line length
	SUB	7		; Adjust for tab
	LD	D,A		; Put back
	POP	AF		; Restore current column
	CP	D		; Check for partial tab at end of line
	JR	C,CHKT1		; If not close to end, handle normally
	AND	7		; Else, stop at normal tab before line end
	JP	Z,MSLOP		; If at tab stop, quit

CHKT1:	LD	A,' '
	CALL	ENTCHR
	LD	A,(COLUMN)
	AND	7
	JR	NZ,CHKTAB
	JP	MSLOP

CHKSPC:	LD	(SPCSTR),A	; Keep track of last space received
	JP	MSLOP1

; Enter and display a CR-LF.

CRLF:	CALL	CRCOM		; Call common section
	LD	A,(CRS)		; Bump # cr in a row
	INC	A		; And if over 3 then quit
	LD	(CRS),A
	CP	2
	JP	NC,EXITCR	; Two consecutive CR, so quit
	LD	A,CR
	LD	(IX),A		; Store in the buffer
	PUSH	IX		; Save buffer address
	CALL	ECHO		; Show the CR on the CRT
	POP	IX		; Get the buffer address back
	INC	IX		; Increment to next position
	LD	A,(GETFLG)
	OR	A
	LD	A,LF
	CALL	Z,ECHO		; Display a line feed on CRT
	XOR	A		; Reset
	LD	(COLUMN),A	;  Current column
	LD	(PNTCHR),A	;  Printable character flag
	LD	(SPCSTR),A	;  Space found flag
	LD	(IX),A		; Terminate message with a 0
	RET

CRCOM:	DEC	BC		; Add back one count for this CR
	LD	A,B		; More that 256 characters left?
	OR	A
	RET	NZ		; If yes, everything is ok
	OR	C		; See if out of space entirely
	JR	Z,CRCOM1	; If yes, reset stack and exit
	CP	150		; Last 150 characters?
	JP	C,LSTLN		; If yes, tell user only 2 lines left
	RET

CRCOM1:	POP	HL		; Remover CALL Z,CRLF

ENDBUF:	POP	HL		; Remove CALL CRCOM from stack
	POP	AF		; Clear stack
	INC	BC		; Re-align counter
	PUSH	BC		; Save it
	DEC	IX		; Back to end of block
	PUSH	IX		; Save again
	LD	(IX),0		; Set end of message
	CALL	PRINT
	DB	CR,LF,'-- Message buffer full --',CR,LF,0
	JP	EXIT0

LSTLN:	NOP			; Get's changed to a RET
	PUSH	BC		; Save pointers
	PUSH	IX
	CALL	PRINT
	DB	CR,LF,'-- 2 lines left --',CR,LF,0
	LD	A,RET		; Disable last line message so it can
	LD	(LSTLN),A	;  only be shown one time
	POP	IX		; Restore pointers
	POP	BC
	RET

TURNUP:	CALL	CRCOM		; See if any room left, etc.
	PUSH	BC		; Save pointers
	PUSH	HL
	PUSH	IX
	CALL	PCRLF
	POP	IX		; Restore pointers
	POP	HL
	POP	BC
	XOR	A		; Reset
	LD	(COLUMN),A	;  Current column
	LD	(PNTCHR),A	;  Printable character flag
	LD	(SPCSTR),A	;  Space found flag
	INC	A		; Set
	LD	(CRS),A		;  Consecutive CR flag
	RET

EXITCR:	PUSH	BC		; Save buffer length for later handling
	PUSH	IX		; Save address for later handling
	LD	IX,(MSG)
	INC	IX
	LD	A,(IX)
	OR	A
	JP	Z,ABXIT

EXIT0:	CALL	SHOHDR
	LD	A,(MFLDR)	; Have message folder yet?
	OR	A
	CALL	Z,GFLDR		; Get message folder if supposed to

HLP:	CALL	EATCHR		; Kill any stray characters...

; Display expanded menu

	CALL	PCRLF
	LD	A,(ALLFLG)	; Message to ALL?
	OR	A
	JR	NZ,EXIT0B	; Yup, so can't be PRIVATE
	LD	A,(ACESS)
	CP	ALLLV		; Public allowed?
	JR	C,EXIT0B	; If yes, skip next
	CALL	PRINT
	DB	'P)rivate, ',0

EXIT0B:	CALL	PRINT
	DB	'S)ave, A)bort, C)ontinue, '
	DB	'E)dit, H)eader, L)ist:  ',0

EXIT1:	CALL	GTCHAR		; Get a character from the console
	CP	CR
	JP	Z,SAVE		; If so, defaults to public save
	CP	' '		; Else, printable character?
	JR	C,EXIT1		; If not, get another one
	LD	HL,JPEXT
	LD	BC,DBEXT-JPEXT
	CALL	FINDER
	JR	NZ,EXITN
	PUSH	DE
	RET

EXITN:	CALL	DOBS
	JR	EXIT1

JPEXT:	DB	'ACEHLPS'

DBEXT:	DW	SAVE		; Save (S)
	DW	PRVT		; Private save (P)
	DW	LISTE		; List (L)
	DW	CHDR		; Header edit (H)
	DW	EDIT		; Edit (E)
	DW	CONT		; Continue (C)
	DW	ABXIT		; Abort (A)

;-------------------------------------------------------------------------
; Change message header.

CHDR:	CALL	PRINT
	DB	'eader Change',CR,LF,0
	CALL	GETHDR
	XOR	A		; Set folder
	LD	(MFLDR),A	;  to GLOBAL
	JP	EXIT0

;-------------------------------------------------------------------------
; Process abort request.

ABXIT:	CALL	PRINT
	DB	'bort',0
	LD	A,(MODE)
	OR	A
	JR	Z,PMSGEX
	CALL	PRINT
	DB	CR,LF,'Abort this message? (y/N) ',0
	CALL	DEFNO		; Get an answer (default = NO)
	CP	1		; Yes?
	JP	Z,ABXIT1	; If so, abort
	CALL	PRINT		; Else, clear line and continue
	DB	CR,'                          ',CR,0
	JP	CONT0

PMSGEX:	CALL	PRINT
	DB	CR,LF,'Abort A)ll messages or T)his message only: (a/T) ',0
	CALL	GTCHAR		; Get input
	CALL	CAPS
	CP	'A'		; Abort all?
	JR	Z,ABXIT1	; If so, all done
	JR	ABXIT2

ABXIT1:	CALL	PRINT
	DB	CR,LF,'Session terminated.  ',CR,LF,0
	POP	IX
	POP	BC
	JP	ABEXIT

ABXIT2:	POP	IX		; Restore stack
	POP	BC
	JP	NXTMSG		; Go get next message

;-------------------------------------------------------------------------

; Gets the message header

GETHDR:	LD	A,(ACESS)	; See if this
	CP	PSYSP		;  is the Sysop
	JR	C,CHKLV		; Check level for message post access
	CALL	PRINT
	DB	CR,LF,LF,'Use your N)ame or S)ysop? (N/s) ',0

PMW0:	CALL	GTCHAR		; Get input
	JR	Z,PMW0		; Get another
	CALL	CAPS		; Make sure its capital
	CP	'S'
	JR	Z,PMWDON
	LD	A,'N'

PMWDON:	LD	(SYSBYT),A	; Store answer

CHKLV:	LD	A,(ACESS)	; Get users access level
	CP	ALLLV		; Can user post public messages?
	JP	C,ENTER		; If not, don't allow change of receiver name

GETTO:	NOP			; Inline modification for return

TRYAG:	LD	A,CR
	CALL	ECHO
	LD	HL,MTOTMP
	LD	B,30
	CALL	PRINTL
	LD	HL,DSHLNE
	CALL	PRINTL
	CALL	PRINT
	DB	'         <<  Message to?  ',0
	LD	A,(ACESS)	; Access level
	CP	ALLLV		; Public messages allowed?
	JR	C,GETTO1	; Access too low, skip next
	CALL	PRINT
	DB	'<CR> for no change',0

GETTO1:	CALL	PRINT
	DB	CR,0
	LD	C,20H
	LD	B,30
	XOR	A		; Echo on
	LD	D,A
	LD	(TOSYSP),A	; Clear Sysop flag
	CALL	INPUT
	OR	A
	JR	Z,GETTO2	; Keep old name
	LD	HL,INBUF
	LD	DE,MTOTMP
	LD	BC,30
	LDIR			; Save message receiver

GETTO2:	LD	HL,INBUF	; Point to input

; If message was to 'SYSOP' then substitute name at label 'SYSOP'
; as message receiver name.

	LD	DE,SYSSTR	; See if to 'Sysop'
	LD	B,6
	CALL	MATCH
	JR	NZ,POSTM2	; Not 'Sysop', so search for entry
	LD	A,1
	LD	(TOSYSP),A
	LD	HL,SYSOP	; Was 'Sysop' so move name at label
	LD	DE,MTOTMP	; 'Sysop' to MTO stuff
	LD	BC,30
	LDIR

POSTM2:	LD	DE,ALLMSG
	LD	B,10
	CALL	MATCH
	JP	NZ,NOALL
	LD	HL,ALLMSG
	LD	DE,MTOTMP
	LD	BC,10
	LDIR
	INC	A
	LD	(ALLFLG),A
	LD	A,CR
	CALL	ECHO
	LD	HL,MTOTMP
	LD	B,30
	CALL	PRINTL
	LD	HL,DSHLNE
	CALL	PRINTL
	JR	PUB

NOALL:	LD	A,CR
	CALL	ECHO
	LD	HL,MTOTMP
	LD	B,30
	CALL	PRINTL
	LD	HL,DSHLNE
	CALL	PRINTL
	XOR	A		; Reset
	LD	(PFLAG),A	;  Private flag
	CALL	PRINT
	DB	CR,LF,'Locating user record...',0
	CALL	GETUSR
	JR	Z,GOTIT
	CALL	PRINT
	DB	CR,'Unable to locate user, ',0
	LD	HL,MTOTMP
	LD	B,30
	CALL	PRINTL
	CALL	PCRLF
	JP	TRYAG

GOTIT:	LD	(MTOREC),HL	; Save record number for later
	LD	A,(ACESS)	; Access level
	CP	ALLLV		; Public messages allowed?
	JR	NC,ENTER	; If not, skip next
	LD	A,1
	LD	(PFLAG),A	; Force private
	JR	ENTER

PUB:	LD	A,(ACESS)	; Access level
	CP	ALLLV		; Public messages allowed?
	JP	C,EXIT0		; If not, jump
	CALL	PCRLF

ENTER:	LD	A,CR
	CALL	ECHO
	LD	HL,MSBTMP
	LD	B,26
	CALL	PRINTL
	LD	HL,DSHLNE
	CALL	PRINTL
	CALL	PRINT
	DB	'             <<  Subject?     <CR> for no change',CR,0
	LD	B,26
	XOR	A		; Set input flags
	LD	D,A
	LD	C,A
	CALL	INPUT
	OR	A
	JR	Z,GTHDDN	; Exit with <cr>
	LD	DE,MSBTMP
	LD	HL,INBUF
	LD	BC,26
	LDIR			; Save subject
	LD	A,CR
	CALL	ECHO
	LD	HL,MSBTMP
	LD	B,26
	CALL	PRINTL
	LD	HL,DSHLNE
	CALL	PRINTL

GTHDDN:	JP	PCRLF1

;-------------------------------------------------------------------------

; Edit current message

EDIT:	CALL	PRINT
	DB	'dit',0
	LD	HL,EBUF		; Clear
	LD	DE,EBUF+1	;  edit buffers
	LD	BC,129		;   including ELEN
	LD	(HL),0		;    and RLEN
	LDIR			;     to null
	CALL	PRINT
	DB	CR,LF,LF
	DB	'You may now edit individial characters, words or lines.',CR,LF
	DB	'Use a ^ to represent a carriage return.',CR,LF
	DB	'Enter character(s) that you wish to change:  ',0
	XOR	A
	LD	C,A
	LD	D,A
	LD	B,64
	CALL	INPUT
	OR	A
	JR	NZ,EDIT1
	CALL	PCRLF1
	JP	EXIT0

EDIT1:	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,'Enter the replacement characters:  ',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	(HL),CR

NCR:	INC	HL
	DJNZ	CRLOP		; Do until all characters checked
	LD	HL,EBUF		; Point to search string
	LD	DE,(MSG)	;  and message start

SELOP:	LD	A,(DE)
	CP	(HL)
	JR	Z,SELOP0
	INC	DE		; Next in buffer
	LD	A,(DE)
	OR	A		; At end?
	JR	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
	JR	Z,SELOP2	; Got a match
	LD	A,(DE)
	CP	(HL)
	JR	Z,SELOP1
	POP	HL
	POP	DE
	INC	DE		; Point to next in buffer
	JR	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 position 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
	LD	C,A		; First move
	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		; Realign
	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=difference
	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
	CALL	PRINT
	DB	CR,LF,LF,'Changed.',0
	JP	EXIT0

LNGSTR:	POP	HL
	POP	HL		; Clear stack
	CALL	PRINT
	DB	CR,LF,LF,'Replacement string too long.',0
	JP	EXIT0

NOSTR:	CALL	PRINT
	DB	CR,LF,LF,'Old string not found.',0
	JP	EXIT0

;-------------------------------------------------------------------------
; Continue entering text from keyboard input

CONT:	CALL	PRINT
	DB	'ontinue',CR,LF,0

CONT0:	POP	IX
	POP	BC

CONT1:	DEC	BC		; Buffer full when 1 byte left
	LD	A,B
	OR	C		; See if at end of buffer
	INC	BC		; Realign counter
	JR	Z,NOCONT	; At end of buffer, so go
	XOR	A
	LD	(GETFLG),A
	JP	MSLOP		; Go for it...

NOCONT:	PUSH	BC
	PUSH	IX
	CALL	PRINT
	DB	'Can''t continue, at end of buffer.',CR,LF
	DB	'Use E)dit to delete from and change message.',0
	JP	EXIT0

;-----------------------------------------------------------------------
; List the current message.

LISTE:	CALL	PRINT
	DB	'ist',0
	LD	IX,(MSG)
	LD	HL,(MSG)
	CALL	LISTA
	JP	HLP

LIST:	CALL	PCRLF1		; Print CR and 2 LFs
	LD	HL,(MSG)
	LD	B,24
	CALL	PRINTL
	LD	IX,(MSG)
	LD	HL,(MSG)
	LD	BC,128
	ADD	IX,BC
	ADD	HL,BC

LISTA:	LD	A,(TLIN)	; Get user's terminal length
	SUB	7
	LD	(TLINES),A
	PUSH	HL
	CALL	PCRLF1
	POP	HL
	XOR	A		; Reset
	LD	(COLUMN),A	;  Current column
	LD	(SPCSTR),A	;  Space found flag
	LD	(PNTCHR),A	;  Printable character flag

; Count the text one character at a time.  If too many for the desired
;  maximum line length, do a word wrap on the local display.

LSTLP:	LD	A,(HL)		; Get the character
	OR	A
	JR	Z,LSTLP1	; End of message, exit
	CP	CR		; End of line character?
	JP	Z,LSTNEW	; See if CR should be retained
	CP	' '		; See if 01 or other non-printing
	JR	C,LSTLP4	; Skip any non-printing characters

LSTLP1:	LD	A,(COLUMN)	; Increment for this character
	INC	A
	LD	(COLUMN),A
	LD	A,(HL)		; Get the character back again
	CP	CR+1		; See if a <ret> or end of message
	JP	C,SHOLIN	; If yes, send the new line
	CP	' '
	JR	NZ,LSTLP2
	LD	(SPCSTR),A	; Set space found flag
	JR	LSTLP3

LSTLP2:	LD	(PNTCHR),A	; Set printable character flag

LSTLP3:	LD	A,(LENG)	; Get user's maximum line length
	LD	D,A		; Save for test
	LD	A,(COLUMN)	; Now get current column
	CP	D		; Check maximum line length
	JR	NC,LSTWRP	; If less, can continue normally

LSTLP4:	INC	HL
	JR	LSTLP		; Get the next character

; Line was too long, see why and fix the count accordingly.

LSTWRP:	LD	A,(HL)		; Get the character back
	CP	' '		; Space at end of full line?
	JR	Z,SHOLIN	; If yes, send the line

LSTWR1:	DEC	HL
	LD	A,(COLUMN)
	DEC	A
	LD	(COLUMN),A
	LD	A,(SPCSTR)	; Any spaces yet?
	OR	A
	JR	Z,SHOLIN	; If not show what we have so far

LSTWR2:	LD	A,(HL)
	CP	'-'
	JR	Z,SHOLIN
	CP	' '
	JR	NZ,LSTWR1	; Neither of these, keep backtracking

; Ok all finished, now, display the line.

SHOLIN:	LD	A,(IX)
	OR	A		; Message all finished?
	JR	Z,SHOLN1	; Yes, go reset zero flag and return
	CP	CR
	JR	Z,LSTCR		; Exit if at end of this line
	CP	' '
	JR	C,LSTWR4	; Ignore 01's and non-printing
	CALL	ECHO		; Display the character
	LD	A,(COLUMN)
	DEC	A
	LD	(COLUMN),A
	JR	Z,LSTCR		; If zero, no <ret> so add one

LSTWR4:	INC	IX
	JR	SHOLIN		; Do the next character

SHOLN1:	INC	A		; Reset zero flag
	RET

; Displays CR, resets the column counter, then checks to see if time for
; the [more] pause, returns with LF in 'A', not displayed yet.

LSTCR:	CALL	LSTUP		; Display a CR and check for [more]
	CALL	ECHO		; Display the LF
	CALL	TWAIT		; Check for screen full, pause or abort
	RET	Z
	INC	HL		; Increment for this character
	PUSH	HL		; Transfer HL address to IX
	POP	IX
	JP	LSTLP		; Back to work on the next line

LSTUP:	XOR	A		; Reset
	LD	(COLUMN),A	;  Column counter
	LD	(PNTCHR),A	;  Printable character flag
	LD	(SPCSTR),A	;  Space found flag
	LD	A,CR		; Turn up a new line
	CALL	ECHO
	LD	A,LF
	RET

LSTNEW:	INC	HL		; Check next character
	LD	A,(HL)
	OR	A		; See if end of message
	JR	Z,LSTN3		; If yes, handle this CR normally
	CP	' '		; Is it a space for blank line?
	JR	Z,LSTN3		; If yes, handle normally
	DEC	HL		; Back to normal position
	LD	A,(PNTCHR)	; Any printing chars. on line yet?
	OR	A
	JR	NZ,LSTN4	; If yes, call this a 'soft return'
	DEC	HL		; Else check ahed of this for a space
	LD	A,(HL)
	CP	' '		; Space for a blank line, etc.
	JR	Z,LSTN2		; If yes, keep the 'hard return'

LSTN1:	INC	HL		; Back to current location
	LD	A,' '		; Call it a space then
	LD	(HL),A		; Put into the message for now
	JP	LSTLP1		; Back to work

LSTN2:	INC	HL		; Handle normally
	JP	LSTLP1

LSTN3:	DEC	HL
	JP	LSTLP1		; Handle normally

; Line had some printing characters, check for a trailing space.

LSTN4:	DEC	HL
	LD	A,(HL)
	CP	' '		; Was it a trailing space?
	JR	NZ,LSTN1	; If not, call this a 'soft return'
	INC	HL
	LD	(HL),1
	JP	LSTLP		; Get next character, ignore this return

; End of list messages.
;-----------------------------------------------------------------------
; Save the message.

PRVT:	LD	A,(ALLFLG)	; See if message is to ALL
	OR	A
	JP	NZ,EXIT1	; If yes, can't be private, ask again
	LD	A,(ACESS)	; See if this is Sysop or co-Sysop

; Determine who can send private messages regardless of restrictions

	CP	COSYS
	JR	NC,PRVTOK	; If yes, they can send private

PRVTOK:	CALL	PRINT
	DB	'rivate save.',0
	LD	A,1
	LD	(PFLAG),A	; Make it private
	JR	SAVEP

SAVE:	CALL	PRINT
	DB	'ave.  ',0
	XOR	A		; Make it public
	LD	(PFLAG),A

SAVEP:	POP	IX
	POP	BC		; Must clear stack first

NMLT:	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
	JR	NC,DLOP
	ADD	HL,DE
	LD	A,C
	INC	A
	INC	A
	LD	(LINES),A
	LD	A,H
	OR	L
	JR	Z,NOREM
	LD	A,(LINES)
	INC	A
	LD	(LINES),A

NOREM:	PUSH	IX
	PUSH	BC
	CALL	PRINT
	DB	CR,LF,'Updating:  ',0
	POP	BC
	POP	IX
	LD	E,1		; Set
	LD	C,WRTLOC	;  write lock
	CALL	SPBDOS		;   in BYE
	LD	A,(PFLAG)	; Get private mail flag
	OR	A		; Private?
	JR	NZ,USET		; If yes, go update receiver's user rec
	LD	A,(ALLFLG)	; Else, get ALL flag
	OR	A		; To ALL?
	JR	NZ,ALLSKP	; If yes, skip user update

; Set flag in receiver's user record so he's bumped to mail next signon

USET:	CALL	PRINT
	DB	'Users file...',0
	CALL	UOPEN		; Open users file
	LD	HL,(MTOREC)	; Record # saved when we searched for reciever
	CALL	GET
	LD	HL,MAILF
	INC	(HL)
	LD	HL,(RRNO1)	; Get record number
	CALL	PUT		;  and write record back
	CALL	CLOSE
	CALL	PRINT
	DB	BS,BS,BS,', ',0

; 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. Have to open
; new record for message in MSGINDEX, so set up for it.

ALLSKP:	PUSH	HL		; Save pointers
	PUSH	IX
	PUSH	BC
	CALL	PRINT
	DB	'Message Index file...',0
	POP	BC		; Restore pointers
	POP	IX
	POP	HL
	CALL	MIOPEN		; Open message index file
	CALL	CLRBUF
	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	(MRECF),HL	; Store rec# in msgindex
	LD	(IMNDX),HL
	LD	(RRNO1),HL	; Set record number in buffer

; Now write the MSGINDEX record # determined above.

WRITE:	CALL	GETTIM		; Get time and date string
	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 receiver field
	LD	HL,BTIME	; And time
	LD	DE,MTIMEF
	LD	BC,3
	LDIR
	LD	HL,IDATE	; And date
	LD	DE,MDATF
	LD	BC,3
	LDIR
	LD	A,(PFLAG)	; Private flag
	LD	(MPUBF),A
	LD	HL,MSBTMP
	LD	DE,MSUBF
	LD	BC,26
	LDIR			; Set subject field
	PUSH	DE		; Save next buffer address

; See if Sysop, if so see if he wants to use 'Sysop' or his name in the
; sender string.

	LD	A,(ACESS)
	CP	PSYSP
	JR	C,NOSYS		; Not sysop, so just store user's name
	LD	A,(SYSBYT)
	CP	'N'		; Want to use his name?
	JR	Z,NOSYS		; Yes
	LD	HL,SYSSTR	; Else, point to 'Sysop' string
	LD	BC,6
	JR	ISYS

NOSYS:	LD	HL,UNAME	; Get user's name
	LD	BC,30

ISYS:	POP	DE
	LDIR			; Move user's name
	LD	A,(MFLDR)
	LD	(MFNUMF),A
	LD	HL,(RRNO1)
	CALL	PUT
	CALL	CLOSE		; Message index file 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,IDATE	; Update index info
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	CALL	IOPEN
	CALL	PUT
	CALL	CLOSE		; Index closed

; And finally, write each 64 byte line to sequential records.

	CALL	PRINT
	DB	BS,BS,BS,', Messages file...',0
	CALL	MSGOPN		; Open messages file
	LD	HL,(STRTMP)	; Set record number for first line
	LD	(RRNO1),HL
	LD	IY,(MSG)
	LD	A,(LINES)
	LD	B,A
	CALL	WRTLP
	CALL	CLOSE
	LD	DE,0
	LD	C,WRTLOC
	CALL	SPBDOS
	LD	A,(MODE)
	OR	A
	JP	NZ,REXIT1

; Added to support multiple messages

NXTMSG:	LD	A,(MSGSDN)	; All done yet?
	OR	A
	JP	NZ,REXIT	; Yes
	CALL	PRINT
	DB	CR,LF,'Next message.    ',CR,LF,0
	LD	A,1
	LD	(HDSRCH),A	; Show looking for header now

; Initialize receiver and subject buffers

	LD	HL,MSBTMP
	LD	DE,MSBTMP+1
	LD	(HL),0
	LD	BC,26-1
	LDIR
	LD	HL,MTOTMP
	LD	DE,MTOTMP+1
	LD	(HL),0
	LD	BC,30-1
	LDIR

; Set current buffer position/byte count

	LD	DE,(MSGTXT)	; Get current upload message text pointer
	LD	HL,0FFH		; Buffer ends here
	OR	A		; Clear carry
	SBC	HL,DE		; Calculate bytes left in buffer
	PUSH	HL
	POP	BC		; And set for count down
	EX	DE,HL		; Get current upload message pointer text back
	LD	A,B
	OR	C		; Anything left in buffer?
	JR	NZ,REXIT0	; Yes, continue

; Get another record

	CALL	NXTRCD		; Get next record
	LD	HL,(MSGTXT)
	LD	BC,128

REXIT0:	XOR	A
	LD	(MFLDR),A
	LD	(UMFLDR),A
	INC	A
	LD	(GETFLG),A	; Set to read from file, not console input
	JP	FNDMSG		; And go search for another message

; All done, clean up and exit to CP/M

REXIT:	CALL	PRINT
	DB	CR,LF,'All done.    ',CR,LF,0

	 IF	DSKLOG
	LD	A,(ACESS)	; Is a sysop?
	CP	COSYS
	JR	NC,REXIT1	; Yup, so don't turn on DISKLOG
	LD	C,SDSKLOG	; Else, BYE DISKLOG status request
	LD	E,0FFH		; Ask for status
	CALL	SPBDOS
	CP	77		; 77 says "NO is set in BYE5"
	JR	Z,REXIT1	; Exit with no change to the flag
	LD	A,(DSKFLG)	; See if DISKLOG was originally on  ????
	OR	A
	JR	Z,REXIT1	; If not, all done
	LD	C,SDSKLOG	; BYE5 DISKLOG status byte
	LD	E,1		; Else turn the DISKLOG back on
	CALL	SPBDOS		;  to catch Sysop's log off time
	 ENDIF

REXIT1:
	 IF	DELFIL
	CALL	MDEL		; Delete message file on exit
	 ENDIF			; DELFIL

ABEXIT:	LD	A,(OLDDRV)
	LD	E,A
	LD	C,LOGDRV
	CALL	SPBDOS		; Restore original drive
	LD	A,(OLDUSR)
	LD	E,A
	LD	C,LOGUSR
	CALL	SPBDOS		; Restore original user area

REXIT2:	LD	SP,(CCPSTK)	; Restore original stack
	RET			; And exit

WEXIT:	CALL	PRINT
	DB	CR,LF,'Not Wheel - Abort...',CR,LF,0
	JP	ABEXIT

; Clear buffer for next.

CLRBUF:	LD	HL,RNDBUF
	LD	(HL),0
	LD	DE,RNDBUF+1
	LD	BC,USRLEN-1	; Longest used length-1
	LDIR
	RET

WRTLP:	PUSH	BC		; Save pointers
	PUSH	IY
	POP	HL
	LD	DE,RNDBUF
	LD	BC,MSGLEN
	LDIR
	PUSH	HL
	POP	IY
	LD	HL,(RRNO1)
	CALL	PUT64
	LD	HL,(RRNO1)
	INC	HL
	LD	(RRNO1),HL
	POP	BC
	DJNZ	WRTLP
	RET

EATCHR:	LD	E,0FFH
	LD	C,6
	CALL	SPBDOS
	OR	A
	JR	NZ,EATCHR
	RET

MDEL:	LD	DE,PMSFCB	; Point to message file FCB
	LD	C,FDEL		; BDOS delete file function
	CALL	SPBDOS		; Delete file
	RET

; This routine gets a character from the current message file record and
; returns with it in A.  If the current record has all been read, the next
; record is read in (sequentially).  The current address for this read
; buffer is 80H.  Making a call to this routine with no more bytes left in
; current record, and no more records to read causes 2 CR's to be output.
; This causes the CRS to be set to 1 and a CR loaded into register A.
; Then it returns.  The calling routine sees this as an EOM (End of
; message) flag.

GTNCH:	LD	HL,(MSGTXT)
	LD	A,(HL)
	PUSH	BC
	LD	B,A
	LD	A,L
	INC	HL
	LD	(MSGTXT),HL
	INC	A		; End of TBUF area?
	LD	A,B
	POP	BC
	RET	NZ		; Not at end of TBUF yet so just return
				; with next character in A

; No more bytes left in buffer get another record

NXTRCD:	PUSH	AF
	PUSH	BC
	PUSH	IX

; Get the current drive/user

	LD	E,0FFH
	LD	C,LOGUSR
	CALL	SPBDOS
	LD	C,A		; User area into C
	PUSH	BC		; Save it
	LD	C,25		; Get current disk
	CALL	SPBDOS
	POP	BC
	LD	B,A		; Drive into B
	PUSH	BC		; Save BC=Drive/User respectively
	LD	A,(MSGUSR)	; Get message upload user area
	LD	E,A
	LD	C,LOGUSR	; Set to requested user area
	CALL	SPBDOS
	LD	A,(MSGDRV)	; Get message upload drive
	LD	E,A
	LD	C,LOGDRV	; Set to requested drive
	CALL	SPBDOS
	LD	DE,80H
	LD	C,SETDMA
	CALL	SPBDOS		; Set DMA
	LD	DE,PMSFCB
	LD	C,FREAD		; Read sequential
	CALL	SPBDOS
	OR	A
	LD	HL,80H		; Set buffer position to start of buffer
	LD	(MSGTXT),HL
	JR	NZ,ALLDON	; No more records
	CALL	STPRTY		; Strip all high bits
	POP	BC		; Get system files drive/user back
	CALL	RSETDU		; Set it
	POP	IX		; Restore stack
	POP	BC
	POP	AF
	LD	BC,80H		; Set search for 1 record
	RET			; And process this record

ALLDON:	LD	A,1
	LD	(MSGSDN),A	; Show we're all done now
	LD	A,(HDSRCH)	; Were we doing a header search?
	OR	A
	JP	NZ,REXIT	; Yes, no header, so abort current message
	INC	A		; All done with current message/or entire file
	LD	(CRS),A		; Show we've had one CR so far
	POP	BC		; Get system files drive/user back
	CALL	RSETDU		; Set it
	POP	IX		; Restore registers
	POP	BC
	POP	AF
	LD	A,CR		; Second CR says we're done with this message
	RET

RSETDU:	PUSH	HL
	PUSH	BC
	LD	E,B
	LD	C,LOGDRV
	CALL	SPBDOS
	POP	BC
	LD	E,C
	LD	C,LOGUSR
	CALL	SPBDOS
	POP	HL
	RET

; Strip record of high bits

STPRTY:	PUSH	HL
	PUSH	BC
	LD	B,128
	DEC	B		; Account for current position
	LD	A,7FH		; Get strip mask

STRPLP:	AND	(HL)		; Strip character
	INC	HL		; Point next
	DJNZ	STRPLP		; Loop til done
	POP	BC		; Restore pointers
	POP	HL
	RET

; Filename parsing error messages/subroutines

NOFNM:	CALL	PRINT
	DB	CR,LF,'No filename specified',CR,LF,0
	JP	REXIT		; And exit

CKNUM:	CP	'0'
	JR	C,ILLDU		; Error if less than ASCII '0'
	CP	'9'+1
	RET	C		; Error if more than ASCII '9'

ILLDU:	CALL	PRINTM
	DB	CR,LF
	DB	'Drive/User Error'
	DB	CR,LF
	DB	0
	JP	REXIT

; Message file upload not found, display error message and abort

NOFILE:	LD	A,CR
	CALL	ECHO
	LD	C,25
	CALL	SPBDOS
	ADD	A,'A'
	CALL	ECHO
	LD	E,0FFH
	LD	C,LOGUSR
	CALL	SPBDOS
	LD	L,A
	LD	H,0
	CALL	PB2ASC
	LD	A,':'
	CALL	ECHO
	LD	HL,PMSFCB+1
	LD	B,11

SHNAM:	LD	A,(HL)
	PUSH	HL
	PUSH	BC
	CALL	ECHO
	POP	BC
	POP	HL
	INC	HL
	DJNZ	SHNAM
	CALL	PRINT
	DB	' file not found.  Please leave a NOTE telling sysop.',CR,LF,0
	JP	REXIT

MTFILE:	CALL	PRINT
	DB	CR,LF,'Invalid message file format - '
	DB	'Premature EOF encountered.',CR,LF,0
	JP	REXIT

; This routine moves the filename pointed to by HL into the FCB pointed
; to by DE padded with spaces.

MOVFCB:	LD	DE,PMSFCB+1
	LD	A,1		; Count for number bytes stuffed in FCB

MSGFNM:	EX	AF,AF'          ; Put count away for now
	LD	A,(HL)		; Source byte
	INC	HL		; Next character
	CP	'.'		; Filename seperator?
	JR	Z,MSGFN1	; Yes, fill rest of filename with spaces
	LD	(DE),A		; Store in FCB
	INC	DE		; Next destination byte
	EX	AF,AF'          ; Get the count back
	INC	A		; Increment it

MSGFN0:	DJNZ	MSGFNM		; One byte less to transfer
	RET			; All done

MSGFN1:	EX	AF,AF'          ; Get count
	CP	9
	JR	NC,MSGFN0	; Yes
	INC	A		; Bump it one
	EX	AF,AF'          ; Put away count again
	LD	A,' '
	LD	(DE),A
	INC	DE
	JR	MSGFN1

; Help guide

HELP:	CALL	PRINT
	DB	CR,LF
	DB	'   USAGE:   PMSG [du:]filename.ext',CR,LF
	DB	'            PMSG',CR,LF
	DB	'            PMSG ? or / - Displays this help screen.',CR,LF,LF
	DB	'   PMSG forwards a preformatted text file to your PBBS',CR,LF
	DB	'   message base when the name of the file is specified',CR,LF
	DB	'   on the command line.',CR,LF,LF
	DB	'   PMSG will allow the user to enter public or private',CR,LF
	DB	'   messages to the SYSOP if no filename is specified.'
	DB	CR,LF,LF
	DB	'                 -<< MESSAGE FORMATTING >>-',CR,LF
	DB	'           TO: John User',CR,LF
	DB	'           SUBJ: subject (use keywords in subject)',CR,LF,LF
	DB	'           message text...',CR,LF,LF
	DB	'           Seperate messages with 2 or more <CR>s.',CR,LF
	DB	'           Terminate file with 2 or more <CR>s).',CR,LF,0
	JP	ABEXIT

;-----------------------------------------------------------------------
; Print a menu of the available mail folders including folder 0 (GLOBAL)
; then get and validate input.	Set (UMFLDR) to the input value, but set
; the contents of MFLDR to the real (DECODED) folder value.  After the
; user's input is validated, place the value in UMFLDR and jump to UFLDR
; to set the acutal values.  Don't show folder 0, just return the selected
; value in 'A'.

GFLDR:
	 IF	NMFLDRS	GT 1
	LD	A,(ACESS)	; Access level
	CP	COSYS		; A sysop?
	JR	NC,GFLDR0	; If yes, skip next
	LD	A,(MXFLDR)
	CP	1		; Access to multiple folders
	RET	Z		; No, all done
				; Set the mail folder access levels

; Set the mail folder access levels

GFLDR0:	LD	HL,ACCTBL	; Get address of access table into 'HL'
	LD	(HL),0		; Mark first byte of the table
	PUSH	HL
	PUSH	HL
	INC	HL
	EX	DE,HL
	POP	HL
	LD	BC,9
	LDIR
	POP	HL
	LD	(HL),1
	INC	HL
	LD	(HL),1
	INC	HL
	LD	IX,MXFLDR
	LD	(IX+00H),1
	LD	IY,MAILTBL
	LD	A,(UFACC)
	LD	B,A
	LD	A,(UFACC+1)
	LD	C,A
	LD	A,(ACESS)
	LD	E,A
	LD	A,040H
	LD	D,NMFLDRS-1
	PUSH	AF

AFTEST:	POP	AF
	PUSH	AF
	LD	(AFT1+1),A
	INC	A
	LD	(AFT3+1),A
	ADD	A,080H
	LD	(AFT2+1),A

AFT1:	BIT	0,B
	JR	NZ,AFT4
	LD	A,(IY+00H)
	OR	A		; Clear carry
	CP	E
	JR	Z,AFT2
	JR	NC,AFT3

AFT2	EQU	$
	SET	0,C

AFT3	EQU	$
	BIT	0,C
	JR	Z,AFT4
	LD	(HL),1
	INC	(IX+00H)

AFT4:	INC	HL
	INC	IY
	POP	AF
	ADD	A,08H
	PUSH	AF
	DEC	D
	JR	Z,AFT5
	JR	AFTEST

AFT5:	POP	AF
	LD	A,C
	LD	(UFACC+1),A

; Print the available folder names (1 thru (MXFLDR)) NOW

	CALL	PRINT
	DB	CR,LF,'Select message folder from the following list:'
	DB	CR,LF,LF,0
	XOR	A
	LD	(GFLDR3),A	; Skip first line feed

GFLDR1:	PUSH	IY
	LD	HL,FNAME1-16
	LD	IY,ACCTBL	; Access table
	LD	D,NMFLDRS	; Loop count
	LD	E,0		; For display
	PUSH	DE
	PUSH	HL

GFLDR2:	POP	HL
	POP	DE
	INC	IY
	LD	BC,16
	ADD	HL,BC
	LD	A,(IY+00H)
	CP	1
	JR	NZ,GFLDR4
	PUSH	DE
	PUSH	HL
	CALL	PRINT
	DB	CR

GFLDR3:	DB	0,0
	POP	HL
	POP	DE
	INC	E
	PUSH	DE
	PUSH	HL
	LD	L,E
	LD	H,0
	CALL	PB2ASC
	CALL	PRINT
	DB	'. ',0
	POP	HL
	PUSH	HL
	LD	B,16		; PRINT routines use B as counter
	CALL	PRINTL
	POP	HL
	POP	DE

GFLDR4:	DEC	D
	PUSH	DE
	PUSH	HL
	JR	Z,GFLDR5
	LD	A,LF
	LD	(GFLDR3),A
	JR	GFLDR2

GFLDR5:	POP	HL
	POP	DE
	POP	IY
	CALL	PRINT
	DB	CR,LF,LF,'Enter folder #:  ',0

GFLDR6:	CALL	GTCHAR		; Get input
	LD	C,A
	CP	'0'
	JR	C,GFLDR6
	LD	A,(MXFLDR)
	ADD	A,030H
	CP	C
	JR	C,GFLDR6
	LD	A,C
	CP	'0'
	JR	Z,GFLDR6
	SUB	30H
	LD	(UMFLDR),A

; Using the value in UMFLDR scan the ACCTBL for the UMFLDRth folder the
; user has access to, place the table position value in 'A' and then re-
; turn.  The number of the folder the user wanted is in'A'

	LD	IX,ACCTBL	; Set IX to first table entry
	LD	C,A		; Folder user wanted into 'C'
	LD	DE,0		; Clear 'D' and 'E' for counters

UFLDR3:	INC	IX		; Point to next table entry
	INC	E		; Increment table loop counter
	LD	A,(IX+00H)	; Get access code
	OR	A		; Is it zero
	JR	Z,UFLDR3	; Yes, go check next entry
	INC	D		; No increment valid counter
	LD	A,C		; Get desired folder back
	CP	D		; Eaual to valid counter
	JR	NZ,UFLDR3	; No, try next entry
	LD	A,E		; Yes, table index into A
	LD	(MFLDR),A	; Set the value into MFLDR
	LD	(MFNUMF),A
	RET

; Display the folder number and name of the currently active folder, or
; folder 0 if universal.

SHFLDR:	LD	A,(MFLDR)

SFLDR2:	LD	HL,FNAMES+3	; Point to "GLOBAL" folder
	OR	A
	CALL	NZ,CNAME	; If not zero go set 'HL' to name
	LD	B,25		; PRINT routines use B as counter
	CALL	PRINTL		; PRINTL terminates when B=0 or (HL)=0
	RET

; Get the folder name of the active folder and display it after the
; user's folder number (may not be the actual folder number)

CNAME:	LD	HL,FNAME1	; Point to folder names
	DEC	A		; Decrement for base 0
	ADD	A,A		; Multiply by 16
	ADD	A,A
	ADD	A,A
	ADD	A,A
	LD	B,0
	LD	C,A		; 'BC' now has offset
	ADD	HL,BC		; Add to base to form true address
	 ENDIF			; NMFLDRS GT 1

	RET			; Just in case

;-------------------------------------------------------------------------

; Show the current message header info

SHOHDR:
	 IF	NMFLDRS	GT 1
	LD	A,(MFLDR)
	OR	A
	JR	Z,SHDR1
	CALL	PRINT
	DB	CR,LF,LF,'Folder:  ',0

	LD	A,(UMFLDR)
	CALL	SHFLDR
	CALL	PCRLF1
	 ENDIF			; NMFLDRS GT 1

SHDR1:	CALL	PRINT

	 IF	NMFLDRS	EQ 1
	DB	CR,LF,LF
	 ENDIF

	DB	'Dated:  ',0
	LD	IX,IDATE
	CALL	PDATE
	LD	B,A
	LD	A,28
	SUB	B
	LD	B,A
	LD	HL,PADSTR
	CALL	PRINTL

R0:	CALL	PRINT
	DB	' Subj:  ',0
	LD	HL,MSBTMP
	LD	B,26
	CALL	PRINTL

NRDMSG:	CALL	PRINT
	DB	CR,LF,' From:  ',0
	LD	A,(ACESS)	; Is this
	CP	PSYSP		;  the Sysop?
	JR	NZ,R1		; If not, skip next
	LD	A,(SYSBYT)	; See if he wants
	CP	'N'		;  to use his name
	JR	Z,R1		; If yes, go print name
	LD	HL,SYSSTR	; Else, point to 'SYSOP'
	JR	R2		;  and go print it

R1:	LD	HL,UNAME

R2:	LD	B,30
	CALL	PRINTN
	LD	HL,PADSTR
	INC	B		; Take care of zero case.
	CALL	PRINTL
	LD	B,53
	LD	A,(LENG)
	SUB	B
	JR	NC,R4
	CALL	PCRLF

R4:	CALL	PRINT
	DB	'To:  ',0
	LD	HL,MTOTMP
	LD	B,30
	CALL	PRINTN
	CALL	PCRLF
	RET

;***********************************************************************
;  SUBROUTINE:	GETUSR
;     PURPOSE:	See if user name at MTOTMP is in USERS.PBS
;	INPUT:	name must be in MTOTMP
;      OUTPUT:	HL=user record number, Z flag set if match, clear if not
;	 USES:	A,DE,HL
;***********************************************************************

GETUSR:	LD	HL,MTOTMP	; Point to message receiver buffer
	LD	DE,ALLMSG	; Point to ALL message
	LD	B,10		; Length of ALL message
	CALL	MATCH		; Is message posted to ALL?
	JR	NZ,GDUSR	; If not, process user
	LD	A,1		; Else, set
	LD	(ALLFLG),A	;  ALL message flag
	RET			;   and skip GETUSR

GDUSR:	XOR	A		; Reset
	LD	(ALLFLG),A	;  ALL message flag
	CALL	UOPEN
	LD	HL,MTOTMP	; Get receiver's name
	LD	BC,30		; Get max number of characters
	LD	A,' '		; Want to find a space
	CPIR			; Now find it
	JR	NZ,PBNONE	; Nope, go get a real name
	LD	A,(HL)		; Get first char of last name
	CP	'A'		; Check for valid char.
	JR	C,PBNONE	; Go get a real name
	CP	'Z'+1
	JR	NC,PBNONE	; Go get a real name
	CALL	HASH
	LD	(HSHREC),HL
	LD	HL,(HSHREC)

; We now have the beginning hashed record for this user probe

PMLP:	CALL	GET
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,PBNONE	; Not an active record, so no user
	LD	A,(ACESSF)	; See if active (0=deleted, 1=twit, >=2 okay)
	CP	2
	JR	C,PMLP0
	LD	HL,UNAMEF	; See if to user
	LD	DE,MTOTMP
	LD	B,30
	CALL	MATCH
	JR	Z,USRGOT

PMLP0:	LD	HL,(RRNO1)
	INC	HL		; Next record number
	EX	DE,HL

PMLP1:	LD	HL,(HSHREC)	; Have we checked them all?
	XOR	A
	SBC	HL,DE
	JR	Z,PBNONE	; Yup, so there's no user here
	LD	HL,MAXU-1	; Are we at highest possible user?
	XOR	A		; Clear carry
	SBC	HL,DE
	EX	DE,HL
	JR	NC,PMLP		; Nope, continue
	LD	DE,0		; Else, start at first record in file,
	JR	PMLP1		;  and test again

PBNONE:	CALL	CLOSE		; Users file
	XOR	A
	DEC	A		; Clear zero flag
	RET

USRGOT:	CALL	CLOSE
	LD	HL,(RRNO1)	; Return the record number
	XOR	A		; Set flag
	RET

;***********************************************************************
;  SUBROUTINE:	FINDER
;     PURPOSE:	See if character is a valid command and return the
;		address of that command if so
;	INPUT:	A  = command character
;		HL = start of jump command table
;		BC = length of table

;      OUTPUT:	DE = address of command routine if valid character
;		 or Z flag cleared if invalid
;	 USES:	A,BC,DE,HL
;***********************************************************************

FINDER:	LD	E,A		; Save input character
	LD	A,(FBYTE)	; Get the user's flag byte
	BIT	HOTBIT,A	;  and test the hotkey flag
	LD	A,E		; Restore input character
	JR	NZ,FINDR1	; If hotkeys not on, don't need ECHO
	CALL	CAPS		; Else, make sure character is upper case
	CALL	ECHO		;  and show it on screen

FINDR1:	CPIR			; Search table for match
	RET	NZ		; If entry not found, return
	ADD	HL,BC		; Else, multiply pointer by 3
	ADD	HL,BC
	ADD	HL,BC
	LD	E,(HL)		; Move address into DE
	INC	HL
	LD	D,(HL)
	RET

; Check for a request to pause or abort the display.  First check for screen
; full.  If screen is full, then print '[more]' message, wait for next
; character and then take appropriate action (abort, advance 1 line or advance
; a full screen).  If the screen is not full, then check for pause or abort.
; If pause requested, then wait for next character and take appropriate action
; (abort as below or continue).  If abort requested, then print appropriate
; message and return with zero flag set.  ABORT: maybe entered directly if
; screen full check is not wanted.

; Returns with Z flag set if abort requested.

TWAIT:	LD	A,(TLINES)	; Get number of lines to go
	DEC	A		; Decrease by one
	LD	(TLINES),A	; Put it back
	JR	NZ,ABORT	; Screen not full, so go check for abort
	PUSH	HL		; Save regs
	PUSH	DE
	PUSH	BC
	LD	HL,MORE		; Print [more] message
	CALL	PRINTM
	CALL	ABRTCH		; Go get character and check it
	JR	Z,ABORT2	; Got an abort char, so go print abort message
	CP	' '		; Else, space prints 1 line and stops again
	LD	A,1		; Just in case it is a space
	JR	Z,TWAIT1
	LD	A,(TLIN)	; Nope, so print another full screen
	DEC	A		; Allow for [more] line

TWAIT1:	LD	(TLINES),A	; Update line counter
	LD	HL,MORE1	; Erase [more] message
	CALL	PRINTM

TWAIT2:	POP	BC		; Restore regs
	POP	DE
	POP	HL
	XOR	A		; Reset
	INC	A		;  zero flag
	RET

ABORT:	PUSH	HL		; Save regs
	PUSH	DE
	PUSH	BC
	LD	E,0FFH		; Get a character
	LD	C,6		;  using BDOS Direct
	CALL	SPBDOS		;   console I/O
	OR	A		; Anything there?
	JR	Z,TWAIT2	; Nope, so go return with zero flag reset
	CP	'S'-'@'		; Else, is ^S to pause?
	JR	Z,ABRTWT	; Yup, go wait for next character
	LD	E,A		; Else, save character
	AND	31		; Convert to equivalent CTL character
	CP	'S'-'@'		; Is S, s or ^S to pause?
	JR	Z,ABRTWT	; If so, go wait for next character
	CALL	ABRTC1		; Else, go check if it's an abort character
	JR	ABORT1		; Now test for abort

ABRTWT:	CALL	ABRTCH		; Get a char and check it

ABORT1:	JR	NZ,TWAIT2	; Nothing yet, return with zero flag reset

ABORT2:	CALL	PRINT
	DB	CR,LF,'++ ABORTED ++',CR,LF,0
	POP	BC		; Restore regs
	POP	DE
	POP	HL
	XOR	A		; Set zero flag
	RET			;  and return to caller

ABRTCH:	CALL	GETCH		; Get a character directly from the BIOS
	LD	E,A		; Save it in [E]
	AND	31		; Convert to equivalent CTL character

ABRTC1:	CP	'K'-'@'		; Is K, k or ^K to abort?
	RET	Z		; If so, return with zero flag set
	CP	'C'-'@'		; Else, is C c or ^C to abort?
	RET	Z		; If so, return with zero flag set
	CP	'X'-'@'		; Else, what about X, x or ^X?
	LD	A,E		; Restore the original character
	RET			;  and return with flags set

;***********************************************************************
;  SUBROUTINE:	HASH
;     PURPOSE:	Calc pos'n in USERS.PBS to start search
;	INPUT:	A =first character of last name
;      OUTPUT:	HL=pos'n in USERS.PBS to begin search
;	 USES:	A,DE,HL
;***********************************************************************

HASH:	SUB	41H		; Make it 0 thru 25
	ADD	A,A		; Double it
	LD	HL,HSHTBL	; Point to start of table
	LD	E,A		; Calc pos'n in table
	LD	D,0
	ADD	HL,DE
	LD	A,(HL)		; Get starting pos'n in HL
	INC	HL
	LD	H,(HL)
	LD	L,A
	RET

;***********************************************************************
;  SUBROUTINE:	GTCHAR
;     PURPOSE:	Find out if the user is using 'hotkeys' and then get a
;		character from the console using the approprate input
;		routine.
;	INPUT:	none
;      OUTPUT:	A = character from console
;	 USES:	A,DE,BC
;	CALLS:	GETCH, GTCHCR
;***********************************************************************

GTCHAR:	LD	A,(FBYTE)	; Get the user's flag byte
	BIT	HOTBIT,A	;  and test the hotkey flag
	JR	NZ,GTCHR1	; Hotkeys not on, so get input + CR
	CALL	GETCH		; Else, get hotkey input
	RET			;  and return

GTCHR1:	CALL	GTCHCR		; Get input + CR
	RET

;***********************************************************************
;  SUBROUTINE:	DEFYES and DEFNO
;     PURPOSE:	Get a character from the keyboard, determine if it is
;		a 'Y' (for yes), an 'N' (for no) or some other characer.
;		If Y or N, print the appropriate word, if not, depending
;		on whether YES or NO is the default, print the default.
;	INPUT:	none
;      OUTPUT:	Zero flag set if answer is NO or default = NO (A = 0)
;		Sign flag reset if answer is YES or default = YES (A = 1)
;	 USES:	A,HL
;	CALLS:	YESNO
;***********************************************************************

DEFYES:	CALL	YESNO
	JP	M,PRYES
	RET

DEFNO:	CALL	YESNO
	JP	M,PRNO
	RET

;***********************************************************************
;  SUBROUTINE:	YESNO
;     PURPOSE:	Get a character from the keyboard, determine if it is
;		a 'Y' (for yes), an 'N' (for no) or some other characer.
;		If Y or N, print the appropriate word
;	INPUT:	none
;      OUTPUT:	Zero flag set if answer is NO (A = 0)
;		Sign flag reset if answer is YES (A = 1)
;		Sign flag set if some other character was entered (A = -1)
;	 USES:	A,HL
;	CALLS:	GTCHAR
;		PRINTM
;***********************************************************************

YESNO:	CALL	GTCHAR		; Go get a character from the console
	CALL	CAPS		; Make sure it's upper case
	CP	'Y'
	JR	Z,PRYES
	CP	'N'
	JR	Z,PRNO
	XOR	A		; Clear zero
	DEC	A		; Set minus
	RET

PRYES:	LD	HL,YESMSG
	LD	A,(FBYTE)	; Get the user's flag byte
	BIT	HOTBIT,A	;  and test the hotkey flag
	JR	Z,PRYES1	; If hotkeys on, must print 'Y'
	INC	HL		; Else, 'Y' already printed

PRYES1:	CALL	PRINTM
	XOR	A		; Clear zero
	INC	A		; Set plus
	RET

PRNO:	LD	HL,NOMSG
	LD	A,(FBYTE)	; Get the user's flag byte
	BIT	HOTBIT,A	;  and test the hotkey flag
	JR	Z,PRNO1		; If hotkeys on, must print 'N'
	INC	HL		; Else, 'N' already printed

PRNO1:	CALL	PRINTM
	XOR	A		; Set zero flag
	RET

PNOTE:	LD	A,0FFH		; Mode of operation flag (0=PMSG NZ=PNOTE)
	LD	(MODE),A	; Save flag
	CALL	PRINT
	DB	CR,LF,LF
	DB	'Comments are Public unless Private Save is selected:'
	DB	CR,LF,LF,0
	LD	HL,UNAME
	CALL	PRINTS
	CALL	PRINT
	DB	', you are allowed ',0
	LD	HL,MSGBUF	; Message buffe length
	CALL	PB2ASC		; Display
	CALL	PRINT
	DB	' characters in this message.',CR,LF
	DB	'Use a space + <CR> in column 1 to add a blank line.',CR,LF
	DB	'Use 2 carriage returns to exit.',CR,LF,LF
	DB	'Enter text... ',CR,LF,LF,0
	LD	IX,(MSG)	; Point to message buffer start
	LD	BC,MSGBUF	; Message buffer length
	JP	CONT1

NTSYS:	CALL	PRINT
	DB	CR,LF,'Unable to locate SYSOP record',0
	JP	ABXIT1

;-------------------------------------------------------------------------
; Initialized Storage
;-------------------------------------------------------------------------

PMSFCB:	DB	0,'           ',0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0

DSHLNE:	DB	'______________________________',0

MORE:	DB	CR,' [Type <CR> to continue; C, K or X to abort]',CR,0
MORE1:	DB	'                                            ',CR,0

MSGTXT:	DW	80H		; Pointer to next message text byte
EBUF:	DS	64		; Edit string buffer
RBUF:	DS	64		; 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
ALLFLG:	DB	0
MTOTMP:	DS	30
SYSSTR:	DB	'SYSOP',0
MSBTMP:	DB	'CP/M Note'
MSBLEN	EQU	$-MSBTMP
	DS	26-MSBLEN

TOSYSP:	DB	0
ACCTBL:	DS	10
MXFLDR:	DB	0
MFLDR:	DB	0
UMFLDR:	DB	0
MTOREC:	DW	0
HSHREC:	DW	0
STRTMP:	DW	0
PFLAG:	DB	0
MODE:	DB	0		; Mode of operation flag
TLINES:	DB	0
SYSBYT:	DB	0

GOTIND:	DB	0		; Shows whether we've read index info yet
MSGSDN:	DB	0		; NZ if no more records in message upload file
HDSRCH:	DB	0		; 0=reading message text
				; NZ=Searching for header info

GETFLG:	DB	1		; 1=read from disk buffer, else get keypress
DUSAVE:	DB	'    '		; Storage for possible d/u on command line
MSGDRV:	DB	0
MSGUSR:	DB	0
OLDUSR:	DB	0
OLDDRV:	DB	0
LINES:	DB	0
CHRCNT:	DB	0		; Character count for word wrap transfer
PNTCHR:	DB	0		; Got a printing char. for auto-wrap
SPCSTR:	DB	0		; Flag to show a space has been received
CCPSTK:	DW	0
DELLEV:	DB	0
TMPSTK:	DW	0

	DS	128		; Stack area

STACK	EQU	$

MSG:	DW	0		; Message entry storage starts after
				;  linked PBBSUBS.REL file
MSGARR:	DW	0		; Storage for message pointers

	END