;  PROGRAM:	VDKCOM.Z80
;  VERSION:	1.2
;  DATE:	16 April 1988
;  AUTHOR:	Fred Haines

;  Copyright 1988 by Fred Haines. Released by the author to the CP/M
;  community for all reasonable noncommercial purposes.  Thanks to Rob
;  Friefeld for code review and corrections.

;  Set up for SLR assembler and linker (clip and use as ZEX file):
;
;    SLR180 VDKCOM/R
;    SLRNK /P:0100/D:1000,VDKCOM,VDKCOM/N/E
;
;  Your linker may automatically put the DSEG after the SYSLIB routines.
;  If you are not using an SLR assembler, change the REQUEST statement
;  from SYSSLR to SYSLIB.

;  Version 1.2 - 1 May 1988
;
;  This version is almost entirely the work of Rob Friefeld, who compacted
;  subroutines, established a DSEG, and substituted a standard PRINT 
;  routine for SYSLIB's EPRINT routine, reducing the program from 26
;  records to ten, with consequent savings in space and speed. He also
;  noted that the report of activity to the console, which I thought would
;  be necessary to reassure the user that the program was working, were
;  taking most of the time the program took to run. It actually runs fast 
;  enough that you don't have time to worry about it, so I took it out.
;  Other than the substantial increase in speed, there are no new features. 

;  Version 1.1 - 21 April 1988
;
;  Simplified to permit lower case 'n' or 'q' character at beginning
;  of any key macro to specify No Repeat or Quiet option rather than
;  '<N>' or '<Q>' strings. A slash can be used to specify that the next
;  character is to be taken literally. Use '/^' to print a literal
;  carat rather than designate a control character and '//' to print a
;  literal slash. Single slashes will be ignored, so, if you need to 
;  start a no-option string with 'n' or 'q', just precede it with a
;  slash. This not only makes things easier for the user, it elimates a
;  lot of unduly complicated code and runs faster. Other code has been
;  rationalized as well.

;  Version 1.0 - 16 April 1988
;
;  VDKCOM is a "compiler" of *.VDK files for installation in VDE v2.65
;  with VINST265.  This first version does not permit strings that begin 
;  with the character '<' or the character '^' anywhere in a string,
;  except as the prefix for a control character.  (The string '^^' will
;  produce the control character for changing the case of a letter.)  If
;  you need a '<' as the first character of a macro key string, precede
;  it with 'c^S' where c stands for any character but the prohibited ones.
;  I have no workaround for '^'.

VERS	EQU	12

FALSE	EQU	0
TRUE	EQU	NOT FALSE

	.REQUEST SYSSLR
;	.REQUEST SYSLIB		; if not using SLR180

	EXT	F$DELETE	; delete existing file
	EXT	F$MAKE		; create a new file
	EXT	FX$GET		; fetch byte from input file
	EXT	FX$PUT		; write byte to output file
	EXT	FXI$CLOSE	; close input file for byte i/o
	EXT	FXI$OPEN	; open input file for byte i/o
	EXT	FXO$CLOSE	; close output file for byte i/o
	EXT	FXO$OPEN	; open output file for byte i/o
	EXT	PFN2		; print file name to console
	EXT	PAFDC		; print A as decimal characters
	EXT	PHLDC		; print HL as decimal characters

;  CP/M equates

FCB	EQU	5CH		; FCB
CR	EQU	13		; <CR>
LF	EQU	10		; <LF>
BS	EQU	8		; <BS>

; PROGRAM

; print banner

	CALL	PRINT
	DB	'VDKCOM Version '
	DB	VERS/10+'0','.',(VERS MOD 10)+'0', ' [Z80]',CR,LF
	DB	0

; test for help request

	LD	A,(FCB+1)	; get first character of file name
	CP	' '		; no file spec?
	JR	Z,HELP
	CP	'/'		; help option caught?
	JP	NZ,CHKTYP

; print help information

HELP:
	CALL	PRINT
	DB	'Syntax:',CR,LF
	DB	' VDKCOM <ufn>.VDT',CR,LF
	DB	'   converts text file to <ufn>.VDK overlay',CR,LF
	DB	' VDKCOM <ufn>.VDK',CR,LF
	DB	'   converts overlay to <ufn>.VDT text file'
	DB	0
	RET

; check type of input file for VDT or VDK

CHKTYP:
	LD	(OLDSTK),SP	; store system stack pointer

	LD	HL,FCB+9	; point HL at first byte of file type
	LD	A,(HL)		; get it into A
	CP	'V'		; is it going to be VDT or VDK?
	JP	NZ,TYPERR	; if it isn't, quit now
	INC	HL		; get second character
	LD	A,(HL)		; stick it in A
	CP	'D'		; still building VDT or VDK?
	JP	NZ,TYPERR	; if not, bail out
	INC	HL		; get third character
	LD	A,(HL)		; stick it in A
	CP	'T'		; is it a T?
	JP	Z,SETFCB	; bingo!
	CP	'K'		; no, we're converting VDK to VDT
	JP	NZ,TYPERR	; if neither T nor K, just quit

