TITLE	'PBYE.MAC version 5.00			October 09/90'

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

;		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 1.00 - March 1st 1986 - initial public release
; Version 2.00 - April 6th 1986
; Version 3.00 - June 15th 1986
; Version 4.00 - November 1st 1987
; Version 4.10 - April 15th 1988
; Version 4.50 - April 17th 1989
; Version 5.00 - October 9th 1990

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

;   This program is called as BYE5's EXFILE when a user is logged off.

;NOTE:	This file MUST be linked to PBBSUBS.REL.

	INCLUDE	PBBSEQU.HDR	; PBBS configuration equates

	 IF	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 Level

VNAME:	DB	'PBYE '		; Name
	DB	'Release v ',0	; Status

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

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

AUTHOR:	DB	'Ian Cottrell',0; Author

	INCLUDE	PBBSDB.HDR	; PBBS configuration strings, etc

	INCLUDE	BDOSHDR.MAC	; Time and date conversions

START:	LD	E,241
	LD	C,BEXIST	; Check for presence of BYE
	CALL	BDOS
	CP	77
	JR	Z,CONTINU	; Yup, it's there
	CALL	PRINT		; Else, tell us then quit
	DB	'BYE not present!  Aborting.',CR,LF,0
	RET

CONTINU:LD	(CCPSTK),SP	; Save original stack
	LD	SP,STACK	;  and install our own
	CALL	ENDPBS		; Returns HL-> last byte of file
	LD	(HL),-1
	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+128	; Messages must be multiples of 64, so
	ADD	HL,DE		;  this become the start of general buffer
	LD	(HL),0		; Terminator for buffer
	INC	HL
	LD	(MSGARR),HL
	LD	E,SYSDRV	; System files are here
	LD	C,LOGDRV
	CALL	BDOS		; Log the drive
	LD	E,SYSUSR	; System user area
	LD	C,LOGUSR	; Log the user area
	CALL	BDOS

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

	CALL	IOPEN		; Open index file
	CALL	GET		; Get index file record
	CALL	CLOSE		; Index file
	LD	HL,IDATEF	; Move from buffer
	LD	DE,IDATE	;  to storage
	LD	BC,NDXLEN	; Length
	LDIR			; Move record
	LD	A,0CDH		; Disable Ctrl-C's
	LD	(0000),A
	LD	A,0C3H		; Patch ERROR in PBBSUBS to prevent chain loop
	LD	(ERROR),A
	LD	HL,BYERROR	; Address of local error handler
	LD	(ERROR+1),HL
	LD	A,(REENTR)	; Anyone here?
	OR	A
	JP	Z,CARCHK	; Nope, see if we can update

; Valid user is on system, and has typed BYE.  Signoff the user,
; and perform his maintenance.

MAINT:
	 IF	DSKLOG
	LD	E,0FFH		; Ask for status
	LD	C,SDSKLOG	; BYE DISKLOG status request
	CALL	BDOS
	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	; BYE5 DISLOG request
	CALL	BDOS
	 ENDIF

MAINT1:	CALL	GETTIM		; Current time (logoff)
	CALL	UOPEN		; Open users file
	LD	HL,(USREC)	; Get this user's record # 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

; Now check to see if there is a carrier.

CHKCAR:	LD	C,MDCARCK	; Ask BYE to check for carrier
	CALL	BDOS
	JP	Z,NOPE		; No carrier, so update without comment

FEDBK:	LD	A,(ACESSF)	; Access level
	CP	PSYSP		; Is it the Sysop?
	JP	NZ,FEDBK1	; Nope, so skip next

; Log the Sysop's activity to COMMENTS file.

LOGOUT:	LD	A,2		; Bump # lines by one for 'from' info
	LD	(LINES),A
	LD	E,1		; Set write
	LD	C,WRTLOC	;  lock on
	CALL	BDOS
	LD	HL,COMMENTS	; Point to comments file name (in PBBSDB.HDR)
	CALL	SPOPEN		; Create and/or open file (record size = 64)
	LD	HL,0		; Get record number
	CALL	GET64		; Comments record
	LD	HL,(RNDBUF)	; Get first 2 bytes of record 0 (current
	PUSH	HL		;  record number) and save it
	LD	A,(LINES)	; Number of lines (records) in this comment
	LD	D,0
	LD	E,A
	ADD	HL,DE		; New number for next comment
	LD	(RNDBUF),HL	; Put it back into first 2 bytes
	LD	HL,0		; Set record number
	CALL	PUT64		;  and write it

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

	POP	HL		; Get starting record number back
	LD	(RRNO1),HL
	LD	IY,BREAKIN	; Point to breakin message
	LD	A,(LINES)	; Get line (record) count
	DEC	A		; Less one because of 'from' line
	LD	B,A		; Set up counter
	CALL	WRTLP		; Write one line
	CALL	CLRBUF		; Zero the buffer
	LD	HL,UNAME	; User's name
	LD	DE,RNDBUF
	LD	B,30		; Maximum length of UNAME
	CALL	MOVNM		; Move it to RNDBUF in mixed case
	LD	A,' '		; Now a space
	LD	(DE),A		;  into the buffer
	CALL	GETTIM		; Get date and time
	LD	HL,TIME
	INC	DE
	LD	BC,8
	LDIR			; Move time string into place
	LD	A,' '		; Another space
	LD	(DE),A
	LD	HL,DATE
	INC	DE
	LD	BC,8
	LDIR			; Now move date string into place
	LD	HL,MSGBRK	; Finally, move message separator
	LD	BC,15		;  into place
	LDIR
	LD	HL,(RRNO1)
	CALL	PUT64		; Write last line
	CALL	CLOSE		; Comments file
	LD	E,0		; Turn the write
	LD	C,WRTLOC	;  lock off
	CALL	BDOS
	JP	NOPE

WRTLP:	PUSH	BC
	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

FEDBK1:
	 IF	EXCMT		; If allowing exit comment
	CALL	PRINT
	DB	CR
	DB	'Would you like to leave a comment to the Sysop (y/N)? ',0
	CALL	EATCHR

; Delay routine to insure logoff after 15 seconds.

DELAY1:	CALL	GETTIM
	LD	A,(BTIME+2)
	LD	(OLDSEC),A
	LD	B,15		; 15 seconds to respond

DELAY2:	PUSH	HL		; Save the values, consume some time
	PUSH	DE
	PUSH	BC
	PUSH	AF
	LD	E,0FFH
	LD	C,6
	CALL	SPBDOS		; Get console status
	OR	A		; Character ready?
	JR	Z,DELAY3	; Keep going
	CALL	CAPS
	CP	'Y'
	JR	Z,CMNT		; Exit, clear stack, write the note
	LD	SP,STACK	; Clear up the stack, to exit
	CALL	PRINT
	DB	'No',CR,LF,0
	JP	NOPE		; Exit, did not want to write a note

DELAY3:	POP	AF
	POP	BC		; Restore the values
	POP	DE
	POP	HL
	CALL	GETTIM
	LD	A,(OLDSEC)
	LD	HL,BTIME+2
	CP	(HL)
	JR	Z,DELAY2
	LD	A,(BTIME+2)
	LD	(OLDSEC),A
	DJNZ	DELAY2		; Another second gone
	JP	NOPE		; Timed out, exit

CMNT:	CALL	PRINT
	DB	'Yes',CR,LF,0
	LD	A,(ACESS)	; Get access level
	CP	ALLLV
	JR	NC,CMNTA	; Access >ALLLV, so skip next
	CALL	PRINT
	DB	CR,LF,LF
	DB	'Comments entered here are Private to the Sysop:',0
	LD	A,1
	LD	(PFLAG),A	; Force private
	JR	CMNTB

CMNTA:	CALL	PRINT
	DB	CR,LF,LF
	DB	'Comments are Public unless Private Save is selected:',0
	XOR	A
	LD	(PFLAG),A

CMNTB:	LD	HL,SYSOP	; All exit comments go to Sysop, so move
	LD	DE,MTOTMP	;  name at label SYSOP to receiver buffer
	LD	BC,30
	LDIR
	CALL	UOPEN
	LD	HL,MTOTMP	; Get TO: name

