;**********************************************************************
;
;		 (c) 1994 J.Skypala & Z.Kabelac
;                        kabi@fi.muni.cz
;		  $VER: OneFont.s 4.0 (25.8.94)
;
;**********************************************************************
;Have you been wondering how can you change font in Execute command?
;Well, maybe this is the solution for you - try this small program.
;Just remember to run this program from CLI >BEFORE< workbench OPENS
;any screen after reboot.
;Program is patching SetFont (and also, if you want, OpenFont and OpenDiskFont)
;But not all programs need this patch - they are not font sensitive or they
;can select font in its preferences.  You have to insert name of those programs
;in the tasks'list in this source file (some of them are listed here : text and
;font editors (to be possible to use topaz font) and some old and not font
;sensitive programs, but you still could select 8x8 font for them (if you have
;nicer or localized fonts). To find task's names use ARTM or some similar
;program (you only need a few starting letters (4 - 6) to indentify task).
;
;for compiling this source you need Includes for 2.0 system
;  Thinpaz is really nice font for this purpose
;
;feel free to change anything you want
;if its really good change in this program - send me a copy:
;	kabi@fi.muni.cz


		incdir	'Include:'
		include	'exec/tasks.i'
		include	'exec/exec_lib.i'
		include	'exec/memory.i'
		include	'graphics/graphics_lib.i'
		include	'graphics/text.i'
		include	'graphics/rastport.i'
		include	'diskfont/diskfont_lib.i'

_SysBase	equ	4

;set it 1 if you want patch also OpenFont & OpenDiskFont
PATCH_OPEN	SET	0

Start		move.l	(_SysBase).w,a6
		moveq	#0,d0
		lea	diskfontname(pc),a1
		jsr	_LVOOpenLibrary(a6)
		tst.l	d0
		beq.w	BadEnd			;Sorry no lib
		move.l	d0,a6
		move.l	a6,a3
		lea	TopazDefault(pc),a0
		jsr	_LVOOpenDiskFont(a6)	;TOPAZ 8
		lea	FontDefault(pc),a4
		move.l	d0,(a4)+
		beq.w	CloseLib
		lea	TAttr(pc),a0		;Open Desired Font
		jsr	_LVOOpenDiskFont(a6)
		move.l	d0,(a4)+
		beq.w	CloseLib
		lea	Instead(pc),a0		;Open Instead Topaz Font
		jsr	_LVOOpenDiskFont(a6)
		move.l	d0,(a4)+
		beq.w	CloseLib

;------- Allocate memory for resident part of program

		move.l	(_SysBase).w,a6
		move.l	#ResidentEnd-ResidentStart,d4
		move.l	d4,d0
		moveq	#MEMF_PUBLIC,d1
		jsr	_LVOAllocMem(a6)	;allocate memory
		tst.l	d0
		beq.b	CloseLib
		move.l	d0,a0
		move.l	d0,a4
		lea	ResidentStart(pc),a1
.loop		move.b	(a1)+,(a0)+		;and move resident part
		subq.w	#1,d4
		bne.b	.loop			;there

	IFNE	PATCH_OPEN
		move.l	a3,a1			;Base of diskfont.library
		move.w	#_LVOOpenDiskFont,a0
		moveq	#DiskFont-ResidentStart,d0
		add.l	a4,d0
		jsr	_LVOSetFunction(a6)	;patch OpenDiskFont()
		move.l	d0,OpenDiskFont-ResidentStart(a4)
	ENDC
		lea	gfxname(pc),a1
		moveq	#0,d0
		jsr	_LVOOpenLibrary(a6)	;open graphics.library
		tst.l	d0
		beq.b	EndPatch
		move.l	d0,a1
		move.w	#_LVOSetFont,a0
		moveq	#GfxSetFont-ResidentStart,d0
		add.l	a4,d0
		jsr	_LVOSetFunction(a6)     ;patch SetFont()
		move.l	d0,SetFont-ResidentStart(a4)

	IFNE	PATCH_OPEN
		move.w	#_LVOOpenFont,a0
		moveq	#GfxFont-ResidentStart,d0
		add.l	a4,d0
		jsr	_LVOSetFunction(a6)	;patch OpenFont()
		move.l	d0,OpenFont-ResidentStart(a4)
	ENDC

EndPatch
	IFEQ	PATCH_OPEN
		move.l	a3,a1
		move.l	(_SysBase).w,a6
		jsr	_LVOCloseLibrary(a6)
	ENDC
		moveq	#0,d0
		rts
CloseLib	move.l	a3,a1
		move.l	(_SysBase).w,a6
		jsr	_LVOCloseLibrary(a6)
BadEnd		moveq	#10,d0
		rts
