.he MORSETXT.* v1.0     de WB1HKU/6 --CHR$(13)24AUG85         -#-
.po2
;
;Assemble with ASM.
;
BDOS	equ	5
LF	equ	10
CR	equ	13
FCB	equ	5Ch
DMA	equ	80h
FX	equ	0FFh
FOXES	equ	0FFFFh
;
CLOCK	equ	40	;CPU clockspeed in hundreds of kilohertz
;
FALSE	equ	0
TRUE	equ	NOT FALSE
;
;
CONDBUG	equ	FALSE	;assembles in debugging tracers for
			;console interactions if true, 
			;including all ditrate controls
BIGDBUG	equ	FALSE	;assembles in debugging tracers for
			;wildcard filename expansions and 
			;command-line controls if true
DEBUG	equ	FALSE	;assembles in debugging tracers for
			;single-file buffer refresh if true
;
NODBUG	equ	NOT (CONDBUG OR BIGDBUG OR DEBUG)
;
;tracing messages mess up your screen, but I needed 'em...
;
;
PORTAS	equ	84h	;console status and control port
PORTAD	equ	80h	;console data port
CINMSK	equ	1	;character-is-input mask
CINMCH	equ	1	;character-is-input match
PORTBS	equ	8Ch	;port B status and control port
PORTBD	equ	88h	;port B data port (not presently used)
;
RECORD	equ	4000h	;start-point of read-in records
			;--must be on a page boundary
;
;
	org	100h
;
	call	ILPRT
;
;Sign on at the console. 
;
;			 0123456789012345678901234567890123
;
	db	CR,LF,9,'***----MORSETXT.COM v1.0-----***'
	db	CR,LF,9,'*                              *'
	db	CR,LF,9,'*   International Morse Code   *'
	db	CR,LF,9,'*  transmitter for text files  *'
	db	CR,LF,9,'*  Ampro Little Board version  *'
	db	CR,LF,9,'*    via Port B''s HSO line     *'
	db	CR,LF,9,'*                              *'
	db	CR,LF,9,'***-- --CHR$(13)23AUG85------***'
	db	CR,LF,LF,0,1Ah
;
;
	lxi	h,0
	dad	sp
	shld	STAKS
	lxi	sp,STAKS
	call	MULTD	;Correct delay constant for clockrate.
	call	START	;Now earn your disk space.
EXIT:	lhld	STAKS
	sphl
	ret
;
;These storage cells are down here where it's easy to get to
;them with DDT. For ROMming, copy 'em up back, in RAM, and
;work on 'em there.
;
DELCON:	db	0,0	;32-bit value stored in byte-serial
	db	4,0A6h	;form. Delay constant for 0.1 wpm
			;when running a Z80 at 0.1 MHz. This
			;value is adjusted for declared
			;clockrate in the first routine 
			;called.
DITCNT:	ds	2	;the key delay variable.
;
DAHCNT:	ds	2	;no longer directly used by program.
;
CLKBYT:	db	CLOCK	;clock frequency in 100 KHz increments
WSPACE:	db	0	;if true, space out the characters.
XTNFLG:	db	0	;if true, only ARRL characters. 
PRETTY:	db	0	;if 0, excess period becomes <bt>, and
			;only one <space> in a row is sent.
;
;WSPACE, XTNFLG and PRETTY are copied into WSPBYT, XTNBYT and
; PRYBYT just before each command line's arguments are brought
; down. Thus (last-minute change) the defaults may be set by
; overlay.
;
KEY:	jmp	KEYR
UNKEY:	jmp	UNKEYR 	;Hooks for the three hardware-dependent
CONSEN:	jmp	CSEN	;routines, allowing for overlays.
SEIKON:	jmp	CONSAY
;
;These are the hardware-specific sending routines.
;As written, KEYSTB works with the Ampro's DART.
;The callers, KEY and UNKEY, differ in that KEY
;calls with A=0FFh, while UNKEY calls with A=0.
;The Ampro initialization routines set the HSO line
; on serial-B, so this routine-set resets that line
;in order to key the oscillator.
;Don't trash anything but A, and be as quick as you
;can. The massive delays in KEY and UNKEY will mask
;a lot of fixed delay, but you want to be able to 
;really hear an honest 45 wpm, don't you?  
;
;
KEYR:	mvi	a,FX	;delay-count is in hl
	call	KEYSTB
KELP:	nop! nop! nop! nop! nop	;If you mess with these
	nop! nop! nop! nop! nop	;delays, you'll have to
	nop! nop! nop! nop! nop	;retune the master delay
	nop! nop! nop! nop! nop	;count. Try to put it in
	nop! nop! nop! nop! nop	;the same general range.
	nop! nop 		;Otherwise, you'll run
	mov	a,a		;out of arithmetic range
	dcx	h		;one way or the other.
	mov	a,l
	ora	h
	jnz	KELP
	ret
;
UNKEYR:	xra	a	;ditto
	call	KEYSTB
UKELP:	nop! nop! nop! nop! nop
	nop! nop! nop! nop! nop
	nop! nop! nop! nop! nop
	nop! nop! nop! nop! nop
	nop! nop! nop! nop! nop
	nop! nop
	mov	a,a
	dcx	h
	mov	a,l
	ora	h
	jnz	UKELP
	ret
;
KEYSTB:	cma
	push	psw
	mvi	a,5
	out	PORTBS
	pop	psw
	push	b
	mvi	b,68h
	ani	2
	add	b
	out	PORTBS
	pop	b
	ret
;
;This is the direct port status call. It is called by
; ILMORS and GOCHAR on their way back from sending a
; character. If CON: has a freshly typed character,
; go play with it. Otherwise, as you were.   
;
CSEN:	in	PORTAS	;console port
	ani	CINMSK
	cpi	CINMCH	;Here's where we break off if
	cz	SEIKON	;CON: is sending.
	ret
;
;
;I trust this is enough room for whatever you have to do.
; 
	org	400h
;
START:	lxi	h,200	;wpm * 10
	shld	RESULT
	call	CONVRT	;set up a 20 wpm coderate
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'default baudrate set.',0
	;
	ENDIF	;DEBUG
;
;
;Copy the single filename, if there is one, into NAMBUF
;and cap it with a <crlf> and an EOF, so we've got 
;someplace to go if we get ^X'd out of the test string.
;
COPYUP:	lxi	h,DMA
	mvi	b,0	;pick up the extended-argument
	mov	c,m	;bytecount left by CCP
	inx	h
	inx	h	;skip over the inevitable space
	dcr	c	;...and knock it off the count.
	lxi	d,NAMBUF
	call	M2D4B
	mvi	a,CR
	stax	d
	inx	d
	mvi	a,LF
	stax	d
	inx	d
	mvi	a,1Ah
	stax	d
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'Entry string copied up.',0
	;
	ENDIF	;DEBUG
;
;
;Send 'test' out at the morse line. With no sending-rate yet
; sought, that'll be at the default rate. 
;
	lhld	DITCNT	;DAHCNT = 3 * DITCNT
	push	h
	pop	b
	dad	h
	dad	b
	shld	DAHCNT
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'DAHCNT expanded.',0
	;
	ENDIF	;DEBUG
;
	lda	FCB+1
	cpi	'$'
	jz	INLIST
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'call ILMORS',0
	;
	ENDIF	;DEBUG
;
	call	ILMORS
	db	'TEST DE WB1HKU/6 @',0
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'TEST de WB1HKU/6 *',CR,LF,0
	;
	ENDIF	;DEBUG
;
;Empty argument string, or just hashes or query? Then the user
; was just kerchunking. Go home.
;
	lda	FCB+1	;all the well-known ways to
	cpi	' '	;tell a program "just kidding".
	rz
	cpi	'/'
	rz
	cpi	'?'
	jnz	BIZNES
	lda	FCB+2
	cpi	' '
	rz
	cpi	'/'
	jnz	BIZNES
	lda	FCB+3
	cpi	' '
	rz
;
	IF	DEBUG
	;
	call	ILPRT
	db	CR,LF,'BIZNESS',0
	;
	ENDIF	;DEBUG
;
;
;Nope, the user means  business.  Get to work.  First,  we've
;already gotten the opening parameters  up out of harm's way.
;Now copy it right back down, but formatted. Clumsy, you say?
;Maybe, but it lets you use (rather than send) a SUBfile from
;the console, without restart.
;
BIZNES:	mvi	a,0h		;the filename isn't preformatted...
	sta	USEMOV		;use M2D4BF to move it down again.

;
;At this point  there is a list  of one or more filenames  in
;the names buffer at NAMBUF, perhaps with trailing arguments,
;each line demarcated by <crlf>, the list terminated with ^Z. 
;Now,  one at a time,  those filenames  are brought down into
;the FCB at 5Ch,  brought in and sent.  Any  command switches
;in the line  are asserted.  Any not present  are deasserted.
;The ditrate  remains  the same  unless  there is  a  numeric
;argument in the line.
;
;Go get the first filename. 
;
SETUP:	lhld	NAMPTR	;if that's a control Z you've got
UPEND:	mov	a,m	;there, I'm going home.
	ani	7Fh
	cpi	1Ah	;(Will never be seen if '&' switch
	rz		;is used.)
	cpi	CR
	jz	UPSET
	cpi	' '
	jz	UPSET
	cpi	LF
	jz	UPSET
	cpi	'$'
	jz	INLIST
	cpi	'!'
	jnz	NOKEY
	inx	h
	shld	NAMPTR
	call	MORKY
	jmp	SETUP