@PMHSH:	LD	A,(HL)		; Get a character
	INC	HL		; Point next
	CP	' '		; See if it's a space
	JR	NZ,@PMHSH	; Nope, loop til we find one
	LD	A,(HL)		; Else, get first char of last name
	CALL	HASH		; Calc starting pos'n in USERS.PBS
	LD	(HSHREC),HL
	LD	HL,(HSHREC)

@PMLP:	CALL	GET
	LD	A,(ACESSF)	; See if active (0=deleted, 1=twit, >=2 okay)
	CP	2
	JR	C,@PMLP0
	LD	HL,UNAMEF	; Is this the receiver?
	LD	DE,MTOTMP
	LD	B,30
	CALL	MATCH
	JR	Z,@GOTIT	; Yup, continue

@PMLP0:	LD	HL,(RRNO1)	; Else, see if all user records checked
	INC	HL		; Next record number
	EX	DE,HL		; Make HL safe
	LD	HL,MAXU-1
	XOR	A		; Clear carry
	SBC	HL,DE		; Done with records?
	EX	DE,HL		; Get HL back
	JR	NZ,@PMLP
	LD	HL,0		; Load up first record in file
	JR	@PMLP		;  and keep going

@GOTIT:	CALL	CLOSE
	LD	HL,(RRNO1)
	LD	(MTOREC),HL	; Save record number for later
	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 space + <CR> in column 1 to add a blank line.'
	DB	CR,LF
	DB	'Use 2 carriage returns to exit.'
	DB	CR,LF,LF
	DB	'Enter text...',CR,LF,LF,0
	XOR	A
	LD	(CRS),A
	LD	(COLUMN),A	; Current column number
	LD	(LSTLN),A	; Set last line routine
	LD	(PNTCHR),A	; Zero printing character flag
	LD	(SPCSTR),A	; Zero the 'no space yet' flag
	LD	HL,0		; Ready to 0 buffers
	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' delete key
DELOS	EQU	1FH		; ^- on the OS-1

MSLOP:	PUSH	BC
	CALL	GETCH
	POP	BC
	AND	7FH
	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	' '+1
	JR	C,MSLOP		; Must be a printable character
	CP	'~'+1
	JR	NC,MSLOP
	LD	(PNTCHR),A	; Have a printing character this line

MSLOP1:	CALL	ENTCHR
	JP	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
	LD	A,C		; See how far under 255 chars. we are
	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	; Temporary buffer address
	LD	(HL),0		; Zero 1st 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	; If not, go beep and ignore
	LD	A,' '		; Else, 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
	PUSH	HL
	PUSH	IX
	CALL	DOBS		; Remove it from the display
	POP	IX
	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
	RET	Z
	CALL	ENTCH8		; 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
	PUSH	HL
	CALL	PRINT		; Sound off as can't continue at present
	DB	BEL,0
	POP	HL
	POP	BC
	RET			; Return for next character

ENTCH7:	POP	AF		; Get the character back

ENTCH8:	LD	(IX),A		; Add to buffer
	CALL	ECHO		; Show character
	INC	IX		; Increment it for next character
	LD	A,(COLUMN)	; Get current position on line
	INC	A
	LD	(COLUMN),A
	XOR	A		; In meantime, 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 position on the line
	OR	A
	JP	Z,MSLOP		; If zero, can't backspace
	DEC	A
	LD	(COLUMN),A	; This backspace go to left margin?
	JR	NZ,BCKSP1	; If not, exit
	LD	(PNTCHR),A	; Else, reset flag for printing character
	LD	(SPCSTR),A	;  and flag for got a space character
	INC	A		; Set
	LD	(CRS),A		;  the consecutive CR count

BCKSP1:	DEC	IX		; Move the buffer pointer back one
	LD	(IX),0		; Fload a 0 at end of message
	INC	BC
	PUSH	BC
	PUSH	IX
	CALL	DOBS		; Backspace one
	POP	IX
	POP	BC
	JP	MSLOP

; 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, quit
	LD	(CRS),A
	CP	2
	JP	NC,EXITCR	; Two consecutive CR, so quit
	LD	A,CR
	LD	(IX),A		; Store in the buffer
	CALL	ECHO		; Show the CR on the CRT
	INC	IX		; Increment to next position
	LD	A,LF
	CALL	ECHO		; Display a line feed on CRT
	XOR	A		; Clear the A register
	LD	(COLUMN),A	; Show in Column 0, now
	LD	(PNTCHR),A	; Reset flag for printing character
	LD	(SPCSTR),A	; Reset flag for got a space character
	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
	LD	A,C		; See if only two lines left
	CP	150		; Last 150 characters?
	JP	C,LSTLN		; If yes, tell user only 2 lines left
	RET

CRCOM1:	POP	HL		; Remove JP Z,CRLF from stack
	POP	HL		; Remove CALL CRCOM from stack

ENDBUF:	POP	AF		; Clear stack
	INC	BC		; Re-align counter
	DEC	IX
	PUSH	BC		; Save it
	PUSH	IX		; Save again
	XOR	A
	LD	(IX),A		; Set end of message
	CALL	PRINT
	DB	CR,LF,LF
	DB	'++ Buffer Full ++',0
	JP	EXIT0

; Notify user only two lines left.

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

TURNUP:	CALL	CRCOM		; See if any room left, etc.
	PUSH	BC
	PUSH	HL
	PUSH	IX
	CALL	PCRLF		; New line
	POP	IX
	POP	HL
	POP	BC
	XOR	A
	LD	(COLUMN),A
	LD	(PNTCHR),A
	LD	(SPCSTR),A
	INC	A		; Set
	LD	(CRS),A		;  consecutive cr flag
	RET

EXITCR:	POP	HL		; Remove 'CALL	CRLF' from stack
	LD	(IX),0
	LD	HL,(MSG)
	INC	HL
	LD	A,(HL)
	OR	A
	JR	NZ,XITCR1
	DEC	HL
	LD	BC,MSGBUF
	PUSH	BC		; Save buffer length for later handling
	PUSH	HL		; Save address for later handling
	JP	ABXIT

XITCR1:	PUSH	BC
	PUSH	IX

EXIT0:	CALL	PCRLF1		; 2 new lines
	CALL	EATCHR		; Kill any stray characters...
	LD	A,(PFLAG)
	OR	A
	JR	NZ,EXITA
	CALL	PRINT
	DB	'P)rivate, ',0

EXITA:	CALL	PRINT
	DB	'S)ave, E)dit, L)ist, A)bort, C)ontinue ? ',0

EXIT1:	CALL	GTCHAR		; Get character from user
	CP	CR
	JR	Z,EXIT0
	CP	' '		; Printable character?
	JR	C,EXIT1		; If not, go get another
	LD	HL,JPEXT	; Point to table of valid command chars
	LD	BC,DBEXT-JPEXT	;  and get length of that table
	CALL	FINDER		; See if entered char is valid
	JR	NZ,EXITN	; If not valid, go erase & get another
	JP	(HL)		; Else, go do it

EXITN:	CALL	DOBS		; Erase the character
	JR	EXIT1		;  and go get another one

JPEXT:	DB	'ACELPS'

DBEXT:	DW	SAVE		; Save
	DW	PRVTA		; Private save
	DW	LIST		; List
	DW	EDIT		; Edit
	DW	CONT		; Continue
	DW	ABXIT		; Abort

PRVTA:	LD	A,(PFLAG)	; Ok to store as private?
	OR	A
	JR	NZ,EXIT1	; If not, get another character
	JP	PRVT		; Else, go do it

ABXIT:	CALL	PRINT
	DB	'bort',CR,LF,'Abort this message (y/N)?  ',0
	CALL	GTCHAR		; Get character from user
	CP	'Y'
	JP	Z,ABXIT1
	CALL	PRINT
	DB	'No',0
	JP	EXIT0

ABXIT1:	CALL	PRINT
	DB	'Yes',0
	POP	IX
	POP	BC

EXIT2:	JP	NOPE

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 individual characters, words, or lines...'
	DB	CR,LF
	DB	'Use a ^ to represent a carriage return...'
	DB	CR,LF
	DB	'Enter characters you wish to change: ',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 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, 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)
	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 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		; Now save them all
	PUSH	IX
	PUSH	BC
	PUSH	IY
	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, 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
	CALL	PRINT
	DB	'...Done.',0
	JP	EXIT0

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

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

