; SLTRAP RCP
;  By Paul Pomerleau
;  January 13, 1986.
;
;  This RCP traps all output going to the console or the printer 
; and deposits it into a file.  Trapping starts with:
;   'SOPEN filename.typ'  (or LOPEN)
; and ends with:
;   'SCLOSE' (or LCLOSE)
;
;  This code assembles with ZASM (Cromemco) ONLY!
;
;  Maybe someday I (or someone else) will comment this better,
; clean up the code (It's very wasteful).  For now, please except
; my apologies.

VERS	equ	12
BDOS	equ	5

*INCLUDE1	Z3BASE.LIB	; USE BASE ADDRESSES

;
;  SYSTEM Entry Point
;
	org	RCP		; passed for Z3BASE
	db	'Z3RCP'		; Flag for Package Loader
	db	06		; How long each name is
CTAB:
	db	'H     '	; Help for RCP
	dw	CLIST
	db	'SOPEN '
	dw	OPEN
	db	'LOPEN '
	dw	LOPEN
	db	'KEY   '
	dw	KEY
	db	'SCLOSE'
	dw	CLOSE
	db	'LCLOSE'
	dw	LCLOSE
CTAB1:
	db	0
;
;  Banner Name of Rcp:
;  Command List Routine
;
CLIST:
	ld	de,RCP$NAME
	jp	STRING

;
; Routines for SCR-TRAPing.  From here to end, all is neccessary.
;
ORIGNAME	equ	5ch
ONKEY		equ	'\' - '@'
;
KEY:	ld	de,KEYSTR
	call	STRING		; Print msg
GETKEY:	ld	e,0ffh
	call	DCIO		; Bring in a key
	or	a
	jr	z,GETKEY	; Keep at it 'till we get a key
	ld	(KEYON + 1),a	; Save key
	bit	7,a
	jr	z,NOTHIGH	; Check for high bit
	push	af
	ld	e,'~'		; Print a ~
	call	DCIO
	pop	af
NOTHIGH:
	and	01111111b	; Remove high bit
	cp	' '
	jr	nc,NOTCTRL	; Check for control char
	push	af
	ld	e,'^'		; Print a '^'
	call	DCIO
	pop	af
	add	a,'@'		; Make normal char
NOTCTRL:
	ld	e,a
	jp	DCIO		; Print it

OPEN:	ld	a,(OPENFLG)	; Check to see if a file is already open
	or	a
	jr	z,CONTOPEN	; No
	ld	de,ALREADY	; Yes, print and abort
	jp	STRING
CONTOPEN:
	ld	hl,FILE
	ld	de,FILE + 1
	ld	bc,35
	xor	a
	ld	(hl),a		; Zap the whole FCB
	ldir
	ld	hl,ORIGNAME
	ld	de,FILE
	ld	bc,13
	ldir			; Move file name to protected memory
	ld	a,'?'
	ld	bc,0bh
	ld	hl,FILE + 1
	cpir			; Check entire name for ambiguity
	jr	z,AMBIG
	
	ld	a,(5ch)
	or	a
	jr	nz,STOREU
	ld	c,25
	call	BDOS
	inc	a
	ld	(FILE),a
STOREU:	ld	hl,5ch + 13	; Get user number
	ld	a,(hl)
	ld	(UNUM + 1),a	; Store it to user routine

	call	TOU		; Go to proper user #
	ld	c,13h
	call	FCBBDOS
	ld	c,16h
	call	FCBBDOS
	ld	c,16h
	inc	a		;  0ffh = No room
	jp	z,FULL		; No good?  Then abort

	ld	de,OPENMSG
	call	STRING

	ld	hl,BUFFER
	ld	(POINTER),hl	; POINTER => first char of BUFFER
	xor	a
	ld	(ON),a
	ld	(COUNTER),a

	ld	hl,(1)		; Get BOOT location
	ld	de,0ah		; Offset for JP <LOCATON>
	add	hl,de
	ld	(JCON),hl	; Save location for JP to CONSOLE OUT
	ld	e,(hl)
	inc	hl
	ld	d,(hl)		; Move to de
	ld	(CON),de	; Save DE
	ld	de,NEWOUT
	ld	(hl),d
	dec	hl
	ld	(hl),e		; Fill our NEWOUT location in

	ld	hl,(1)		; Get BOOT location
	ld	de,07h		; Offset for JP <LOCATON>
	add	hl,de
	ld	(JCONIN),hl	; Save location for JP to CONSOLE IN
	ld	e,(hl)
	inc	hl
	ld	d,(hl)		; Move to de
	ld	(CONIN),de	; Save DE
	ld	de,NEWIN
	ld	(hl),d
	dec	hl
	ld	(hl),e		; Fill our NEWOUT location in

	call	SETBDOS

	ld	a,0ffh
	ld	(OPENFLG),a	; Show that there is a S file open

	jp	BACKU		; Come back to normal U

AMBIG:	ld	de,AMBIGSTR
	jp	STRING		; Print the message

NEWIN:	call	ORIGIN		; Bring key in
KEYON:	cp	ONKEY		; Is it the trigger key?
	ret	nz
	ld	a,(ON)
	cpl
	ld	(ON),a		; Flip On to Off or Off to On
	jp	ORIGIN		; Get a new key

NEWOUT:	push	bc
	call	ORIGOUT		; Print the char
	pop	bc
	ld	a,(ON)		; Are we in trap mode?
	or	a
	ret	z
	ld	a,c
	cp	26		; EOF?
	ret	z
NOUT2:	push	hl
	ld	hl,(POINTER)	; Consider BUFFER point
	ld	(hl),c		; Store the Char
	inc	hl		; Go to next char in buffer
	ld	(POINTER),hl	; Save that point
	pop	hl
	ld	a,(COUNTER)	; Consider # of chars in buffer
	inc	a
	cp	80h		; Time to write?
	jr	z,WRITE
	ld	(COUNTER),a	; Save counter
	ret

WRITE:	ld	a,(BDOSFLG)
	or	a
	jr	z,DOWRITE
	ld	(PEND),a
	push	hl
	push	de
	push	bc
	ld	hl,BUFFER
	ld	(POINTER),hl
	ld	de,BUFF2
	ld	bc,128
	ldir
	xor	a
	ld	(COUNTER),a
	pop	bc
	pop	de
	pop	hl
	ret
DOWRITE:
	push	hl
	call	TOU		; Go to file's user number
	ld	c,26		; Set dma
	ld	de,BUFFER	; At buffer
	call	BDOSCALL
	xor	a
	ld	(COUNTER),a	; No chars (start fresh)
	ld	hl,BUFFER
	ld	(POINTER),hl	; No chars in buffer
	ld	c,21		; Write sequential
	call	FCBBDOS
	pop	hl
	or	a
	jr	nz,FULL		; No good, write msg
	jp	BACKU		; Come back to normal U ;~

FINISH:
	push	hl
	call	TOU		; Go to file's user number
	ld	c,26		; Set dma
	ld	de,BUFF2	; At buffer
	call	BDOSCALL
	ld	c,21		; Write sequential
	call	FCBBDOS
	pop	hl
	or	a
	jr	nz,FULL		; No good, write msg
	jr	BACKU		; Come back to normal U

FULL:	call	BACKU		; Come back to normal U
	ld	de,FULLMSG
	jp	STRING

CLOSE:	ld	a,(OPENFLG)	; Is there really a file open?
	or	a
	jr	nz,CONTCLOSE	; Yes, Skip
	ld	de,NONE		; No
	jp	STRING
CONTCLOSE:
	call	CLRBDOS

	xor	a
	ld	(OPENFLG),a	; Save fact that there is no file open

	ld	hl,(JCONIN)	; Get place to restore
	ld	de,(CONIN)	; Get location that LISTST should JP to
	ld	(hl),e
	inc	hl
	ld	(hl),d		; Put in a JP and the location

	ld	hl,(JCON)	; Place to restore
	ld	de,(CON)	; Location to JP to
	ld	(hl),e
	inc	hl
	ld	(hl),d		; Put into place

	call	TOU		; Go to proper user #
	ld	c,26		; Write an end of file
	call	NOUT2
	ld	a,(COUNTER)	; Was buffer just written?
	or	a
	jr	z,DONTWRITE	; Yes, don't write
	ld	c,26
	ld	de,BUFFER
	call	BDOSCALL	; Set DMA to BUFFER
	ld	c,21
	call	FCBBDOS		; Write sequential
DONTWRITE:
	ld	c,16
	call	FCBBDOS		; Close file
	inc	a
	jr	z,FULL		; No?  Print msg.
	ld	de,CLOSEMSG
	call	STRING
	jr	BACKU		; Come back to normal U

STRING:	ld	c,9
	jp	BDOS
FCBBDOS:
	ld	de,FILE
	jp	BDOS

TOU:	ld	e,0ffh
	call	USER		; Get current user number
	ld	(CURU),a	; Store it
UNUM:	ld	e,00
	jp	USER		; Set to file's
BACKU:	ld	c,26
	ld	de,(DMA)
	call	BDOSCALL
	ld	a,(CURU)	; Get current user number
	ld	e,a
	jp	USER		; Go to it

;;;;;;;;;;;;;;; HACK, HEW, CUT, RIP!

LOPEN:	ld	a,(LOPENFLG)	; Check to see if a file is already open
	or	a
	jr	z,LCONTOPEN	; No
	ld	de,ALREADY	; Yes, print and abort
	jp	STRING
LCONTOPEN:
	ld	hl,LFILE
	ld	de,LFILE + 1
	ld	bc,35
	xor	a
	ld	(hl),a		; Zap the whole FCB
	ldir
	ld	hl,ORIGNAME
	ld	de,LFILE
	ld	bc,13
	ldir			; Move file name to protected memory
	ld	a,'?'
	ld	bc,0bh
	ld	hl,LFILE + 1
	cpir			; Check entire name for ambiguity
	jp	z,AMBIG
	
	ld	a,(5ch)
	or	a
	jr	nz,LSTOREU
	ld	c,25
	call	BDOS
	inc	a
	ld	(LFILE),a
LSTOREU:	ld	hl,5ch + 13	; Get user number
	ld	a,(hl)
	ld	(LUNUM + 1),a	; Store it to user routine

	call	LTOU		; Go to proper user #
	ld	c,13h
	call	LFCBBDOS	; Delete file
	ld	c,16h
	call	LFCBBDOS	; Create file
	inc	a		;  0ffh = No room
	jp	z,LFULL		; No good?  Then abort

	ld	de,OPENMSG
	call	STRING

	ld	hl,LBUFFER
	ld	(LPOINTER),hl	; POINTER => first char of BUFFER
	xor	a
	ld	(LCOUNTER),a

	ld	hl,(1)		; Get BOOT location
	ld	de,0dh		; Offset for JP <LOCATON>
	add	hl,de
	ld	(JLIST),hl	; Save location for JP to list
	ld	e,(hl)
	inc	hl
	ld	d,(hl)		; Move to de
	ld	(LIST),de	; Save DE
	ld	de,NLOUT
	ld	(hl),d
	dec	hl
	ld	(hl),e		; Fill our NLOUT location in
	ld	hl,(1)		; Get BOOT address, again
	ld	de,2ah		; Offset for <JP> LOCATON
	add	hl,de
	ld	(JLISTST),hl	; Save JP LISTST location
	ld	(hl),3eh	; LD A,
	inc	hl
	ld	e,(hl)
	ld	(hl),0ffh	; 0ffh
	inc	hl
	ld	d,(hl)
	ld	(hl),0c9h	; RET instruction
	ld	(LISTST),de	; Save Location for JP
	call	SETBDOS
	ld	a,0ffh
	ld	(LOPENFLG),a	; And register the fact
	jp	LBACKU		; Come back to normal U

NLOUT:
	ld	a,c
	cp	26
	ret	z
ZNLOUT:	ld	hl,(LPOINTER)	; Consider BUFFER point
	ld	(hl),c		; Store the Char
	inc	hl		; Go to next char in buffer
	ld	(LPOINTER),hl	; Save that point
	ld	a,(LCOUNTER)	; Consider # of chars in buffer
	inc	a
	cp	80h		; Time to write?
	jr	z,LWRITE
	ld	(LCOUNTER),a	; Save counter
	ret

LWRITE:	xor	a
	ld	(LCOUNTER),a	; No chars (start fresh)
	ld	hl,LBUFFER
	ld	(LPOINTER),hl	; No chars in buffer
	ld	a,(BDOSFLG)
	or	a
	jr	z,LDOWRITE
	ld	(LPEND),a
	ret
LDOWRITE:
	call	LTOU		; Go to file's user number
	ld	c,26		; Set dma
	ld	de,LBUFFER	; At buffer
	call	BDOSCALL
	ld	c,21		; Write sequential
	call	LFCBBDOS
	or	a
	jr	nz,LFULL	; No good, write msg
	jr	LBACKU		; Come back to normal U

LFULL:	call	LBACKU		; Come back to normal U
	ld	de,FULLMSG
	jp	STRING

LCLOSE:	ld	a,(LOPENFLG)	; Is there really a file open?
	or	a
	jr	nz,LCONTCLOSE	; Yes, Skip
	ld	de,NONE		; No
	jp	STRING
LCONTCLOSE:
	call	CLRBDOS

	xor	a
	ld	(LOPENFLG),a	; Save fact that there is no file open

	ld	hl,(JLISTST)	; Get place to restore
	ld	de,(LISTST)	; Get location that LISTST should JP to
	ld	(hl),0c3h	; JP 
	inc	hl
	ld	(hl),e
	inc	hl
	ld	(hl),d		; Put in a JP and the location

	ld	hl,(JLIST)	; Place to restore
	ld	de,(LIST)	; Location to JP to
	ld	(hl),e
	inc	hl
	ld	(hl),d		; Put into place

	call	LTOU		; Go to proper user #
	ld	c,26		; Write an end of file
	call	ZNLOUT
	ld	a,(LCOUNTER)	; Was buffer just written?
	or	a
	jr	z,LDONTWRITE	; Yes, don't write
	ld	c,26
	ld	de,LBUFFER
	call	BDOSCALL	; Set DMA to BUFFER
	ld	c,21
	call	LFCBBDOS	; Write sequential
LDONTWRITE:
	ld	c,16
	call	LFCBBDOS	; Close file
	inc	a
	jr	z,LFULL		; No?  Print msg.

	ld	de,CLOSEMSG
	call	STRING

	jr	LBACKU		; Come back to normal U

LFCBBDOS:
	ld	de,LFILE
	jp	BDOS

LTOU:	ld	e,0ffh
	call	USER		; Get current user number
	ld	(LCURU),a	; Store it
LUNUM:	ld	e,00
	jp	USER		; Set to file's
LBACKU:	ld	c,26
	ld	de,(DMA)
	call	BDOSCALL
	ld	a,(LCURU)	; Get current user number
	ld	e,a
	jp	USER		; Go to it

LFULLMSG:
	db	'LTRCP Msg: Disk Full.$'

JLIST:	dw	0
LIST:	dw	0
JLISTST:
	dw	0
LISTST:	dw	0
LCURU:	db	0
LOPENFLG:
	db	0
LCOUNTER:
	db	0
LPOINTER:
	dw	LBUFFER
LFILE:
	ds	36
LBUFFER:
	ds	129

;;;;;;;;;;;;;;;  Paste, Glue, Tape!
;;;;;;;;;;;;;;;  Suction, Damn it, I need more suction!

SETBDOS:
	ld	a,(LOPENFLG)
	ld	hl,OPENFLG
	or	(hl)
	ret	nz
	ld	hl,(6)
	ld	(BDOSCALL + 1),hl
	ld	de,3
	sbc	hl,de
	ld	(6),hl
	ld	(hl),0c3h
	inc	hl
	ld	de,CALLBDOS
	ld	(hl),e
	inc	hl
	ld	(hl),d
	ret

CLRBDOS:
	ld	a,(LOPENFLG)
	ld	hl,OPENFLG
	xor	(hl)
	ret	z
	ld	hl,(BDOSCALL + 1)
	ld	(6),hl
	ret

CALLBDOS:
	ld	a,0ffh
	ld	(BDOSFLG),a
	ld	a,c
	cp	26
	jr	nz,NOTDMA
	ld	(DMA),de
NOTDMA:
	call	BDOSCALL
	push	af
	xor	a
	ld	(BDOSFLG),a
	ld	a,(PEND)
	or	a
	jr	z,P1
	xor	a
	ld	(PEND),a
	call	FINISH
P1:	ld	a,(LPEND)
	or	a
	jr	z,P2
	xor	a
	ld	(LPEND),a
	call	LWRITE
P2:	pop	af
	ret

BDOSCALL:
	jp	0000


USER:	ld	c,32
	jp	BDOS

DCIO:	ld	c,6
	jp	BDOS

OPENMSG:
	db	'File open.$'
CLOSEMSG:
	db	'File closed.$'
RCP$NAME:
	db	'SLTRAP RCP vers ',(vers / 10) + '0'
	db	'.',(vers mod 10) + '0',13,10
	db	'KEY',9,9,'- Change screen trigger key.',13,10
	db	'SOPEN name.typ',9,'- Open a file for screen output.',13,10
	db	'LOPEN name.typ',9,'- Open a file for list output.',13,10
	db	'SCLOSE',9,9,'- Close the screen file.',13,10
	db	'LCLOSE',9,9,'- Close the list file.$'
ALREADY:
	db	'File already open.$'
NONE:	db	'No file open.$'
AMBIGSTR:
	db	'Bad file name.$'
FULLMSG:
	db	'STRCP Msg: Disk Full.$'
KEYSTR:	db	'Trigger key: $'
ORIGOUT:
	db	0c3h	; JP
CON:	dw	0
JCON:	dw	0

ORIGIN:
	db	0c3h	; JP
CONIN:	dw	0
JCONIN:	dw	0

ON:	db	0
CURU:	db	0
PEND:	db	0
LPEND:	db	0
BDOSFLG:
	db	0
OPENFLG:
	db	0
COUNTER:
	db	0
POINTER:
	dw	BUFFER
DMA:	dw	0000
FILE:	ds	36
BUFFER:	ds	129
BUFF2:	ds	128
	END