NOKEY:	cpi	'&'	;Ampersand means, loop forever.
	jnz	NOTUPS	;Sorry, you can't use that as the
			;first character in a filename.
	lxi	h,NAMBUF
	shld	NAMPTR
	call	CONSEN	;Lockup-proofing for the idiots.
	jmp	SETUP
UPSET:	inx	h
	jmp	UPEND
;
NOTUPS:	inx	h	;If that's a letter between A and P
	mov	a,m	;inclusive, and what follows it is
	dcx	h	;a colon, it's a drive spec. Put it
	cpi	':'	;in and pray.
	jnz	NOTSPE	;Either way, HL ends up pointing at
	mov	a,m	;the first letter of the filename.
	inx	h
	inx	h
	ani	5Fh
	sui	40h
	jc	NOTSPE
	cpi	17
	jnc	NOTSPE
	sta	FCB	;Never mind that null, son, we've
	jmp	SPECD	;already got our drivespec.
;
NOTSPE:	xra	a	;No? Okay, then, go ahead and 
	sta	FCB	;zero out the drivespec.
;
; +++ COPY DOWN THE FIRST LINE'S FILENAME.TYP +++
;
SPECD:	lxi	d,FCB+1
	mvi	c,11
	lda	USEMOV
	ora	a
	jz	OTHRMV	;If USEMOV is NOT ZERO, use the
	call	M2D4B	;regular filename mover, well-behaved 
	jmp	M2OVDN	;If USEMOV is ZERO, use the
OTHRMV:	call	M2D4BF	;special filename mover, pads names
			;and ambiguities (frightening thought,
			;eh? They call that "fashion".)
M2OVDN:	shld	NAMPTR	;Now store the pointer for next time,
			;suitably advanced.

;
;First, arguments are brought down from NAMBUF and plugged
; in as initial parameters. We'll stop trying when we hit
; the <crlf>.
;
GETARG:	lda	WSPACE	;Turn 'em to default. This way, if we
	sta	WSPBYT	;toggle, MAYBE it's to assert.
	lda	XTNFLG
	sta	XTNBYT
	lda	PRETTY
	sta	PRYBYT
	lhld	NAMPTR
GARGLP:	mov	a,m
	ani	7Fh
	cpi	1Ah
	rz
	cpi	' '
	jz	GARGSP
;
;Inspect argument for numbers.
;
	cpi	'0'	;This means '$', bang will be
	jc	GARGDN	;noticed as soon as the file is
			;sent.
	cpi	':'
	jc	GARGNM
;
	ani	5Fh	;No numbers? Mask for letters.
	cpi	'W'	;Any letter switches not found
	cz	WTOG	;on a submitted line are presumed
	cpi	'X'	;deasserted.
	cz	XTOG
	cpi	'P'
	cz	PTOG
	jmp	GARGSP
;
;Found any? Then pointer is at the most-significant one.
; Beginning there, convert into hex. The numbers are the
; nominal desired words-per-minute rate times 10. Put 'em
; into the furnace for CONVRT and DIVI to work on.
;
;These subsidiary labels sure read like Orkish, don't they?
; Or R'Lyehn...
;
GARGNM:	call	ILPRT
	db	CR,LF,'[No','w'+80h,0
	lxi	b,0		;prepare count
	lxi	d,CONBUF+2	;point for copying
GRGNLP:	mov	a,m	;hl points into NAMBUF
	push	psw
	call	PCHAR
	pop	psw
	stax	d	;de points into CONBUF
	inr	c	;count the passed byte
	mov	a,c	;...but don't allow more
	cpi	16	;than 16. You don't have to
	jz	GRGNDN	;type silly. BDOS'll getcha.
	inx	d	;Bump the pointers and check
GRS:	inx	h 	;the next byte: number?
	mov	a,m	;I'll do you a favor: any
	cpi	'.'	;dots, we'll simply skip.
	jz	GRS	;Anything else, though, and
	cpi	'0'	;that's it for the number.  
	jc	GRGNDN
	cpi	':'
	jc	GRGNLP
GRGNDN:	mov	a,c
	sta	CONBUF+1
	push	h	
	call	ASDEC
	call	CONVRT
	pop	h
	call	ILPRT
	db	'/1','0'+80h,'wpm.]',0
	jmp	GARGLP
;
GARGSP:	inx	h
	jmp	GARGLP
GARGDN:	shld	NAMPTR

;
;Inspect filename for *.SUB. If so, pull it in, record
;by record, verbatim into NAMBUF.  If not, go test for
;wildcards.
;
ISSUB:	lxi	h,FCB+9	
	mov	a,m
	cpi	'S'
	jnz	NOTSUB	;wildcard test next.
	inx	h
	mov	a,m
	cpi	'U'
	jnz	NOTSUB
	inx	h
	mov	a,m
	cpi	'B'
	jnz	NOTSUB
;
;It's a SUB file.
;
	xra	a		;We'll use M2D4BF to bring down
	sta	USEMOV		;virtual (unformatted) console
				;input at SETUP. SUBfiles aren't
				;formatted by CCP.
	lxi	d,NAMBUF
	mvi	c,1Ah	;set DMA
	call	BDOS
;
	mvi	a,1Ah	;Insert an end-of-list marker.
	sta	NAMBUF	;if nothing gets copied (empty
			;directory entry), we'll just
			;shut down on finding it. 
	xra	a
	sta	FCB+32
	sta	FCB+12
	lxi	d,FCB
	mvi	c,0Fh	;open file
	call	BDOS
	inr	a
	jnz	SUBOPN
	call	ILPRT
	db	'BDOS can''t find that SUB file.',0
	ret
;
SUBOPN:	lxi	d,NAMBUF
	shld	DMADR
SBOPLP:	lxi	d,FCB
	mvi	c,14h	;read sequential
	call	BDOS
	ora	a
	jz	SBOPDN
	lhld	DMADR
	lxi	b,80h
	dad	b
	shld	DMADR
	xchg
	mvi	c,1Ah	;set DMA (80h up)
	call	BDOS
	jmp	SBOPLP
;
SBOPDN:	lxi	h,NAMBUF
	shld	NAMPTR	;Reset the pointer to Go.
	jmp	SETUP	;go pull down the first line for use.
			;If you're clever, the first filetype
			;in your SUB file isn't SUB or some-
			;thing ambiguous... otherwise, we'll
			;just go around again until we do get
			;a file we can send.
;
;Inspect filename for '?'. Any? Then do search-for-first, then
; search-for-next, to collect all the filenames that match into
; a names buffer. The buffer will be capped with ^Z; when all
; the names are serviced, there'll be ^Z instead of a name, the 
; signal to go home.
;Of course, any ambiguous filename.typ will be expanded out right
; on top of anything you might have had in NAMBUF...
;
;If no '?', use the lone filename.typ into the filenames
; buffer and proceed.
;
NOTSUB:	call	ISAMBG
	jz	ISNOT	;go open and send the file.
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'Enter EXPAN.',0
	;
	ENDIF	;BIGDBUG
;
	lxi	d,DMA
	mvi	c,1Ah	;set DMA address to 80h
	call	BDOS
	lxi	h,NAMBUF	;reset the NAMBUF pointer here
	shld	NAMPTR
;
;
;
;-------<EXPANSION MODULE>--------START
;
EXPAN:	mvi	a,0FFh	;pop the MOV flag --this stuff'll
	sta	USEMOV	;be preformatted when it's used.
	xra	a
	sta	FIRSTM	;set the FIRST TIME flag
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'FCB: ',CR,LF,0
	mvi	a,8
	sta	DMPCTR
	lxi	h,FCB
	call	DUMPR
	call	ILPRT
	db	CR,LF,'DRIVE CODE: ',0
	lda	USRDRV
	call	PHEX
	call	ILPRT
	db	CR,LF,'[SEARCH FOR FIRST] ',0
	;
	ENDIF	;BIGDBUG
;
	lxi	d,FCB
	mvi	c,11h	;search for first
	call	BDOS
EXPLP:
;
	IF	BIGDBUG
	;
	sta	STASH
	call	ILPRT
	db	'result code: ',0
	lda	STASH
	call	PHEX
	call	ILPRT
	db	CR,LF,0
	lda	STASH
	;
	ENDIF	;BIGDBUF
;
	cpi	0FFh	;FF? No more matches. We're done.
	jz	EXPDUN
	add	a	;rotate returned code
	add	a	;to be an offset
	add	a
	add	a
	add	a
	mvi	d,0
	mov	e,a
	lxi	h,DMA+1	;step across user number
	dad	d	;now points to directory entry
	shld	STASHW	;save a pointer copy for later
;
	IF	BIGDBUG
	;
	push h! push d! push b
	push psw
	mvi	a,0Eh
	sta	DMPCTR
	call	DUMPR
	pop psw
	pop b! pop d! pop h
	;
	ENDIF	;BIGDBUG
;
	xchg
	lhld	NAMPTR	;first time, @ NAMBUF.
	xchg		;hl @ 80h+, de @ NAMBUF+
	lda	FIRSTM	;If this is the first time
	ora	a	;through, don't preface new
	jz	SKIPCR	;name with <crlf> or look 
			;for duplication of entry.
	call	CHEK11	;test for redundance
	mov	a,b	;Zero? Matches previous entry.
	ora	a
	jz	REDUND
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	'(not redundant) ',0
	;
	ENDIF	;BIGDBUG