CONT:	CALL	PRINT
	DB	'ontinue'
	DB	CR,LF,LF,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
	JR	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	MSLOP		; 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

;-----------------------------------------------------------------------
; Displays messages.

LIST:	CALL	PRINT
	DB	'ist',CR,LF,0
	CALL	LISTE
	JP	EXIT0

LISTE:	CALL	PCRLF1		; Start a new line
	LD	A,(TLIN)	; Get user's CRT length
	SUB	5		; Reduce for number available
	LD	(TLINES),A	; If [more] is shown
	XOR	A
	LD	(COLUMN),A	; Current column number
	LD	(SPCSTR),A	; Flag to show a space has been received
	LD	(PNTCHR),A	; Reset printing character flag
	LD	IX,(MSG)	; Point to buffer
	LD	HL,(MSG)	; Independent check for line length

; 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	; If end of message, exit
	CP	CR		; Else, end of line character?
	JR	Z,LSTLP1	; If yes, go see if CR should be retained
	CP	' '		; Else, see if is non-printing character
	JR	C,LSTLP4	; If so, skip

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>
	JP	C,SHOLIN	; If yes, send the new line
	CP	' '
	JR	NZ,LSTLP2
	LD	(SPCSTR),A
	JR	LSTLP3

LSTLP2:	LD	(PNTCHR),A	; Show a printing character on the line

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?
	RET	Z		; Yes, exit
	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

; 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
	PUSH	HL
	LD	E,0FFH
	LD	C,6
	CALL	SPBDOS		; See if we want to pause / restart
	OR	A
	CALL	NZ,LSTPSE	; Yes
	POP	HL
	INC	HL		; Increment for this character
	PUSH	HL		; Transfer [HL] address to [IX]
	POP	IX
	JP	LSTLP		; Back to work for the next line

LSTPSE:	CALL	GETCH		; Wait for another character
	RET			; Back to the farm...

LSTUP:	XOR	A
	LD	(COLUMN),A	; Reset column counter
	LD	(PNTCHR),A	; Reset printing character flag
	LD	(SPCSTR),A	; Reset space character flag
	LD	A,CR
	CALL	ECHO
	LD	A,(TLINES)
	DEC	A
	LD	(TLINES),A
	LD	A,LF
	JR	NZ,LSTUP1
	PUSH	HL
	CALL	PRINT
	DB	LF,'<more>',0
	CALL	LSTPSE
	CALL	PRINT
	DB	CR,'      ',0
	POP	HL
	LD	A,(TLIN)	; Get user's terminal length
	DEC	A		; Allow a 2
	DEC	A		;  line overlap
	LD	(TLINES),A
	LD	A,LF

LSTUP1:	RET

; Into the main part of the message now, check next character after CR
; to see if a space for a blank line or new paragraph, or end of msg.

	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	A,1
	LD	(HL),A
	JP	LSTLP		; Get next character, ignore this return

; Save the message.

PRVT:	LD	A,1
	LD	(PFLAG),A	; Make it private
	CALL	PRINT
	DB	'rivate S',0

SAVE:	CALL	PRINT
	DB	'ave',0

SAVEP:	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
	CALL	DIV16
	LD	A,L		; Get number of lines
	LD	(LINES),A
	LD	A,D
	OR	E		; If any remainder, then need extra line
	JR	Z,NOREM
	LD	HL,LINES
	INC	(HL)

NOREM:	CALL	PRINT
	DB	CR,LF
	DB	'Updating:  Users...',0
	LD	E,1		; Set write
	LD	C,WRTLOC	;  lock on
	CALL	BDOS

; Set flag in Sysop's record so he's bumped to mail next signon.

USET:	CALL	UOPEN		; Users file
	LD	HL,(MTOREC)	; Get record # for receiver
	PUSH	HL		;  and save it
	CALL	GET
	LD	HL,MAILF	; Point to user's mail flag
	INC	(HL)		;  and add one to it
	POP	HL		; Restore receiver's record number
	CALL	PUT		;  and write record back
	CALL	CLOSE		; Users file
	CALL	PRINT
	DB	BS,BS,BS,', Index...',0
	CALL	MIOPEN		; Message index file
	CALL	CLRBUF		; Make sure the buffer is all zeroes
	LD	HL,(IMRNM)	; Get message record number
	LD	(MSTRF),HL	;  and store it as starting block number
	LD	A,(LINES)	; Set the number of
	LD	(MBLKF),A	;   lines (64 character records)
	LD	D,0
	LD	E,A
	ADD	HL,DE		; Calc new record start
	LD	(IMRNM),HL	;  and store in index
	LD	HL,(IMNDX)	; Bump number
	INC	HL		;  of records
	LD	(IMNDX),HL	;   in index
	LD	(MRECF),HL	; Store rec # in message index file
	LD	(RRNO1),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
	CALL	GETTIM		; Get the date and time
	LD	HL,BDATE	; Move the date (binary)
	LD	DE,MDATF	;  into the buffer
	LD	BC,3
	LDIR
	LD	HL,BTIME	; And the time (binary)
	LD	DE,MTIMEF
	LD	BC,3
	LDIR
	LD	A,(PFLAG)	; Private flag
	LD	(MPUBF),A
	LD	HL,MSUBTMP	; Set subject field
	LD	DE,MSUBF
	LD	BC,MSUBLEN
	LDIR
	LD	HL,UNAME	; Set sender's name
	LD	DE,MFROMF	;  into the buffer
	LD	BC,30
	LDIR

; Set the folder number to 1 (all comments must go to folder 1).

	LD	A,1		; Set the folder
	LD	(MFNUMF),A	;  number to 1
	LD	HL,(RRNO1)
	CALL	PUT
	CALL	CLOSE		; Message index file

; Now update index info.

	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 the date
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	CALL	IOPEN		; Index file
	CALL	PUT
	CALL	CLOSE		; Index file

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

	CALL	PRINT
	DB	BS,BS,BS,', Messages...',0
	CALL	MSGOPN		; Open messages file
	LD	HL,(STRTMP)	; Set record number for first line
	LD	(RRNO1),HL
	LD	IY,(MSG)	; Point to message
	LD	A,(LINES)	; Get line count
	LD	B,A		; Set up counter
	CALL	WRTLP		; Write 'lines' records
	CALL	CLOSE		; Messages file
	LD	E,0
	LD	C,WRTLOC	; Write lock off
	CALL	BDOS
	CALL	PCRLF		; New line
	JP	NOPE
	 ENDIF			; EXCMT

; Clear buffer for next.

CLRBUF:	LD	HL,RNDBUF	; Point to first byte of random buffer
	LD	(HL),0		; Put a null in it

CLRBUF1:LD	DE,RNDBUF+1	; Now point to second byte of buffer
	LD	BC,USRLEN-1	; Length of buffer
	LDIR			; Propogate 1st byte through buffer
	RET

; Update the fields.

NOPE:
	 IF	DSKLOG
	LD	E,0FFH		; Ask for status
	LD	C,SDSKLOG	; BYE DISKLOG status request
	CALL	BDOS
	CP	77		; 77 says "NO is set in BYE5"
	JR	Z,NOPE1		; Exit with no change to the flag
	LD	A,(DSKFLG)	; See if DISKLOG was originally on
	OR	A
	JR	Z,NOPE1		; If not, all done
	LD	E,1		; Else turn the DISKLOG back on
	LD	C,SDSKLOG	; To catch Sysop's
	CALL	BDOS		;  log off time
	 ENDIF

NOPE1:	CALL	UOPEN		; Open users file
	LD	HL,(USREC)	; Get this user's record # in HL
	CALL	GET		; Get record into buffer
	CALL	CLOSE		;  and close users file
	LD	HL,(UPLDSF)	; Get number of previous uploads
	LD	A,(UPLOADS)	;  and uploads this session
	LD	D,0		; Clear high order bit
	LD	E,A		; Get current uploads
	LD	(UPLODS),DE	; Save them for logoff
	ADD	HL,DE		; Get total
	LD	(UPLDST),HL	; For totals
	LD	(UPLDSF),HL	; Update the random buffer directly
	LD	HL,(DNLDSF)	; Get number of previous downloads
	LD	A,(DNLOADS)	;  and downloads this session
	LD	D,0		; Clear high order bit
	LD	E,A		; Get current downloads
	LD	(DNLODS),DE	; Save them for log off
	ADD	HL,DE		; Get total
	LD	(DNLDST),HL	; For totals
	LD	(DNLDSF),HL	; Update the random buffer directly
	LD	A,(TRMCD)	; Get the current terminal ID
	LD	(TCODEF),A	; Update terminal type
	LD	DE,255
	LD	C,NULLS		; Get number of nulls from BYE
	CALL	BDOS
	LD	(NNULLF),A	; Update number of nulls
	LD	A,(BSPEED)	; Get current modem speed
	LD	(BDCDEF),A	;  and update baud rate byte

