;	EXEC
FindTask	=-294
Wait		=-318
Signal		=-324
AddPort		=-354
RemPort		=-360
FindPort	=-390
OldOpenLibrary	=-408
CloseLibrary	=-414
OpenLibrary	=-552
CacheClearU	=-636

;	DOS
Open		=-30
Close		=-36
Read		=-42
Write		=-48
Output		=-60
Lock		=-84
UnLock		=-90
Examine		=-102
SetComment	=-180
SetFiledate	=-396

;	INTUITION
DisplayAlert	=-90

;	DISKFONT
AvailFonts	=-36


;	ZMIENNE
fileinfoblock	=0
buffer		=262
bufbytes	=266
file		=270
filesize	=274

varsize		=278

OLDSYS		=34
NEWSYS		=36

	move.b	#NEWSYS,system
	lea	dosname,a1
	moveq	#36,d0
	move.l	4,a6
	jsr	OpenLibrary(a6)		; otworzenie OS2.0 dos.library...
	move.l	d0,dosbase
	tst.l	d0
	bne.s	OS20

	move.b	#OLDSYS,system
	lea	dosname,a1
	move.l	4,a6
	jsr	OldOpenLibrary(a6)	; otworzenie dos.library...
	move.l	d0,dosbase

OS20:
	lea	intname,a1
	move.l	4,a6
	jsr	OldOpenLibrary(a6)	; ...i intuition
	move.l	d0,intbase

	lea	portname,a1		; sprawdzenie, czy w systemie znajduje
	move.l	4,a6			; sië juû port o nazwie
	jsr	FindPort(a6)		; "FontsCat port".
	tst.l	d0
	beq.s	notinstalled

;	Jeôli tak, to program jest juû zainstalowany i naleûy go usunâê

	move.l	d0,a1
	move.l	16(a1),a1
	move.l	4,a6
	move.l	#$1000,d0
	jsr	Signal(a6)		; wysîanie sygnaîu Ctrl-C

	bsr.w	closelibraries		; zamkniëcie bibliotek

	clr.l	d0			; wyjôcie z programu
	rts

;	Instalowanie programu

notinstalled:
	lea	installinfo,a0
	bsr.w	CLIoutput		; wysîanie informacji o zainstalowaniu

	suba.l	a1,a1
	move.l	4,a6
	jsr	FindTask(a6)		; znalezienie struktury wîasnego tasku
	move.l	d0,Task

	lea	myport,a1
	jsr	AddPort(a6)		; dodanie do systemu wîasnego portu

	lea	diskfontname,a1
	move.l	4,a6
	jsr	OldOpenLibrary(a6)	; otworzenie diskfont.library
	tst.l	d0
	beq.w	nodiskfont
	move.l	d0,diskfontbase

	move.l	diskfontbase,a6
	move.l	AvailFonts+2(a6),AvailFontsAdr
					; zachowanie oryginalnego adresu
					; funkcji AvailFonts
	move.l	#MyAvailFonts,AvailFonts+2(a6)
					; i "podwieszenie" wîasnej procedury
	bsr.w	cacheclear		; wyczyszczenie cache

loop_wait:
	move.l	#$1000,d0
	move.l	4,a6
	jsr	Wait(a6)		; czekanie na Ctrl-C

deinstall:
	move.l	diskfontbase,a6
	cmp.l	#MyAvailFonts,AvailFonts+2(a6)
					; sprawdzenie, czy jakiô inny program
					; nie zmieniî wektora AvailFonts
	beq.s	remove

	move.l	intbase,a6
	moveq	#0,d0
	moveq	#31,d1
	lea	cannotremove,a0
	jsr	DisplayAlert(a6)	; jeôli tak - wyôwietlenie komunikatu
	bra.s	loop_wait		; i dalsze czekanie

;	Usuwanie programu i powrót do systemu