;
	xchg		;hl @ last NAMBUF entry +1
	mvi	m,CR	;put in EOL marker
	inx	h
	mvi	m,LF
	inx	h
	shld	NAMPTR	;advance the stored pointer now
	xchg		;put it back into de
SKIPCR:	lhld	STASHW	;rewind input pointer to start of name
	lxi	b,11
	call	M2D4B	;NOW copy the filename up.
	mvi	a,0FFh	;And reset the flag: we're in
	sta	FIRSTM	;and running.
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	9,7,'-------<<<<< COPY >>>>-------',CR,LF,0
	mvi	a,0Eh
	sta	DMPCTR
	lhld	NAMPTR
	call	DUMPR	
	call	BDWAIT
	call	BDWAIT
	;
	ENDIF	;BIGDBUG
;
REDUND:	lxi	d,FCB
	mvi	c,12h	;search for next
	call	BDOS
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'[SEARCH FOR NEXT]',0
	;
	ENDIF	;BIGDBUG
;
	jmp	EXPLP
;
EXPDUN:	lhld	NAMPTR	;BDOS can't find any more matches.
	lxi	d,11	;Put a line-end <crlf> after the
	dad	d	;last entry and go on.
	mvi	m,CR
	inx	h
	mvi	m,LF
	inx	h
	mvi	m,1Ah	;cap it with EOF
	lxi	h,NAMBUF
	shld	NAMPTR	;Reset the pointer to Go.
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'EXPDUN. Now jmp SETUP.',CR,LF,0
	;
	ENDIF	;BIGDBUG
;
	jmp	SETUP	;Still inline. A return here would
			;be to EXIT. 'Course, it IS a
			;back-jump... Go pull down the first
			;line for use.
;
;11-character filenam.typ ambiguity test for 
;initial argument
;
AMBIG:	lxi	b,11	;c is counter, b is flag
	mvi	a,'?'	;Assuming that CCP put together
AMBGLP:	cmp	m	;this filename.typ, the only
			;ambiguous character is '?'.
			;If it came out of a console
	jnz	NOAM	;string or a SUBfile, though,
	mov	b,a	;the string may include '*'.
NOAM:	inx	h	;That'll have to be handled
	dcr	c	;gently, since it'll throw
	jnz	AMBGLP	;off the character count.
	ret			
;
;Check two eleven character strings for duplication.
;On return, b = 0 if they match.
;On return, hl and de point once beyond their strings.
;
CHEK11:	lxi	b,11	;set up loop-counter and flag.
CHK11L:	ldax	d	;get byte from NAMBUF.
	cmp	m	;Match? Fall out if not: the name
	jnz	CHKOUT	;is not redundant.
	inx	h	;Keep looping. When c = 0, we'll
	inx	d	;blindly copy it into b, indicating
	dcr	c	;a true compare. If we fall out,
	jnz	CHK11L	;though, that'll be a nonzero
CHKOUT:	mov	b,c	;loopcount we copy into b.
	xra	a
	cmp	c
	rz
CHKOLP:	inx	h
	inx	d
	dcr	c
	jnz	CHKOLP
	ret
;
	IF	BIGDBUG
	;
BDWAIT:	push	h	;This waitloop gives me time
	push	psw	;to see what the filename lines
	lxi	h,0	;are up to, without sending CQ
BDWALP:	dcx	h	;on the ^S key.
	mov	a,l
	ora	h
	jnz	BDWALP
	pop	psw
	pop	h
	ret
	;
	ENDIF	;BIGDBUG
;
;
;-------<EXPANSION MODULE>--------END
;
ISNOT:
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'Next file, according to NAMPTR: ',CR,LF,0
	lhld	NAMPTR
	lxi	b,-16	;back it off to include present line
	dad	b
	mvi	a,0Eh	;two lines, please.
	sta	DMPCTR
	call	DUMPR
	;
	ENDIF	;DEBUG
;
	xra	a
	sta	FCB+12	;and et cetera
	sta	FCB+32	;and et cetera.
;
	IF	BIGDBUG
	;
	call	ILPRT
	db	CR,LF,'Check this out. Did I fill out the '
	db	'FCB okay?',CR,LF,7,0
	mvi	a,8
	sta	DMPCTR	;I only wanna see one record, honest.
	lxi	h,FCB
	call	DUMPR
	;
	ENDIF	;BIGDBUG
;
	lxi	d,FCB
	mvi	c,0Fh	;open file
	call	BDOS
	inr	a
	jnz	ISOPEN
	call	ILPRT
	db	CR,LF,9,'BDO','S'+80h,'can''','t'+80h
	db	'fin','d'+80h,'m','y'+80h,'file',':'+80h,0
	jmp	WIMPER
;
;Pull the first two records of the file into the file buffer.
;From here until file end, program flow should be relatively
;linear unless pestered. At file end, it'll pull down the next
;line in NAMBUF and play with that.
;
ISOPEN:	lxi	d,RECORD
	mvi	c,1Ah	;set DMA address
	call	BDOS
	lxi	d,FCB
	mvi	c,14h	;read sequential
	call	BDOS
	lxi	d,RECORD+80h
	mvi	c,1Ah	;set DMA up a record
	call	BDOS
	lxi	d,FCB
	mvi	c,14h	;read sequential
	call	BDOS
;
; Set the record toggle, indicating that the second record was
; the last one loaded. Set the record pointer to the byte previous 
; to the first byte of the first record. Because of how we
; increment the pointer, that means setting it to the last byte
; of the records page.
;
	mvi	a,FX
	sta	RECTGL
	lxi	h,RECORD+255
	shld	RECPTR
	xra	a	;Reset the EXHAUST flag too.
	sta	XHAUST
	call	CRLF	;Start a new screen line
;
	call	LOOP	;Now send the file.
	jmp	SETUP	
;
;Loop.
;Advance the pointer. Ani 7Fh. Zero? Reset the high byte to 
; wrap around. Then test the record pointer.
;For this to work as is, the record buffers must be on even
; page boundaries. That's why I put 'em someplace up high,
; where I could define the edges in isolation.
;
LOOP:	lhld	RECPTR	;advance the character pointer here...
	inr	l	;but don't let it out of the page.
	shld	RECPTR	;store it immediately.
	mov	a,l
	ani	7Fh	;Did we just walk across the border
	jnz	INREC	;into another record?
;
	IF	DEBUG
	;
	call	ILPRT
	db	'7Fh hit.',8,8,8,8,8,8,8,8,LF,0
	;
	ENDIF	;DEBUG
;
;
;Ani 80h. Are the exposed bit and the record toggle now
; in the same state? Then set the record-exhausted flag, so
; it'll be noticed next time there's a sentence end.
;
	lda	RECPTR	;pick up lobyte of record pointer,
	ani	80h	; and mask. Now it's either 80h 
	jz	NOFF	; or 00. If it's 00, leave it. If
	mvi	a,FX	; it's 80h, turn it into 0FFh.
NOFF:	lxi	h,RECTGL	;repoint to the record-toggle
	cmp	m	;...and compare. Match? Then we just
	jnz	INREC	;walked into the last record loaded.
	mvi	a,FX	;That means the one we left is 
	sta	XHAUST	;exhausted. Flag for a refresher.
;
	IF	DEBUG
	;
	call	ILPRT
	db	'XHAUST set.',8,8,8,8,8,8,8,8,8,8,8,LF,0
	;
	ENDIF	;DEBUG
;
;Get the character. EOF? We done.
;
INREC:	lda	RECPTR
	ani	7Fh
	cpi	7Fh
	jnz	SOKAY
;
;Test for emergency fetch. Pointer at end of record? 
; Record-exhausted flag raised? Then Thomas Hardy has struck. 
;Obtrusive or not, fetch the next record NOW.
;
MRGNC:	lda	XHAUST
	ora	a
	jz	SOKAY
	call	GETIT
;
SOKAY:	lhld	RECPTR
	mov	a,m
	ani	7Fh	;WS top bits drive it crazy.
	sta	STASH
	cpi	1Ah
	rz
;
;Show it at the console.
;
	mov	e,a
	mvi	c,6
	call	BDOS
;
; Is it a period? Then increment the period-count.
; Query? Ditto, then send.
; Bang? Ditto. 
; Semicolon? Ditto.
; Comma? Ditto. (I hate to do it, but it seems I write
; longer sentences than I thought. Even this might not
; be enough for Thomas Hardy texts.)
;
	lda	STASH
	cpi	'.'
	jz	PERIOD
	cpi	'?'
	jz	PERIOD
	cpi	'!'
	jz	PERIOD
	cpi	';'
	jz	PERIOD
	cpi	','
	jnz	CNTPER
PERIOD:	lda	PERCNT
	inr	a
	sta	PERCNT
;
	IF	DEBUG
	;
	call	ILPRT
	db	'up PERCNT.',8,8,8,8,8,8,8,8,8,8,LF,0
	;
	ENDIF	;DEBUG