; Determine the logon, logoff, and elapsed time.

	CALL	PRINT
	DB	CR,LF,'Please wait...',0
	LD	HL,LOGSTR	; Get address of logon time
	LD	DE,ONTIM	; Point to where to put it
	LD	BC,8		; No. of bytes
	LDIR			; Move em
	CALL	GETTIM		; Get the current time
	LD	HL,TIME		; Point to the time string
	LD	DE,OFFTIM	; Where to put it
	LD	BC,8
	LDIR			; Move it
	CALL	CALTIM		; Calculate the elapsed time
	LD	HL,ELPTIM	; Get binary minutes
	CALL	GETBIN		; Get hours in A
	LD	E,A		; Convert to
	LD	D,0		;  minutes
	LD	HL,60		;   by multiplying
	CALL	MLDL		;    by 60
	LD	A,L
	PUSH	AF		; Save it
	LD	HL,ELPTIM+3	; Point to minutes
	CALL	GETBIN		; Get minutes (binary in A)
	POP	BC		; Restore hours (as minutes)
	ADD	A,B		; Get total minutes on-line
	PUSH	AF		; Hold total, RNDBUF is in use by USERS file
	LD	HL,TOTMEF	; Point to current time used
	ADD	A,(HL)		; Add this session
	LD	(HL),A		;  and resave

UPDACC:	LD	HL,JUNK		; Get the junk location
	LD	DE,ASCACC	; Get the location of ASCII Access
	XOR	A		; Clear CY
	SBC	HL,DE		; See if they are the same location
	JR	Z,NOUPD		; Sysop not using ASCACC, so skip update
	LD	A,(ASCACC)	; Special to update access from
	SUB	ASCII		;  the low memory access storage area
	LD	(ACESSF),A	;   in case MBASIC has changed it

; Rewrite the record.

NOUPD:	LD	E,1		; Set write
	LD	C,WRTLOC	;  lock on
	CALL	BDOS
	CALL	UOPEN		; Open users file
	LD	HL,(USREC)
	CALL	PUT		; Replace the record
	CALL	CLOSE		; Users file

; Don't include the Sysop in the caller's list or system usage.

	LD	A,(ACESS)	; Access level
	CP	PSYSP		; Sysop?
	JP	Z,SYSSKP	; If yes, skip next
	POP	AF		; Restore user's minutes on
	CALL	SYSUSE		; Update today's system usage
	LD	HL,CALLRS	; Point to name in PBBSDB.HDR
	CALL	SPOPEN		; Create and/or open callers file (rec size=64)
	LD	HL,0		; Get record number
	CALL	GET64		; Get 1st record
	LD	HL,(RNDBUF)	; Current rec # is first 2 bytes of 1st record
	PUSH	HL		; Save current record number
	INC	HL		; Bump record number
	PUSH	HL		; Save it til later
	CALL	CLRBUF		; Fill buffer with nulls
	POP	HL		; Restore next record number
	LD	(RNDBUF),HL	; Store it in random buffer
	LD	HL,0		;  and write it
	CALL	PUT64		;   to record 0

; And finally, write the 64 byte line to sequential record.

	POP	HL		; Get current record number back
	LD	(RRNO1),HL
	LD	HL,RNDBUF	; Fill buffer with spaces
	LD	(HL),' '
	CALL	CLRBUF1
	LD	DE,RNDBUF
	LD	HL,DATE
	LD	BC,5
	LDIR			; Move date string into place
	INC	DE		; Leave a space
	LD	HL,ONTIM
	LD	BC,5
	LDIR			; Move logon time into place
	LD	A,'-'		; Insert a
	LD	(DE),A		;  dash into buffer
	INC	DE
	LD	HL,OFFTIM	; Move logoff time
	LD	BC,5
	LDIR
	INC	DE		; Another space
	LD	A,(BSPEED)	; Get modem speed
	CP	1CH		; BYE5xx stores 'L'-30H for local login
	LD	HL,BPSLCL	; Assume its local
	JR	Z,DLDIR		; Yup, is local
	ADD	A,A		; Else, multiply X2
	LD	B,A
	ADD	A,A		; X4
	ADD	A,B		; X6
	LD	HL,BPSTBL	; Point to speed table
	LD	C,A
	LD	B,0
	ADD	HL,BC		; Point to baud rate string

DLDIR:	LD	BC,6
	LDIR			; Move it
	INC	DE
	LD	HL,UNAME	; Point to user's name
	LD	B,18		; Make sure we move =< 18
	CALL	MOVNM		; Copy in mixed case
	LD	L,B		; Add remaining spaces
	LD	H,0		;  to pointer
	ADD	HL,DE		;   in DE
	EX	DE,HL

CITY:	INC	DE		; Must be at least 1 space
	LD	HL,PSWRD-1	; Point to end of city & prov/state

CITY1:	LD	A,(HL)		; Get char from buffer
	CP	' '		; Find space between
	DEC	HL		;  city and province/state
	JR	NZ,CITY1
	INC	HL		; Point to space
	LD	(HL),0		; Make it a null
	LD	(NEWFRE),HL	; Save that location for later
	LD	HL,CITST	; Point to start of city
	LD	B,14		; Maximum length allowed for city
	CALL	MOVNM		; Move it, with first letters capitalized
	LD	L,B		; Add remaining spaces
	LD	H,0		;  to pointer
	ADD	HL,DE		;   in DE
	EX	DE,HL
	INC	DE		; Must be at least one space
	LD	HL,(NEWFRE)	; Restore pointer to space after city
	LD	(HL),' '	; Put the space back
	INC	HL		; Now point to province/state
	LD	BC,2		; Print 2 characters only
	LDIR			; Move province/state (upper case)

PDONE:	LD	DE,RNDBUF+61	; Use last three spaces for CR-LF-0
	LD	HL,CRLFSTR
	LD	BC,3
	LDIR			; Leaves a null at the end (pretty trick)
	LD	HL,(RRNO1)
	CALL	PUT64		; Write last line
	CALL	CLOSE		; All done

SYSSKP:	LD	HL,REENTR
	LD	(HL),0		; Reset re-enter bit
	LD	E,0		; Set write
	LD	C,WRTLOC	;  lock off
	CALL	BDOS

; Now print the session statistics.  Even if the guy hung up, the Sysop
; might be interested.

PSTATS:	CALL	PRINT
	DB	CR,'               '
	DB	CR,'Session Statistics'
	DB	CR,LF
	DB	CR,LF,'User.............. ',0
	LD	HL,UNAME
	LD	B,30		; Max chars to print
	CALL	PRINTN
	CALL	PRINT
	DB	CR,LF,'Logoff............ ',0
	LD	HL,OFFTIM
	CALL	PRINTM
	CALL	PRINT
	DB	CR,LF,'Logon............. ',0
	LD	HL,ONTIM
	CALL	PRINTM
	CALL	PRINT
	DB	CR,LF,'Connect time...... ',0
	LD	HL,ELPTIM
	CALL	PRINTM
	CALL	PRINT
	DB	CR,LF,'New uploads....... ',0
	LD	HL,(UPLODS)
	CALL	PB2ASC

	 IF	XMACC
	LD	A,(ACESS)	; Get access level
	CP	XMLVL		; Can he download?
	JR	C,NODL		; If not, don't talk about it
	 ENDIF			; XMACC

	CALL	PRINT		; Else, list new downloads
	DB	CR,LF,'New downloads..... ',0
	LD	HL,(DNLODS)
	CALL	PB2ASC