; default is VDT->VDK.	If it's VDK->VDT, rewrite flag byte

	LD	HL,FLAG		; using last byte of file type as flag
	LD	(HL),'K'	; input must be changed to VDK
	LD	HL,IOFCB1+11	; point at file type in output FCB
	LD	(HL),'T'	; change it to VDT

; write input filename to both input and output i/o FCB's

SETFCB:
	LD	HL,FCB+1	; point HL at first byte of file name
	LD	DE,IOFCB0+1	; point DE at i/o FCB
	LD	BC,8		; number of characters in file name
	LDIR

	LD	HL,FCB+1	; point HL at first byte of file name
	LD	DE,IOFCB1+1
	LD	BC,8		; number of characters in file name
	LDIR

; open input file

	LD	DE,IOCTL0	; point to control block for input file
	CALL	FXI$OPEN	; ..and open it
	JP	NZ,OUTFILE	; continue if okay, else..
	CALL	PRINT		; ..if file not found
	DB	' File not found.'
	DB	0
	JP	RETURN

; create and open output file

OUTFILE:
	LD	DE,IOFCB1	; point to FCB in output IOCTL block
	CALL	F$DELETE	; delete old file
	CALL	F$MAKE		; create file described in IOCTL
	LD	DE,IOCTL1	; point to output IOCTL
	CALL	FXO$OPEN	; ..and open file for byte i/o
	JP	Z,NODIR 	; if no directory space

; print input file name to console

	CALL	PRINT
	DB	CR,' converting '
	DB	0
	LD	DE,FCB+1	; get input filename from FCB
	CALL	PFN2		; print it to console
	CALL	PRINT
	DB	'...'
	DB	0

; branch according to VDT->VDK or VDK->VDT

	LD	A,(FLAG)	; flag is T or K in i/o input FCB file type
	CP	'K'		; T requires no action
	JP	Z,VDK		; K switches you into VDK-VDT conversion

; start overall program counter

	LD	BC,512		; VDK is exactly four records long

; implant VINST version ID number as first two bytes of file

	LD	DE,IOCTL1	; set for output
	LD	A,02H		; enter two-byte version ID (0250h)
	CALL	OUTPUT		; write first byte
	LD	A,50H		; second ID byte
	CALL	OUTPUT		; write second byte

; initialize byte count buffer

	XOR	A		; zero A
	LD	(BCNTR),A	; store it to byte counter buffer

; start new string by leaving place for byte-count byte

STRING:
	XOR	A		; use temporary 00h for string-length byte
	CALL	OUTPUT		; send it to output file
	CALL	SETPTR		; mark place for later insert of length

; check for LF and No Repeat or Quiet Option

	LD	DE,IOCTL0	; initialize input file
	CALL	FX$GET		; get next character
	CP	0AH		; is it the leftover line feed?
	CALL	Z,FX$GET	; burn it and get next character
	CP	'n'		; is it an No Repeat option character?
	JR	Z,NOPT		; process string as No Repeat option 
	CP	'q'		; is it a Quiet option
	JR	Z,QOPT		; process it as Quiet option
	JR	GETCHR1 	; keep character we've got and process string

; process strings from input file

GETCHR:
	LD	DE,IOCTL0	; initialize input file
	CALL	FX$GET		; get next character

GETCHR1:
	CP	0DH		; is it the end of the string?
	JR	Z,COUNT 	; go take care of the count
	CP	'/'		; is it literal indicator?
	JR	Z,LITERAL	; burn it and get next character instead
	CP	'^'		; is it a control character?
	JR	Z,CTRL		; convert to real control character
	CP	1AH		; is it EOF?
	JR	Z,EOF		; go quit
	CP	0AH		; is it LF?
	JR	Z,GETCHR	; just skip it

GETCHR2:
	CALL	OUTPUT		; ..else, output character to VDK file
	JR	GETCHR		; ..and get the next one

; process No Repeat and Quiet options

QOPT:
	CALL	NQOPT
	LD	DE,IOCTL0	; reset for input

NOPT:
	CALL	NQOPT
	JR	GETCHR

NQOPT:
	CALL	FX$GET		; waste 'n' character
	CP	'^'		; is it control character?
	CALL	Z,OPCTRL	; go take care of it 
	CP	'/'		; is it a literal indicator?
	CALL	Z,FX$GET	; waste it
	ADD	80H		; set high bit
	JP	OUTPUT		; send to output file

