;please after linking set pure

	ttl	AltFontPatch - alternative font program
	include	'offsets/libs.offsets'

	movem.l	d2-d5/a2-a6,-(sp)

;look for exec.library
	MOVE.W	#4,A0
	MOVE.L	(A0),A6

	move.l	a6,d5	;d5=exec

;open graphics.library
	lea.l	graphicsname(pc),a1
	jsr	_LVOOldOpenLibrary(a6)
	tst.l	d0
	beq	nograph
	move.l	d0,a2	;a2=graphics


;is patch active?
	jsr	_LVOForbid(a6)
	move.l	(_LVOOpenFont+2)(a2),a4	;a4=possible afp
	cmp.l	#'ALTP',(IDENT-patchvec)(a4)
	beq	nopatg

;open diskfont.library
	lea.l	diskfontname(pc),a1
	jsr	_LVOOldOpenLibrary(a6)
	tst.l	d0
	beq.s	nodiskf
	move.l	d0,d2	;d2=diskfont

;install patch to memory
	moveq	#((endpatch-patchbase+3)/4),d0
	lsl.l	#2,d0
	moveq	#1,d1	;MEM,CLEAR
	swap.w	d1
	jsr	_LVOAllocMem(a6)
	tst.l	d0
	beq.s	noalmem

	move.l	d0,a4
	lea.l	(patchbeg-patchbase)(a4),a1
	move.l	a1,a4
	lea.l	patchbeg(pc),a0
	moveq	#(endpatch-patchbeg+3)/4,d0
	lsl.l	#2,d0
	jsr	_LVOCopyMemQuick(a6)

;install patch to graphics.library
	addq.l	#8,a4	;a4=afp
	move.l	a4,d0	;entry=d0
	move.l	a2,a1	;a2=graphics

	MOVE.L	A1,(GFX-PAD)(A4)

	move.w	#_LVOOpenFont,a0
	jsr	_LVOSetFunction(a6)
	move.l	d0,(oldOGF-PAD)(a4)


;install patch to diskfont.library
	move.l	d2,a1			;a1=library ;d2=diskfont

	MOVE.L	A1,(DFONT-PAD)(A4)

	move.l	a4,d0
	add.l	#(diskf-patchvec),d0	;entry=d0
	move.w	#_LVOOpenDiskFont,a0
	jsr	_LVOSetFunction(a6)
	move.l	d0,(oldODF-PAD)(a4)

	jsr	_LVOPermit(a6)
	bra.s	nclg


noalmem	move.l	d2,a1	;d2=diskfont
	jsr	_LVOCloseLibrary(a6)

nodiskf	jsr	_LVOPermit(a6)

	move.l	a2,a1	;a2=graphics
	jsr	_LVOCloseLibrary(a6)

nograph	moveq	#20,d0
	movem.l	(sp)+,d2-d5/a2-a6
	rts

nopatg	jsr	_LVOPermit(a6)

	move.l	a2,a1	;a2=graphics
	jsr	_LVOCloseLibrary(a6)

;have data array good version
	cmp.l	#IDNTVR,(VERSION-patchvec)(a4)
	bne.s	nograph

	clr.l	(NEWDAT-PAD)(A4)	;after installing it is already zero
	clr.l	(NEWEXT-PAD)(A4)
	clr.l	(DEFEXT-PAD)(A4)
nclg

;close old alternative font
	move.l	(GFX-PAD)(A4),a6
	move.l	(TOPAZ8-PAD)(a4),d0
	move.l	d0,a1
	beq.s	noc8
	jsr	_LVOCloseFont(a6)
noc8	move.l	(TOPAZ9-PAD)(a4),d0
	move.l	d0,a1
	beq.s	noc9
	jsr	_LVOCloseFont(a6)
noc9

;open dos.library
	move.l	d5,a6	;d5=exec
	lea.l	dosname(pc),a1
	jsr	_LVOOldOpenLibrary(a6) ;OpenLibrary(libName,version)(A1,D0)
	tst.l	d0
	beq	doser
	move.l	d0,a2

;read ENV:Sys/altfont.prefs
	move.l	d0,a6

	lea.l	ALTNAME(pc),a0
	MOVE.l	a0,d1		;name
	move.l	#1005,d2	;accessMode MODE_OLDFILE
	jsr	_LVOOpen(a6)
	tst.l	d0
	BEQ.S	kepext
	MOVE.L	D0,A3

	moveq	#$22,d2	;offset
	MOVEQ	#3,d4	;length
	LEA.L	(NEWDAT-PAD)(A4),A5	;buffer
	bsr.s	rdbytes

	LEA.L	(NEWEXT-PAD)(A4),A5	;buffer

	move.b	(NEWDAT-PAD)(A4),d0
	beq.s	movext
	move.b	d0,(A5)+