NODL:	CALL	PRINT
	DB	CR,LF,'Upload total...... ',0
	LD	HL,(UPLDST)
	CALL	PB2ASC

	 IF	XMACC
	LD	A,(ACESS)	; Get access level
	CP	XMLVL		; Can he download?
	JR	C,NODL1		; If not, don't talk about it
	 ENDIF			; XMACC

	CALL	PRINT		; Else, list total downloads
	DB	CR,LF,'Download total.... ',0
	LD	HL,(DNLDST)
	CALL	PB2ASC
NODL1:	CALL	PRINT
	DB	CR,LF,LF
	DB	'Thanks for calling ',0
	LD	HL,LOCSTR
	CALL	PRINTM
	LD	B,30
	LD	HL,UNAME
	CALL	PRINTS
	CALL	PRINT
	DB	'.',CR,LF,0

; Now clear the 25th line if sysop so desires.

	 IF	SET25 and DEL25
	LD	HL,IN25		» Selecô thå 25tè linå mode
	CALL	PRLC		»  anä senä iô tï locaì consolå only
	LD	HL,SP57		» Prinô string to clear 25 line
	CALL	PRLC		» Prinô locaì consolå only
	LD	HL,OUT25	; Now de-select
	CALL	PRLC		»  25tè linå mode
	 ENDIF			» SET25 and DEL25

; Now check to see if there is a carrier.

CARCHK:	LD	C,MDCARCK	; Ask BYE to check for carrier
	CALL	BDOS
	JR	Z,NOCAR		; If no carrier, chk for update
	LD	C,IMDONE	; Else, ask BYE to hangup
	CALL	BDOS

; Valid user was on system, but lost carrier.
; Perform system maintenance if date is different.

NOCAR:	CALL	GETTIM		; Get current time and day

; Open the index file and copy to memory.

	CALL	IOPEN		; Open index file
	CALL	GET		; Get record
	CALL	CLOSE		; Index file
	LD	HL,IDATEF	; Move from buffer
	LD	DE,IDATE	;  to storage
	LD	BC,NDXLEN
	LDIR

; New date routine.

	LD	IX,BDATE	; Get today's date
	LD	IY,MUSRD	; Get last user update
	CALL	DATDIF		; Compare them
	LD	A,H		; H has the flags
	OR	A
	CALL	M,UPD25		; Go update if less, otherwise exit

PBRET:
	 IF	DSPCLR
; Print the callers file.

PCLRS:	LD	HL,CALLRS	; Point to name of callers file (PBBSDB.HDR)
	CALL	OPEN		; Open it
	CP	0FFH		; Did it exist?
	JR	NZ,PCLRS1	; If yes, carry on
	CALL	PRINT		; Else, warn us and skip display
	DB	CR,LF
	DB	'CALLERS file not found.',CR,LF,0
	JP	PCALRS4		; Abort

PCLRS1:	LD	HL,64
	LD	(RRSZ1),HL	; Set record size
	LD	HL,0		; Get record number
	CALL	GET64
	LD	HL,(RNDBUF)	; First 2 bytes of record 0
	LD	(RRNO1),HL	;  is the starting record #
	LD	IX,DSPNUM	; Point to number to display

PCLRS2:	LD	HL,(RRNO1)	; Get record number
	DEC	HL
	LD	A,H
	OR	A		; Record zero?
	JR	NZ,PCALR	; Nope..
	LD	A,L		; Maybe..
	OR	A
	JR	Z,PCLRS3	; If so, get out

PCALR:	CALL	GET64		; Else, get a record from callers file
	LD	HL,RNDBUF	;  then print
	CALL	PRINTM		;   it to the null
	DEC	(IX)		; Decrement the count
	JR	NZ,PCLRS2	; Loop til done

PCLRS3:	CALL	CLOSE		; CALLERS
	 ENDIF			; DSPCLR

PCALRS4:LD	SP,(CCPSTK)	; Restore the sytem stack
	RET			;  and return to OS (hope BYE is there)

; Update total system usage minutes, calculate new current percent
; and re-write INDEX.PBS.

SYSUSE:	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	HL,(SYACU)	; Daily system usage minutes accumulator
	LD	B,0
	LD	C,A		; Get user's minutes into BC
	ADD	HL,BC		; Update accumulator
	LD	(SYACU),HL	; Update field
	LD	DE,10		; Prepare to calculate percent
	CALL	MLDL		; HL * DE = HL (system minutes times 10)
	LD	DE,144		; Total minutes in day divided by 10
	CALL	DIV16		; HL / DE = HL, remainder in DE
	LD	A,L
	LD	(SYCRP),A	; Update field
	LD	HL,SYDCC	; Point to daily call count
	INC	(HL)		; Add 1 more
	LD	HL,IDATE	; Move from storage
	LD	DE,IDATEF	; To buffer
	LD	BC,NDXLEN	; This many bytes
	LDIR			; Move record
	CALL	IOPEN		; Open the Index file to first record (HL = 0)
	CALL	PUT		; Write it
	CALL	CLOSE		; Index file
	POP	BC		; Restore conditions
	POP	DE
	POP	HL
	RET

; Copy current percent usage to previous percent usage, move zero to
;  current day total minutes.

SYSUPD:	PUSH	BC
	PUSH	DE
	PUSH	HL
	CALL	IOPEN		; Open index file, pointing to first record
	LD	HL,2		; Point to third record
	CALL	GET		; Read into RNDBUF
	LD	A,(MUSRD+1)	; Get last day that users file was updated
	LD	L,A		; Store as 16-bit value in HL
	LD	H,0
	LD	DE,3		; 3 bytes of storage per day
	CALL	MLDL		; HL * DE = HL, index into storage
	LD	DE,RNDBUF	; DE points to beginning of record #3
	ADD	HL,DE		; HL now points to correct day storage location
	EX	DE,HL		; Now DE = destination
	LD	HL,SYACU	; HL = source
	LD	BC,3		; BC = length
	LDIR			; Block move
	LD	HL,2		; Point to record #3
	CALL	PUT		; Write from RNDBUF
	CALL	CLOSE		; Close index file
	LD	A,(SYCRP)	; Move system current usage percent
	LD	(SYPVP),A	;  to system previous usage percent
	XOR	A		; Zero the
	LD	(SYCRP),A	;  system current usage percent
	LD	(SYDCC),A	;  and daily call counter
	LD	HL,0		; Zero the 
	LD	(SYACU),HL	;  daily total accumulator
	POP	HL		; Restore conditions
	POP	DE
	POP	BC
	RET

; USER and MSGINDEX file cleanup.  Deletes any user records that are over
; (DELLEV) days old.  (DELLEV) is determined from a read of byte 4 (days
; to deletion) of the access level table for current access level.  Banned
; users (access level 1) are not deleted nor are any that have a 0 in byte
; 4 of their access level table.

UPD25:	LD	IX,(MSGARR)	; Get pointer to array area
	PUSH	IX		;  and save it
	LD	(IX),0		; Mark end of current array
	LD	(IX+1),0	;  with 2 nulls
	CALL	PRINT
	DB	CR,'Loss of carrier - updating System Usage in INDEX file.'
	DB	CR,LF,0
	CALL	SYSUPD		; Init system usage counters for a new day
	CALL	PRINT
	DB	'                - updating USERS file.',CR,LF,0
	CALL	UOPEN		; Open users file
	LD	HL,0
	LD	(IUSER),HL
	LD	HL,MAXU-1	; Maximum number of records
	INC	HL		; Force record number + 1
	LD	(RRNO1),HL	;  to record number counter

SRTLP:	LD	HL,(RRNO1)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD252	; If yes, exit
	CALL	GET		; Get next user record
	XOR	A		; Clear carry flag
	LD	A,(ACESSF)	; Access level
	SUB	2		; Normalize, relative zero
	JR	C,SRTLP		; If <2, get next one
	LD	DE,ACTBLEN	; Access table entry length
	LD	H,0
	LD	L,A		; HL = access level
	CALL	MLDL		; HL = offset into access table
	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)		; Get days to deletion for this level
	LD	(DELLEV),A	;  and save it for later
	LD	IY,IDATE	; Today's date
	LD	IX,LSTONF	; Last time this record active
	CALL	DATDIF		; Compare dates
	LD	A,H		; Check that the clock is not screwy
	OR	A
	JP	M,CLKERR	; Bad news...don't touch a thing
	LD	A,(DELLEV)	; Get # days to deleteion
	OR	A		; 0 = no delete
	JR	Z,ADDONE	; Don't delete this guy, but bump count
	LD	D,0
	LD	E,A		; Days tolerated to DE
	AND	A		; Clear carry
	SBC	HL,DE		; Inactivity (HL) > tolerated (DE)?
	JR	Z,ADDONE	; Equal, so don't delete
	JR	C,ADDONE	; This is okay too
	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		; Save address of end of list