remove:
	move.l	diskfontbase,a6
	move.l	AvailFontsAdr,AvailFonts+2(a6)
					; przywrócenie oryginalnej wartoôci
					; wektorowi funkcji AvailFonts
	bsr.w	cacheclear		; wyczyszczenie cache
	lea	myport,a1
	move.l	4,a6
	jsr	RemPort(a6)		; usuniëcie MsgPort'u

	lea	removeinfo,a0
	bsr.b	CLIoutput		; powiadomienie o usuniëciu programu

	move.l	diskfontbase,a1
	move.l	4,a6
	jsr	CloseLibrary(a6)	; zamkniëcie diskfont.library

nodiskfont:
	bsr.b	closelibraries		; i pozostaîych bibliotek

	clr.l	d0

	rts				; * K * O * N * I * E * C *       :-)

; Czyszczenie cache procesora

cacheclear:
	move.l	4,a6
	cmp.w	#37,20(a6)
	blt.s	cacheend
	jsr	CacheClearU(a6)
cacheend:
	rts

;	Zamkniëcie bibliotek

closelibraries:
	move.l	dosbase,a1
	move.l	4,a6
	jsr	CloseLibrary(a6)

	move.l	intbase,a1
	move.l	4,a6
	jsr	CloseLibrary(a6)
	rts

;	Procedura wyôwietlajâca komunikat w oknie CLI

;	Wejôcie: a0 - adres komunikatu zakoïczonego zerem

;	uûyte rejestry: d0,d1,d2,d3,a0,a1,a6

CLIoutput:
	move.l	a0,-(sp)
	moveq	#-1,d0
out_loop:
	add.l	#1,d0
	tst.b	(a0)+
	bne.s	out_loop
	move.l	d0,-(sp)
	move.l	dosbase,a6
	jsr	Output(a6)
	tst.l	d0
	beq.s	out_err
	move.l	d0,d1
	move.l	(sp)+,d3
	move.l	(sp)+,d2
	move.l	dosbase,a6
	jsr	Write(a6)
	rts
out_err:
	move.l	(sp)+,d0
	move.l	(sp)+,d1
	rts

;	Procedura zastëpujâca Availfonts

MyAvailFonts:
	btst	#1,d1			; czcionki z dysku ?
	bne.b	DiskFonts
	move.l	a5,-(sp)		; jeôli program domaga sië czcionek
	move.l	AvailFontsAdr,a5	; z ROM'u - wywoîywana jest oryginalna
	jsr	(a5)			; funkcja AvailFonts
	move.l	(sp)+,a5
	rts				; powrót

;	Czcionki z dysku

diskfonts:
	move.l	a4,-(sp)
	sub.l	#varsize,sp
	move.l	sp,a4

	movem.l	d1-d3/d7/a0/a1/a6,-(sp)

	move.l	a0,buffer(a4)		; zapamiëtanie wartoôci przekazywanych
	move.l	d0,bufbytes(a4)		; do procedury (w a0 - adres bufora
					; na listë fontów, w d0 - jego rozmiar)
	lea	fontscat,a0
	bsr.w	fsize
	
	move.l	132(a0),d1
	move.l	136(a0),d2
	move.l	140(a0),d3

	lea	fontscatname,a0
	bsr.w	FSize			; sprawdzenie dîugoôci pliku z
					; katalogiem fontów
	cmp.b	#OLDSYS,system
	beq.s	nocompdate

	cmp.l	132(a0),d1		; porównanie dat
	bne.w	nocatalog
	cmp.l	136(a0),d2
	bne.w	nocatalog
	cmp.l	140(a0),d3
	bne.w	nocatalog

nocompdate:
	cmp.l	bufbytes(a4),d0
	bge.b	nomem			; jeôli bufor jest zbyt maîy - wyjôcie

	move.l	#fontscatname,d1
	move.l	#$3ed,d2		; MODE=OldFile
	move.l	dosbase,a6
	jsr	Open(a6)		; otworzenie katalogu do odczytu
	tst.l	d0
	beq.s	nocatalog
	move.l	d0,file(a4)

	move.l	file(a4),d1
	move.l	buffer(a4),d2
	move.l	filesize(a4),d3
	move.l	dosbase,a6
	jsr	Read(a6)		; odczytanie katalogu do bufora

	move.l	file(a4),d1
	move.l	dosbase,a6
	jsr	Close(a6)		; zamkniëcie pliku