;
;
;  Then test the period count... two or more? Then reset
;   the period count to one, change the character-to-send
;   to double-dash (three periods sent as: . = =). If that
;   default flag is reset. (0=pretty it up. Else, don't get
;   cute.)
;
CNTPER:	lda	PRYBYT
	ora	a
	lda	STASH
	jnz	NOPER
;
	lda	PERCNT
	cpi	2
	lda	STASH
	jc	NOPER
	cpi	'.'
	jnz	NOPER
	mvi	a,'='
	sta	STASH
	mvi	a,1
	sta	PERCNT
	lda	STASH
;
; Is it <lf>? Throw it away. <cr>? Turn it into a space.
;
NOPER:	cpi	LF
	jz	LOOP
	cpi	CR
	jnz	NOTCR
	mvi	a,' '
	sta	STASH
;
; Is it none of the above? Then reset the period-count.
;
NOTCR:	lda	STASH
	cpi	'.'
	jz	NORST
	cpi	'?'
	jz	NORST
	cpi	'!'
	jz	NORST
	cpi	'='
	jz	NORST
	xra	a
	sta	PERCNT
	lda	STASH
;
; Is it <space>?  Test the space-count. Zero? Then 
; send  a  seven-dit  period  of rest.  Otherwise,
; throw it away. This checking is to eliminate the
; lumpiness of word-spacing that otherwise results
; from sending a WordStar document-mode file.  The 
; spaces  still show up  on the screen,  they just 
; don't occupy time now.  Turning a  <cr> into one
; nominally guarantees an  interword space  in  WS
; wordwraps.
; Tabs get the same treatment.
; 
NORST:	cpi	' '
	jz	ISP
	cpi	9	;tab
	jnz	NSP
ISP:	lda	PRYBYT
	ora	a
	jnz	NOPRET
	lda	SPACNT
	ora	a
	jnz	LOOP
	inr	a
	sta	SPACNT
NOPRET:	call	SPACE
	jmp	LOOP
;
;Ampsersand, <es>, is handled as a special case,  because
; of the timing. It is the only prosign that requires it.
; This character is a holdout from Telegraph Morse. 
;
NSP:	mov	e,a	;stash it quick
	xra	a	;reset space-count
	sta	SPACNT
	mov	a,e	;get it back
	cpi	'&'	;NOW the ampsersand...
	jnz	NES
	call	ES	;jumps through to MORSER
	jmp	LOOP
;
;Here's the ARRL/full International Morse filter.
;First, test: if XTNFLG = 0, we're running wide open.
;No?  Then we gotta slog.  We gotta find out if  the character
;is on the short list, and there's no simple mathematic test I
;know for that.
;
;
NES:	sta	STASH	;put character someplace safe
	lda	XTNBYT	;now, about that flag...
	ora	a
	jz	GOCHAR	;Zero? Never mind long involved test, then.
	lda	STASH	;No? Okay, slog time. First, split things
	sui	41h	;down the middle. No jump if it might be a
	jc	ISANUM	;letter. Now mask off uppercasing. Z or
	ani	1Fh	;below? Then it is a letter, otherwise it's
	cpi	1Ah	;extended-set punctuation, which we don't
	jc	GOCHAR	;want to send just now.
	jmp	OGO
;
ISANUM:	lda	STASH	
	cpi	'?'	
	jz	GOCHAR	
	cpi	'='	
	jz	GOCHAR
	cpi	':'
	jnc	OGO
	cpi	'+'	;<ar>?
	jz	GOCHAR	
	cpi	'#'	;<sk>?
	jz	GOCHAR
	cpi	','	
	jz	GOCHAR	
	cpi	'.'	
	jz	GOCHAR	
	cpi	'/'
	jz	GOCHAR
	cpi	'0'
	jc	OGO
;
GOCHAR:	lda	STASH	;pick up the character...
	call	MORSER	;send it out...
	call	CONSEN	;now see if CON: said anything.
;
OGO:	lda	PERCNT
	ora	a
	jz	LOOP
	lda	XHAUST
	ora	a
	jz	LOOP
;
	IF	DEBUG
	;
	call	ILPRT
	db	'found XHAUST.',8,8,8,8,8,8,8,8,8,8,8,8,8,LF,0
	;
	ENDIF	;DEBUG
;
	call	GETIT
;
	jmp	LOOP
;
;Look up the character in the table. Each table entry is
; two bytes, a baud-count nibble plus up to the remainder
; of two bytes to be shifted rightwards out the door. 
; The character symbols algorithm is from a message keyer
; program in 73 by VE3CWY, originally written for the 
; CDP1802, which I used in the Morse-code readout for TSCRT.
;
MORSER:	lxi	d,TABLE	;character brought in in a
	mvi	h,0
	mov	l,a	;character into hl
	dad	h	;shift it left
	dad	d	;add in the table base
	mov	e,m	;pick up lobyte
	inx	h
	mov	d,m	;pick up hibyte
	mvi	a,FX
	cmp	d
	jnz	OK	;empty entry = foxes, 0FFFFh . 
	cmp	e
	jnz	OK
	ret
OK:	call	IAMBIC
	ret
;
SPACE:	lda	SPACNT
	dcr	a	;Including what DIT or DAH and IAMB
	jz	NUTHRS	;have already provided, provide		
	call	DAHSP	;seven dit-counts of unkeyed time
			;between words. If WSPACE is true,
NUTHRS:	call	DAHSP	;twice that. It's handled this
	lhld	DITCNT	;way because 16 bits of delay can     
	call	UNKEY   ;only be so long, and there might 
	lda	WSPBYT  ;otherwise be rollover irregularities 
	ora	a     	;at slow speeds. If this is an
	rz		;additional space, send the whole
	lda	SPACNT	;thing from here... nobody began it
	dcr	a	;for us.
	jz	NUTHRW
	call	DAHSP
NUTHRW:	call	DAHSP
	lhld	DITCNT
	call	UNKEY
	ret
;
DAHSP:	lhld	DITCNT
	call	UNKEY
	lhld	DITCNT
	call	UNKEY
	lhld	DITCNT
	call	UNKEY
	ret
;
ES:	lhld	DITCNT
	call	KEY
	lhld	DITCNT
	call	UNKEY
	lhld	DITCNT
	call	UNKEY
	mvi	a,'S'
	sta	STASH
	jmp	MORSER
;
;One element at a time, shift the bits right and out.
; A hi is a dah, a lo is a dit. Each is followed by
; a dit of quiet. The character is followed by a dah
; of quiet, double that if WhiteSPACE is set.
;
IAMBIC:	mov	a,d
	cpi	FX
	jnz	BIGGIE
	mov	a,e
BIGGIE:	rrc	;highest nibl is the length-count
	rrc	;isolate it and stash it in counter.
	rrc
	rrc
	ani	0Fh
	mov	b,a
IAMLUP:	mov	a,e	;now rightshift-with-carry loop...
	rrc		;if cy=0, DIT. if cy=1, DAH.
	mov	e,a
	jnc	DODIT
DODAH:	call	DAH
	jmp	IAMDEC
DODIT:	call	DIT
IAMDEC:	dcr	b	;countdown: done?
	jnz	IAMLUP
	lhld	DITCNT	;two dits of additional space.
	call	UNKEY	;the third, DIT or DAH provided.
	lhld	DITCNT
	call	UNKEY
	lda	WSPBYT
	ora	a
	rz	
	call	DAHSP
	ret
;
DIT:	lhld	DITCNT	;ditcount
	call	KEY
	lhld	DITCNT
	call	UNKEY
	ret
;
DAH:	lhld	DITCNT
	call	KEY	;All of this boring duplication,
	lhld	DITCNT
	call	KEY	;just to allow for a large DITCNT... 
	lhld	DITCNT
	call	KEY	;
	lhld	DITCNT
	call	UNKEY
	ret
;-----------------------------
;
; filename ambiguity test.
; On return, zero flag is SET if there are no question-
; marks or asterisks in the filename.
; Uses all but de.
;
ISAMBG:	lxi	h,FCB+1
	mvi	b,11
	mvi	c,0
ISALP:	mov	a,m
	cpi	'*'
	jz	YESAM
	cpi	'?'
	jnz	NOISA
YESAM:	inr	c
NOISA:	inx	h
	dcr	b
	jnz	ISALP
	xra	a
	cmp	c
	ret
;
;Go find out what CON: has to say.
;
CONSAY:	push h! push d! push b
	call	CMENU
	call	FLOOSH
	pop b! pop d! pop h
	ret
;
FLOOSH:	mvi	c,6	;use direct console calls to
	mvi	e,FX	;flush the CON: port of any
	call	BDOS	;backed-up characters
	ani	7Fh
	ora	a
	jnz	FLOOSH
	ret
;
CRLF:	push h! push d! push b
	push	psw
	mvi	e,CR
	mvi	c,6
	call	BDOS
	mvi	e,LF
	mvi	c,6
	call	BDOS
	pop	psw
	pop b! pop d! pop h
	ret
;
CMENU:	mvi	c,6	;direct-console-input BDOS call.
	mvi	e,FX
	call	BDOS
	ani	7Fh
	cpi	'!'
	jz	MORKY
	cpi	'&'
	jz	LOOPME	;Convert to continuous operation.
	cpi	'$'
	jz	INLIST	;Flush old list, get new one. Start over.
	cpi	'C'-40h	;Go home. Right now.
	jz	EXIT
	cpi	'X'-40h	;go play with next file, or leave.
	jz	INSHIN
	cpi	'T'-40h	;go send dits until asked to <esc>.
	jz	DITEST
	ani	5Fh
	cpi	'W'
	jz	WTOG
	cpi	'X'
	jz	XTOG
	cpi	'P'
	jz	PTOG