NOM:	XOR	A
	LD	(ACESSF),A	; Delete user
	LD	(MAILF),A	;  and zero his mail flag
	LD	HL,(RRNO1)
	CALL	PUT		; Update users file
	LD	HL,DELUSR	; Bump number of
	INC	(HL)		;  deleted users
	JR	SRTLP		; Go get another

ADDONE:	LD	HL,(IUSER)	; This was a valid user,
	INC	HL		;  so bump the system user count
	LD	(IUSER),HL	;   and store it back
	JP	SRTLP		; Get the next one

UPD252:	CALL	CLOSE		; Users file
	POP	IX		; Get back end of array (if existing)
	LD	(IX),0		;  and null 2 bytes
	LD	(IX+1),0	;   to mark end
	LD	IX,(MSGARR)	; Get start of array
	LD	A,(IX)		;  and see if we have any
	LD	B,(IX+1)	;   mail to delete
	OR	B		; If first 2 bytes are 0, then
	JP	Z,UPD254	;  no mail, so quit
	CALL	PRINT
	DB	'                - updating MESSAGE file.',CR,LF,0
	CALL	MIOPEN		; Open message index file
	LD	HL,(IMNDX)	; Number records
	INC	HL
	LD	(RRNO1),HL	; To record # counter

SRTLP2:	LD	HL,(RRNO1)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD253	; If yes, all done
	CALL	GET		; Else, get record from message index file
	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?
	JR	Z,DELOP1	; Yes, so kill it
	POP	DE		; Get the pointer back
	PUSH	DE
	LD	HL,MFROMF	; See if it from deleted user
	LD	B,30
	CALL	MATCH
	JR	Z,DELOP1	; Yup, go delete it.
	POP	DE		; Else, point to
	LD	HL,30		;  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		; End of array?
	JR	Z,SRTLP2	; If so, go get next message
	PUSH	DE		; Else, save new pointer & check next name
	JR	DELOP

DELOP1:	POP	DE		; Stack housekeeping
	LD	A,-1
	LD	(MREAD),A	; Delete message
	LD	HL,(RRNO1)
	CALL	PUT
	LD	HL,(RRNO1)	; Save the
	LD	(RRNO2),HL	;  message record
	LD	HL,MTOF		; Save the receiver's name
	LD	DE,MTOTMP	;  before updating thread
	LD	BC,30		;   links (which
	LDIR			;    changes the MTOF value)

	 IF	MSGTHD
	LD	HL,(MFLNK)	; Get foward link
	LD	(FWDMSG),HL	;  and save it
	LD	HL,(MRLNK)	; Now the reverse link
	LD	(REVMSG),HL	;  and save it
	CALL	UPDEL		; Now update links
	 ENDIF			; MSGTHD

	CALL	CLOSE		; Message file

; Go update receivers mail flag.

	CALL	UOPEN		; Open users file
	LD	HL,MTOTMP	; Point to receiver's name

MF2:	LD	A,(HL)		; Get a character
	INC	HL		; Point next
	OR	A		; Null (error)?
	JP	Z,MF7		; If null, ignore
	CP	' '		; Space?
	JR	NZ,MF2		; If not, loop
	LD	A,(HL)		; Else, get first char of last name
	CP	'A'		; Check for valid char
	JP	C,MF7		; If not valid, ignore
	CP	'Z'+1
	JP	NC,MF7		; If not valid, ignore
	CALL	HASH		; Find record number to begin search
	LD	(HSHREC),HL

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

MF4:	CALL	GET		; Users file record
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,MF7		; Not an active record, so no user
	LD	HL,UNAMEF	; See if to user
	LD	DE,MTOTMP
	LD	B,30
	CALL	MATCH
	JR	Z,MF6		; Match!
	LD	HL,(RRNO1)
	INC	HL		; Next record number
	EX	DE,HL
	LD	HL,(HSHREC)	; Have we checked all of them?
	XOR	A		; Clear CY
	SBC	HL,DE
	JR	Z,MF7		; If yes, there's no user here
	LD	HL,MAXU-1
	XOR	A		; Clear CY
	SBC	HL,DE
	EX	DE,HL
	JR	NC,MF4		; If not at end of file, loop
	LD	HL,0		; Else, go to top of file
	JR	MF4		;  and keep going

MF6:	LD	A,(MAILF)	; Get mail waiting flag
	OR	A		; Any mail?
	JR	Z,MF7		; If not, done with this user
	DEC	A		; Else, one less message
	LD	(MAILF),A
	LD	HL,(RRNO1)	; Get record number
	CALL	PUT		; Update users file

MF7:	CALL	CLOSE		; Users file
	LD	HL,DELMSG	; Bump number of
	INC	(HL)		;  deleted messages
	CALL	MIOPEN		; Open message index file
	LD	HL,(RRNO2)
	LD	(RRNO1),HL	; Restore the message record number
	JP	SRTLP2

UPD253:	CALL	CLOSE

UPD254:	LD	HL,BDATE
	LD	DE,MUSRD
	LD	BC,3
	LDIR
	LD	HL,BTIME
	LD	DE,MUSRT
	LD	BC,3
	LDIR
	LD	HL,IDATE	; Move from buffer
	LD	DE,IDATEF	; To storage
	LD	BC,NDXLEN	; This many bytes
	LDIR			; Move record
	CALL	IOPEN		; Rewrite the index file
	CALL	PUT
	CALL	CLOSE

; Now write the purge info to COMMENTS so the Sysop will know when, who
;  and how many users and messages were deleted.

	LD	HL,DATE
	LD	DE,AUTOP0
	LD	BC,8
	LDIR			; Move date into place
	LD	HL,TIME
	LD	DE,AUTOP1
	LD	BC,5
	LDIR			; Move time into place
	LD	A,(DELUSR)	; Get number of deleted users
	CALL	BINASC		; Convert to ASCII for printing
	LD	(AUTOP2),A	; MSN was in [A]
	LD	A,B		; LSN was in [B]
	LD	(AUTOP2+1),A	; Deleted users in place
	LD	A,(DELMSG)	; Get number of deleted msg
	CALL	BINASC		; Convert to ASCII for printing
	LD	(AUTOP3),A	; MSN was in [A]
	LD	A,B		; LSN was in [B]
	LD	(AUTOP3+1),A	; Deleted messages in place

UPDNOT:	LD	HL,COMMENTS
	CALL	SPOPEN		; Create and/or open comments file
	LD	HL,0
	CALL	GET64		; Get record 0
	LD	HL,(RNDBUF)
	PUSH	HL		; Save next record to write to
	INC	HL
	INC	HL		; We will write two records
	LD	(RNDBUF),HL
	LD	HL,0
	CALL	PUT64		; So next entry starts at correct record
	LD	DE,RNDBUF

CLMSG	EQU	$+1
	LD	HL,AUTOP0
	LD	BC,64
	LDIR			; Put data into place
	POP	HL		; Original open record
	PUSH	HL		; But save it for next record
	CALL	PUT64		; One record written
	LD	HL,(MSGARR)	; Point to list of names

LDUSR:	LD	A,(HL)		; Test for end
	INC	HL
	OR	(HL)
	JR	Z,LOGUT2	; No more names
	DEC	HL		; Point to proper place
	PUSH	HL		; Save pointer
	CALL	CLRBUF		; Zero the buffer
	LD	DE,RNDBUF	; Pointer to random buffer
	LD	HL,CRLFSTR	; Start with a CR,LF
	LD	BC,2
	LDIR
	POP	HL		; Restore pointer
	PUSH	HL		;  and save it again
	LD	B,30		; Maximum of 30 chars
	CALL	MOVNM		; Move name and convert to mixed case
	LD	HL,PADSTR	; Fill rest with spaces
	LD	C,B		; Change counter from B to BC (for
	LD	B,0		;  LDIR instruction)
	INC	BC		; Add 2 more
	INC	BC
	LDIR
	POP	HL		; Restore pointer
	LD	BC,30		; Point to
	ADD	HL,BC		;  next name
	LD	A,(HL)		; Test for end
	INC	HL
	OR	(HL)
	JR	NZ,LOGUT4	; If not, continue
	PUSH	DE		; Else, fill
	POP	HL		;  the rest
	INC	DE		;   with zeroes
	LD	(HL),0
	LD	BC,29
	LDIR
	POP	HL		; Get original record back
	INC	HL		; Point at next record
	PUSH	HL		; Save it for the next write
	CALL	PUT64		; Write this record
	JR	LOGUT2		; All done