OPCTRL:
	CALL	FX$GET		; get next character 
	SUB	'@'		; make into control character
	RET

; convert ASCII '^c' to real control character

CTRL:
	CALL	OPCTRL
	JR	GETCHR2

; string complete, get count and write to string-length byte

COUNT:
	LD	HL,(PNTR)	; get pointer to length byte into HL
	DEC	HL		; string-length byte itself not counted
	LD	A,(BCNTR)	; get current byte count
	DEC	A		; subtract one for string-length byte
	LD	(HL),A		; write it to length byte in output file buffer
	XOR	A		; restart byte counter at zero
	LD	(BCNTR),A	; store to the buffer
	JR	STRING		; start new string

; burn literal indicator and output next byte no matter what it is

LITERAL:
	CALL	FX$GET		; get next character, skipping literal
	JR	GETCHR2

; fill remainder of four-sector file with nulls

EOF:
	XOR	A		; zero accumulator
	LD	DE,IOCTL1	; set to output character
	CALL	FX$PUT		; write it and count down another byte
	DEC	BC
	LD	A,B		; check B against C for both set 0
	OR	C
	JR	NZ,EOF		; if not, loop

CLOSE:
	LD	DE,IOCTL1	; set for output
	CALL	FXO$CLOSE	; close output file

RETURN:
	LD	SP,(OLDSTK)	; get system stack back
	RET			; and program ends here

; convert VDK file to VDT

VDK:
	LD	DE,IOCTL0	; set for input
	CALL	FX$GET		; waste two-byte version ID (0250h)
	CALL	FX$GET		; ..to get to length-byte of first string
	CALL	FX$GET		; we have byte count in A

; initialize both byte (string length) and string count buffers

	LD	(BCNTR),A	; store it to byte counter buffer
	LD	A,10		; initialize string counter for ten strings
	LD	(SCNTR),A	; write it to string counter buffer

; start new string to convert VDK->VDT

NEWSTR:
	CALL	INPUT		; read in first byte and count down string
	CP	80H		; is it an option (N or Q)?
	JR	C,GETCHRK2	; if not, skip option processing
	SUB	80H		; if it is, reset high bit
	LD	(BYTBUF),A	; write character to buffer
	CALL	INPUT		; get second byte
	CP	80H		; is it a Q option?
	JR	C,NOPTION	; if not, skip

QOPTION:
	SUB	80H		; reset high bit
	LD	(BYTBUF+1),A	; write it to buffer
	LD	A,'q'		; get a Q ready
	JR	NOPTION1

NOPTION:
	LD	(BYTBUF+1),A	; write character to buffer
	LD	A,'n'		; get an N ready

NOPTION1:
	LD	DE,IOCTL1
	CALL	FX$PUT		; write it to output	

GETCHRK:
	LD	A,(BYTBUF)	; get first character into A
	CP	20H		; is it a control character?
	CALL	C,CTRLK 	; convert it to ASCII '^c'
	CALL	LITCHK0		; is it a literal character? 
	LD	DE,IOCTL1	; set for output
	CALL	FX$PUT		; write the byte
	LD	A,(BYTBUF+1)	; get second character

GETCHRK2:
	CP	20H		; is it a control character (Q option)?
	CALL	C,CTRLK 	; convert it to ASCII '^c'
	CALL	LITCHK		; check for / or ^
	LD	DE,IOCTL1	; set for output
	CALL	FX$PUT		; write it and fall through

GETCHRK1:
	CALL	INPUT		; get new character from string
	JR	GETCHRK2	; and go back for another

; convert real control to ASCII '^c'

CTRLK:
	PUSH	AF		; put pending control character aside
	LD	A,'^'		; write prefix out in ASCII
	LD	DE,IOCTL1	; set for output
	CALL	FX$PUT		; write the prefix
	POP	AF		; get control character back
	ADD	A,'@'		; make it normal printable character
	RET

; check for literal character as first character in two-byte buffer

LITCHK0:
	CP	'/'		; is it a slash?
	JR	Z,ADDLIT0	; add a slash
	CP	'^'		; is it a caret?
	JR	Z,ADDLIT0	; add a slash
	RET

ADDLIT0:
	CALL	ADDLIT
	CALL	FX$PUT		; and write it to output file
	LD	A,(BYTBUF+1)	; get second character from two-byte buffer
	CALL	FX$PUT		; and write it out to output file
	JR	GETCHRK1	; carry on with string processing	
 
; general check for characters requiring literal prefix slash

LITCHK:
	CP	'/'		; is it a slash?
	JR	Z,ADDLIT	; add a slash	
	CP	'^' 		; is it a caret?
	JR	Z,ADDLIT	; add a slash	
	RET			; if neither, return to processing