;
	call	FLOOSH
	call	ILPRT
	db	CR,LF,LF
	db	9,'***------CONSOL'
	db	'E'+80h,'COMMAND------***',CR,LF
	db	9,'*'+80h,'Optio','n'+80h,'Switche','s'+80h
	db	'supported:',1Fh,4,'*',CR,LF
	db	9,'*',1Fh,3,'X'+80h,'='+80h
	db	'Extende','d'+80h
	db	'Internationa','l'+80h,' *',CR,LF
	db	9,'*',1Fh,8,'Mors','e'+80h
	db	'Alphabe','t'+80h
	db	'on/of','f'+80h,' *',CR,LF
	db	9,'*',1Fh,3,'W'+80h,'='+80h
	db	'Extende','d'+80h,'intercharacte'
	db	'r'+80h,'*',CR,LF
	db	9,'*',1Fh,8,'(white',')'+80h,'spac','e'+80h
	db	'on/off',1Fh,3,'*',CR,LF
	db	9,'*',1Fh,3,'P'+80h,'='+80h
	db	'Multiple-spac','e'+80h
	db	'and',1Fh,6,'*',CR,LF
	db	9,'*',1Fh,8,'ellipsi','s'+80h
	db	'mask','s'+80h,'on/of','f'+80h,' *',CR,LF
	db	9,'*',1Fh,3,'!'+80h,'='+80h,'Ente'
	db	'r'+80h,'Mors','e'+80h
	db	'keyboard',1Fh,4,'*',CR,LF
	db	9,'*',1Fh,8,'loop',1Fh,19,'*',CR,LF
	db	9,'*',1Fh,3,'&'+80h,'='+80h
	db	'Loo','p'+80h,'o','n'+80h
	db	'presen','t'+80h,'list',1Fh,4,'*',CR,LF
	db	9,'*',1Fh,8,'unti','l'+80h
	db	'interrupted',1Fh,6,'*',CR,LF
	db	9,'*',1Fh,3,'$'+80h,'='+80h
	db	'Loa','d'+80h,'ne','w'+80h,'lis'
	db	't'+80h,'from',1Fh,6,'*',CR,LF
	db	9,'*',1Fh,8,'console',1Fh,16,'*',CR,LF
	db	9,'***-------MORSETX','T'+80h
	db	'v1.0-------***',CR,LF,LF
	db	9,'Ente','r'+80h,'eithe','r'+80h
	db	'ne','w'+80h 
	db	'coderate-times-te','n'+80h
	db	'o','r'+80h,'optio','n'+80h
	db	'switch:___',8,8,8,0
;
	lxi	d,CONBUF
	call	LINEUP
	call	CRLF
;
	lda	CONBUF+2
	cpi	'!'
	jz	MORKY
	cpi	'$'
	jz	INLIST
	cpi	'&'
	jz	LOOPME	;Convert to continuous operation.
	ani	5Fh
	cpi	'W'
	jz	WTOG
	cpi	'X'
	jz	XTOG
	cpi	'P'
	jz	PTOG
;
	IF	CONDBUG
	;
	lxi	h,CONBUF
	call	DUMPR
	;
	ENDIF	;CONDBUG
;
	call	ASDEC	;ASCII-decimal conversion
	jnz	PUI	;lousy input? Punk typists...
	call	CONVRT
;
	IF	CONDBUG
	;
	call	ILPRT
	db	CR,LF,'DITCNT now is: ',0
	lhld	DITCNT
	call	PHL
	call	ILPRT
	db	',',CR,LF,'DAHCNT now is: ',0
	lhld	DAHCNT
	call	PHL
	call	ILPRT
	db	'.',CR,LF,0
	;
	ENDIF	;CONDBUG
;
PUI:	call	CRLF
	ret
;
DITEST:	call	ILPRT
	db	CR,LF
	db	9,'***----DITRAT','E'+80h,'TES','T'+80h
	db	'MODE-----***',CR,LF
	db	9,'*'+80h,'Cleartex','t'+80h
	db	'Words-Per-Minute',':'+80h,' *',CR,LF
	db	9,'*'+80h,' dit','s'+80h,'pe','r'+80h
	db	'mi','n'+80h,'/'+80h
	db	'25','.'+80h,'(PARIS',')'+80h,' *',CR,LF
	db	9,'* Rando','m'+80h,'group','s'+80h
	db	'abou','t'+80h,'5/','6'+80h,'tha'
	db	't'+80h,'*',CR,LF
	db	9,'*',1Fh,3,'rat','e'+80h,'(o','r'+80h
	db	'us','e'+80h,'CODE','X'+80h,'test)'
	db	'.'+80h,' *',CR,LF
	db	9,'*'+80h,'T','o'+80h,'exit',','+80h
	db	'hi','t'+80h
	db	'<escape>.',1Fh,7,'*',CR,LF
	db	9,'***-------MORSETX'
	db	'T'+80h,'v1.0------***',CR,LF,0
	call	FLOOSH
;
DTESTD:	call	DIT
	mvi	c,6
	mvi	e,FX
	call	BDOS
	ora	a
	jz	DTESTD
	ani	7Fh
	cpi	'C'-40h
	jz	EXIT
	cpi	'X'-40h
	jz	INSHIN
	cpi	1Bh	;<escape>
	cnz	CONSAY
	xra	a
	ret

;
LOOPME:	call	ILPRT
	db	'-<&>-',8,8,8,8,8,LF,0
	lxi	h,NAMBUF
	mvi	a,1Ah	;^Z
LOPLUP:	inx	h
	cmp	m
	jnz	LOPLUP
	mvi	m,'&'
	inx	h
	mvi	m,1Ah
	ret
	
;
MORKY:	call	FLOOSH
	call	ILPRT
	db	CR,LF,9,'***---MORS','E'+80h
	db	'KEYBOAR','D'+80h,' LOOP---***'
	db	9,'PROSIGNS:',9,'[ar]',9,'@'+80h,'+'
	db	CR,LF,9,'*'+80h,' N','o'+80h
	db	'softwar','e'+80h
	db	' type-ahea','d'+80h,'i','s'+80h,' *'
	db	9,9,9,'[bt]',9,'='
	db	CR,LF,9,'*'+80h,' provided','.'+80h
	db	'Hi','t'+80h,'<esc','>'+80h
	db	'(^[',')'+80h,'t','o'+80h,'*'
	db	9,9,9,'[bk]',9,'\'
	db	CR,LF,9,'*'+80h,' retur','n'+80h,' t'
	db	'o'+80h,' file-sending.',1Fh,3,'*'
	db	9,9,9,'[kn]',9,'('+80h,'~'
	db	CR,LF,9,'***------MORSETX'
	db	'T'+80h,'v1.0-------***'
	db	9,9,9,'[sk]',9,'#'
	db	CR,LF,1Fh,64,'[as]',9,'*'+80h,'!'
	db	CR,LF,1Fh,64,'[hh]',9,'<bs>'
	db	CR,LF,1Fh,64,'[sn]',9,'{'+80h,'^'
	db	CR,LF,0
MORKLP:	mvi	c,6
	mvi	e,FX
	call	BDOS
	sta	STASH
	ora	a
	jz	MORKLP
	cpi	CR
	jnz	ICTL
	call	CRLF
	jmp	MORKLP
ICTL:	cpi	20h
	jnc	EKO
	mvi	e,'^'
	mvi	c,6
	call	BDOS
	lda	STASH
	adi	40h	
EKO:	mov	e,a
	mvi	c,6
	call	BDOS
	lda	STASH
	cpi	'X'-40h
	jz	INSHIN
	cpi	'C'-40h
	jz	EXIT
	cpi	'T'-40h
	cz	DITEST
	cpi	1Bh	;esc
	rz
	lxi	h,MORKLP
	push	h
	lxi	h,SPACE
	cpi	' '
	jz	JOUT
	cpi	9
	jz	JOUT
	lxi	h,ES
	cpi	'&'
	jz	JOUT
	jmp	MORSER
JOUT:	pchl
;
;The following is a buffered-console routine that doesn't
; use the BDOS call. The buffer it uses must look like 
; the one in function 10, though, with:
; CONBUF: 	db 	MAX ;where MAX is the maximum 
;			    ;character count the buffer
;			    ;can hold
;		ds	1   ;byte counter
;		ds	MAX
;call with de-->CONBUF
;
LINEUP:	push d! pop h	;now hl points there too.
	shld	STASHW	;save me one. Other user of this is DIV.
	mov	c,m
	inx h! inx h	;repoint to first storage byte
	mvi	b,0	;set up the counter
LINLUP:	call	GETCHR	;stack-shielded conin call
	cpi	20h
	jc	DCIN
	mov	m,a
	inx	h
	inr	b
	mov	a,c
	cmp	b
	jnz	LINLUP
LINDUN:	lhld	STASHW	;CONBUF...
	inx	h	;+1.
	mov	m,b
	ret