;	Wpisanie adresów nazw czcionek do struktur TextAttr

	move.l	buffer(a4),a0
	move.w	(a0)+,d0		; d0 - iloôê fontów
	move.l	a0,a1
	move.w	d0,d7
	sub.w	#1,d7			; trzeba odjâê 1, bo uûywamy DBF
	ext.l	d0
	mulu	#10,d0			; iloôê fontów *10 (dîugoôê TextAttr)
	add.l	d0,a1			; + adres bufora daje adres nazwy
					; pierwszego fontu
seloop2:
	move.l	a1,2(a0)		; wpisywanie kolejnych adresów
	adda.l	#10,a0
seloop:
	tst.b	(a1)+			; szukanie nastëpnej nazwy fontu
	bne.s	seloop
	dbf	d7,seloop2
;-----------------------------
	movem.l	(sp)+,d1-d3/d7/a0/a1/a6
	add.l	#varsize,sp
	move.l	(sp)+,a4
	clr.l	d0			; brak bîëdu
	rts				; powrót

;	Bufor jest zbyt maîy, wiëc nie moûna wczytaê katalogu.

nomem:
	movem.l	(sp)+,d1-d3/d7/a0/a1/a6
	move.l	filesize(a4),d0		; w d0 zwracany jest wymagany
	add.l	#varsize,sp		; rozmiar bufora
	move.l	(sp)+,a4
	rts				; powrót

;	Katalogu czcionek nie ma na dysku, wiëc trzeba go stworzyê

nocatalog:
	movem.l	(sp)+,d1-d3/d7/a0/a1/a6
	move.l	bufbytes(a4),d0
	moveq	#-1,d1
	move.l	a5,-(sp)
	move.l	AvailFontsAdr,a5
	jsr	(a5)			; skok do systemowego AvailFonts
	move.l	(sp)+,a5
	tst.l	d0
	beq.s	writecatalog		; jeôli d0=0 - moûna przystâpiê do
					; nagrywania katalogu.
	add.l	#varsize,sp
	move.l	(sp)+,a4
	rts				; powrót

writecatalog:
	movem.l	d0-d3/d7/a0-a2/a6,-(sp)
	move.l	#fontscatname,d1
	move.l	#$3ee,d2		; MODE=NewFile
	move.l	dosbase,a6
	jsr	Open(a6)		; otworzenie nowego pliku z fontami
	tst.l	d0
	beq.w	cannotwrite
	move.l	d0,file(a4)

	move.l	buffer(a4),a0
	move.w	(a0)+,d0		; obliczenie dîugoôci listy fontów
	ext.l	d0			; (ale bez ich nazw)
	mulu	#10,d0
	add.l	#2,d0

	move.l	file(a4),d1
	move.l	buffer(a4),d2
	move.l	d0,d3
	move.l	dosbase,a6
	jsr	Write(a6)		; nagranie listy fontów (wszystkich
					; struktur TextAttr)
;-------Nagrywanie nazw czcionek-------

	move.l	buffer(a4),a0
	move.w	(a0)+,d7		; iloôê fontów do d7
	sub.w	#1,d7			; -1, bo uûywane z DBF
writeloop:
	move.l	2(a0),a1		; adres nazwy fontu ze struktury
	move.l	a1,a2			; TextAttr do a1 i a2
	clr.l	d0
; Search for end of text
sloop:	addq	#1,d0			; szukanie koïca nazwy
	tst.b	(a1)+
	bne.s	sloop

