;test

;
; Joyce screen dump using ESC L n1 n2 to give about 3/4 width dump
;
; program by Cliff Lawson, 1986 Amstrad Consumer Electronics plc.
;
; This is inplemented as a null .COM file with attached RSX that is set
; to renain in memory. It intercepts BOOS function 2 and if an escape
; character is printed then the dump springs into life. Two types of dump
; are supported. ESC O gives a heavy print while ESC P is more of a "draft"
; quality dump. The heavy one works by printing the info, once, performing
; a fractional line feed then overprinting followed by the rest of a conplete
; line feed.
; A new BDOS call 73 (as always) is implemented so that the RSX can be
; removed.
;
; Use  RMAC B:JOYCEDMP $PZSZRM
;      LINK M:JOYCEDMP[OP $SZRB]
;      REN JOYCEDMP.RSX=JOYCEDMP.PRL
;      GENCOM B:JOYCEDMP [NULL]
;

bdos		equ	5
listout 	equ	5
cr		equ	00dh
lf		equ	00ah
esc		equ	27
heavy		equ	'O'
light		equ	'P'
offsetuserf 	equ	87
scrrunroutine 	equ	00e9h
bytesperline 	equ	720
roller		equ	0b600h

	db	0,0,0,0,0,0	; 'ole faithful RSX prefix
	jp	start
next:	db	0c3h
	dw	0		; Next chain entry filled by LOADER
prev:	dw	0		; Previous entry     "    "    "
remov:	db	000h		; Leave in memory
nbank:	db	0		; Not non-banked
	db	'SCRNDMP'
loader:	db	0
	db	0,0

start:	
	ld	a,c
	cp	2
	jp	z,begin
	cp	73
	jp	z,takeaway
	jp	next

takeaway:
	
	ld	a,0ffh
	ld	(remov),a
	ret

begin:	
	ld	a,(flagesc)
	cp	0ffh
	jp	z,contest	; Just had an escape
	ld	a,e
	cp	esc		; Escape O or P Starts dump
	jp	z,setflag
	jp	next		; Nothing to do with us

setflag:
	ld	a,0ffh
	ld	(flagesc),a
	ret

contest:
	ld	a,e
	cp	heavy		; Heavy dump
	jp	z,goforit
	cp	light		; Light dump
	jp	z,goforit
	xor	a
	ld	(flagesc),a	; Forget that last ESC
	push	de
	push	bc
	ld	c,2
	ld	e,esc
	call	next		; But esc wasn't ours so make amends
	pop	bc
	pop	de
	jp	next		; Pass current char down the thain

goforit:
	ld	(dtype),a	; Save 'O' or 'P' that deterwine dump type
	xor	a
	ld	(flagesc),a	; Esc has been used so reset

	ld	hl,0
	add	hl,sp
	ld	(oldstak),hl	; Save CCP stack
	ld	sp,mystak	; Use my own 64 byte stack

	ld	hl,(1)
	ld	de,offsetuserf
	add	hl,de
	ld	(userf+1),hl	; That famous ole routine

	ld	a,esc
	call	prntbyte
	ld	a,'3'
	call	prntbyte
	ld	a,25		; Fiddle factor
	call	prntbyte

	ld	a,0		; Start at line 0
dloop:	
	push	af		; Keep line count safe
dark:	
	push	af		; Save line count while sussin lf setting

	ld	a,(dtype)
	cp	light
	jp	z,fred
	ld	a,esc		; Only set this fractional line feed lf
	call	prntbyte	; We're going to overtype for heavy dump
	ld	a,'3'
	call	prntbyte
	ld	a,2
	call	prntbyte	; Set first line feed to 2/216"
fred:	
	pop	af		; Ok to retrieve line count for grabyte
	ld	bc,grabyte
	call	userf
	dw	scrrunroutine
	call	dumpaline
	ld	a,(dtype)
	cp	light
	jp	z,justone	; If ESC P then dont do line again
	ld	a,esc		; Second pass, lf now to be set to 23/216"
	call	prntbyte
	ld	a,'3'
	call	prntbyte
	ld	a,23		; Previous 2/216 + 23/216 = 25/216
	call	prntbyte
	pop	af
	push	af		; What was that line count ?
	ld	bc,grabyte	; Need to grab bytes cos dump is destructive
	call	userf
	dw	scrrunroutine
	call	dumpaline	; Overtype what's just been printed