;
DCIN:	cpi	CR
	jz	LINDUN
	cpi	LF
	jz	LINDUN
	cpi	'C'-40h
	jz	EXIT
	cpi	'T'-40h
	jz	DITEST
	cpi	'X'-40h
	jz	INSHIN
	cpi	'H'-40h
	jnz	FLUSH		;match? backspace.
	push h! push d! push b
	call	ILPRT
	db	' ',8,0		;first bs already echoed by BDOS
	pop b! pop d! pop h
	mov	a,b
	ora	a
	jz	FLUSH
	dcx	h
	mvi	m,0
	dcr	b
	jnz	LINLUP
FLUSH:	cpi	'U'-40h
	jnz	LINLUP
	call	ILPRT
	db	CR,LF,'# ',0
	jmp	LINEUP
;
GETCHR:	push h! push d! push b	;uses direct-console call.
GCRL:	mvi	e,FX
	mvi	c,6
	call	BDOS
	ora	a
	jz	GCRL
	push	psw
	cpi	20h
	jnc	GCROK
	cpi	CR
	jz	GCROK
	cpi	LF
	jz	GCROK
	cpi	8
	jz	GCROK
	mvi	e,'^'
	mvi	c,6
	call	BDOS
	pop psw! push psw
	adi	40h
GCROK:	mov	e,a
	mvi	c,6
	call	BDOS
	pop	psw
	pop b! pop d! pop h
	ret
;
;The following converts up to the last four decimal digit (0-9)
;characters typed to a console-buffer line into an absolute
;binary value. On return, the zero flag is set if there's a
;worthwhile value stored in RESULT. If the buffer contains no
;ASCII numeric bytes, the zero flag is reset and a = 0FFh.
;
ASDEC:	lda	CONBUF+1
	ora	a
	jz	NOBUF
	mvi	d,0
	lxi	h,0
	shld	RESULT
	lxi	h,CONBUF+2
	lda	CONBUF+1
	mov	c,a
	mvi	b,0
ASDLP:	mov	a,m
	sui	30h
	jc	NODEC
	cpi	0Ah
	jnc	NODEC
	mov	e,a
	push	h
	lhld	RESULT
	call	MULTEN
	dad	d
	shld	RESULT
	pop	h
	inr	b
NODEC:	inx	h
	dcr	c
	jnz	ASDLP
	mov	a,b
	ora	a
	jz	NOBUF
	xra	a
	ret
;
MULTEN:	push	d
	push	h
	pop	d
	dad	h
	dad	h
	dad	d
	dad	h
	pop	d
	ret
;
NOBUF:	mvi	a,0FFh
	ora	a
	ret
;
;
CONVRT:	lhld	DELCON+2	;bring in a fresh copy of
	shld	DIV+4		;the (clockrate-corrected)
	lhld	DELCON		;0.1 wpm delay constant.
	shld	DIV+2
	xra	a
	sta	DIV+1
	sta	DIV
;
	IF	CONDBUG
	;
	call	ILPRT
	db	CR,LF,'Binary equivalent of that:',9,0
	lhld	RESULT	;
	call	PHL
	call	ILPRT
	db	CR,LF,'Starting delay constant'
	db	CR,LF,'  (32-bit value)--',9,0
	call	SHOW32
	;
	ENDIF	;CONDBUG
;
	call	DIVI
;
	IF	CONDBUG
	;
	call	ILPRT			
	db	CR,LF,'Division results:',9,0
	call	SHOW32
	call	ILPRT
	db	CR,LF,'Remainder:',9,9,0
	lda	DIV
	call	PHEX
	lda	DIV+1
	call	PHEX
	db	CR,LF,LF,0
	;
	ENDIF	;CONDBUG
;
	lhld	DIV+2
	mov	a,l
	ora	h
	jz	SMALL
;
	IF	CONDBUG
	;
	call	ILPRT
	db	CR,LF,'Ditdelay too big: 0FFFFh substituted.',CR,LF,0
	;
	ENDIF	;CONDBUG
;
	lxi	h,FOXES
	shld	DIV+4
SMALL:	lxi	h,DIV+5
	mov	e,m
	dcx	h
	mov	d,m
	xchg
	shld	DITCNT
	push	h
	pop	b
	dad	h
	dad	b
	shld	DAHCNT
	ret
;
	IF	CONDBUG
	;
SHOW32:	lda	DIV+2
	call	PHEX
	lda	DIV+3
	call	PHEX
	lda	DIV+4
	call	PHEX
	lda	DIV+5
	call	PHEX
	ret
	;
	ENDIF	;CONDBUG
;
DIVI:	mvi	a,33
	sta	SHCNT
	xra	a
	jmp	SHIN
DIVLP:	sta	SHCNT	;shift count. 
	call	SUBT	;
SHIN:	call	SHIFT	;48-bit leftshift, carry-in.
	lda	SHCNT
	dcr	a
	jnz	DIVLP
	ret
;
SUBT:	lhld	DIV	;keep a copy for the restore
	shld	STASHW	;(need not be saved in order)
	lhld	RESULT	;16-bit divisor stored as a word
	xchg
	lxi	h,DIV+1	;to 32-bit dividend stored byte-serial
	mov	a,m
	sub	e
	mov	m,a
	dcx	h	;go down
	mov	a,m
	sbb	d
	mov	m,a	;Now. Carry? Undo the subtract.
	cmc		;SHIFT will need the carry the other
	rc		;way, so react based on that.
	lhld	STASHW
	shld	DIV
	ret
;
;++ CARRY BIT AT ENTRY WILL BE SHIFTED INTO LSB ++
;
SHIFT:	mvi	b,6	;bytes to be rotated
	lxi	h,DIV+5	;start at the least byte
SHILUP:	mov	a,m	;get it...
	ral		;roll it left. Hibit into carry, 
	mov	m,a	;carry into lobit. Store it.
	push	psw	;Save the flags (especially carry) 
	dcx	h	;repoint to more significant byte
	dcr	b	;tick off one pass. Done?
	jz	SHIDUN
	pop	psw	;Nope. Gimme back my flags.
	jmp	SHILUP
;
SHIDUN:	pop	psw	;Done. Unplug the stack and leave.
	ret		;Anybody want a used carry flag?
;
;
;
WTOG:	call	ILPRT
	db	'-<W>-',8,8,8,8,8,LF,0
	lda	WSPBYT
	cma
	sta	WSPBYT
	ret
;
XTOG:	call	ILPRT
	db	'-<X>-',8,8,8,8,8,LF,0
	lda	XTNBYT
	cma
	sta	XTNBYT
	ret
;
PTOG:	call	ILPRT
	db	'-<P>-',8,8,8,8,8,LF,0
	lda	PRYBYT
	cma
	sta	PRYBYT
	ret
;
;Bring in a list of files to send from the console. Use the
;buffered console function for each line. Stop looping when
;the linebuffer's character count reads zero.
;
;1. Sign on, announce the game rules.
;2. Point to beginning of NAMBUF. Set up controls in NAMBEL.
;3. Bring in a line using the BDOS buffered line function.
;4. Test: line had zero characters? Then wrap it up.
;5. Repoint to next free space.
;6. Convert previous line's control bytes to <crlf>.
;7. Goto 3.
;
;The input line will be evaluated when it's acted upon. 
;
INLIST:	call	FLOOSH
	call	ILPRT
	db	CR,LF,LF,LF
	db	9,'***--CONSOL','E'+80h
	db	'FILENAM','E'+80h,'ENTRY--***',CR,LF
	db	9,'*'+80h,'Ente','r'+80h,'on','e'+80h
	db	'dr:filename.ty','p'+80h,'o'
	db	'n'+80h,'*',CR,LF
	db	9,'*'+80h,' eac','h'+80h,'line',','+80h
	db	'followe','d'+80h,'b','y'+80h
	db	'an','y'+80h,' *',CR,LF
	db	9,'*'+80h,'optio','n'+80h
	db	'switche','s'+80h,'o','r'+80h,'ne'
	db	'w'+80h,'spee','d'+80h,'*',CR,LF
	db	9,'*'+80h,'a','s'+80h,'wp'
	db	'm'+80h,'time','s'+80h
	db	'ten','.'+80h,' N','o'+80h
	db	'*.SUB','s'+80h,'*',CR,LF
	db	9,'*'+80h,'o','r'+80h,'ambiguou','s'+80h
	db	'filenames',':'+80h,'the','y'+80h,'*',CR,LF
	db	9,'*'+80h,'overwrit','e'+80h,'followin'
	db	'g'+80h,' entrie','s'+80h,'*',CR,LF
	db	9,'*'+80h,'a','t'+80h,'expansion','.'+80h
	db	'A','n'+80h,'extr','a'+80h,'<cr'
	db	'>'+80h,' *',CR,LF
	db	9,'*  end','s'+80h,'entry.',1Fh,17,'*',CR,LF
	db	9,'***-------MORSETX'
	db	'T'+80h,'v1.0------***',CR,LF,LF,0
	lxi	h,NAMBEL
	shld	NAMPTR
	xra	a	;Console (unformatted) entries---
	sta	USEMOV	;use M2D4BF to move 'em down.
;
	lxi	h,32h
	shld	NAMBEL
INLILP:	lhld	NAMPTR	;first time, this points to NAMBEL.
	xchg		;After that, we move it up.
			;buffered console string
	call	LINEUP	;homebrew function 10
	mvi	e,LF
	mvi	c,6	;BDOS echos only what it gets. That
	call	BDOS	;means, send your own linefeed.