movext	moveq	#$32,d2	;offset
	MOVEQ	#7,d4	;length	;could can be 8, if AFP_ASEPAR = 0
	bsr.s	rdbytes

	LEA.L	(DEFEXT-PAD)(A4),A5	;buffer

	move.b	(NEWDAT-PAD)(A4),d0
	beq.s	movexd
	move.b	d0,(A5)+

movexd	moveq	#$42,d2	;offset
	MOVEQ	#7,d4	;length	;could can be 8, if AFP_ASEPAR = 0
	bsr.s	rdbytes

	move.l	A3,d1
	jsr	_LVOClose(a6)
kepext

;open new alternative fonts
	move.l	(DFONT-PAD)(A4),a6

	LEA.L	top8(pc),A0
	jsr	_LVOOpenDiskFont(a6)
	move.l	d0,(TOPAZ8-PAD)(a4)

	LEA.L	top9(pc),A0
	jsr	_LVOOpenDiskFont(a6)
	move.l	d0,(TOPAZ9-PAD)(a4)

;message
	move.l	a2,a6
	jsr	_LVOOutput(a6)
	tst.l	d0
	beq.s	nstdo

	move.l	d0,d1
	lea.l	mestxt(pc),a0
	move.l	a0,d2
	moveq	#(mesend-mestxt),d3
	jsr	_LVOWrite(a6)

nstdo
	move.l	d5,a6	;d5=exec
	move.l	a2,a1
	jsr	_LVOCloseLibrary(a6)

	moveq	#0,d0
myer	movem.l	(sp)+,d2-d5/a2-a6
	rts

doser	moveq	#10,d0
	bra.s	myer

rdbytes	move.l	A3,d1
	moveq	#-1,d3	;OFFSET_BEGINNING
	JSR	_LVOSeek(A6) ;Seek(file,position,offset)(D1/D2/D3)
	tst.l	d0
	bmi.s	keper

	move.l	A3,d1	;d1=file
	MOVE.l	A5,d2	;buffer
	MOVE.l	d4,D3	;length
	jsr	_LVORead(a6)

keper	rts

ALTNAME	dc.b	'ENV:Sys/altfont.prefs',0

TOPFNT	dc.b	'topaz.font',0

diskfontname
	dc.b	'diskfont.library',0

graphicsname
	dc.b	'graphics.library',0

dosname
	dc.b	'dos.library',0

	DC.B	'$VER: AltFontPatch 1.7 (28.10.92)',0

IDNTVR	EQU	$00020007

mestxt	dc.b	'AltFontPatch 1.7 - Alternative Font Patch by UTX '
	dc.b	'(Stanislav Brabec)',$a
mesend

	cnop	0,4
top8	DC.L	TOPFNT
	DC.L	$00080000

	cnop	0,4
top9	DC.L	TOPFNT
	DC.L	$00090000

	cnop	0,4
patchbeg
PADX	SET	patchbeg

IDENT	dc.l	'ALTP'	;AltFontPatch identifier
VERSION	dc.l	IDNTVR
PAD

PADX	SET	PADX-4
DFONT	EQU	PADX

PADX	SET	PADX-4
GFX	EQU	PADX

PADX	SET	PADX-4
oldODF	EQU	PADX

PADX	SET	PADX-4
oldOGF	EQU	PADX

PADX	SET	PADX-8
DEFEXT	EQU	PADX

PADX	SET	PADX-8
NEWEXT	EQU	PADX

PADX	SET	PADX-4
NEWDAT	EQU	PADX

PADX	SET	PADX-4
TOPAZ9	EQU	PADX

PADX	SET	PADX-4
TOPAZ8	EQU	PADX

patchbase equ PADX

;OpenFont(textAttr)(A0)
patchvec
	move.l	oldOGF(pc),a1

	cmp.l	#'DEFA',8(a0)	;magic trash
	beq.s	nopatch

dopatch
	BSR.S	DoAlt
	tst.l	d0
	bne.s	patchok
nopatch	jmp	(a1)

;OpenDiskFont(textAttr)(A0)
diskf
	move.l	oldODF(pc),a1
	bra.s	dopatch