; ----- a2 - adres nazwy fontu ; d0 - dîugoôê nazwy -----

	move.l	a0,-(sp)
	move.l	file(a4),d1
	move.l	a2,d2
	move.l	d0,d3
	move.l	dosbase,a6
	jsr	Write(a6)		; nagranie nazwy do pliku
	move.l	(sp)+,a0

	adda.l	#10,a0			; obliczenie adresu nastëpnej
					; struktury TextAttr
	dbf	d7,writeloop		; i powrót

;--------------------------------

	move.l	file(a4),d1
	move.l	dosbase,a6
	jsr	Close(a6)		; zamkniëcie pliku

	cmp.b	#OLDSYS,system
	beq.s	nosetdate

	lea	fontscatname,a0
	bsr.b	fsize

	add.l	#132,a0
	move.l	a0,d2
	move.l	#fontscat,d1
	jsr	SetFileDate(a6)		; ustawienie daty

nosetdate:
cannotwrite:
	movem.l	(sp)+,d0-d3/d7/a0-a2/a6
	add.l	#varsize,sp
	move.l	(sp)+,a4
	rts

;	Funkcja podajâca dîugoôê pliku

; wejôcie: a0 - nazwa pliku
; wyjôcie: dîugoôê pliku w d0 oraz pod etykietâ filesize
;	   a0 - fileinfoblock

fsize:
	movem.l	d1/d2/a1/a6,-(sp)

	move.l	a0,d1
	moveq	#-2,d2
	move.l	dosbase,a6
	jsr	Lock(a6)
	tst.l	d0
	beq.s	lerr
	move.l	d0,d1

	move.l	d1,-(sp)
	move.l	#fileinfoblock,d2
	add.l	a4,d2
	add.l	#3,d2
	and.l	#$fffffffc,d2
	move.l	dosbase,a6
	jsr	Examine(a6)
	move.l	d2,a0
	move.l	124(a0),filesize(a4)
	move.l	(sp)+,d1

	move.l	a0,-(sp)
	move.l	dosbase,a6
	jsr	Unlock(a6)
	move.l	(sp)+,a0

loadend:
	movem.l	(sp)+,d1/d2/a1/a6
	move.l	filesize(a4),d0
	rts
lerr:
	movem.l	(sp)+,d1/d2/a1/a6
	move.l	#0,filesize(a4)
	clr.l	d0
	rts

diskfontname:
	dc.b	'diskfont.library',0

	even

dosname:
	dc.b	'dos.library',0

	even

intname:
	dc.b	'intuition.library',0

	even

myport:
;	-  Node   -
	dc.l	0		; Succ
	dc.l	0		; Pred
	dc.b	4		; Type=NT_MsgPort
	dc.b	-128		; Pri
	dc.l	PortName	; Name
;	- MsgPort -
	dc.b	2		; Flags=ignore
	dc.b	0		; SigBit
Task:	dc.l	0		; Task
;	-  List   -
Head:	dc.l	Tail		; Head
Tail:	dc.l	0		; Tail
	dc.l	Head		; TailPred
	dc.b	4		; Type=NT_MsgPort
	dc.b	0		; pad

PortName:
	dc.b	'FontsCat port',0

system:
	dc.b	0

fontscat:
	dc.b	'FONTS:',0
fontscatname:
	dc.b	'FONTS:Catalog',0
installinfo:
	dc.b	'FontsCat v.1.0 by PP/TERMOS/UNION succesfully installed.'
	dc.b	10,0
removeinfo:
	dc.b	'FontsCat v.1.0 by PP/TERMOS/UNION succesfully removed.'
	dc.b	10,0
cannotremove:
	dc.b	0,224,13
	dc.b	"WARNING !  I CAN'T EXIT !"
	dc.b	0,1
	dc.b	0,104,23
	dc.b	"Other programs have patched system routines used by me."
	dc.b	0,0

	dc.b	'$VER: FontsCat 1.0 (15.04.95)',0

	even

diskfontbase:
	dc.l	0
intbase:
	dc.l	0
dosbase:
	dc.l	0
availfontsadr:
	dc.l	0