***********************************************************************
ResidentStart
SaveSetRegs	reg	d0/d1/a0/a1/a2/a6
SaveRegs	reg	d0/a0/a2/a6

GfxSetFont	move.l	SetFont(pc),-(a7)
		cmp.l	FontDefault(pc),a0
		bne.b	.not_for_us
		movem.l	SaveSetRegs,-(a7)
		bsr.b	GetTheName
		movem.l	(a7)+,SaveSetRegs
		move.l	FontInstead(pc),a0
		bne.b	.nochange
		move.l	FontAddr(pc),a0
;we have to prevent removing font from memory
;because if only SetFont is patched than CloseFont will decrease open counter
;of new font instead of topaz font
.nochange	move.b	#20,$1f(a0)			;Open Count
.not_for_us	rts

	IFNE	PATCH_OPEN
GfxFont		move.l	OpenFont(pc),-(a7)	;address of OpenFont()
		bra.b	Patching		;and the rest is same
DiskFont	move.l	OpenDiskFont(pc),-(a7)	;address of OpenDiskFont()

Patching	cmp.w	#8,ta_YSize(a0)		;is it size 8?
		bne.b	.end
		move.l	a1,-(a7)
		movem.l	SaveRegs,-(a7)
		move.l	(a0),a0
		lea	TopazName(pc),a1
.loop		move.b	(a0)+,d0		;is it 'topaz.font'
		cmp.b	(a1)+,d0
		bne.b	.notopaz
		tst.b	d0
		bne.b	.loop
		bsr.b	GetTheName
		beq.b	.not_in_list
		movem.l	(a7)+,SaveRegs
		lea	InsteadTopaz(pc),a1
		bra.b	.con
.not_in_list	movem.l	(a7)+,SaveRegs
		lea	FontName(pc),a1		;change it to
.con		move.l	a1,(a0)			;desired font
		bra.b	..
.notopaz	movem.l	(a7)+,SaveRegs
..		move.l	(a7)+,a1
.end		rts				;and do the original func.
	ENDC

GetTheName	move.l	(_SysBase).w,a6
		sub.l	a1,a1			;Zero - find our name
		jsr	_LVOFindTask(a6)
		move.l	d0,a1

		move.l	$ac(a1),d0		;task pointer
		beq.b	.normal			;not CLI
		asl.l	#2,d0
		move.l	d0,a2
		move.l	$10(a2),d0
		beq.b	.normal
		asl.l	#2,d0
		addq.l	#1,d0
		move.l	d0,a1
		bra.b	.shell_proc             ;yes it's CLI process
.normal		move.l	LN_NAME(a1),a1		;Get the address of task's name
.shell_proc	lea	TasksNames(pc),a2
.mainloop	move.l	a1,a0
		tst.b	(a2)
		beq.b	.notfound

.nextbyte	move.b	(a2)+,d0
		beq.b	.found			;found => not patching
.search		move.b	(a0)+,d1
		eor.b	d1,d0
		and.b	#%11011111,d0		;not case sensitive
		beq.b	.nextbyte

.catch_end	tst.b	(a2)+
		bne.b	.catch_end
		bra.b	.mainloop		;make another search
.found		subq.b	#1,d0			;set NOT ZERO
.notfound	rts

	IFNE	PATCH_OPEN
OpenDiskFont	dc.l	0
OpenFont	dc.l	0
	ENDC
SetFont		dc.l	0
;don't touch this sequence!!!
FontDefault	dc.l	0
FontAddr	dc.l	0
FontInstead	dc.l	0
TopazName	dc.b	'topaz.font',0

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;Font instead topaz - must be 8x8 !!!

InsteadTopaz	dc.b	'topaz.font',0

;Font normaly used - any type - but don't expect that everything
;run ok if you set 100x100 font :-)

FontName	dc.b	'thinpaz.font',0
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

;**** TASK LIST ********************************************************
;You need only starting letters
TasksNames	dc.b	"DISKMON",0
		dc.b	"ASM",0			;no case sensitive !!!!
		dc.b	"TRASH",0
		dc.b	"VIEW80",0
		dc.b	"DW",0
		dc.b	"GOLD",0
		dc.b	"WBFED",0
		dc.b	"PFM",0
		dc.b	"DEKSID",0
		dc.b	"QBTOOL",0
		dc.b	0          		;end of list

		EVEN
ResidentEnd
;***********************************************************************
;set right TAtributes for your font
TAttr		dc.l	FontName
		dc.w	8
		dc.w	0
Instead		dc.l	InsteadTopaz
		dc.w	8
		dc.w	0
TopazDefault	dc.l	TopazName
		dc.w	8
		dc.w	0


version		dc.b	'$VER: OneFont 4.0 (25/8/94)',0
diskfontname	dc.b	'diskfont.library',0
gfxname		dc.b	'graphics.library',0