;DoAlt(origattr,chook)(a0,a1)
;a0,a1 are saved
DoAlt
	movem.l	d2/a0/a1/a2/a3/a4,-(sp)
	move.l	a0,a3
	move.l	a1,d2

	lea.l	PAD(pc),a4

	move.l	(a3),a0
	lea.l	(NEWEXT-PAD)(A4),a2
	bsr	FindSuffixs	;end offset altape=FindSuffixs(source,appendix)(a0,a2)
	move.l	d0,d1
	moveq	#0,d0
	tst.l	d1
	bne.s	patxt

	TST.B	(NEWDAT-PAD+2)(a4)
	beq.s	ndapat

	move.l	(a3),a0
	lea.l	(DEFEXT-PAD)(A4),a2
	bsr.s	FindSuffixs	;end offset altape=FindSuffixs(source,appendix)(a0,a2)
	tst.l	d0
	bne.s	defape

ndapat	moveq	#0,d0
	TST.B	(NEWDAT-PAD+1)(a4)
	beq.s	patxt

	LINK	A5,#STACKL

	bsr.s	prepname

	LEA.L	FONTNAME(A5),A0
	bsr.s	FindFontA	;end offset altape=FindSuffixs(source,appendix)(a0,a2)
	tst.l	d0
	beq.s	badname

	move.l	d0,a0
	lea.l	(NEWEXT-PAD)(A4),a1
	bsr	Extend	;Extend(pointer,appendix)(a0,a1)

	clr.l	(TEXTA+8)(a5)	;clear magic trash
patcon	move.l	d2,a1
	lea.l	TEXTA(A5),a0
	jsr	(a1)	;custom hook to original
	clr.l	(TEXTA+8)(a5)	;clear magic trash

badname	UNLK	A5
patxt	movem.l	(sp)+,d2/a0/a1/a2/a3/a4
;imported label
patchok
	rts

defape	LINK	A5,#STACKL

	bsr.s	prepname

	LEA.L	FONTNAME(A5),A0
	lea.l	(DEFEXT-PAD)(A4),a2
	bsr.s	FindSuffixs	;end offset altape=FindSuffixs(source,appendix)(a0,a2)
				;cannot fail, it has the same input
	move.l	d1,a0
	bsr.s	ExtFon	;ExtFon(pointer)(a0)

	move.l	#'DEFA',(TEXTA+8)(a5)	;set magic trash

	bra.s	patcon


;prepname(orig,copy)(a3,a5)
prepname
	MOVE.L	(A3),A0
	LEA.L	FONTNAME(A5),A1
	bsr.s	CopyString	;CopyString(source,dest)(a0,a1)

	LEA.L	TEXTA(A5),A1
	LEA.L	FONTNAME(A5),A0
	MOVE.L	A0,(A1)
	MOVE.L	4(A3),4(A1)
	rts

FindFontA
;!!! loose a2
	lea.l	(NEWEXT-PAD+7)(A4),a2	;points to zero
;end offset altape=FindSuffixs(source,appendix)(a0,a2)
; a0   d0     d1
;    .font   -xxx
;      =0
;no app
FindSuffixs
COCL	move.L	a2,A1
	move.l	a0,d1
NENCL	TST.B	(A1)
	BEQ.S	APEOK
	TST.B	(A0)
	BEQ.S	APENOT
	CMPM.B	(A0)+,(A1)+
	BEQ.S	NENCL
	bne.s	COCL

APEOK	LEA.L	(SUFONT-PAD)(A4),A1	;^ '.font'
	move.l	a0,d0
CMFCL	TST.B	(A0)
	BEQ.S	APENOT
	CMPM.B	(A0)+,(A1)+
	BNE.S	COCL
	TST.B	(A1)
	BNE.S	CMFCL
;	TST.B	(A0)
;	BNE.S	COCL
	rts

APENOT	moveq.l	#0,d0
	rts
;end of appendix -??.font test

;Extend(pointer,appendix)(a0,a1)
Extend
EXTEXT	MOVE.B	(A1)+,(A0)+
	BNE.S	EXTEXT
	SUBQ.L	#1,A0
;ExtFon(pointer)(a0)
ExtFon	LEA.L	(SUFONT-PAD)(A4),A1
EXTFNT	MOVE.B	(A1)+,(A0)+
	BNE.S	EXTFNT
	rts
;end of extend

;CopyString(source,dest)(a0,a1)
CopyString
CNCL	MOVE.B	(A0)+,(A1)+
	BNE.S	CNCL
	rts
;end of copy string


SUFONT	dc.b	'.font',0

	cnop	0,4
endpatch

TEXTA	EQU	-268

FONTNAME EQU	-256	;MAXFONTPATH

STACKL	EQU	-268

	IFNE	(patchvec-patchbeg)-8
	FAIL	"Phasing difference error"
	ENDC
	end