LOGUT4:	DEC	HL		; Else, point to proper place
	PUSH	HL		;  save pointer
	LD	B,30		;   and write next name on same line
	CALL	MOVNM
	LD	HL,PADSTR	; Fill rest with spaces
	LD	C,B		; Change counter from B to BC (for
	LD	B,0		;  LDIR instruction)
	LDIR
	POP	IX		; Pointer back to IX
	POP	HL		; Get original record back
	INC	HL		; Point at next record
	PUSH	HL		; Save that for next time
	CALL	PUT64		; Write this record
	PUSH	IX
	POP	HL		; Get pointer back to HL
	LD	BC,30		; Point to
	ADD	HL,BC		;  next name
	JR	LDUSR		; Loop til done

LOGUT2:	CALL	CLRBUF		; Zero the buffer
	LD	DE,RNDBUF	; Put EOM marker in place
	LD	HL,MSGBRK
	LD	BC,15
	LDIR
	POP	HL		; Get original record back
	INC	HL		; Point at next record
	CALL	PUT64		;  and write this one
	LD	HL,0
	CALL	GET64		; Get record 0
	LD	HL,(RNDBUF)	; Get last record used
	LD	A,(DELUSR)	; Get number of users deleted
	SRL	A		; Divide by 2
	JR	NC,LOGUT3	; If was even number, skip next
	INC	A		; Else, compensate for odd number

LOGUT3:	LD	E,A		; Add it to record counter
	LD	D,0
	ADD	HL,DE
	LD	(RNDBUF),HL	; And write it back to
	LD	HL,0		;  record 0 so that the next
	CALL	PUT64		;   entry starts at correct record
	CALL	CLOSE		; All done
	RET

CLKERR:	POP	IY		; Clear the stack
	CALL	CLOSE		; Close any open files
	LD	HL,CLKMSG
	LD	(CLMSG),HL
	CALL	PRINTM		; Print it on the screen
	CALL	PCRLF		;  followed by a new line
	JP	UPDNOT		; Go put the message in the sysop log

;	----------------  local subroutines  -------------------

BYERROR:CALL	FERR		; This is error trap from PBBSUBS
	DB	CR,LF,'+ PBBSUBS error, aborting +',BEL,CR,LF,'$'

FERR:	POP	DE		; String address
	LD	C,9		; Console string output
	CALL	BDOS
	JP	PBRET

	 IF	MSGTHD
; Deleting or Undeleting a record in a threaded message chain requires some
; attention. If you remove a record from the thread, you must update the
; forward and reverse links of that message to reflect the new links.
;
;	MSG 100 		MSG 140 		MSG 180
;	flink 140		flink 180		flink 220
;	rlink  80		rlink 100		rlink 140
;
;	MSG 100 		MSG 140 (Deleted)	MSG 180
;	flink 180					flink 220
;	rlink  80					rlink 100
;
; As you can see, the links in messages 100 and 180 have been changed to
; reflect the deletion of message 140.

; If the first message in a thread is deleted, then all the response link
; numbers (base message number) in the thread must be updated to the
; number of the second message in the original thread.

; This section of code is responsible for UPdating forward, reverse and
; response links for a DELeted message

UPDEL:	PUSH	HL		; Save all registers
	PUSH	DE
	PUSH	BC
	PUSH	AF
	LD	HL,(MRLNK)	; Get reverse link
	LD	A,L		; Are we deleting
	OR	H		;  the base message?
	JR	NZ,UPFL		; If not, go update fwd link
	LD	HL,(MFLNK)	; Else, get forward link
	LD	(NEWMSG),HL	;  and save it as new base message
REPLP:	CALL	GETRC		; Convert msg # to msg index record #
	JR	C,UPFL		; Oops, didn't find it, go do fwd link
	LD	HL,(RRNO1)	; Else, get record #
	PUSH	HL		; Save record number
	CALL	GET		; Get record
	LD	HL,(NEWMSG)	; Get first message in link
	LD	(MREPLY),HL	; Save in buffer
	POP	HL		; Restore record number
	CALL	PUT		; Write record
	LD	HL,(MFLNK)	; Get next forward link
	LD	A,L		; Are we at the
	OR	H		;  most recent message?
	JR	NZ,REPLP	; If not, continue updating response link

UPFL:	LD	HL,(FWDMSG)	; Else, get forward link
	LD	A,L		; Are we deleting the
	OR	H		;  most recent message?
	JR	Z,UPRL		; If so, go update reverse link
	CALL	GETRC		; Else, convert msg # to msg index record #
	JR	C,UPRL		; Oops, didn't find it, go do rev links
	LD	HL,(RRNO1)	; Get record #
	PUSH	HL		; Save record number
	CALL	GET		; Get record
	LD	HL,(REVMSG)	; Get new reverse link
	LD	(MRLNK),HL	; Replace reverse link
	POP	HL		; Restore record number
	CALL	PUT		; Save record

UPRL:	LD	HL,(REVMSG)	; Get reverse link message number
	LD	A,L		; Are we deleting
	OR	H		;  the oldest message?
	JR	Z,DELEX		; If so, all done
	CALL	GETRC		; Else, convert msg # to msg index record #
	JR	C,DELEX		; Oops, didn't find it, get out of here
	LD	HL,(RRNO1)	; Else, get record number
	PUSH	HL		;  and save it
	CALL	GET		; Get record
	LD	HL,(FWDMSG)	; Get new forward link
	LD	(MFLNK),HL	; Replace forward link
	POP	HL		; Restore record number
	CALL	PUT		; Save record

DELEX:	POP	AF		; Restore registers
	POP	BC
	POP	DE
	POP	HL
	RET
	 ENDIF			; MSGTHD

;***********************************************************************
;  SUBROUTINE:	GETRC
;     PURPOSE:	Take a message number and return the appropriate
;		MSGINDEX.PBS record number for that message.
;	INPUT:	HL=message number to find
;      OUTPUT:	(RRNO1)=message index file record number
;		Z flag set if exact match
;		CY flag set if closest (higher) available message
;	 USES:	A, DE, HL
;	CALLS:	GET
;***********************************************************************

 GETRC:	PUSH	HL		; User request - popped as DE later
	OR	A		; Clear carry
	LD	DE,1
	SBC	HL,DE		; See if user requested msg #1
	JR	NZ,GETNXT	; Nope
	LD	(RRNO1),HL	; It's zero, go get record zero
	JP	GETDON

GETNXT:	LD	HL,(IMNDX)	; Number records
	INC	HL		; Pre-increment
	LD	(RRNO1),HL	; Store in record # counter

GETRC1:	LD	HL,(RRNO1)	; Get record #
	DEC	HL		; Decrement
	LD	A,H		; All done
	CP	0FFH		;  with records?
	JR	Z,GETDON	; If so, start with record 0
	LD	(RRNO1),HL	; Else, get
	CALL	GET		;  new record
	LD	A,(ACESS)	; See if this
	CP	COSYS		;  is a Sysop
	JR	NC,GETRC2	; If so, get 'em all
	LD	A,(MREAD)	; Else, is this
	INC	A		; a deleted message?
	JR	Z,GETRC1	; If yes, next please

GETRC2:	POP	DE		; Else, restore requested msg number
	PUSH	DE		; Save it again
	AND	A		; Clear carry flag
	LD	HL,(MNUMF)	; Get current message number
	SBC	HL,DE		; Test by subtracting
	JR	Z,GETDON	; If equal, this is the one
	JR	C,GETRC3	; Else, if less than, take next one
	JR	GETRC1		; If neither, go round again

GETRC3:	LD	HL,(RRNO1)	; Passed the requested number,
	INC	(HL)		;  so point to next one
	LD	(RRNO1),HL

GETDON:	POP	DE		; Clear the stack
	RET

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