;
	lhld	NAMPTR	;Point to the maximum-count byte.
	inx	h	;Now point to character count. Is it
	xra	a	;zero? Then that's it for the console
	ora	m	;entry schtick. Go cap off the list
	dcx	h	;and get busy. No? Continue.
	jz	SHINIT	;Back to the maximum-count byte.
	mvi	m,CR	;Convert the 32h we wrote to <cr>.
	inx	h	;This is the character count. That we
	mov	e,m	;want. Put it in de. Replace it with 
	mvi	d,0	;<lf>. Bump. Now we point at the first
	mvi	m,LF	;string byte. Add the bytecount, and we
	inx	h	;point to the first free location past
	dad	d	;the string. This is where the new
	shld	NAMPTR	;string will go. Set up control bytes.
	mvi	m,32h
	inx	h	;I don't know that this pre-nulling is
	mvi	m,0	;really necessary, but...
;
	jmp	INLILP	;one more time, with feeling...	
;
SHINIT:	mvi	m,CR	;Back to our max-count. One more <crlf>
	inx	h	;to keep the list handler happy, then
	mvi	m,LF	;put a ^Z where the list handler will
	inx	h	;find it instead of a name, to tell it  
	mvi	m,1Ah	;to go home.
;
	lxi	h,NAMBUF	;repoint to the beginning
	shld	NAMPTR		;of the list...
INSHIN:	lxi	sp,STAKS
	lxi	h,EXIT	;This bit restarts the whole program,
	push	h	;flushing the stack of old (dead)
	jmp	SETUP	;saves and returns. The other visitor
			;here is the ^X response at CONSAY.
			;You think this is dirty? I'd rather
			;design this for humans to use. 
;
;
ILPRT:	xthl		;In-Line Printer, as kind to
	push	psw	;registers as I could make it.
ILLUP:	mov	a,m	;I've commented out the copy
	inx	h	;in TRACEPKG, while preserving
	ora	a	;TRACEPKG as a transplant 
	jz	ILDUN	;module, because of the filler.
	cpi	1Fh	;^_, record separator. In MONITOR,
	jz	FILTHM	;I use TAB the same way.
	call	PCHAR
	jmp	ILLUP
ILDUN:	pop	psw
	xthl
	ret
;
FILTHM:			;We've bumped across the 1Fh,
	mov	a,m	;the process flag. Now pick up the
	inx	h	;space count that follows, and
FLTHLP:	push	psw	;step over that too. Save the
	mvi	a,' '	;count. Now, until it drops to
	call	PCHAR	;zero, send out spaces. Then
	pop	psw	;jump back into action, pointing
	dcr	a	;at the next printable byte.
	jnz	FLTHLP
	jmp	ILLUP

;
;
;This inline Morse string-sender also has machine-specific
; details, though not so rigorously defined. If you can
; adapt the program by merely changing the equates, you
; can use the routine as-is.
;
ILMORS:	pop	h	;Get the pointer...
	mov	a,m	;get the byte... 
	inx	h	;bump the pointer...
	ora	a
	jz	MORDUN	;...and, assuming we're not done,
	push	h	;put the pointer away.
	cpi	' '
	jz	MOSP
	cpi	'&'
	jz	MOES
	call	MORSER
	call	CONSEN	;CON: sensing. Calls CONSAY if true.
	in	PORTAS	;console port
	ani	CINMSK
	cpi	CINMCH	;Here's where we break off if
	cz	CONSAY	;CON: is sending.
	jmp	ILMORS
MOSP:	call	SPACE	;7 dits of silence.
	jmp	ILMORS
MOES:	call	ES	;'&'
	jmp	ILMORS
MORDUN:	pchl		;We're done? Oh. Bye.
;
;
;Short-haul (256 bytes) 8080 equivalent to LDIR.
;
M2D4B:	mov	a,m
	inx	h
	stax	d
	inx	d
	dcr	c
	jnz	M2D4B
	ret
;
;The following is designed to do what CCP does to
;a filename.typ, in copying a virtual line of
;console input into an FCB. 
;
M2D4BF:	mov	a,m	;until c decrements to 0, copy @ hl
	cpi	'.'	;to @ de. BUT:
	jz	DOTTY	;--if the source byte is a period,
	cpi	'*'	;pad out the target subsection
	jz	FILAMB	;(name, type) with spaces. 
	cpi	CR	;--Space? Pad with spaces all the way.
	jz	PADIT	;--if it's an asterisk, pad out the
	cpi	' '	;section with '?'.
	jz	PADIT	;--if it's a space, go pad with spaces.
	cpi	'a'	;'a'-'z'? Uppercase 'em.
	jc	UPPRC
	cpi	'{'
	jnc	UPPRC
	ani	5Fh
UPPRC:	stax	d
	inx	h
	inx	d
	dcr	c
	jnz	M2D4BF
	ret
;
FILAMB:	inx	h	;step across the *.
FLAMBP:	mvi	a,'?'	;Now fill out whichever slot
	stax	d	;we're in (filename or .typ)
	inx	d	;with '?'.
	dcr	c
	mov	a,c
	cpi	3	;Dot's right---
	jz	M2D4BF	;Let DOTTY handle the dot. 
	ora	a	;If the party's over, though,
	rz		;go home.
	jmp	FLAMBP
;
DOTTLE:	mvi	a,' '	;We found a dot, but the count 
	stax	d	;wasn't down to 3. Until it is,
	inx	d	;pad out the target with spaces.
	dcr	c
DOTTY:	mov	a,c	;If the dot in 'FILENAME.TYP' is 
	cpi	4	;what we found, we should jump
	jnc	DOTTLE	;across it and continue, ending
	ora	a	;up with 'FILENAMETYP'.
	rz		;...and this here is partial 
	inx	h	;idiotproofing, to deal with
	jmp	M2D4BF	;multiple dots. Let the caller
			;complain-- at least we don't
			;lock up.
;
PADIT:	mvi	a,' '
	stax	d
	inx	d
	dcr	c
	jnz	PADIT
	ret
;
PCHAR:	push h! push d! push b! push psw
	push	psw
	cpi	CR
	jz	NULCRL
	cpi	LF
	jz	NULCRL
	cpi	9
	jnz	OUTPCR
	jmp	MAKTAB	
NULCRL:	push	psw
	mvi	a,FX
	sta	CRLIN
	pop	psw	
OUTPCR:	ani	7Fh
	mov	e,a
	mvi	c,6
	call	BDOS
	pop	psw
	ani	80h
	jz	PCRDUN
	lda	CRLIN
	inr	a
	sta	CRLIN
DNTB:	mvi	a,' '
	push	psw
	jmp	OUTPCR
PCRDUN:	lda	CRLIN
	inr	a
	sta	CRLIN
	pop psw! pop b! pop d! pop h
	ret
;
MAKTAB:	pop	psw
MKTB:	mvi	e,' '
	mvi	c,6
	call	BDOS
	lda	CRLIN
	inr	a
	sta	CRLIN
	ani	7
	cpi	7
	jnz	MKTB
	jmp	DNTB	
;
;This routine's  only purpose in life is to show
; you what  weird filename.typ you typed in when
; you thought were naming something. Perhaps you
; put in a user code...  V1.0 doesn't understand
; such things.  I'm not really up on  writing it
; yet either,  since  I  keep everything down at
; 0: where  I can keep an eye on who's eating up
; all my disk space.
;
WIMPER:	lxi	h,0C900h	;when stored, that'll be
				;<null>, ret.
	shld	FCB+12
	lxi	h,FCB+1
	push	h
	jmp	ILPRT
;
GETIT:	lda	RECTGL
	ora	a
	lxi	d,RECORD+80h
	jz	DOTOP
	lxi	d,RECORD
DOTOP:	mvi	c,1Ah	;set DMA
	call	BDOS
	lxi	d,FCB
	mvi	c,14h	;read sequential
	call	BDOS
	ora	a
	jnz	INSHIN	;if he's had us reading a file without
	sta	XHAUST	;a ^Z, this could be EOF. Go reloop to
			;SETUP via a stack flush... let him
			;handle it.
	lda	RECTGL
	cma
	sta	RECTGL
;
	IF	DEBUG
	;
	call	ILPRT
	db	'DID READSEQ.',8,8,8,8,8,8,8,8,8,8,8,8,LF,0
	;
	ENDIF	;DEBUG
;
	ret
;
;This routine corrects the 32-bit dit-delay constant for
;the declared CPU clockrate.  The initial delay value as
;assembled  is  the  empirically-determined extrapolated
;dit delay  for a 0.1 wpm coderate  with  a 100 KHz  Z80
;clock (as determined by  the PARIS test).  The  routine
;itself is a  32-bit by 8-bit unsigned multiply, done in
;longhand.  It is executed  once,  when  the program  is 
;first loaded.
;
MULTD:	lxi	h,DELCON
	lxi	d,RECORD	;we're not using it yet...
	lxi	b,4
	call	M2D4B	;copy a unity image up where it's safe
	lda	CLKBYT
	mov	b,a	;INT(crystal frequency * 10) 
	mvi	c,8	;bit-count of that value
