; title 'disk7 -- cp/m file manipulation program'

VERS	EQU	7$6		;version number..
MONTH	EQU	08		;..month..
DAY	EQU	25		;..day..
YEAR	EQU	83		;..and year.

; copyright (c) 1983 by frank gaude'.  all rights reserved.  released to the
; public domain for non-commercial use.  monetary gain in not permitted under
; any circumstance by individual, partnership, or corporation.

; 'disk7' is based on common ideas presented in 'cleanup', 'wash', and 
; 'sweep', written by ward christensen, michael karas, and robert fisher, 
; respectively. existence of these programs generated impetus for writing 
; 'disk7'.

; a single-screen menu is provided after entering 'disk7' followed by cursor
; return.  wildcard filenames and optional drive declaration are permitted.
; disk7 [d:]*.asm shows only 'asm' files on [selected] or current drive.
; any other than a command key causes the menu to reappear.  full error
; trapping and command cancellation recovery is provided.  cancellation 
; occurs by entering a <return>, if no other entry has been made and 
; execution has not begun.

; display is circular, single-file columnar, with crt console cursor moved
; 'forward' with <space> or <return>, and 'reverse' with 'b'.  drive
; remaining storage in kilobytes is automatically displayed whenever disks
; are logged-in or menu recalled.  if a user area with no files is logged-in,
; new drive/user area prompt is presented.

; command functions of 'disk7' are:

;     c - copy file to another drive/user with automatic 'crc' verification.
;         format is --> to drive/user: 'd[nn]<return>' where 'd' is drive and
;         'n' is optional user area.  a 'colon' after the drive or user area
;         is optional.  d, d:, dn, dn:, dnn, dnn: are all valid entries.
;         (system reset occurs for disk change.)  prompts to erase already
;         existing file on other drive or in other user area.
;     d - delete file from disk, prompts for certainty.
;     f - file size in kilobytes, rounded up to next disk allocation block.
;     j - jump 'forward' 15 file names.  used to quickly go through lengthy
;         disk directories.
;     l - log-in new drive/user for display and reset system for disk 
;	  changes. format is same as 'c' for copy.
;     m - mass copy of tagged files to another drive/user area.  auto-erase
;         occurs if file(s) already exist(s).  prompts for desired drive/user
;         area as with 'c' and 'l'.  mass copy function can be repeated
;         without re-tagging files.  simply enter 'm' again to copy 
;	  previously tagged files to another drive/user area. 
;	  (entering 'm' without any files tagged causes cursor to move to 
;	  directory beginning.)
;     p - print tagged text files to cp/m list device (printer), any 
;	  keypress cancels. allows entry of a date/title (up to 30 char),
;	  and first page printed (1-255). Rainbow 100 w/LA50RA printer left
;         margin program default is 2
;     r - rename file on current drive, only cp/m convention names permitted.
;     s - stat of requested drive, shows remaining disk storage in kilobytes.
;     t - tag file for inclusion for mass copy to another drive/user area.
;         file remains tagged until either a disk log-in or 'u' is used to
;         untag it.  a '*' marker is placed on the tagged filename cursor
;         line as a reminder the file is tagged for mass copy.  tagged file
;         size is shown, totals accumulated and presented in parentheses.
;     u - untag file previously tagged for mass copy. 'u' can be used to move
;         cursor 'forward' for quick untagging of files.  logging-in drive
;         again with 'l' also quickly untags all files.
;     v - view text file on console, with pagination and single-line turn-up.
;         <crtl-x> or <esc> cancels function.  only 'ascii' characters are
;         processed.
;     w - write ascii file to cp/m logical punch device, any keypress 
;	  cancels.
;     x - exit to cp/m (to ccp without rebooting, or optionally warmboot if
;         program assembled with 'warmboot' equate set true.)  <esc> can be
;         used also to exit to cp/m.

; 'disk7' is an alternative to 'pip' and 'sweep'.  conveniently, it can be
; added as a subroutine to application programs that require file 
; manipulation but without returning to the cp/m operating system. 
; 'disk7' loads fast and copies files at near theoretical speed using 
; an 8-bit 'crc' table-driven ccitt recommended routine.  the compact 
; menu makes operation essentially self-documenting.  the program occupies 
; approximately 4.5k bytes of memory.

; installation requires setting maximum allowed drive to be logged-in or
; copied to, and deciding if to warmboot or not on returning to cp/m.  these
; equate options plus several others are at program 'starting definitions'
; below.

; disk7 works with cp/m 2.2 only, with 24k or more of ram.  file copy
; functions are faster with large amounts of ram.

; please report bugs noted or improvements incorporated to frank gaude'
; at 10925 stonebrook drive, los altos hills, ca 94022.  telephone is
; 415/941-2219, 6pm to 10pm daily, pacific time.

; latest changes

; 08/25/83  customize for Rainbow 100 video attributes. customize for 
; LA50RA printer paginated mass print mods. changed ('j') to 15 files.
; (76c->rb3)  jrf

; 08/19/83  added paginated mass print mods (76c)  jon kleinhans

; 06/30/83  updated menu to reflect new commands.  (76c)  fg

; 06/19/83  tagged file summation displayed right justified.  added new
; command ('j') to jump forward 22 files.  (76a)  fg
 
; 06/04/83  added 'ani 7fh' to 'v' read function to force text to ascii.
; also added 'w' command to output ascii text to cp/m punch device (tnx to
; bill silvert for recommending these changes).  file size now accumulated
; as tagged ('t') and presented in parentheses on cursor line.  (76)  fg

; starting definitions

TRUE	 EQU	0FFH		;define true and..
FALSE	 EQU	0       	;..false.
WARMBOOT EQU	FALSE		;set true to warmboot on exit
CPM$BASE EQU	0000H		;cp/m system base..
TPA	 EQU	100H		;..'transient program area' start..
CCP	 EQU	800H		;..and 'ccp' length in bytes.
LPS	 EQU	24-2		;lines-per-screen for 'view' pagination
GET	 EQU	0FFH		;get user area e-reg value

; ascii definitions

BELL	EQU	07H		;ascii bell character..
BS	EQU	08H		;..backspace..
LF	EQU	0AH		;..linefeed..
CR	EQU	0DH		;..carriage return..
CAN	EQU	18H		;..cancel..
EOFCHAR	EQU	1AH		;..end-of-file..
ESC	EQU	1BH		;..and escape character.