; This routine will convert a binary number 0-99 in (A), to two ASCII
; digits.  ASCII is returned in (A)=most significant nibble, (B)=LSN.

BINASC:	CALL	BINBCD		; First convert it to packed BCD
	PUSH	HL		; Save register
	LD	(EBUF),A	; Save BCD in temp storage
	LD	HL,EBUF		; Point to BCD number
	LD	A,'0'		; Prepare to convert to ASCII
	RRD			; Convert LSN
	LD	B,A		; Save LSN in B
	RRD			; Convert MSN
	POP	HL		; Restore register
	RET

; This routine will convert a binary 0-99 number to packed BCD.
; Call with (A)=binary number, exits with (A)=BCD number.

BINBCD:	PUSH	HL
	LD	HL,EBUF		; Point to temporary storage
	LD	(HL),255	; -1

BLP:	INC	(HL)		; Increment 10's counter
	SUB	10		; Sub 10 each pass
	JR	NC,BLP
	ADD	A,10		; Get the number back
	RLD			; Combine the two in temp storage
	LD	A,(HL)		; Get BCD into [A]
	POP	HL
	RET

GETBIN:	LD	A,(HL)		; Get tens
	AND	0FH
	LD	B,A		; Save
	XOR	A
	LD	C,10		; Set up multiplier

MUL:	ADD	A,C
	DEC	B
	JR	NZ,MUL
	LD	B,A		; Save tens
	INC	HL		; Point to units
	LD	A,(HL)
	AND	0FH
	ADD	A,B		; Add tens
	RET			; Return value in [A]

;***********************************************************************
;
;  Subroutine:  CALTIM
;     Purpose:  Calculate the difference between two ASCII time strings
;                returning the ASCII difference in a third string.
;      Input:   None
;     Output:   String containing the ASCII difference
;       Uses:   A, BC, DE, HL, IX
;
;***********************************************************************

CALTIM:	LD	HL,BCD$ON	; Destination for packed BCD
	LD	DE,ONTIM	; ASCII time string
	CALL	ASCBCD		; Convert ASCII to packed BCD
	LD	DE,OFFTIM	; HL points to destination already
	CALL	ASCBCD		; convert again
	LD	HL,BCDCUR+2	; Start with seconds
	LD	DE,BCD$ON+2
	XOR	A		; Clear carry
	PUSH	AF		;   and save on stack
	CALL	BCDSUB		; Do seconds
	CALL	BCDSUB		;  and minutes
	EX	DE,HL
	LD	A,(DE)		; Now do the hours
	CP	(HL)		; Check if Off < On
	JR	NC,CALTM0	; NC says not special case
	ADD	A,24H		; Else, bump time off

CALTM0:	LD	B,A		; Carry/borrow passed on stack
	POP	AF		;  so recover it now
	LD	C,(HL)		; Get time on hours
	LD	A,B
	SBC	A,C
	DAA			; Convert result back to packed BCD
	LD	(DE),A		;  and save it for later
	EX	DE,HL		; Now setup registers for BCD to ASCII
	LD	DE,ELPTIM	; Point to destination for ASCII
	LD	B,3		; 3 groups of two digits to process
	LD	A,30H		; Load upper nibble of A with 3

CALTLP:	RLD			; Move lower nibble into place
	LD	(DE),A		;  and save it in the ASCII string
	INC	DE		; Point to next digit
	RLD			;  and process it
	LD	(DE),A
	INC	HL		; Point to next byte of BCD string
	INC	DE		; Skip over colon separator,
	INC	DE		;  point to next ASCII character
	DJNZ	CALTLP		;   and loop until all done
	RET

ASCBCD:	LD	B,3		; Convert 3 ASCII pairs to packed BCD

DBCDLP:	LD	A,(DE)		; ASCII xx:xx:xx location in DE
	RLD			; Packed BCD yyy location in HL
	INC	DE		; Bump to next ASCII character
	LD	A,(DE)		;  and process it
	RLD
	INC	DE		; Skip over colon
	INC	DE		;  and point to next ASCII pair
	INC	HL		; Bump to next BCD byte
	DJNZ	DBCDLP		; Loop until all done
	RET

BCDSUB:	POP	IX		; Save the return address
	POP	AF		;  and restore the old Carry
	LD	A,(DE)		; Get first packed BCD byte
	LD	B,A		; Save it for now
	LD	A,(HL)		; Fetch the second byte
	SBC	A,B		; Find their difference
	DAA			;  and convert the result back to BCD
	PUSH	AF		; Save the carry for later
	JR	NC,BSUB1	; Check for underflow
	SUB	40H		;  and correct to modulo 60

BSUB1:	LD	(HL),A		; Save the result
	DEC	HL		; Bump the pointers
	DEC	DE
	JP	(IX)		; And return to saved address

;***********************************************************************
;  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:	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:	HL = address of command routine if valid character
;		 or Z flag cleared if invalid
;	 USES:	A,BC,DE,HL
;***********************************************************************

FINDER:	CALL	CAPS		; Make sure character is upper case
	CALL	ECHO		; Show character on screen
	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
	JR	HASH1		; Finish in common code

;***********************************************************************
;  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

HASH1:	LD	A,(HL)		; Get starting pos'n in HL
	INC	HL
	LD	H,(HL)
	LD	L,A
	RET

; This routine outputs the string pointed to by HL to the local console
; only, without going out the modem.  String must be terminated with a
; null (0).  Here, used only by the code to clear the 25th line between
; callers.

	 IF	SET25 and DEL25
PRLC:	LD	A,(HL)		» Geô character
	OR	A		» Null?
	RET	Z		» Yes¬ alì done
	LD	E,A		» Setuð foò BDOS
	PUSH	HL
	LD	C,VCONOUT	» BYE'ó consolå onlù call
	CALL	SPBDOS		» Senä it
	POP	HL
	INC	HL		» Nexô char
	JR	PRLC		» Looð tilì nulì found
	 ENDIF			; SET25 and DEL25

;----------------------------------------------------------------------------
;	Data Area
;----------------------------------------------------------------------------

BREAKIN:DB	'Sysop login:  Please check time and date '
	DB	'of your last log... ',CR,LF,0

MSGBRK:	DB	CR,LF,'=== EOM ===',CR,LF,0

CLKMSG:	DB	BEL,'Clock error. Update incomplete!',CR,LF
	DB	'Use PMNT Function 8 to check.',0

AUTOP0:	DB	'MM/DD/YY at '
AUTOP1:	DB	'HH:MM PBYE auto-purged '
AUTOP2:	DB	'nn user(s) and '
AUTOP3:	DB	'nn message(s)',0,0

BYESTR:	DB	'BYE'

ONTIM:	DB	'00:00:00',0
OFFTIM:	DB	'00:00:00',0
ELPTIM:	DB	'00:00:00',0
BCD$ON:	DB	0,0,0		; Storage for start time (BCD) (CALTIM:)
BCDCUR:	DB	0,0,0		; Current/elapsed times go here

BPSTBL:	DB	'@  110'
	DB	'@  300'
	DB	'@  450'
	DB	'@  600'
	DB	'@  710'
	DB	'@ 1200'
	DB	'@ 2400'
	DB	'@ 4800'
	DB	'@ 9600'
	DB	'@19200'
BPSLCL:	DB	' Local'

MSUBTMP:DB	'Exit Comment'

MSUBLEN	EQU	$-MSUBTMP

OLDSEC:	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
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
MTOTMP:	DS	30
MSUB:	DS	26-MSUBLEN
MTOREC:	DW	0
HSHREC:	DW	0
STRTMP:	DW	0
PFLAG:	DB	0
TLINES:	DB	0

UPLODS:	DW	0000
UPLDST:	DW	0000
DNLODS:	DW	0000
DNLDST:	DW	0000
DELUSR:	DB	0
DELMSG:	DB	0
LINES:	DB	0
CCPSTK:	DW	0
DELLEV:	DB	0

	 IF	MSGTHD
FWDMSG:	DW	0
REVMSG:	DW	0
OLDMSG:	DW	0
NEWMSG:	DW	0
	 ENDIF			; MSGTHD

TMPSTK:	DW	0
	DS	128		; Stack area

STACK	EQU	$

MSG:	DW	0		; Message entry buffer pointer
MSGARR:	DW	0		; Message array pointer

	END