MLDLP:	lxi	h,DELCON+3
	mov	a,m	;maybe it's funky, but I need the
	rlc		;flag and the initial non-carry.
	mov	m,a	;Later I'll get real clever about
	dcx	h	;stashing the CPU's flags, but right
	mov	a,m	;now this one-time linear code is 
	ral		;all right by me. Don't like it here?
	mov	m,a	;Put it up in NAMBUF.
	dcx	h
	mov	a,m
	ral
	mov	m,a
	dcx	h
	mov	a,m
	ral
	mov	m,a
;
	mov	a,b
	rlc
	mov	b,a
	jnc	NOADD
;
	lxi	h,DELCON+3	;add the initial value to
	lxi	d,RECORD+3	;the developing product.
	ldax	d
	add	m
	mov	m,a
	dcx	h
	dcx	d
	ldax	d
	adc	m
	mov	m,a
	dcx	h
	dcx	d
	ldax	d
	adc	m
	mov	m,a
	dcx	h
	dcx	d
	ldax	d
	adc	m
	mov	m,a
NOADD:	dcr	c
	jnz	MLDLP
	ret
;
	IF	NOT (NODBUG)
;
;========== TRACER PACKAGE ======================START 
;
;ILPRT:	xthl		;In-Line Printer, as kind to
;	push	psw	;registers as I could make it.
;ILLUP:	mov	a,m
;	inx	h
;	ora	a
;	jz	ILDUN
;	call	TRACER
;	jmp	ILLUP
;ILDUN:	pop	psw
;	xthl
;	ret
;
DMPCTR:	db	0	;Dumps a DDT-style display of two
DMPTIC:	db	0	;records of memory, starting where
DUMPHL:	dw	0	;hl points at entry. DMPCTR counts
DUMPR:	push b! push d	;the lines up to 16. Stuff it nonzero
DUMPIN:	shld	DUMPHL	;before calling, if you want fewer
	call	PHL	;lines.
	call	ILPRT
	db	': ',0
	lhld	DUMPHL
	mvi	e,16
DUMPHX:	mov	a,m
	inx	h
	push h! push d
	call	PHEX
	mvi	a,' '
	call	TRACER
	pop d! pop h
	dcr	e
	jnz	DUMPHX
	lhld	DUMPHL
	mvi	e,16
DUMPAS:	mov	a,m
	inx	h
	push h! push d
	ani	7Fh
	cpi	' '
	jnc	ASOK
	mvi	a,'.'
ASOK:	call	TRACER
	pop d! pop h
	dcr	e
	jnz	DUMPAS
	mvi	a,CR
	call	TRACER
	mvi	a,LF
	call	TRACER
;
	lxi	d,16
	lhld	DUMPHL
	dad	d
	shld	DUMPHL
	lda	DMPCTR
	inr	a
	sta	DMPCTR
	ani	0Fh
	jz	DUMPUP
	cpi	8
	jnz	DUMPIN
	mvi	a,CR
	call	TRACER
	mvi	a,LF
	call	TRACER
	jmp	DUMPIN
DUMPUP:	pop d! pop b
	xra	a	;zero the counter for next time.
	sta	DMPCTR
	sta	DMPTIC
	ret
;
PHL:	push	h
	mov	a,h
	call	PHEX
	pop	h
	mov	a,l
PHEX:	push	psw
	rrc
	rrc
	rrc
	rrc
	call	PNIB
	pop	psw
PNIB:	ani	0Fh
	adi	90h
	daa
	aci	40h
	daa
TRACER:	push b! push d! push h
	push	psw
	mov	e,a
	mvi	c,6
	call	BDOS
	mvi	c,0Bh
	call	BDOS
	ora	a
	jz	NOCSN
CSN:	mvi	e,0FFh
	mvi	c,6
	call	BDOS
	cpi	'S'-40h
	jz	CSN
	cpi	'C'-40h
	jz	0
NOCSN:	pop	psw
	pop h! pop d! pop b
	ret
;
;======= TRACER PACKAGE ============================END
;
	ENDIF	;NOT NODBUG
;
;
TABLE:	db	FX,FX,FX,FX	;NUL SOH
	db	FX,FX,FX,FX	;STX ETX
	db	FX,FX,FX,FX	;EOT ENQ
	db	8,50h,FX,FX	;ACK...<sn> BEL
	db	0,80h,FX,FX	;BS...<hh> HT
	db	0Bh,60h,FX,FX	;LF...<al> VT
	db	15h,50h,51h,70h	;FF...<ka> CR...<bk> 
	db	FX,FX,FX,FX	;SO SI
	db	FX,FX,FX,FX	;DLE DC1
	db	FX,FX,FX,FX	;DC2 DC3
	db	FX,FX,FX,FX	;DC4 NAK
	db	FX,FX,0Ah,50h	;SYN ETB...<ar>
	db	FX,FX,FX,FX	;CAN EM
	db	FX,FX,FX,FX	;SUB ESC
	db	FX,FX,FX,FX	;FS GS
	db	FX,FX,FX,FX	;RS US
	db	FX,FX,2,50h	;<space> bang...<as>
	db	2Dh,60h,28h,60h	;" #...<sk>
	db	84h,70h,21h,50h	;$...<sx: dollarsign> 
				;%...<au: fractions follow>
	db	FX,FX,1Eh,60h	;&...set up ES in a sub
	 			;'
	db	0Dh,50h,2Dh,60h	;( )
	db	2,50h,0Ah,50h	;+...<ar> *...<as>
	db	33h,60h,21h,60h	;, -
	db	2Ah,60h,9,50h	;. /...<fraction bar>
	db	1Fh,50h,1Eh,50h	;0 1
	db	1Ch,50h,18h,50h	;2 3
	db	10h,50h,0,50h	;4 5
	db	1,50h,3,50h	;6 7
	db	7,50h,0Fh,50h	;8,9
	db	7,60h,15h,60h	;: ;
	db	FX,FX,11h,50h	;< =...<doubledash>
	db	FX,FX,0Ch,60h	;> ?
	db	0Ah,50h,22h,FX	;@...<ar> A
	db	41h,FX,45h,FX	;B C
	db	31h,FX,10h,FX	;D E
	db	44h,FX,33h,FX	;F G
	db	40h,FX,20h,FX	;H I
	db	4Eh,FX,35h,FX	;J K
	db	42h,FX,23h,FX	;L M
	db	21h,FX,37h,FX	;N O
	db	46h,FX,4Bh,FX	;P Q
	db	32h,FX,30h,FX	;R S
	db	11h,FX,34h,FX	;T U
	db	48h,FX,36h,FX	;V W
	db	49h,FX,4Dh,FX	;X Y
	db	43h,FX,FX,FX	;Z [
	db	51h,70h,FX,FX	;\...<bk> ]
	db	8,50h,2Ch,60h	;^ _
	db	FX,FX,22h,FX	;accent grave, a
	db	41h,FX,45h,FX	;b c
	db	31h,FX,10h,FX	;d e
	db	44h,FX,33h,FX	;f g
	db	40h,FX,20h,FX	;h i
	db	4Eh,FX,35h,FX	;j k
	db	42h,FX,23h,FX	;l m
	db	21h,FX,37h,FX	;n o
	db	46h,FX,4Bh,FX	;p q
	db	32h,FX,30h,FX	;r s
	db	11h,FX,34h,FX	;t u
	db	48h,FX,36h,FX	;v w
	db	49h,FX,4Dh,FX	;x y
	db	43h,FX,8,50h	;z {
	db	FX,FX,FX,FX	;| }
	db	0Dh,50h,0,80h	;~...<kn> DEL...<hh>
;
;Prosigns:
;     	SIGN  	KEY USED  MEANING
;	au	%	fractions follow
;	sx	$	dollar-sign
;	ar	+,@,ETB	end of message or cross
;	bk	\,CR	"over."
;	sn	ACK,{	understand
;	as	*,!	wait
;	hh	BS,DEL	error
;	sk	#	QSO END
;	kn	(,~	go only
;
;'&', <es>, is best handled as an exception.
; Inter-letter space is dah = 3 dits... space needed is 2 dits.
;
;----------
CURDRV:	ds	1
USRDRV:	ds	1	;
USEMOV:	db	0	;flag, which MOV routine to use.
FIRSTM:	db	0
WSPBYT:	db	0
XTNBYT:	db	0
PRYBYT:	db	0
STASH:	ds	1
STASH2:	ds	1
SHCNT:	db	0	;shiftcounter for division routines
DIV:	db	0,0		;32 bit 0.1 wpm delay constant,
	db	1,0,0,0		;stored in STRAIGHT ASCENDING
				;BYTES, MSBy first. Plus some
				;operating room for the division.
DMADR:	dw	0
STASHW:	dw	0
RESULT:	dw	0
CRLIN:	db	0	;characters/line counter for Function 6 
SPACNT:	db	0
PERCNT:	db	0
RECPTR:	ds	2
XHAUST:	db	0
RECTGL:	db	0
CONBUF:	db	8,0
	ds	10h
	dw	1A1Ah	;...safety
	ds	100h
STAKS:	ds	2
NAMPTR:	dw	NAMBUF
NAMBEL:	ds	2	;room for the first buffered line's controls. 
NAMBUF:	ds	100h

;
	end
;
;Westlink Inc. News Report POBox 463 Pasadena CA 91102 
;monday, 8PM  Santa Clarita ARC Net @ KB6C 147.735- Magic Mtn Rptr
;
eof MORSTXT.ASM/Ampro[stuff.933]--CHR$(13)25JUN85