ADDLIT:
	PUSH	AF		; put input character aside
	LD	A,'/'		; get a slash ready
	LD	DE,IOCTL1	; set for output
	CALL 	FX$PUT		; write slash to output file
	POP	AF		; get input character back
	RET

; output to WORK1 buffer (output file) and increment string-length byte count

OUTPUT:
	LD	DE,IOCTL1	; set for output
	CALL	FX$PUT		; write to work buffer
	DEC	BC		; count down one
	LD	A,B		; check B against C for both set 0
	OR	C
	JP	Z,SIZERR	; if we're over the limit, quit
	LD	A,(BCNTR)	; get current byte count from buffer
	INC	A		; increment it
	CP	128+1		; string limit 127 + 1 length byte
	JP	NC,LENERR	; quit if string is over the limit
	LD	(BCNTR),A	; and store it back to buffer
	RET

; input from WORK0 buffer (input file)

INPUT:
	LD	HL,BCNTR	; get current count from buffer
	DEC	(HL)		; count it down one
	LD	A,(HL)		; put it in accumulator for comparison
	CP	0FFH		; one less than zero allows for length byte
	JR	Z,ENDSTR	; if it is, handle end of string
	LD	DE,IOCTL0	; else, set for input
	CALL	FX$GET		; get next byte
	RET

ENDSTR:
	LD	A,0DH		; end string with <CR>
	LD	DE,IOCTL1	; set for output
	CALL	FX$PUT		; write byte to output file

; update string counter or quit

	LD	A,(SCNTR)	; get string count
	DEC	A		; count it down one
	JP	Z,CLOSE 	; write 1Ah and close files
	LD	(SCNTR),A	; if not done, write new count back to buffer
	LD	DE,IOCTL0	; set for input
	CALL	FX$GET		; this byte is byte count for next string
	LD	(BCNTR),A	; reinitialize byte counter
	JP	NEWSTR		; ..and start new string

; update pointer to last string-length byte to be inserted

SETPTR:
	OR	A		; clear carry
	LD	HL,BUFTOP	; get top of buffer in HL
	SBC	HL,BC		; subtract counter to get pointer
	LD	(PNTR),HL	; ..and store it to memory
	RET

; print routine

PRINT:
	EX	(SP),HL		; get address
	CALL	PRINT1		; print it
	EX	(SP),HL
	RET

PRINT1:
	LD	A,(HL)
	INC	HL
	OR	A
	RET	Z
	CALL	CONOUT		; print character
	JR	PRINT1

CONOUT:
	PUSH	HL
	PUSH	DE
	PUSH	BC
	PUSH	AF
	LD	E,A
	LD	C,2
	CALL	5
	POP	AF
	POP	BC
	POP	DE
	POP	HL
	RET

; error messages

TYPERR:
	CALL	PRINT
	DB	' File type must be VDT or VDK.',CR,LF
	DB	0
	JP	HELP
	RET

NODIR:
	CALL	PRINT
	DB	' No directory space for new file.',CR,LF
	DB	0
	RET

LENERR:
	CALL	PRINT
	DB	' Key macro string exceeds 127 characters.'
	DB	0
	JP	RETURN

SIZERR:
	CALL	PRINT
	DB	' Key macros exceed 498 characters.'
	DB	0
	JP	0

; working i/o control blocks, i/o FCB's, buffers, and data storage

IOCTL0:
	DB	4		; use 4 128-byte pages
	DS	1		; filled in by FXIO
	DS	2		; filled in by FXIO
	DS	2		; filled in by FXIO
	DW	WORK0		; address of working buffer

IOFCB0:
	DS	1		; filled in by FXIO to 0
	DB	'12345678'	; file name
	DB	'VDT'		; file type
FLAG	EQU	$-1		; flag T or K shows sense of operation
	DS	24		; filled in by FXIO


IOCTL1:
	DB	4
	DS	1
	DS	2
	DS	2
	DW	WORK1

IOFCB1:
	DS	1
	DB	'12345678'	; file name
	DB	'VDK'		; file type
	DS	24		; filled in by FXIO

; uninitialized data

	DSEG

WORK0:
	DS	128*4		; working input buffer 0.5K

WORK1:
	DS	128*4		; working output buffer 0.5K

BUFTOP	EQU	$		; top of buffer

PNTR:
	DS	2		; pointer to string-length byte in WORK1 buffer

BCNTR:
	DS	1		; byte-length of string

SCNTR:
	DS	1		; number of strings processed

BYTBUF:
	DS	2		; two-byte buffer for option characters

OLDSTK:
	DS	2		; store system stack pointer

	END