;----------------------------------------------
; DEC Rainbow 100 Equates
;      clear screen & home    27 [ 2 J 27 [ H
;      normal video           27 [ 0 m
;      bold  video            27 [ 1 m
;      reverse  video         27 [ 7 ; 1 m
;      reverse blink video    27 [ 7 ; 1 ; 5 m
;      bold blink video       27 [ 5 ; 1 m
RAIN1	EQU	27
RAIN2	EQU	'['
RAIN3	EQU	'2'
RAIN4	EQU	'J'
RAIN5	EQU	'H'
RAIN6	EQU	'0'
RAIN7	EQU	'1'
RAIN8	EQU	'5'
RAIN9	EQU	'7'
RAIN10	EQU	';'
RAIN11  EQU     'm'
;-------------------------------------------------
; even-page base of filename ring storage

RING	SET	LAST+100H AND 0FF00H

; assembly origin (load address) and program beginning

SOURCE	ORG	CPM$BASE+TPA
	JMP	DISK7

; highest disk drive letter in system

MAXDR	DB	'C'		; 'a', 'b', 'c', etc.

; concealed copyright notice

	DB	' Copyright (c) 1983 by Frank Gaude'''
	DB	' All Rights Reserved'
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
;				Equates for MASS PRINT
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
FF	EQU	0CH		; form feed
TAB	EQU	09H		; tab
SPACE	EQU	20H
NULCHR	EQU	00H
ASCBIAS	EQU	30H
ZERO	EQU	00H

PAGEWID  EQU	81		; 0--80 = 81  Rainbow 100 only

PAGELEN  EQU	65		; 0--65 = 66
HOMELINE EQU	3		; start position of print head on power up.
TOPMRGN  EQU	1		; blank lines from home position to HEADER.
				;	TOPMRGN must be => one
HEADMRGN EQU	2		; blank lines between HEADER and text.
				;	HEADMRGN must be => one
BOTMRGN  EQU	2		; blank lines between text and end of page.
LASTLINE EQU	PAGELEN-HOMELINE-BOTMRGN

; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
;				Storage for MASS PRINT
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
DECDIG	DB	100,10,1
PAGENO	DS	1
LINENO	DS	1
COLNO	DS	1

STRTPG	DB	1		; start page number, initially = 1
STARTED  DB	0FFH		; started flag is zero after started
LEFTMRGN DB	2               ; default for Rainbow 100 w/LA50RA printer
TABSIZE  DB	8
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
;				BEGINNING OF PRINTER ROUTINES.	7/28/83
;	Must change the "P" command to call MASSLST in the command scan.
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

MASSLST
; get date and/or title for header line.
	LXI	H,CMDBUF
	MVI	B,32	     ; # of blankes to ..
	CALL	FILL	     ; ..clear 'cmdbuf'.
	CALL    BLBLNK
	CALL	ILPRT		;new name prompt
	DB	CR,LF,'                          '
  	DB	' ..............................',0
	CALL    NORM
	CALL    BOLD
	CALL    ILPRT
	DB	CR,LF,'Date/Title, up to 30 char: ',0
	CALL    NORM
	LXI	D,CMDBUF	;command line location
	MVI	C,RDBUF		;console read-buffer function
	CALL	BDOS

	LXI	H,PTITLE
	XCHG			; DE = destination pointer
	LXI	H,CMDBUF+2	; HL = source pointer
	MVI	B,30
	CALL	MOVE		; move title to from CMDBUF to PTITLE
				; skip first 2 cells of CMDBUF
ENT2	
	MVI	A,2
	STA	LEFTMRGN
;	CALL    BOLD
;	CALL	ILPRT
;	DB	CR,LF,'Left Margin column number, 0-9 (default ',0
;	LDA     LEFTMRGN
;	ADI	ASCBIAS
;	CALL	TYPE
;	CALL	ILPRT
;	DB	'): ',0
;	CALL    NORM
;	CALL	KEYIN
;	CPI	CR
;	JZ	ENT4
;	SUI	ASCBIAS
;	STA	LEFTMRGN
ENT4	
	MVI	A,8
	STA	TABSIZE
;	CALL    BOLD
;	CALL	ILPRT
;	DB	CR,LF,'Tab Size, 1-9 (default ',0
;	LDA	TABSIZE
;	ADI	ASCBIAS
;	CALL	TYPE
;	CALL	ILPRT
;	DB	'): ',0
;	CALL    NORM
;	CALL	KEYIN
;	CPI	CR
;	JZ	ENT6
;	SUI	ASCBIAS
;	JZ	ENT6
;	STA	TABSIZE
ENT6	
	LXI	H,CMDBUF
	MVI	B,32	     ; # of blankes to ..
	CALL	FILL	     ; ..clear 'cmdbuf'.

	MVI	A,0FFH
	STA	STARTED		; reset started flag, zero = started
	CALL    BOLD
	CALL	ILPRT
	DB	CR,LF,'First Page to be printed, 1-255 (default 1): ',0
	CALL    NORM
	LXI	D,CMDBUF
	MVI	C,RDBUF
	CALL	BDOS
	LXI	H,CMDBUF+4	; point to third char of start page
	CALL	BININT		; convert 3 char ascii to binary integer
	STA	STRTPG

	CALL	ILPRT
	DB	CR,LF,0

; print files tagged using the 't' command.
	LXI	H,RING+12   ;get 1st possible tag location
	SHLD	RINGPOS
JMASS$LP
	MVI	A,'*'
	CMP	M
	INX	H	     ;get in filename synchronization
	SHLD	RINGPOS
	JZ	MPRINT     ;print filename with tag character (*)
; re-entry point for next file mass print
NXTFILE
	LHLD	RINGPOS		;re-entry point for next file mass-copy
	XCHG		     ;at ring..
	LHLD	RINGEND		;..end yet?
	CALL	CMPDEHL	     ; (compare present position with end)
	JZ	JMF$EXIT    ;yes, jump to beginning of ring.

	LHLD	RINGPOS
	JMP	JMASS$LP     ;no, loop 'till thru ring list.
JMF$EXIT
	XRA	A	     ;reset flags..
	STA	FIRST$M		;..for..
	CMA		     ;..next..
	JMP	CMDLOOP	     ;jump to 'ring' beginning
; - - - - - - - - - - - - - -
MPRINT
	XRA	A
	STA	LINENO
	STA	COLNO
	MVI	A,1
	STA	PAGENO
	MVI	A,LIST	     ;out to 'list' device function
	STA	CON$LST	  ;save bdos function

; output file to console/printer/punch
	CALL	RINGFCB	     ;position name to 'fcb'

	LXI	D,TBUF	     ;set to use default cp/m dma buffer
	MVI	C,SETDMA     ;address set function
	CALL	BDOS

	LXI	H,S$FCB+12  ;set pointer to source extent field
	CALL	INITFCB	     ;fix-up 'fcb' before use

	LXI	D,S$FCB     ;open file for reading
	MVI	C,OPEN	     ;file open function code
	CALL	BDOS
	INR	A	     ; 0ffh --> 00h if open okay
	JNZ	JZEROCR    ;if not okay, show error message.
	CALL    RVBLNK
	CALL	ILPRT
	DB	'++ UNABLE TO OPEN FILE ++',0
	CALL    NORM
	JMP	NXTFILE		;NEUTRAL
JZEROCR
	CALL	HEADER	     ; print filename, date/title and page number
	XRA	A	     ;zero file 'current record' field
	STA	S$FCB+32
JREADMR LXI	D,S$FCB     ;point at file 'fcb' for reading
	MVI	C,READ	     ;record read function
	CALL	BDOS
	ORA	A	     ;check if read okay
	JNZ	PRT15		;NEUTRAL   ;eof?
	LXI	H,TBUF	     ;point at record just read
	MVI	B,128	     ;set record character counter to output
JREADLP MOV	A,M	     ;get a character
	ANI	7FH	     ;force to 'ascii'
	CPI	EOFCHAR	     ;see if end-of-file
	JZ	PRT15		;NEUTRAL    ;back to ring loop if 'eof'

	CPI	FF		; is it a form feed
	CZ	NEWPAGE		; in case printer cant handle form feed
	CPI	TAB		; is it a tab
	CZ	TABS
	CPI	LF		; is it a line feed
	CZ	NEWLINE
	CPI	NULCHR
	JZ	PRT10
	CALL	PROUT		; not a special character so print it
	LDA	COLNO
	INR	A		; increment column number
	STA	COLNO
PRT10
	LDA	COLNO
	CPI	PAGEWID		; check for end of line
	CP	NEWLINE
	LDA	LINENO
	CPI	LASTLINE	; check for end of page
	CP	NEWPAGE
	LDA	LINENO
	CPI	0		; print header if new page
	CZ	HEADER

	PUSH	B
	PUSH	H
	MVI	C,CONST		; console status function
	CALL	BDOS
	POP	H
	POP	B
	ORA	A		; check if character there
	JZ	PRT14
	CALL	NEWPAGE		; if key pressed, eject page and abort
	JMP	CMDLOOP

PRT14	INX	H	     ;if not, bump buffer pointer.
	DCR	B	     ;all bytes of record sent yet?
	JNZ	JREADLP    ;no, more in present record.
	JMP	JREADMR	     ;yes, get next record.

PRT15	CALL	NEWPAGE		; eject paper to end of last page
	JMP	NXTFILE	

; - - - - - - - - - - - - - - - - - -
HEADER
	PUSH	PSW
	PUSH	B
	PUSH	H
	LDA	PAGENO
	LXI	H,STRTPG
	CMP	M		; is page number => start page ?
	JM	HEAD0
	XRA	A
	STA	STARTED		; zero if started
	STA	STRTPG		; clear start page for next file
HEAD0
	MVI	B,TOPMRGN
HEAD1	CALL	NEWLINE		; minimum of one line
	DCR	B
	JNZ	HEAD1

	CALL	PRTMSG
	DB	'Filename: ',0
				; print filename
	LDA	LEFTMRGN
	LXI	H,TABSIZE
	ADD	M		; TABS subtracts (LEFTMRGN-1)
	SUI	11		; 11 = max filename length +3
	STA	COLNO		; preset column number for title tab

	LXI	H,RINGPOS+4
	MVI	B,8
HEAD2	MOV	A,M
	CPI	SPACE
	CNZ	PR2OUT
	INX	H
	DCR	B
	JNZ	HEAD2
				; print dot
	MVI	A,'.'
	CALL	PROUT
				; print file type
	MVI	B,3
	CALL	PRTMEM

	CALL	TABS		; tab out to title

	CALL	PRTMSG		; minimum space between filename and title
	DB	' ',0

	CALL	PRTMSG		; print date/title
PTITLE	DB	'                              ',0	; storage for title

	CALL	PRTMSG
	DB	'   Page ',0

	LDA	PAGENO		; convert binary page number to ascii
	LXI	H,ASCPGNO
	CALL	ASCINT

;	MVI	B,3		; print page number ( This works also. )
;	LXI	H,ASCPGNO
;	CALL	PRTMEM

	CALL	PRTMSG		; print page number
ASCPGNO DB	'000',0

	CALL	NEWLINE		; need CR,LF after header line

	MVI	B,HEADMRGN
HEAD8	CALL	NEWLINE		; minimum of one line
	DCR	B
	JNZ	HEAD8
	POP	H
	POP	B
	POP	PSW
	RET
; - - - - - - - - - - - - - - - - -
PRTMSG				; same as ILPRT except to printer
	XTHL		     ;save hl, get msg pointer.
JILPLP	MOV	A,M	     ;get character
	ANI	7FH	     ;strip type bits
	CALL	PROUT		;TYPE	     ;show on console
	INX	H	     ;point to the next character and..
	MOV	A,M
	ORA	A	     ;..test for end-of-text.
	JNZ	JILPLP
	XTHL		     ;set hl-pair and..
	RET		     ;..return past message.
; - - - - - - - - - - - - - - - - -
; Print from memory locations
;			B == number of cells
;			HL points to first cell
PRTMEM	MOV	A,M
	CALL	PROUT
	INX	H		; next character
	DCR	B
	JNZ	PRTMEM
	RET
; - - - - - - - - - - - - - - - - -
PROUT	
	CALL	PRINT
	CALL	TYPE
	RET

PR2OUT	CALL	PRINT
	CALL	TYPE
	LDA	COLNO
	INR	A		; increment column number
	STA	COLNO
	RET

PRINT	PUSH	PSW
	PUSH	B
	PUSH	H
	PUSH	D
	MOV	E,A	     	;**** put character for 'bdos' call
	MVI	C,LIST		; list function call 5
	LDA	STARTED		; check started flag
	ORA	A
	CZ	BDOS		; send character if started
	POP	D
	POP	H
	POP	B
	POP	PSW
	RET
; - - - - - - - - - - - - - - - - -
NEWPAGE
	PUSH	B
	LDA	LINENO
	MOV	B,A		; B == line number
	MVI	A,PAGELEN
	SUB	B
	MOV	B,A		; B == number of lines left
	INR	B		; need more to get correct page eject
	INR	B
NEWPG2	DCR	B		; chalk off one line
	JZ	NEWPG4		; done if B = 0
	CALL	NEWLINE		; eject one line
	JMP	NEWPG2		; repeat line feeds until B = 0
NEWPG4	LDA	PAGENO
	INR	A		; increment page number
	STA	PAGENO
	XRA	A
	STA	LINENO		; set line number to zero
	POP	B
	RET			; with nul char in A reg
; - - - - - - - - - - - - - - - - -
NEWLINE
	PUSH	B
	PUSH	H
	MVI	A,CR
	CALL	PROUT
	MVI	A,LF
	CALL	PROUT
	LDA	LINENO
	INR	A		; increment line number
	STA	LINENO

	LDA	LEFTMRGN
	INR     A
	MOV	B,A
	LXI	H,COLNO
	MVI	M,0		; preset column to zero
	MVI	A,SPACE
LEFT2	DCR	B
	JZ	LEFT4
	CALL	PROUT		; output a space for left margin
	INR	M		; increment column number
	JMP	LEFT2
LEFT4	POP	H
	POP	B
	XRA	A		; nul char into A reg
	RET
; - - - - - - - - - - - - - - - - - -
; Expand tabs to spaces.
TABS	
	PUSH	B
	PUSH	H
TABS2	MVI	A,SPACE
	CALL	PROUT		; output a space (at least one space)
	LDA	COLNO
	INR	A		; increment column number
	STA	COLNO
	CPI	PAGEWID		; check for end of line
	JP	TABS6		; stop if zero or positive

	LXI	H,LEFTMRGN
	SUB	M		; subtract LEFTMRGN
	LXI	H,TABSIZE
TABS4	SUB	M		; subtract TABSIZE
	JZ	TABS6		; on a tab position if zero, finished
	JM	TABS2		; not on a tab position
	JMP	TABS4
TABS6	POP	H
	POP	B
	XRA	A		; nul char into A reg
	RET
; - - - - - - - - - - - - - - - -
; Convert binary integer in A reg to a three character ascii decimal integer.
; Store the ascii result in memory pointed to by HL.
; Range 000 to 255
ASCINT	
	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	XCHG			; DE points to ASCII storage cells
	LXI	H,DECDIG	; HL points to DECIMAL WEIGHT (100,10,1)
	MVI	B,3		; 3 ascii characters for 000 to 255
ASCZERO XCHG	
	MVI	M,'0'		; preset digit to ascii zero
	XCHG	
COMPDIG CMP	M
	JM	NXTDIG		; go to next dig if binary < decimal weight
	SUB	M		; subtract if binary number => decimal weight
	XCHG	
	INR	M		; increment the stored ascii character
	XCHG	
	JMP	COMPDIG
NXTDIG	INX	D		; point to next storage cell
	INX	H		; point to next decimal weight
	DCR	B		; check for last of 3 digits
	JNZ	ASCZERO
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

; - - - - - - - - - - - - - - - -
; Convert 3 char ascii integer to a binary integer in A reg.
; On entry, HL points to 3 character ascii integer
; At exit, A reg contains binary integer

BININT	PUSH	B
	PUSH	D
	PUSH	H
	XRA	A
	MOV	C,A		; zero binary number in C
	LXI	D,DECDIG+2	; point to dec 1 (100,10,1)
	MVI	B,3		; 3 ascii digits
NXTCHR	MOV	A,M		; get ascii
	SUI	ASCBIAS		; ascii to binary
	JM	INCPTR		; skip if < 0
	CPI	10
	JP	INCPTR		; skip if > 9

SCALE	PUSH	B
	PUSH	PSW
	MOV	C,A		; put binary into C
	XCHG
	MOV	A,M		; get decimal digit
	XCHG
	MOV	B,A		; B = dec digit for multiply (100,10,1)
	POP	PSW		; retrieve binary
SCALE2	DCR	B
	JZ	SCALE3
	ADD	C
	JMP	SCALE2
SCALE3	POP	B		; get old binary in C

	ADD	C		; add old binary to new binary
	MOV	C,A		; store updated binary
	DCX	D		; point to next larger dec digit (100,10,1)
INCPTR	DCX	H		; point to next ascii digit
	DCR	B
	JNZ	NXTCHR
	MOV	A,C		; put binary into A reg for return
	POP	H
	POP	D
	POP	B
	RET
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
;				END OF PRINTER ROUTINES.
; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
 
; start of program

DISK7	 IF	NOT WARMBOOT
	LXI	H,0		;clear hl-pair then..
	DAD	SP		;..add cp/m's stack address
	SHLD	STACK
	 ENDIF			;not warmboot

	LXI	SP,STACK	;start local stack
	CALL	HELP		;show 'menu'
	MVI	E,GET		;determine..
	CALL	GET$USR		;..user area then..
	STA	C$U$A		;..store as current and..
	STA	O$USR		;..as original for exit.
	LDA	FCB		;default drive?
	ORA	A
	JZ	EMBARK		;if so, branch.
	DCR	A
	STA	C$DR		;store 0 --> 'a', 1 --> 'b',etc.
	CALL	SET$DR		;select requested drive as current

; determine if specific file(s) requested -- show remaining storage

EMBARK	CALL	FRESTOR		;get bytes remaining on drive (decode default)
	LDA	FCB+1		;check if a filename was entered
	CPI	' '		;filename a space?
	JNZ	PLUNGE		;no, name was entered.
	LDA	FCB+9		;filetype also space?
	CPI	' '		;if so, then..
	JNZ	PLUNGE
	LXI	H,JOKER		;..treat as '*.*' with 'joker'..
	LXI	D,FCB+1		;..loaded here.
	MVI	B,11		; # of characters to move
	CALL	MOVE		;set field to *.*

; build 'ring' with filename positioned in default 'fcb' area

PLUNGE	MVI	C,SETDMA	;initialize dma address..
	LXI	D,TBUF		;..to default buffer.
	CALL	BDOS
	XRA	A		;clear search 'fcb'..
	STA	FCBEXT		;extent byte..
	STA	FCBRNO		;..and record number.
	CMA
	STA	CANFLG		;make cancel flag true
	LXI	D,FCB		;default 'fcb' for search..
	MVI	C,SRCHF		;..of first occurrence.
	CALL	BDOS
	INR	A		; 0ffh --> 00h if no file found
	JNZ	SETRING		;if found, branch and build ring.
	STA	CANFLG		;make log-cancel toggle false
	CALL	ILPRT		;else say none found, fall thru to log.
	DB	CR,LF,0
        CALL    RVBLNK
        CALL    ILPRT
        DB	'++ NO FILE FOUND ++',0
        CALL    BLBLNK
	CALL    ILPRT
 	DB	CR,LF,LF,0
        DB      ' --->  ',0
        CALL    NORM

; l o g

; select drive and user area (system reset for disk change on-the-fly)

LOG	CALL    BOLD
	CALL	ILPRT		;prompt to get drive/user selection
	DB	BS,'Log-in drive/user: ',0
	CALL	NORM
	CALL	DEF$D$U
	LDA	R$U$A		;establish requested area..
	STA	C$U$A		;..as current area.
	CALL	SET$USR
	CALL	RESET		;reset disk system, make requested current.
	MVI	A,' '		;set default 'fcb' to look like *.*
	STA	FCB+1
	STA	FCB+9
	LXI	H,0		;initialize tagged..
	SHLD	TAG$TOT		;..file size accumulator.
	CALL	ILPRT
	DB	CR,LF,LF,0	;fresh line and..
	JMP	EMBARK		;..restart.

; routine to define current drive and user area with full error trapping.
; (check validity of user area entry first, then drive validity, then proceed
; with implementation.)

DEF$D$U	LXI	H,CMDBUF+2
	MVI	B,7		; # of blanks to..
	CALL	FILL		;..clear 'cmdbuf'.
	LXI	D,CMDBUF	;get drive/user selection from..
	MVI	C,RDBUF		;..console buffer read.
	CALL	BDOS
	LDA	CMDBUF+1	;if only a..
	ORA	A		;..cursor return, cancel..
	JZ	COMCAN		;..log function.
	CALL	CONVERT		;make sure alpha is upper case
 	XRA	A		;initialize..
	STA	R$U$A		;..user area to zero.
	LDA	CMDBUF+3	; 1st digit of user area?
	CPI	':'		;allow ':' after drive declaration
	JZ	SETEXIT
	CPI	'0'		;no valid user area request..
	JC	SETEXIT		;..then to new drive and ring list.
	CPI	'9'+1
	JNC	ERRET		;error, not a user area.
	SUI	30H		;convert to binary and..
	CPI	1		;..test if 10's digit.
	JNZ	SETUSER		;if none, then set user area now.
	LDA	CMDBUF+4	;a second user area digit?
	CPI	':'		;allow ':' here
	JZ	SETUONE
	CPI	'0'		;test for 1's digit
	JC	SETUONE
	CPI	'5'+1		;if user area >15, go..
	JNC	ERRET		;..error msg, show file line.
	SUI	30H-10		;make 1 --> 11, 2 --> 12, etc.
	STA	R$U$A		;save as 'requested user area' here..
	JMP	SETEXIT

SETUONE	MVI	A,1		;set to user area 'one'
SETUSER	MOV	B,A
	LDA	CMDBUF+4
	CPI	':'		;double dot (colon)?
	JZ	DDPASS
	CPI	'0'		;if >19 user area, go error msg.
	JNC	ERRET
DDPASS	MOV	A,B
	STA	R$U$A		;..and here.
SETEXIT	LDA	MAXDR		;check if system maximum and..
	INR	A
	MOV	B,A
	LDA	CMDBUF+2	;..requested drive are compatible.
	CMP	B		;if input too big..
	JNC	ERRET		;..or..
	MVI	B,'A'-1		;..too..
	CMP	B		;..small, show..
	JC	ERRET		;..error msg.
	SUI	'A'-1		;ready for fcb use
	STA	FCB		;store 1 --> a:, 2 --> b:, etc.
	DCR	A
	STA	R$DR		;ready for 'login' request
	RET

; error return and recovery from command cancellation

ERRET	CALL	ILPRT
	DB	CR,LF,0
        CALL    RVBLNK
        CALL    ILPRT
        DB	'++ Drive/User Entry Error ++',0
        CALL    NORM
        CALL    ILPRT
        DB	BELL,0
COMCAN	LXI	SP,STACK	;reset stack..
	LDA	CANFLG
	ORA	A		;..from..
	CZ	CRLF
	JZ	PLUNGE
	JMP	NEUTRAL		;..error/command abort.

; e x i t

; return to cp/m ccp

CPM$CCP	LDA	O$USR		;get and set original..
	CALL	SET$USR		;..user area and..
	LXI	D,TBUF		;..tidy up..
	MVI	C,SETDMA	;..before going home.
	CALL	BDOS
	CALL	CRLF

	 IF WARMBOOT
	JMP	CPM$BASE
	 ENDIF			;warmboot

	 IF	NOT WARMBOOT
	LHLD	STACK		;put cp/m's pointer..
	SPHL			;..back to 'sp'.
	RET			;return to cp/m ccp
	 ENDIF			;not warmboot

; h e l p  (menu)

HELP	CALL	CLS		;show menu but 'clear-screen' first
	CALL	NORM		;reset to normal video if not....
	CALL	ILPRT
	DB	CR,'      DISK ',VERS/10+'0','.',VERS MOD 10+'0',' for ',0
	CALL	RVBLNK		;turn on reverse,bold,blink video
	CALL	ILPRT
	DB	'RAINBOW 100',0
	CALL	NORM
	CALL	ILPRT
	DB	' -- File Manipulation Program -- '
	DB	MONTH/10+'0',MONTH MOD 10+'0','/'
	DB	DAY/10+'0',DAY MOD 10+'0','/'
	DB	YEAR/10+'0',YEAR MOD 10+'0'
	DB	CR,LF,0
	CALL    RVRSE		;turn on reverse,bold video
	CALL	ILPRT
	DB	'   C - Copy file   | D - Delete file  | F - File size  | J '
	DB	'- Jump 15 files   ',CR,LF
	DB	'   L - Log-in      | M - Mass copy    | P - Mass print | R '
	DB	'- Rename file     ',CR,LF
	DB	'   S - Stat drive  | T - Tag file     | U - Untag file | V '
	DB	'- View text file  ',CR,LF
	DB	'   W - Write punch | X - Exit to CP/M | <space> advances cu'
	DB	'rsor <- B backs up',0
	CALL    NORM
	CALL    ILPRT
        DB      CR,LF,LF,0
	RET

; establish ring (circular list) of filenames

SETRING	LXI	H,RING		;initialize ring pointer
	SHLD	RINGPOS		;start --> current position of ring

; put each found name in ring.  a-reg --> offset into 'tbuf' name storage

TO$RING	DCR	A		;un-do 'inr' from above and below
	ADD	A		;times 32 --> position index
 	ADD	A
	ADD	A
	ADD	A
	ADD	A
	ADI	TBUF		;add page offset and..
	MOV	L,A		;..put address into..
	MVI	H,0		;..hl-pair.
	LDA	FCB		;get drive/user designator and..
	MOV	M,A		;..put into 'fcb' buffer.
	XCHG
	LHLD	RINGPOS		;pointer to current load point in ring
	XCHG
	MVI	B,12		;move drive designator and name to ring
	CALL	MOVE
	XCHG			;de-pair contains next load point address
	MVI	M,' '		;space for potential..
	INX	H		;..tagging of files for mass copy.
	SHLD	RINGPOS		;store and search..
	MVI	C,SRCHN		;..for next occurrence.
	LXI	D,FCB		;filename address field
	CALL	BDOS
	INR	A		;if all done, 0ffh --> 00h.
	JNZ	TO$RING		;if not, put next name into ring.

; all filenames in ring -- setup ring size and copy-buffer start point

	LHLD	RINGPOS		;next load point of ring is start of buffer
	SHLD	RINGEND		;set ring end..
	SHLD	BUFSTART	;..and copy-buffer start.
	LXI	D,RING+13	;compare 'ringend' (tab base+13)
	CALL	CMPDEHL
	JZ	CMDLOOP		;go to command loop, if no sort.

; sort ring of filenames

SORT	LXI	H,RING		;initialize 'i' sort variable and..
	SHLD	RINGI
	LXI	D,13		;..also 'j' variable.
	DAD	D
	SHLD	RINGJ
SORTLP	LHLD	RINGJ		;compare names 'i & j'
	XCHG
	LHLD	RINGI
	PUSH	H		;save position pointers..
	PUSH	D		;..for potential swap.
	MVI	B,13		; # of characters to compare

; left to right compare of two strings (de-pair points to 'a' string;
; hl-pair, to 'b'; b-reg contains string length.)

CMPSTR	LDAX	D		;get an 'a' string character and..
	CMP	M		;..check against 'b' string character.
	JNZ	NOCMP		;if not equal, set flag.
	INX	H		;bump compare..
	INX	D		;..pointers and..
	DCR	B		; (if compare, set as equal.)
	JNZ	CMPSTR		;..do next character.
NOCMP	POP	D
	POP	H
	MVI	B,13
	JNC	NOSWAP

; swap if 'j' string larger than 'i'

SWAP	MOV	C,M		;get character from one string..
	LDAX	D		;..and one from other string.
	MOV	M,A		;second into first
	MOV	A,C		;first into second
	STAX	D
	INX	H		;bump swap pointers
	INX	D
	DCR	B		;all bytes swapped yet?
	JNZ	SWAP
NOSWAP	LHLD	RINGJ		;increment 'j' pointer
	LXI	D,13
	DAD	D
	SHLD	RINGJ
	XCHG			;see if end of 'j' loop
	LHLD	RINGEND
	CALL	CMPDEHL
	JNZ	SORTLP		;no, so more 'j' looping.
	LHLD	RINGI		;bump 'i' pointer
	LXI	D,13
	DAD	D
	SHLD	RINGI
	DAD	D		;set start over 'j' pointer
	SHLD	RINGJ
	XCHG			;see if end of 'i' loop
	LHLD	RINGEND
	CALL	CMPDEHL
	JNZ	SORTLP		;must be more 'i' loop to do

; sort done -- initialize tables for fast crc calculations

	CALL	INITCRC

; calculate buffer maximum available record capacity

B$SIZE	LXI	B,0		;count records
	LHLD	BDOS+1		;get 'bdos' entry (fbase)

	 IF	NOT WARMBOOT
	LXI	D,-(CCP)
	DAD	D
	 ENDIF			;not warmboot

	DCX	H
	XCHG			;de-pair --> highest address of buffer
	LHLD	BUFSTART	;start address of buffer (end of ring list)
B$SIZE2	INX	B		;increase record count by one
	PUSH	D
	LXI	D,128		; 128-byte record
	DAD	D		;buffer address + record size
	POP	D
	CALL	CMPDEHL		;compare for all done
	JNC	B$SIZE2		;more will fit?
	DCX	B		;set maximum record count less one
	MOV	A,B		;memory available for copy?
	ORA	C
	JNZ	B$SIZE3		;yes, buffer memory space available.
	CALL	ILPRT
	DB	CR,LF,BELL,0
        CALL    RVBLNK
        DB	'++ NO MEMORY FOR COPY BUFFER ++',0
	CALL    NORM
	JMP	NEUTRAL

B$SIZE3	MOV	L,C		;store..
	MOV	H,B		;..maximum..
	SHLD	REC$MAX		;..record count.

; buffer size suitable -- process file/display loop

CMDLOOP	LXI	H,RING		;set start point of listing
	SHLD	RINGPOS
LOOP	CALL	ILPRT
	DB	CR,LF,'   ',0
LOOP2	LHLD	RINGPOS		;ring filename location
	MOV	A,M		;move 'fcb' to a-reg and..
	ADI	'A'-1		;..make drive printable (a - p).
	CALL	TYPE
	LDA	C$U$A		;get current (last requested) user area
	ORA	A		;branch if 'user..
	JZ	UAZ		;..area zero'.
	CPI	10		;less then ten?
	JC	LT$TEN		;if yes, branch.
	SUI	10		;if not, suppress leading 10's digit.
	PUSH	PSW
	MVI	A,'1'		;print 10's digit as 'one'
	CALL	TYPE
	POP	PSW
LT$TEN	ADI	'0'		;make 1's digit printable
	CALL	TYPE
UAZ	CALL   	BOLD
	CALL	ILPRT		;fence between 'drive/user' and..
	DB	': ',0		;..'fn.ft'.
	CALL	NORM
	INX	H		;beginning of 'fn.ft' string
	MVI	B,8		; 8 filename characters
PRT$FN	MOV	A,M
	CALL	TYPE
	INX	H
	DCR	B
	JNZ	PRT$FN
	MVI	A,'.'		;period between 'fn' and 'ft'
	CALL	TYPE
	MVI	B,3		; 3 filetype characters
PRT$FT	MOV	A,M
	CALL	TYPE
	INX	H
	DCR	B
	JNZ	PRT$FT
	MOV	A,M		;get tag (*) and..
	STA	TAG+2		;..put after colon.
	INX	H
	SHLD	RINGPOS		;save ring position
	CALL	BOLD
	CALL	ILPRT
TAG	DB	' : ',0		;space, colon, space or * before cursor.
	CALL    NORM
	LDA	J$FLG		;jump..
	ORA	A		;..forward?
	JZ	PRE$FOR
K$WAIT	CALL	KEYIN		;wait for character from keyboard
	CPI	' '		;if 'space' or..tract one ring position.
	JZ	FORWARD
	CPI	CR		;..'cursor return', move to next file.
	JZ	FORWARD
	CPI	'B'		;if reverse, subtract one ring position.
	JZ	REVERSE
	CPI	'C'		;copy file to another disk?
	JZ	COPY
	CPI	'D'		;delete a file?
	JZ	DELETE
	CPI	'F'		;show file size?
	JZ	FIL$SIZ
	CPI	'J'		;jump forward?
	JZ	JUMP15
	CPI	'L'		;log-in another drive?
	JZ	LOG
	CPI	'M'		;tagged multiple file copy?
	JZ	MASS
	CPI	'P'		;output file to 'list' device?
	JZ	MASSLST			;**** MASS PRINT		LSTFILE
	CPI	'R'		;if rename, get to work.
	JZ	RENAME
	CPI	'S'		;free bytes on..
	JZ	R$DR$ST		;..requested drive?
	CPI	'T'		;if tag, put '*' in..
	JZ	TAG$EM		;..front of cursor.
	CPI	'U'		;remove '*' from..
	JZ	UNTAG		;..in front of cursor?
	CPI	'V'		; 'view' file at console?
	JZ	VIEW
	CPI	'W'		;file to punch?
	JZ	PUNFILE
	CPI	'X'		;if exit, then to cp/m ccp.
	JZ	CPM$CCP
	CPI	ESC		; 'esc' exits to cp/m ccp also.
	JZ	CPM$CCP
	CALL	HELP  		;get help message (menu) and..
	CALL	FRESTOR		;..show free storage remaining.
NEUTRAL	LHLD	RINGPOS		;stay..
	LXI	D,-13		;..in..
	DAD	D		;..the..
	SHLD	RINGPOS		;..same..
	JMP	LOOP		;..position.

; jump forward 15 files

PRE$FOR	LDA	J$CNT		;adjust jump..
	INR	A		;..counter..
	STA	J$CNT		;..until..
	CPI	15		;..at top limit.
	JNZ	FORWARD
	MVI	A,TRUE		;at top, so..
	STA	J$FLG		;..turn off jump switch and..
	JMP	K$WAIT		;..wait for next keyboard input.

; u n t a g

UNTAG	XRA	A		;set tag/untag..
	STA	T$UN$FG		;..flag to untag.
	LHLD	RINGPOS		;move back one..
	LXI	D,-1		;..character position..
	DAD	D		;..and check tagging status.
	MOV	A,M		;if file previously tagged, remove..
	CPI	'*'		;..size from..
	MVI	M,' '		; (untag character, to next ring position.)
	JZ	FS2		;..summation.
	JMP	FORWARD
 
; t a g

TAG$EM	LHLD	RINGPOS
	LXI	D,-1		;move back one..
	DAD	D		;..position..
	MOV	A,M		; (if file
	CPI	'*'		; already tagged, skip
	JZ	FORWARD		; to next file.)
	MVI	M,'*'		;..and store a '*' tag character.
	MVI	A,TRUE		;set..
	STA	T$UN$FG		;..tag/untag and..
	STA	FS$FLG		;..file size flags to tag.
	JMP	FS2		;get file size

; f i l e   s i z e

; determine and display file size in kilobytes -- round up to next disk
; allocation block -- accumulate tagged file summation

FIL$SIZ	XRA	A		;set file size/tagged..
	STA	FS$FLG		;..file flag to file size.
FS2	MVI	A,BS		;backspace over..
	CALL	TYPE		;..command character.
	CALL	RINGFCB		;move name to 's$fcb'

; determine file record count and save in 'rcnt'

	MVI	C,COMPSZ
	LXI	D,S$FCB
	CALL	BDOS
	LHLD	S$FCB+33
	SHLD	RCNT		;save record count and..
	LXI	H,0
	SHLD	S$FCB+33	;..reset cp/m.

; round up to next disk allocation block

	LDA	B$MASK		;sectors/block - 1
	PUSH	PSW		;save 'blm'
	MOV	L,A
	XCHG
	LHLD	RCNT		;..use here.
	DAD	D		;round up to next block
	MVI	B,3+1		;convert from..
	CALL	SHIFTLP		;..records to kilobytes.
	POP	PSW		;retrieve 'blm'
	RRC			;convert..
	RRC			;..to..
	RRC			;..kilobytes/block.
	ANI	1FH
	CMA			;finish rounding
	ANA	L
	MOV	L,A		;hl-pair contains # of kilobytes
	LDA	FS$FLG
	ORA	A
	JZ	D$F$SIZ		;branch if 'f' function

; tagged file size summation

	XCHG			;file size to de-pair
	LDA	T$UN$FG
	ORA	A
	JZ	TAKE		;if untag, take size from total.
	LHLD	TAG$TOT		;accumulate..
	DAD	D		;..sum of..
	SHLD	TAG$TOT		;..tagged file sizes.
	XCHG			;file size to hl-pair
	JMP	D$F$SIZ		;branch to display sizes

TAKE	LHLD	TAG$TOT		;subtract..
	MOV	A,L		;..file..
	SUB	E		;..size..
	MOV	L,A		;..from..
	MOV	A,H		;..summation..
	SBB	D		;..total.
	MOV	H,A		;then put..
	SHLD	TAG$TOT		; (save total)
	XCHG			;..file size in hl-pair.

; display file size in kilobytes -- right justify tagged file total

D$F$SIZ	CALL	DET$BCD		;determine # of bcd digits in hl-pair
	MVI	A,9		;limit of right margin (good for max cp/m 2.2)
	SUB	B		; # of digits returned in b-reg from det$bcd
	STA	TEST$RT		;save intermediate right-justify data
	CALL	DECOUT          ;print individual file size
	CALL	ILPRT
	DB	'k',0
	LDA	FS$FLG
	ORA	A
	JZ	FORWARD         ;show next file if not tagging

; determine # of digits in tagged summation

	LHLD	TAG$TOT		;get present summation
	CALL	DET$BCD

; insert necessary spaces (blanks) to right justify display

	LDA	TEST$RT		;get intermediate right-justify data
	SUB	B
	MOV	B,A
	MVI	A,' '		;adjust..
ADD$SP	CALL	TYPE		;..to..
	DCR	B		;..achieve..
	JNZ	ADD$SP		;..right justification.
	MVI	A,'('
	CALL	TYPE
	CALL	DECOUT          ;print tagged file summation
	CALL	ILPRT
	DB	'k)',0          ;to next file..
	JMP	FORWARD		;..cursor line.

; j u m p

JUMP15	XRA	A		;clear..
	STA	J$FLG		;..jump forward flag and..
	STA	J$CNT		;..file counter.  fall-thru to next filename.

; f o r w a r d

FORWARD	LHLD	RINGPOS		;at end of loop yet?
	XCHG
	LHLD	RINGEND
	CALL	CMPDEHL		;compare 'present' to 'end'
	JNZ	LOOP		;to next print position
	CALL	CRLF		;end-of-directory shows with fresh line
	LXI	H,RING		;set position pointer to beginning and..
	SHLD	RINGPOS
	JMP	LOOP		;..redisplay start entry.

; r e v e r s e

REVERSE	LHLD	RINGPOS		;see if at beginning of ring
	LXI	D,RING+13
	CALL	CMPDEHL
	JNZ	REV1		;skip position pointer reset if not..
	CALL	CRLF		;..at beginning.  skip line at junction.
	LHLD	RINGEND		;set to end +1 to backup to end
	LXI	D,13
	DAD	D
	SHLD	RINGPOS
REV1	CALL    BOLD
	CALL	ILPRT		;indicate reverse
	DB	CR,LF,'<- ',0
	CALL    NORM
	LHLD	RINGPOS
	LXI	D,-(13*2)	;one ring position..
	DAD	D		;..backwards.
	SHLD	RINGPOS
 	JMP	LOOP2		;display without 'crlf'

; s t a t

; determine remaining storage on requested drive

R$DR$ST	CALL    BOLD
	CALL	ILPRT
	DB	BS,'Storage remaining on drive: ',0
	CALL	NORM
	CALL	DEF$D$U		;determine drive requested and..
	CALL	RESET		;..login as current.
	CALL	ILPRT
	DB	CR,LF,LF,0
	CALL	FRESTOR		;determine free space remaining
	LDA	C$DR		;login original as..
	CALL	SET$DR		;..current drive.
	JMP	NEUTRAL

; d e l e t e

; set up to delete filename at cursor position

DELETE	CALL	RINGFCB		;move name from ring to 'rename fcb'
	CALL    BLBLNK
	CALL	ILPRT
	DB	BS,'Delete? (Y/N): ',0
	CALL    NORM
	CALL	KEYIN
	CPI	'Y'
	JNZ	NEUTRAL	

; delete file

	LXI	D,S$FCB		;point at delete 'fcb'
	MVI	C,ERASE		;erase function
	CALL	BDOS
	INR	A
	JNZ	DEL2		;file deleted okay
FNF$MSG	CALL	ILPRT		;show error message
	DB	CR,LF,0
        CALL    RVBLNK
        CALL	ILPRT
	DB	'++ NO FILE FOUND ++',0
	CALL	NORM
	JMP	NEUTRAL

; reverse ring to close up erased position

DEL2	LHLD	RINGPOS		;prepare move up pointers
	PUSH	H
	LXI	D,-13
	DAD	D
	SHLD	RINGPOS		;reset current position for move
	XCHG			;de-pair = 'to' location
	POP	H		;hl-pair = 'from' location
MOVUP	XCHG
	PUSH	H		;check if at end
	LHLD	RINGEND		;get old end pointer
	CALL	CMPDEHL		;check against current end location
	POP	H
	XCHG
	JZ	MOVDONE		;must be at end of ring
	MVI	B,13		;one name size
	CALL	MOVE		;move one name up
	JMP	MOVUP		;go check end parameters

MOVDONE	XCHG
	SHLD	RINGEND		;set new ring end if all moved
	LXI	D,RING		;see if ring is empty..
	CALL	CMPDEHL		;..(listend --> listpos --> ring)
	JNZ	FORWARD
	LHLD	RINGPOS
	CALL	CMPDEHL
	JNZ	FORWARD		;neither equal so not empty
	CALL	ILPRT
	DB	CR,LF,LF,'    ',0
       	CALL    RVBLNK
	CALL	ILPRT
	DB	'++ List Empty ++',0
        CALL    NORM
	CALL    ILPRT
	DB	CR,LF,LF,0
        CALL	BLBLNK
	CALL	ILPRT
	DB	' --->  ',0
	CALL	NORM
	JMP	LOG		;go to drive/user area with files

; r e n a m e

; set-up to rename file at cursor position -- scan keyboard buffer and
; move filename to 'rename' destination 'fcb' (dfcb)

RENAME	LHLD	RINGPOS		;move name from ring to rename 'fcb'
	LXI	D,-13
	DAD	D		;point to name position
	LXI	D,D$FCB		;place to move name
	MVI	B,12		;amount to move
	CALL	MOVE
	CALL   	BOLD
	CALL	ILPRT		;new name prompt
	DB	BS,'Rename file to: ',0
	CALL    NORM
	LXI	D,CMDBUF	;command line location
	MVI	C,RDBUF		;console read-buffer function
	CALL	BDOS
	CALL	CONVERT		;capitalize alpha
	LXI	H,D$FCB+16	;set drive to null as..
	MVI	M,0		;..required by 'bdos'.
	INX	H

; initialize new filename field with spaces

	PUSH	H		;save start pointer
	MVI	B,11		; # of spaces to 'blank'
	CALL	FILL
	POP	H
	XCHG
	LXI	H,CMDBUF+1	;put length..
	MOV	C,M		;..in c-reg.
	INX	H
	XCHG			;de-pair --> buffer pointer and hl-pair..
	CALL	UNSPACE		;..--> 'fcb' pointer.  remove leading spaces.

; extend buffer to spaces beyond command length

EXTEND	PUSH	H
	MOV	L,C		;double-byte remaining length
	MVI	H,0
	DAD	D		;to buffer end +1
	MVI	M,' '		;force illegal character end
	POP	H

; start filename scan

SCAN	MVI	B,8		; 8 characters in filename
SCAN1	CALL	CKLEGAL		;get and see if legal character
	JC	COMCAN		;all of command line?
	CPI	' '		;see if end of parameter field
	JZ	CPYBITS		;rename file
	CPI	'.'		;at end of filename
	JZ	SCAN2		;process filetype field
	MOV	M,A		;put character into destination 'fcb'
	INX	H
	DCR	B		;check name character count
	JNZ	SCAN1

; entry if eight characters without a 'period'

SCAN1A	CALL	CKLEGAL		;scan buffer up to period or end
	JC	CPYBITS		;no extent if not legal
	CPI	' '		;end of parameter field?
	JZ	CPYBITS
	CPI	'.'
	JNZ	SCAN1A		;do till end or period

; build filetype field

SCAN2	MVI	B,3		;length of filetype field
	LXI	H,D$FCB+25	;destination 'rename' filetype start
SCAN3	CALL	CKLEGAL		;get and check character
	JC	SCAN4		;name done if illegal
	CPI	' '		;end of parameter field?
	JZ	SCAN4
	CPI	'.'		;check if another period
	JZ	SCAN4
	MOV	M,A
	INX	H
	DCR	B
	JNZ	SCAN3		;get next character
SCAN4	LXI	H,D$FCB+28	;set pointer to 'rename' filetype end
	CALL	INITFCB		;..and zero counter fields.

; copy old file status bit ($r/o or $sys) to new filename

CPYBITS	LXI	D,D$FCB+1	;first character of old name..
	LXI	H,D$FCB+17	;..and of new name.
	MVI	C,11		; # of bytes with tag bits
CBITS1	LDAX	D		;fetch bit of old name character
	ANI	128		;strip upper bit and..
	MOV	B,A		;..save in b-reg.
	MVI	A,7FH		;mask for character only
	ANA	M		;put masked character into a-reg
	ORA	B		;add old bit
	MOV	M,A		;copy new byte back
	INX	H		;bump copy pointers
	INX	D
	DCR	C		;bump copy counter
	JNZ	CBITS1

; check if new filename already exists.  if so, say so.  then go
; to command loop without moving ring position

	LDA	D$FCB		;copy new name to source 'fcb'
	STA	S$FCB
	MVI	B,11
	LXI	H,D$FCB+17	;copy new name to..
	LXI	D,S$FCB+1	;..source 'fcb' for existence check.
	CALL	MOVE
	LXI	H,S$FCB+12	;clear cp/m 'fcb' system..
	CALL	INITFCB		;..fields.
	LXI	D,S$FCB		;search to see if this file exists
	MVI	C,SRCHF		;search first function
	CALL	BDOS
	INR	A		; 0ffh --> 00h if file not found
	JZ	RENFILE		;to rename, if duplicate doesn't exists.
	CALL	ILPRT		;announce the situation
	DB	CR,LF,0
        CALL	RVBLNK
	CALL	ILPRT
	DB	'++ FILE ALREADY EXISTS ++',0
        CALL	NORM
	CALL	ILPRT
	DB	CR,LF,BELL,'   ',0
	JMP	NEUTRAL		;try again?

; copy new name into ring position

RENFILE	LHLD	RINGPOS		;get ring position pointer
	LXI	D,-12		;back 12 leaves drive designation intact
	DAD	D
	XCHG
	LXI	H,D$FCB+17	;point at new name and..
	MVI	B,11
	CALL	MOVE		;..move.
	LXI	D,D$FCB		;rename 'fcb' location
	MVI	C,REN		;rename function
	CALL	BDOS
	INR	A		; 0ffh --> 00h if rename error
	JNZ	NEUTRAL		;if okay, proceed, else..
	JMP	FNF$MSG		;..show no-file msg.

; v i e w

; type file to console with pagination set to 'lps' -- single-line scroll
; using <space> bar , <ctrl-x> to cancel, any other key to page screen.

VIEW	CALL	ILPRT
	DB	CR,LF,0
	CALL    RVRSE
	CALL	ILPRT
	DB	'<CTRL-X> cancels, <space> turns up one line, '
	DB	'other keys page screen.',0
        CALL	NORM
	CALL 	ILPRT
	DB	CR,LF,LF,0
	MVI	A,1		;initialize..
	STA	LPSCNT		;..lines-per-screen counter.
	STA	VIEWFLG		; 'view' paginate if not zero
	MVI	A,WRCON		;write console out function
	JMP	CURRENT		;to common i/o processing

; p r i n t e r

; send file to logical list device -- any keypress cancels

LSTFILE	XRA	A		;zero for..
	STA	VIEWFLG		;..output to printer.
	MVI	A,LIST		;out to 'list' device function
	JMP	CURRENT

; p u n c h

; write file to cp/m logical punch device

PUNFILE	XRA	A
	STA	VIEWFLG
	MVI	A,PUNCH		;put to 'punch' device function

; output character for console/list/punch processing

CURRENT	STA	CON$LST		;save bdos function

; output file to console/printer/punch

	CALL	RINGFCB		;position name to 'fcb'
	LXI	D,TBUF		;set to use default cp/m dma buffer
	MVI	C,SETDMA	;address set function
	CALL	BDOS
	LXI	H,S$FCB+12	;set pointer to source extent field
	CALL	INITFCB		;fix-up 'fcb' before use
	LXI	D,S$FCB		;open file for reading
	MVI	C,OPEN		;file open function code
	CALL	BDOS
	INR	A		; 0ffh --> 00h if open okay
	JNZ	ZEROCR		;if not okay, show error message.
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ UNABLE TO OPEN FILE ++',0
	CALL	NORM
	JMP	NEUTRAL

ZEROCR	XRA	A		;zero file 'current record' field
	STA	S$FCB+32
READMR	LXI	D,S$FCB		;point at file 'fcb' for reading
	MVI	C,READ		;record read function
	CALL	BDOS
	ORA	A		;check if read okay
	JNZ	NEUTRAL		;eof?
	LXI	H,TBUF		;point at record just read
	MVI	B,128		;set record character counter to output
READLP	MOV	A,M		;get a character
	ANI	7FH		;force to 'ascii'
	CPI	EOFCHAR		;see if end-of-file
	JZ	NEUTRAL		;back to ring loop if 'eof'
	MOV	E,A		;put character for 'bdos' call
	PUSH	B
	PUSH	H
	PUSH	D		; (character in e-reg)
	LDA	CON$LST		;get function for punch/list/console output
	MOV	C,A
	CALL	BDOS		;send character
	LDA	VIEWFLG		;if 'view'..
	ORA	A
	POP	D
	CNZ	PAGER		;..check for 'lf'.
	MVI	C,CONST		;console status function
	CALL	BDOS		;status?
	POP	H
	POP	B
	ORA	A		;if character there, then abort..
	JNZ	NEUTRAL 	;..to same ring position.
	INX	H		;if not, bump buffer pointer.
	DCR	B		;all bytes of record sent yet?
	JNZ	READLP		;no, more in present record.
	JMP	READMR		;yes, get next record.

PAGER	MOV	A,E		; (character in e-reg)
	CPI	LF
	RNZ
	LDA	LPSCNT		;is counter..
	INR	A		;..at..
	STA	LPSCNT		;..limit..
	CPI	LPS		;..of lines-per-screen?
	RC			;no, return.
	XRA	A		;yes, initialize..
	STA	LPSCNT		;..for next screen full.
	CALL	RVRSE
	CALL	ILPRT
	DB	'  [more...]',CR,0	;show msg line
	CALL	NORM
	CALL	DKEYIN		;wait for keyboard input
	CPI	' '		;see if <space> bar..
	PUSH	PSW
	CALL	ILPRT
	DB	'           ',CR,0	;clear above msg line
	POP	PSW
	JNZ	CANVIEW		;..if not, see if cancel.
	MVI	A,LPS-1		;if so, set up for single-line..
	STA	LPSCNT		;..scroll and..
	RET			;..return for one more line.

CANVIEW	CPI	ESC		;escape?
	JZ	COMCAN
	CPI	CAN		;cancel?
	JZ	COMCAN		;retain ring position
	RET			;return for another page

; m a s s   c o p y

; copy files tagged using the 't' command.  auto-erase if file exists
; on requested destination drive or in user area.

MASS	LXI	H,RING+12	;get 1st possible tag location
	SHLD	RINGPOS
MASS$LP	MVI	A,'*'
	CMP	M
	INX	H		;get in filename synchronization
	SHLD	RINGPOS
	JZ	MCOPY		;copy filename with tag character (*)
M$LP	LHLD	RINGPOS		;re-entry point for next file mass-copy
	XCHG			;at ring..
	LHLD	RINGEND		;..end yet?
	CALL	CMPDEHL		; (compare present position with end)
	JZ	MF$EXIT		;yes, jump to beginning of ring.
	LHLD	RINGPOS
	JMP	MASS$LP		;no, loop 'till thru ring list.

MF$EXIT	XRA	A		;reset flags..
	STA	FIRST$M		;..for..
	CMA			;..next..
	STA	MFLAG		;..mass-copy request.
	JMP	CMDLOOP		;jump to 'ring' beginning

; c o p y

; copy source file at current 'ring' position to another drive.  set-up
; fcb's and buffer area and check for correct keyboard inputs.  contains
; auto-crc file copy verification.

MCOPY	XRA	A		;zero flag to..
	STA	MFLAG		;..mass copy.
COPY	LXI	H,0		;initialize storage for..
	SHLD	CRCVAL		;..'crc' working value.
	CALL	RINGFCB		;move from 'ring' to 'sfcb'
	LXI	H,S$FCB+12	;set pointer to source extent field
	CALL	INITFCB
	XRA	A		;zero fcb 'cr' field
	STA	S$FCB+32
	MVI	B,32		;copy source 'fcb' to destination 'fcb'
	LXI	H,S$FCB+1	;from point..
	LXI	D,D$FCB+1	;..to point..
	CALL	MOVE		;..move across.
	LXI	D,S$FCB		;open file for reading
	MVI	C,OPEN		;open function
	CALL	BDOS
	INR	A		; 0ffh --> 00h if bad open
	JNZ	COPY2		;if okay, skip error message.
	CALL	ILPRT
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ UNABLE TO OPEN SOURCE ++',0
  	CALL	NORM
	CALL	ILPRT
	DB 	CR,LF,0
	JMP	NEUTRAL

COPY2	LDA	FIRST$M		;by-pass prompt, drive/user compatibility..
	ORA	A		;..test, and disk reset after..
	JNZ	COPY3M		;..1st time thru in mass-copy mode.
	CALL	BOLD
	CALL	ILPRT		;prompt for drive selection
	DB	BS,'Copy to drive/user: ',0
	CALL	NORM
	CALL	DEF$D$U

; either drives or user areas must be different

	LDA	FCB		;get requested drive from 'fcb' and..
	MOV	B,A		;..put into b-reg for..
	LDA	S$FCB		;..comparison.
	CMP	B
	JNZ	COPY3		;branch if different
	LDA	R$U$A		;requested user area --> rua
	MOV	B,A
	LDA	C$U$A		;current user area --> cua
	CMP	B
	JNZ	COPY3
	CALL	ILPRT		;if not, show error condition:
	DB	CR,LF,BELL,0
	CALL    RVBLNK
        CALL    ILPRT
        DB	'++ Drives or User Areas must be different ++',0
	CALL	NORM
	JMP	NEUTRAL		;try again?

COPY3	CALL	RESET		;make sure disk is read/write
COPY3M	LDA	FCB		;put requested drive into..
	STA	D$FCB		;..place in destination fcb.
	LDA	R$U$A		;toggle to..
	CALL	SET$USR		;..requested user area.
	LDA	MFLAG		;auto-erase..
	ORA	A		;..if..
	JZ	COPY4M		;..in mass-copy mode.
	LXI	D,D$FCB		;search for duplicate
	MVI	C,SRCHF		; 'search first' function
	CALL	BDOS
	INR	A		;if not found, 0ffh --> 00h.  then..
	JZ	COPY5		;go to 'make' function for new file.
	CALL 	BLBLNK
	CALL	ILPRT		;if found, ask to replace:
	DB	CR,LF,' ---> Copy exists, erase? (Y/N): ',0
	CALL	NORM
	CALL	KEYIN		;get answer
	CPI	'Y'		;if yes, then..
	JZ	COPY4M		;..delete and overlay.
	LDA	C$U$A		;reset to..
	CALL	SET$USR		;..current user area.
	JMP	FORWARD		;if re-copy not wanted, to next position.

COPY4M	LXI	D,D$FCB		;delete file already existing
	MVI	C,ERASE		;erase function
	CALL	BDOS
COPY5	LXI	D,D$FCB		;create new file and open for writing
	MVI	C,MAKE		;make function
	CALL	BDOS
	INR	A		;if directory full, 0ffh --> 00h.
	JNZ	COPY6		;if not, branch.
	CALL	ILPRT
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ Destination Directory Full ++',0
	CALL	NORM
	CALL	ILPRT
	DB	CR,LF,0
	JMP	NEUTRAL		;if error, back to ring processor.

COPY6	MVI	B,8		;show filename and..
	LXI	H,D$FCB+1
	LXI	D,COPYMFN
	CALL	MOVE
	INX	D
	MVI	B,3		;..filetype during copy.
	CALL	MOVE
	LDA	FIRST$M		;if 1st time thru mass-copy..
	ORA	A		;..mode, add..
	MVI	A,LF		;..a line feed.
	CZ	TYPE
	CALL	CLR$L		;clear line
	CALL	BOLD
	CALL	ILPRT
	DB	CR,' ---> Copying file    ',0
	CALL    BLBLNK
	CALL    ILPRT
COPYMFN	DB	'        .    ',0
	CALL	NORM
	XRA	A		;clear 'eof'..
	STA	EOFLAG		;..flag.
COPY6A	LDA	C$U$A		;reset user area..
	CALL	SET$USR		;..to current.
	LXI	H,0		;clear current-record..
	SHLD	REC$CNT		;..counter.
	LHLD	BUFSTART	;set buffer start pointer..
	SHLD	BUF$PT		;..to begin pointer.

; read source file -- fill buffer memory or stop on 'eof' -- update 'crc'
; on-the-fly

COPY7	LHLD	BUF$PT		;set dma address to buffer pointer
	XCHG			; de-pair --> dma address
	MVI	C,SETDMA
	CALL	BDOS
	LXI	D,S$FCB		;source 'fcb' for reading
	MVI	C,READ		;record read function
	CALL	BDOS
	ORA	A		; 00h --> read okay
	JZ	S$RD$OK
	DCR	A		;eof?
	JZ	COPY8		;yes, end-of-file, set 'eof' flag.
	CALL	ILPRT
	DB	'      ',0
	CALL 	RVBLNK
	CALL	ILPRT
	DB	'++ SOURCE READ ERROR ++',0
	CALL	NORM
	CALL	ILPRT
	DB	CR,LF,BELL,0
	JMP	NEUTRAL

S$RD$OK	LHLD	BUF$PT
	MVI	B,128
COPY7A	MOV	A,M		;get character and..
	CALL	UPDCRC		;..add to 'crc' value.
	INX	H
	DCR	B
	JNZ	COPY7A		;loop 'till record read finished
	LHLD	BUF$PT		;bump buffer pointer..
	LXI	D,128		;..by..
	DAD	D		;..one..
	SHLD	BUF$PT		;..record.
	LHLD	REC$CNT		;bump buffer..
	INX	H		;..record count and..
	SHLD	REC$CNT		;..store.
	XCHG			;ready to compare to..
	LHLD	REC$MAX		;..maximum record count (full-buffer).
	CALL	CMPDEHL		;compare
	JNZ	COPY7    	;if not full, get next record.
	JMP	COPY9		;full, start first write session.

; indicate end-of-file read

COPY8	MVI	A,TRUE		;set 'eof' flag
	STA	EOFLAG

; write 'read-file' from memory buffer to destination 'written-file'

COPY9	LDA	R$U$A		;set user to requested..
	CALL	SET$USR		;..area.
	LHLD	BUFSTART	;adjust buffer pointer..
	SHLD	BUF$PT		;..to start address.
COPY10	LHLD	REC$CNT		;buffer empty?
	MOV	A,H
	ORA	L
	JZ	COPY11		;buffer empty, check 'eof' flag.
	DCX	H		;dec buffer record count for each write
	SHLD	REC$CNT
	LHLD	BUF$PT		;set up dma address
	PUSH	H		;save for size bump
	XCHG			;pointer in de-pair
	MVI	C,SETDMA
	CALL	BDOS
	POP	H
	LXI	D,128		;bump pointer one record length
	DAD	D
	SHLD	BUF$PT
	LXI	D,D$FCB		;destination file 'fcb'
	MVI	C,WRITE		;write record function
	CALL	BDOS
	ORA	A   		; 00h --> write okay
	JZ	COPY10		;okay, do next record.  else..
	CALL	ILPRT		;..say disk write error.
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ COPY DISK FULL ++',0
	CALL	NORM
	CALL 	ILPRT
	DB	CR,LF,BELL,0
C$ERA	LXI	D,D$FCB		;delete..
	MVI	C,ERASE		;..partial..
	CALL	BDOS		;..from directory.
	XRA	A      		;reset 1st-time-thru tag flag..
	STA	FIRST$M		;..for continuation of mass copying.
	JMP	NEUTRAL		;back to ring

COPY11	LDA	EOFLAG		;buffer all written, check for 'eof'.
	ORA	A
	JZ	COPY6A		;branch to read next buffer full
	LXI	D,D$FCB		;point at 'fcb' for file closure
	MVI	C,CLOSE
	CALL	BDOS
	INR	A		;if no-close-error then..
	JNZ	CRC$CMP		;..compare file crc's.
	CALL	ILPRT
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ COPY CLOSE ERROR ++',0
	CALL	NORM
	CALL 	ILPRT
	DB	CR,LF,BELL,0
	JMP	C$ERA

; read destination 'written-file' and compare crc's

CRC$CMP	LHLD	CRCVAL		;transfer 'crc' value to..
	SHLD	CRCVAL2		;..new storage area.
	LXI	H,0		;clear working storage..
	SHLD	CRCVAL		;..to continue.
	LXI	D,TBUF
	MVI	C,SETDMA
	CALL	BDOS
	LXI	H,D$FCB+12
	CALL	INITFCB
	LXI	D,D$FCB
	MVI	C,OPEN
	CALL	BDOS
	INR	A		; 0ffh --> 00h if bad open
	JZ	BADCRC		;if bad open, just say 'bad-crc'.
	XRA	A		;zero 'fcb'..
	STA	D$FCB+32	;..'cr' field.
CRCWF1	LXI	D,D$FCB
	MVI	C,READ
	CALL	BDOS
	ORA	A		;read okay?
	JZ	D$RD$OK		;yes, read more.
	DCR	A		;eof?
	JZ	FINCRC		;yes, finish up and make 'crc' comparison.
	CALL	ILPRT
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB	'++ COPY READ ERROR ++',0
	CALL	NORM
	CALL	ILPRT
	DB	CR,LF,BELL,0
	JMP	NEUTRAL

D$RD$OK	LXI	H,TBUF
	MVI	B,128
CRCWF2	MOV	A,M		;get character to..
	CALL	UPDCRC		;..add to 'crc' value. 
	INX	H
	DCR	B
	JNZ	CRCWF2
	JMP	CRCWF1

; crc subroutines

; initialize tables for fast crc calculations

INITCRC	LXI	H,CRCTBL
	MVI	C,0		;table index
GLOOP	XCHG
	LXI	H,0		;initialize crc register pair
	MOV	A,C
	PUSH	B		;save index in c-reg
	MVI	B,8
	XRA	H
	MOV	H,A
LLOOP	DAD	H
	JNC	LSKIP
	MVI	A,10H		;generator is x^16 + x^12 + x^5 + x^0 as..
	XRA	H		;..recommended by ccitt for asynchronous..
	MOV	H,A		;..communications.  produces the same..
	MVI	A,21H		;..results as public domain programs..
	XRA	L		;..chek, comm7, mdm7, and modem7.
	MOV	L,A
LSKIP	DCR	B
	JNZ	LLOOP
	POP	B
	XCHG			;de-pair now has crc, hl pointing into table.
	MOV	M,D		;store high byte of crc..
	INR	H
	MOV	M,E		;..and store low byte.
	DCR	H
	INX	H		;move to next table entry
	INR	C		;next index
	JNZ	GLOOP
	RET

UPDCRC	PUSH	B		;update 'crc'..
	PUSH	H		;..accumulator..
	LHLD	CRCVAL		;pick up partial remainder
	XCHG			;de-pair now has partial
	MVI	B,0
	XRA	D
	MOV	C,A
	LXI	H,CRCTBL
	DAD	B
	MOV	A,M
	XRA	E
	MOV	D,A
	INR	H
	MOV	E,M
	XCHG
	SHLD	CRCVAL
	POP	H
	POP	B
	RET

FINCRC	LDA	C$U$A		;reset user from 'requested'..
	CALL	SET$USR		;..to 'current' area.
	LHLD	CRCVAL		;put written-file 'crc' into..
	XCHG			;..de-pair.
	LHLD	CRCVAL2		;put read-file 'crc' and..
	CALL	CMPDEHL		;..compare 'de/hl' for equality.
	JNZ	BADCRC		;if not zero, show copy-error message.
	CALL 	BOLD
	CALL	ILPRT		;if zero, show 'verified' message.
	DB	'      CRC verified',CR,LF,0
	CALL	NORM
	LDA	MFLAG		;if not mass-copy mode, return..
	ORA	A		;..to next 'ring' position.
	JNZ	FORWARD		;else..
	CMA			;..set 1st-time-thru flag..
	STA	FIRST$M		;..and..
	JMP	M$LP		;..get next file to copy, if one.
 
BADCRC	CALL	ILPRT
	DB	'      ',0
	CALL	RVBLNK
	CALL	ILPRT
	DB 	'++ Error on CRC compare ++',0
	CALL	NORM
	CALL	ILPRT
	DB	CR,LF,BELL,0
	JMP	FORWARD		;move to next 'ring' position

; w o r k h o r s e   r o u t i n e s

; inline print of message

ILPRT	XTHL			;save hl, get msg pointer.
ILPLP	MOV	A,M		;get character
	ANI	7FH		;strip type bits
	CALL	TYPE		;show on console
	INX	H		;point to the next character and..
	MOV	A,M
	ORA	A		;..test for end-of-text.
	JNZ	ILPLP
	XTHL			;set hl-pair and..
	RET			;..return past message.

; clear console crt screen

CLS	CALL	ILPRT		;Rainbow 100 esc sequences to clear screen
     	DB	RAIN1,RAIN2,RAIN3,RAIN4,RAIN1,RAIN2,RAIN5,0
	RET
NORM	CALL	ILPRT
	DB	RAIN1,RAIN2,RAIN6,RAIN11,0
	RET
BOLD	CALL	ILPRT
	DB	RAIN1,RAIN2,RAIN7,RAIN11,0
	RET
RVRSE	CALL	ILPRT
	DB	RAIN1,RAIN2,RAIN9,RAIN10,RAIN7,RAIN11,0
	RET
RVBLNK	CALL	ILPRT
	DB	RAIN1,RAIN2,RAIN9,RAIN10,RAIN7,RAIN10,RAIN8,RAIN11,0
	RET
BLBLNK  CALL	ILPRT
	DB	RAIN1,RAIN2,RAIN7,RAIN10,RAIN8,RAIN11,0
	RET

LFLP	MVI	A,LF
	CALL	TYPE
	DCR	B		;count-down b-reg --> zero
	JNZ	LFLP
	RET

; output 'crlf' to console

CRLF	MVI	A,CR
	CALL	TYPE
	MVI	A,LF

; conout routine (re-entrant)

TYPE	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	MOV	E,A
	MVI	C,WRCON
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

; crt clear-line function

CLR$L	MVI	A,CR
	CALL	TYPE
	MVI	B,30		;blank # of characters on line
	MVI	A,' '
CL$LP	CALL	TYPE
	DCR	B
	JNZ	CL$LP
	RET

; conin routine (waits for response)

KEYIN	MVI	C,RDCON
	CALL	BDOS

; convert character in a-reg to upper case

UCASE	CPI	61H		;less than small 'a'?
	RC			;if so, no convert needed.
	CPI	7AH+1		; >small 'z'?
	RNC			;if so, ignore.
	ANI	5FH		;otherwise convert
	RET

; direct console input w/o echo (waits for input)

DKEYIN	MVI	C,DIRCON	;cp/m function 6
	MVI	E,0FFH
	CALL	BDOS
	ORA	A
	JZ	DKEYIN
	RET

; convert keyboard input to upper case

CONVERT	LXI	H,CMDBUF+1	; 'current keyboard buffer length'..
	MOV	B,M		;..to b-reg.
	MOV	A,B
	ORA	A		;if zero length, skip conversion.
	JZ	COMCAN
CONVLP	INX	H		;point at character to capitalize
	MOV	A,M
	CALL	UCASE
	MOV	M,A		;put back into buffer
	DCR	B
	JNZ	CONVLP
	RET

; fill buffer with 'spaces' with count in b-reg

FILL	MVI	M,' '		;put in space character
	INX	H
	DCR	B		;count done?
	JNZ	FILL		;no, branch.
	RET

; ignore leading spaces (ls) in buffer, length in c-reg.

UNSPACE	LDAX	D		;get character
	CPI	' '
	RNZ			;not blank, a file is entered.
	INX	D		;to next character
	DCR	C
	JZ	COMCAN		;all spaces --> command recovery error
	JMP	UNSPACE

; check for legal cp/m filename character -- return with carry set if illegal

CKLEGAL	LDAX	D		;get character from de-pair
	INX	D		;point at next character
	CPI	' '		;less than space?
	RC			;return carry if unpermitted character
	PUSH	H
        PUSH	B
	CPI	'['		;if greater than 'z', exit with..
	JNC	CKERR		;..carry set.
	MVI	B,8
	LXI	H,CHR$TBL
CHR$LP	CMP	M  
	JZ	CKERR
	INX	H
	DCR	B
	JNZ	CHR$LP
	ORA	A		;clear carry for good character
	POP	B
	POP	H
	RET

CKERR	POP	B
	POP	H
	STC	     		;error exit with carry set
	RET

CHR$TBL	DB	'*',',',':',';','<','=','>','?'	;invalid character table

; filename from 'ring' to 'sfcb'

RINGFCB	LHLD	RINGPOS		;move name from ring to source 'fcb'
	LXI	D,-13		;subtract 13 to..
	DAD	D		;..point to name position.
	LXI	D,S$FCB		;place to move filename and..
	MVI	B,12		;..amount to move.

; move subroutine -- move b-reg # of bytes from hl-pair to de-pair

MOVE	MOV	A,M		;get hl-pair referenced source byte
	ANI	7FH		;strip cp/m 2.x attributes
	STAX	D		;put to de-pair referenced destination
	INX	H		;fix pointers for next search
	INX	D
	DCR	B		;dec byte count and see if done
	JNZ	MOVE
	RET

; initialize 'fcb' cp/m system fields (entry with hl-pair pointing to 'fcb')

INITFCB	MVI	B,4		;fill ex, s1, s2, rc counters with zeros.
INITLP	MVI	M,0		;put zero (null) in memory
	INX	H
	DCR	B
	JNZ	INITLP
	RET

; disk system reset -- login requested drive

RESET	MVI	C,INQDISK	;determine and..
	CALL	BDOS		;..save..
	STA	C$DR		;..current drive.
	MVI	C,RESETDK	;reset system
	CALL	BDOS
	LDA	R$DR		;make requested drive..
SET$DR	MOV	E,A		;..current.
	MVI	C,LOGIN
	JMP	BDOS		;return to caller

; set/reset (or get) user area (call with binary user area in a-reg)

SET$USR	MOV	E,A		; 0 --> 0, 1 --> 1, etc.
GET$USR	MVI	C,SGUSER
	JMP	BDOS		;return to caller

; compare de-pair to hl-pair and set flags accordingly

CMPDEHL	MOV	A,D		;see if high bytes set flags
	CMP	H
	RNZ			;return if not equal
	MOV	A,E
	CMP	L		;low bytes set flags instead
	RET

; shift hl-pair b-reg bits (-1) to right (divider routine)

SHIFTLP	DCR	B
	RZ
	MOV	A,H
	ORA	A
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	JMP	SHIFTLP

; decimal pretty print (h-reg contains msb; l-reg, the lsb.)

DECOUT	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10		;radix
	LXI	D,-1
DECOU2	DAD	B		;sets..
	INX	D
	JC	DECOU2		;..carry.	
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOUT		; (recursive)
	MOV	A,E
	ADI	'0'		;make ascii
	CALL	TYPE
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

; determine # of bcd digits in hl-pair -- place # in b-reg

DET$BCD	LXI	D,9		;test for less than 10
	CALL	CMPDEHL		;compare and..
	MVI	B,1		; (one bcd digit)
	RNC    			;..return if not carry.
	MVI	E,99		;less than 100?
	CALL	CMPDEHL
	MVI	B,2
	RNC
	LXI	D,999		; <1000?
	CALL	CMPDEHL
	MVI	B,3
	RNC
	MVI	B,4		;assume >999  (4 digits)
	RET

; determine free storage remaining on selected drive

FRESTOR	MVI	C,INQDISK	;determine current drive
	CALL	BDOS		;returns 0 as a:, 1 as b:, etc.
	INR	A		;make 1 --> a:, 2 --> b:, etc.
	STA	FCB
	ADI	'A'-1		;make printable and..
	STA	DRNAME		;..use as drive designator.
	MVI	C,GETPARM	;current disk parameter block
	CALL	BDOS
	INX	H		;bump to..
	INX	H
	MOV	A,M		;..block shift factor.
	STA	BSHIFTF		; 'bsh'
	INX	H		;bump to..
	MOV	A,M		;..block mask.
	STA	B$MASK		; 'blm'
	INX	H		;bump to..
	INX	H		;..get..
	MOV	E,M		;..maximum block number..
	INX	H		;..double..
	MOV	D,M		;..byte.
	XCHG
	SHLD	B$MAX		; 'dsm'
	MVI	C,INQALC	;address of cp/m allocation vector
	CALL	BDOS
	XCHG			;get its length
	LHLD	B$MAX
	INX	H
	LXI	B,0		;initialize block count to zero
GSPBYT	PUSH	D		;save allocation address
	LDAX	D
	MVI	E,8		;set to process 8 bits (blocks)
GSPLUP	RAL			;test bit
	JC	NOT$FRE
	INX	B
NOT$FRE	MOV	D,A		;save bits
	DCX	H
	MOV	A,L
	ORA	H    
	JZ	END$ALC		;quit if out of blocks
	MOV	A,D		;restore bits
	DCR	E		;count down 8 bits
	JNZ	GSPLUP		;branch to do another bit
	POP	D		;bump to next count..
	INX	D		;..of allocation vector.
	JMP	GSPBYT		;process it

END$ALC	POP	D		;clear alloc vector pointer from stack
	MOV	L,C		;copy # blocks to hl-pair
	MOV	H,B
	LDA	BSHIFTF		;get block shift factor
	SUI	3		;convert from sectors to thousands (k)
	JZ	PRT$FRE		;skip shifts if 1k blocks
FREK$LP	DAD	H		;multiply blocks by k-bytes per block
	DCR	A		;multiply by 2, 4, 8, or 16.
	JNZ	FREK$LP
PRT$FRE	CALL    BOLD
	CALL 	DECOUT		; # of free k-bytes in hl-pair
	CALL	ILPRT
	DB	'k bytes free on drive '
DRNAME	DB	' :',CR,LF,'   ',0
	CALL	NORM
	RET

; s t o r a g e

; initialized

JOKER	 DB	'???????????'	; *.* equivalent
J$FLG	 DB	TRUE		;default jump 22-files command flag
FIRST$M	 DB	FALSE		; 1st time thru in mass-copy mode
MFLAG	 DB	TRUE		;multiple file copy flag --> 0 for mass copy
TAG$TOT	 DW	0		;summation of tagged file sizes
CMDBUF	 DB	32,0		;command buffer maximum length, usage, and..

; uninitialized

	 DS	100		;..storage for buffer and local stack.
STACK	 DS	2		;cp/m's stack pointer stored here
B$MAX	 DS	2		;highest block number on drive
B$MASK	 DS	1		;sec/blk - 1
BSHIFTF	 DS	1		; # of shifts to multiply by sec/blk
BUF$PT	 DS	2		;copy buffer current pointer..
BUFSTART DS	2		;..and begin pointer.
CANFLG	 DS	1		;no-file-found cancel flag
C$DR	 DS	1		; 'current drive'
CON$LST	 DS	1		;bdos function storage
CRCTBL	 DS	512		;tables for 'crc' calculations
CRCVAL	 DS	2		; 2-byte 'crc' value of working file and..
CRCVAL2	 DS	2		;..of finished source read-file.
C$U$A	 DS	1		; 'current user area'
D$FCB	 DS	33		;fcb for destination file/new name if rename
EOFLAG	 DS	1		;file copy loop 'eof' flag
FS$FLG	 DS	1		;tag total versus file size flag
J$CNT	 DS	1		;jump forward file counter
LPSCNT	 DS	1		;lines-per-screen for 'view'
O$USR	 DS	1		;store initial user area for exit
R$DR	 DS	1		; 'requested drive'
RCNT	 DS	2		; # of records in file and..
REC$CNT	 DS	2		;..currently in ram buffer.
REC$MAX	 DS	2		;maximum 128-byte record capacity of buffer
RINGI	 DS	2		;ring sort pointer
RINGJ	 DS	2		;another ring sort pointer
RINGEND	 DS	2		;current ring end pointer
RINGPOS	 DS	2		;current ring position in scan
R$U$A	 DS	1		; 'requested user area'
S$FCB	 DS	36		;fcb for source (random record) file
TEST$RT	 DS	1		;intermediate right-justify data
T$UN$FG	 DS	1		;tag/untag file summation switch
VIEWFLG	 DS	1		; 00h --> to list/punch else to crt 'view'
 
; cp/m system functions

RDCON	EQU	1		;console input function
WRCON	EQU	2		;write character to console..
PUNCH	EQU	4		;..punch and..
LIST	EQU	5		;..to list logical devices.
DIRCON	EQU	6		;direct console i/o
RDBUF	EQU	10		;read input string
CONST	EQU	11		;get console status
RESETDK	EQU	13		;reset disk system
LOGIN	EQU	14		;log-in new drive
OPEN	EQU	15		;open file
CLOSE	EQU	16		;close file
SRCHF	EQU	17		;search directory for first..
SRCHN	EQU	18		;..and next occurrence.
ERASE	EQU	19		;erase file
READ	EQU	20		;read and..
WRITE	EQU	21		;..write 128-record.
MAKE	EQU	22		;make file
REN	EQU	23		;rename file
INQDISK	EQU	25		;get current (default) drive
SETDMA	EQU	26		;set dma address
INQALC	EQU	27		;allocation vector
GETPARM	EQU	31		;current drive parameters address
SGUSER	EQU	32		;set or get user area
COMPSZ	EQU	35		; # of records in file

; system addresses

BDOS	 EQU	CPM$BASE+05H	;bdos function entry address
FCB	 EQU	CPM$BASE+5CH	;default file control block
FCBEXT	 EQU	FCB+12      	;extent byte in 'fcb'
FCBRNO	 EQU	FCB+32		;record number in 'fcb'
TBUF	 EQU	CPM$BASE+80H	;default cp/m buffer

; assembled 'com' and 'ram-loaded' file size (0c00h = 3k)

COMFILE	 EQU	(CMDBUF+2)-256	; 'prn' listing shows 'com'..
LAST	 END	SOURCE		;..and loaded file size.