justone:
	ld	c,6
	ld	e,0ffh
	call	next		; Attempt to get keyboard char
	cp	0
	jp	nz,pleasereleaseme
	pop	af		; Let's have that line count back again
	inc	a
	cp	32		; Done line 31 yet ?
	jp	nz,dloop
eric:	
	ld	a,(dtype)
	cp	light
	jp	z,dontreset	; Cos it hasn't changed
	ld	a,esc
	call	prntbyte
	ld	a,'2'		; Set line feed Back to 1/6"
	call	prntbyte
dontreset:
	
	ld	hl,(oldstak)	; Let Mr. CCP have his own stack back
	ld	sp,hl
	ret			; An ave it away an our toes

pleasereleaseme:
	
	pop	af		; Don't you just luv a bit of structure ?
	jp	eric

;=======
grabyte:
;=======
;
; Go get one lines worth of bytes fror screen memory
;
; entry : a contains the character line number
; exit  : all corrupt
;
	ld	e,a
;
;The following is a routine whith already sits in common memory
; and is executed by scr_run_routine
;
; this routine courtesy Roland Perry
;
; entry conditions:
;
;    e=line number
;
docommon:
	ld	hl,buffer
	push	hl
	ld	h,0
	ld	l,e		; Hl=e
	add	hl,hl		; Hl=2*e
	add	hl,hl		; Hl=4*e
	add	hl,hl		; Hl=8*e
	add	hl,hl		; Hl=16*e
	ld	de,roller	; That mysterious region of the universe
	add	hl,de		; Hl=roller+16+e
;
	ld	e,(hl)
	inc	hl
	ld	d,(hl)		; De=encoded address
;
	ld	a,e
	and	7		; Also clears carry
	ld	l,a		; L = 3 lsb
	ld	a,e
	rla			; Lp8 to carry
	ld	e,a		; Lp7-4/lp2-lp0/carry
	ld	a,d
	rla			; Lsb=lp8
	ld	d,a
	ld	a,e
	and	0f0h		; Lp7-lp4
	or	l
	ld	e,a		; Don't you just love meaningful comments
;
	pop	hl
	ld	bc,bytesperline
	ex	de,hl		; Move from screen to buffer
	ldir
	ret
;

;=========
dumpaline:
;=========
;
; Dump one lines worth of byte to printer. There are 90 characters each
; composed of eight bytes so HL points at buffer containing 720 bytes.
;
; entry : no conditions	
; exit  : all registers corrupt	
;         (and Buffer contents destroyed)
;
	ld	hl,buffer
	ld	a,esc		; Let Mr. printer know whats happening
	call	prntbyte
	ld	a,'L'
	call	prntbyte
	ld	a,(bytesperline and 0ffh)
	call	prntbyte
	ld	a,(bytesperline/256)
	call	prntbyte

	ld	b,0		; Character count (0..89)
dstart:	
	push	bc
	ld	b,8		; Number of shifts count (8)
ateshft:
	xor	a		; Clear A and carry
	ld	c,8		; Number of bytes in a group (8)
	push	hl
atebit:	
	sla	hl		; Z80 SLA (HL)
				; Drawback of this is that it can't be single
				; Stepped in SID. So put NOP after to hold a
				; RST 6 if needed
;	nop
	rla			; So the 8080 does have rotates after all
	inc	hl
	dec	c
	jp	nz,atebit	; Have we got all 8 top bits ?
	call	prntbyte	; Yup, so print that character
	pop	hl
	dec	b
	jp	nz,ateshft	; Have the current group been shifted 8 times
	ld	de,8
	add	hl,de		; Step hl onto next group of 8
	pop	bc
	inc	b
	ld	a,b
	cp	90		; Hit the 90th group of 8 yet ?
	jp	nz,dstart
	ld	a,cr		; Guess it uould be a guod idea to start
	call	prntbyte	; Next line at l.h. margin
	ld	a,lf
	call	prntbyte	; Either 2/216,23/216 or just 25/216
	ret

prntbyte:
	
	push	hl
	push	de
	push	bc
	ld	e,a
	ld	c,listout
	call	bdos
	pop	bc
	pop	de
	pop	hl
	ret

userf:	db	0c3h		; What do you mean you've never heard of it
	dw	0

	dseg

flagesc:db	0
dtype:	db	0

oldstak:dw	0

buffer:	ds	720
	ds	64
mystak:	

	end