* FONT TRICKS!
*
* An accessory to load any DEGAS or 8-bit font and make it the GEM default
*
* By Charles F. Johnson
*
* Last revision: 10/12/86

	.globl	_main

init_a	=	$A000

degbt	=	7
fn8bt	=	8
sysbt	=	9

	.text

	move.l	#ustk,a7	* get program stack
	jsr	_main		* go to program

_main:	clr.l	ap1rsv		appl_init
	clr.l	ap2rsv
	clr.l	ap3rsv
	clr.l	ap4rsv
	move.l	#a_init,aespb
	bsr	aes
	move.w	intout,myid

	move.l	#m_reg,aespb	menu_register
	move.w	myid,intin
	move.l	#accmsg,addrin
	bsr	aes
	move.w	intout,menuid

	move.w	#4,-(sp)	Check screen resolution
	trap	#14
	addq.l	#2,sp
	move.w	d0,res		And save it

	move.w	#$19,-(sp)	Get current drive and set fsel_input
	trap	#1		directory areas
	addq.l	#2,sp
	add.b	#65,d0
	move.b	d0,ddir		
	move.b	d0,fdir

	cmp.w	#2,res		Are we in high res?
	beq	hires		Yes, skip
	move.w	#8,d1		d1 is the Y coordinate multiplier
	move.l	#mebd1,a5	(character height)
	bra	setres
hires:	move.w	#16,d1
	move.l	#hibd1,a5
setres:	move.w	#8,d0		d0 is the X coordinate multiplier
	move.l	#3,d5		(character width)
	move.l	#boxdat,a4
cpybd:	move.w	(a5)+,(a4)+
	dbf	d5,cpybd

	move.l	#fntbox+24,a5	Go set coordinates in object tree
	move.l	#8,d5		9 objects
	bsr	coord1

	dc.w	init_a
	move.l	-$16(a0),fsavt
	move.l	-$1C4(a0),a5	Save original font pointers
	move.l	$4C(a5),fsav1
	move.l	$54(a5),a5
	move.l	$4C(a5),fsav2
	cmp.w	#2,res		Are we in high resolution?
	beq	dohi1		Yes, skip
	move.l	4(a1),a5	Pointer to 8x8 font header
	move.l	#511,d5		Count 2048 bytes (512*4)
	bra	copyf1
dohi1:	move.l	8(a1),a5	Pointer to 8x16 font header
	move.l	#1023,d5	Count 4096 bytes (1024*4)
copyf1:	move.l	76(a5),a5	Pointer to font data
	move.l	#fntdat,a4
copyf2:	move.l	(a5)+,(a4)+	Copy original font data to our area
	dbf	d5,copyf2

* For some reason, an evnt_timer call with a
* wait parameter of zero seems to allow GEM
* enough time to start up. Without this the
* font will be loaded and installed, but
* GEM sets the pointers back...

	move.l	#e_timr,aespb
	clr.l	intin
	bsr	aes

	move.l	#$A000,a5	This section searches for the fsel_input
s_1:	move.l	#itmtxt,a4	text "ITEM SELECTOR", then searches
	move.l	#12,d5		backwards for the pointer to this text
s_2:	move.b	(a5),d0		in the fsel object tree. New string
	cmp.b	(a4),d0		addresses can be poked into this location.
	beq	s_3
	addq.l	#1,a5
	bra	s_2
s_3:	move.l	a5,a0
s_4:	cmp.b	(a5)+,(a4)+
	bne	s_1
	dbf	d5,s_4
	move.l	a0,d0
	move.l	a0,iasav
	move.l	a0,d1
	and.l	#$FFFFFFFE,d1
	move.l	d1,a0
s_5:	subq.l	#2,a0
	move.l	(a0),d1
	cmp.l	d1,d0
	bne	s_5
	move.l	a0,itmadr

	move.l	#defnam,a5	Try to open the FONT.DEF file
	clr.l	d5
	bsr	openfl
	bmi	evntms		Error, assume file not found and skip ahead
	move.w	d0,handle	Save handle
	move.l	#buffer,a5	Read FONT.DEF to buffer
	move.l	#70,d5
	bsr	readfl
	bsr	closfl		Close it like a good boy
	move.l	#buffer+3,a5	Set pointer to file/path name
	cmp.b	#'D',buffer	DEGAS?
	beq	degfnt		Yes, skip
	cmp.b	#'d',buffer	DEGAS?
	beq	degfnt		Yes, skip
	cmp.b	#'8',buffer	Actually it better be 8-bit at this point
	bne	evntms		If it ain't, skip ahead
	bsr	ld8b4		Go load the font
	bra	evntms		Skip
degfnt:	bsr	ldde4		Load 'er up

evntms:	move.l	#e_mesg,aespb	evnt_mesag (All we want is an AC_OPEN)
	move.l	#mspipe,addrin	Pass address of message pipe
	bsr	aes

	cmp.w	#40,mspipe	Is this an AC_OPEN message?
	bne	evntms		No, go back
	move.w	mspipe+8,d0	Is it for this accessory?
	cmp.w	menuid,d0
	bne	evntms		No, go back

	move.w	#$19,-(sp)	Get current drive
	trap	#1
	addq.l	#2,sp
	move.w	d0,curdrv	Save it

	move.w	#0,-(sp)	Get current pathname
	move.l	#curpth,-(sp)
	move.w	#$47,-(sp)
	trap	#1
	addq.l	#8,sp

	move.l	#fntbox,boxadr	Draw the dialog box
	bsr	drawbx
	clr.w	state		Clear the selected object
	bsr	change

	cmp.w	#degbt,selobj	DEGAS font?
	bne	ckfn8		No, skip
	bsr	loadde		Go load it
	bra	back

ckfn8:	cmp.w	#fn8bt,selobj	8-bit font?
	bne	cksys		No, skip
	bsr	load8b		Go load it
	bra	back

cksys:	cmp.w	#sysbt,selobj	System font?
	bne	back		No, skip
	bsr	resetf		Reset system font pointers

back:	move.w	#3,diflag	Release dialog box memory
	bsr	dial

	move.w	curdrv,-(sp)	Reset current drive and pathname
	move.w	#$0E,-(sp)
	trap	#1
	addq.l	#4,sp
	move.l	#curpth,-(sp)
	move.w	#$3B,-(sp)
	trap	#1
	addq.l	#6,sp

	move.l	itmadr,a4	Replace fsel text pointer
	move.l	iasav,(a4)

	bra	evntms		Go back and wait for another message!

* The subroutines

loadde:	move.l itmadr,a4
	move.l	#i_deg,(a4)

	move.l	#ddir,a0	Set directory line for fsel
	bsr	fsel
	tst.b	file		File selected?
	bne	ldde2		Yes, skip
	rts			Exit
ldde2:	cmp.w	#1,intout+2	OK button?
	beq	ldde3		Yes, skip
	rts			Exit

ldde3:	move.l	#file,a5	Address of filename
ldde4:	clr.l	d5		Read only
	bsr	openfl		Go open it
	bmi	exnof		Error, go exit
	move.w	d0,handle	Save handle number

	move.l	#buffer,a5	Read 2050 bytes into buffer
	move.l	#$0802,d5
	bsr	readfl
	bmi	exnof

	bsr	closfl		Close dat file!

	move.l	#buffer+512,a4	Prepare for conversion
	move.l	#fntdat+32,a5	Skip first 32 characters
	move.l	#95,d5		96 characters

	cmp.w	#2,res		High res?
	beq	hidlp1		Yes, skip

	move.l	#buffer,a0	Can this DEGAS file be scaled to half-height?
	tst.w	2048(a0)
	bne	delp1		Yes, go do it
	move.l	#nohalf,a5	No, show an alert box with commiseration
	move.w	#1,d5		message and exit
	bsr	alert
	bra	exnof

delp1:	move.l	#7,d4		These sections convert DEGAS fonts to
delp2:	move.b	(a4),(a5)	the ST storage format, for either low,
	addq.l	#2,a4		medium or high res
	add.l	#$0100,a5
	dbf	d4,delp2
	suba.l	#$07FF,a5
	dbf	d5,delp1
	bra	fntset

hidlp1:	move.l	#15,d4
hidlp2:	move.b	(a4)+,(a5)
	add.l	#$100,a5
	dbf	d4,hidlp2
	suba.l	#$0FFF,a5
	dbf	d5,hidlp1

fntset:	bsr	setfnt		Install the font
exnof:	rts			And exit

load8b:	move.l	itmadr,a4
	move.l	#i_fn8,(a4)

	move.l	#fdir,a0
	bsr	fsel
	tst.b	file
	bne	ld8b2
	rts
ld8b2:	cmp.w	#1,intout+2
	beq	ld8b3
	rts

ld8b3:	move.l	#file,a5
ld8b4:	clr.l	d5		Open the font file
	bsr	openfl
	bmi	exnof
	move.w	d0,handle

	move.l	#buffer+$100,a5 Read font file to buffer
	move.l	#$200,d5	and rearrange to ASCII order
	bsr	readfl		as we do it
	bmi	exnof

	move.l	#buffer,a5
	move.l	#$100,d5
	bsr	readfl
	bmi	exnof

	move.l	#buffer+$300,a5
	move.l	#$100,d5
	bsr	readfl
	bmi	exnof

	bsr	closfl		Close the file

	move.l	#buffer+256,a4
	move.l	#fntdat+32,a5
	move.l	#95,d5

	cmp.w	#2,res
	beq	hi8lp1

b8lp1:	move.l	#7,d4
b8lp2:	move.b	(a4)+,(a5)
	add.l	#$0100,a5
	dbf	d4,b8lp2
	suba.l	#$07FF,a5
	dbf	d5,b8lp1
	bra	set8

hi8lp1:	move.l	#7,d4
hi8lp2:	move.b	(a4),(a5)
	add.l	#$0100,a5
	move.b	(a4)+,(a5)
	add.l	#$0100,a5
	dbf	d4,hi8lp2
	suba.l	#$0FFF,a5
	dbf	d5,hi8lp1

set8:	bsr	setfnt
	rts

setfnt:	dc.w	init_a
	move.l	#fntdat,-$16(a0)
	move.l	-$1C4(a0),a5	Set system font pointers to user fonts
	cmp.w	#2,res
	beq	hiset
	move.l	#fntdat,$4C(a5)
	bra	setx
hiset:	move.l	$54(a5),a5
	move.l	#fntdat,$4C(a5)
setx:	rts

resetf:	dc.w	init_a
	move.l	fsavt,-$16(a0)
	move.l	-$1C4(a0),a5	Restore system font pointers
	move.l	fsav1,$4C(a5)
	move.l	$54(a5),a5
	move.l	fsav2,$4C(a5)
	rts

* Open a file
* Enter with: a5= address of filename
*	      d5= read/write mode

openfl:	move.w	d5,-(sp)
	move.l	a5,-(sp)
	move.w	#$3D,-(sp)
	trap	#1
	addq.l	#8,sp
	tst.w	d0
	rts

* Read a file
* Enter with: a5= address of buffer
*	      d5= number of bytes to read

readfl:	move.l	a5,-(sp)
	move.l	d5,-(sp)
	move.w	handle,-(sp)
	move.w	#$3F,-(sp)
	trap	#1
	add.l	#12,sp
	tst.l	d0
	rts

* Close a file

closfl:	move.w	handle,-(sp)
	move.w	#$3E,-(sp)
	trap	#1
	addq.l	#4,sp
	tst.w	d0
	rts

* This routine sets all the object coordinates in a specified tree
* Enter with d0= x coordinate multiplier (usually 8)
*	     d1= y coordinate multiplier (8 or 16)
*	     a5= address of starting object
*	     d5= number of objects in tree

coord1:	move.l	#1,d4
	add.l	#16,a5
coord2:	move.w	(a5),d3		Adjust position coordinates of objects
	mulu.w	d0,d3		based on the screen resolution
	move.w	d3,(a5)+
	move.w	(a5),d3
	mulu.w	d1,d3
	move.w	d3,(a5)+
	dbf	d4,coord2
	dbf	d5,coord1
	rts

clrfil:	move.l	#file,a2	Clear out the filename storage area
	move.l	#15,d1		for fsel_input
clrf2	clr	(a2)+
	dbf	d1,clrf2
	rts

fsel:	move.l	a0,temp		Save address of directory name
	bsr	clrfil		Clear file name
	move.l	#f_sel,aespb	fsel_input
	move.l	temp,addrin	Pass directory string address
	move.l	#file,addrin+4	Pass file name address
	bsr	aes

	clr.l	d0
	move.l	temp,a0
	move.b	(a0),d0		Get drive number
	sub.b	#65,d0
	move.w	d0,-(sp)
	move.w	#$0E,-(sp)	Set current drive
	trap	#1
	addq.l	#4,sp
	move.l	temp,a0		Also set pathname from fsel
	addq.l	#2,a0
	move.l	#pathnm,a1
	move.l	#63,d5		Search forward and copy til zero
pathlp:	tst.b	(a0)
	beq	plx1
	move.b	(a0)+,(a1)+
	dbf	d5,pathlp
plx1:	move.l	#63,d5
plp2:	cmp.b	#"\",-(a1)	Search backward til "\" and
	beq	plx2		set a zero after it
	dbf	d5,plp2
plx2:	addq.l	#1,a1
	clr.b	(a1)
	pea	pathnm		Set current pathname
	move.w	#$3B,-(sp)
	trap	#1
	addq.l	#6,sp
	rts

* form_alert
* Enter with a5= address of definition string
*	     d5= number of default box

alert:	move.l	a5,addrin	Set address of string
	move.w	d5,intin	Set default box
	move.l	#f_alrt,aespb	Display alert box with form_alert
	bra	aes

* Dialog box drawing routine
* Enter with boxadr= object tree address

drawbx:	move.l	#f_cntr,aespb	First, let's call form_center
	move.l	boxadr,addrin
	bsr	aes
	move.w	intout+2,cx
	move.w	intout+4,cy
	move.w	intout+6,cw
	move.w	intout+8,ch

	clr.w	diflag		Reserve screen buffer memory
	bsr	dial
	move.w	#1,diflag
	bsr	dial
	move.l	#o_cdrw,aespb	Now, let's call objc_draw
	clr.w	intin		Root object gets drawn first
	move.w	#1,intin+2	Up to 1 level of subordinate objects
	move.w	cx,intin+4
	move.w	cy,intin+6
	move.w	cw,intin+8
	move.w	ch,intin+10
	move.l	boxadr,addrin
	bsr	aes

formdo:	move.l	#f_do,aespb	Here's where it all happens --- form_do
	clr.w	intin		No editable text field
	move.l	boxadr,addrin
	bsr	aes
	move.w	intout,selobj
	rts

* form_dial

dial:	move.l	#f_dial,aespb
	move.w	diflag,intin	diflag determines which action is taken

	move.w	#16,intin+2	Expanding box will grow from "Desk"
	move.w	#2,intin+4	on menu bar
	move.w	#64,intin+6
	cmp.w	#2,res		Adjust for different resolutions
	beq	cntrs1
	move.w	#8,intin+8
	bra	cntrs2
cntrs1:	move.w	#16,intin+8
cntrs2:	move.w	cx,intin+10
	move.w	cy,intin+12
	move.w	cw,intin+14
	move.w	ch,intin+16
	bra	aes

* objc_change

change:	move.l	#o_chng,aespb	Resets a selected object after exiting dialog
	move.w	selobj,intin
	clr.w	intin+2
	move.w	cx,intin+4
	move.w	cy,intin+6
	move.w	cw,intin+8
	move.w	ch,intin+10
	move.w	state,intin+12
	clr.w	intin+14
	move.l	boxadr,addrin
	bra	aes

* AES subroutine

aes:	move.l	#aespb,d1
	move.l	#$c8,d0
	trap	#2
	rts

	data
accmsg:	dc.b	'  Font Tricks!',0

nohalf:	dc.b	'[3][ This font cannot be scaled |'
	dc.b	' to half-size; a monochrome |'
	dc.b	' monitor is needed. Sorry!  |'
	dc.b	" ][ That's Life! ]",0

title1:	dc.b	' FONT TRICKS! ',0
title2:	dc.b	'Presents...',0
title4:	dc.b	'by Charles F. Johnson',0
title5:	dc.b	'Install which font?',0
degbms:	dc.b	'DEGAS',0
b8bms:	dc.b	'8-BIT',0
sysbms:	dc.b	'SYSTEM',0
null:	dc.b	0,0
itmtxt:	dc.b	'ITEM SELECTOR',0
i_deg:	dc.b	'LOAD DEGAS FONT',0
i_fn8:	dc.b	'LOAD 8-BIT FONT',0

	even
a_init:	dc.w	10,0,1,0,0
m_reg:	dc.w	35,1,1,1,0
e_timr:	dc.w	24,2,1,0,0
e_mesg:	dc.w	23,0,1,1,0
f_sel:	dc.w	90,0,2,2,0
f_alrt:	dc.w	52,1,1,1,0
f_cntr:	dc.w	54,0,5,1,0
f_do:	dc.w	50,1,2,1,0
f_dial:	dc.w	51,9,1,1,0
o_cdrw:	dc.w	42,6,1,1,0
o_chng:	dc.w	47,8,1,1,0

aespb:	dc.l	contrl,global,intin,intout,addrin,addrout

* Bit image tables for Analog logo

imag0:	dc.w	$0000,$0000,$0000,$0000
	dc.w	$0000,$0000,$1FE7,$C083
	dc.w	$FC00,$3FF7,$E1C7,$FE00
	dc.w	$6077,$F1CC,$0E00,$C077
	dc.w	$79D8,$0E00,$E077,$3DDC
	dc.w	$0E00,$FF77,$9FDF,$EE00
	dc.w	$FFF7,$CFDF,$FE00,$FF77
	dc.w	$E7DF,$EE00,$F877,$E3DF
	dc.w	$0E00,$FC77,$E1DF,$8E00
	dc.w	$FC57,$E15F,$8A00,$7823
	dc.w	$C08F,$0400,$0000,$0000
	dc.w	$0000,$0000,$0000,$0000
	dc.w	$0001,$C722,$F200,$0002
	dc.w	$28B6,$8A00,$0002,$08AA
	dc.w	$8A00,$0002,$08A2,$F200
	dc.w	$0002,$28A2,$8200,$0001
	dc.w	$C722,$8100

imag1:	dc.w	$0000,$0000,$0000,$0000
	dc.w	$0000,$0000,$C003,$FF1F
	dc.w	$F800,$E007,$FFBF,$FC00
	dc.w	$E007,$FFBF,$FC00,$E007
	dc.w	$03B8,$0000,$E007,$03B8
	dc.w	$0000,$F007,$83BC,$F800
	dc.w	$F807,$C3BE,$7C00,$FC07
	dc.w	$E3BF,$1C00,$FE07,$F3BF
	dc.w	$9C00,$FFE7,$FFBF,$FC00
	dc.w	$FFD7,$FEBF,$F400,$7FE3
	dc.w	$FF1F,$F800,$0000,$0000
	dc.w	$0000,$0000,$0000,$0000
	dc.w	$2FA8,$4E00,$0000,$222C
	dc.w	$5100,$0000,$222A,$5000
	dc.w	$0000,$2229,$5300,$0000
	dc.w	$2228,$D100,$0000,$C228
	dc.w	$4F00,$0000

* BITBLK structures

btblk0:	dc.l	imag0
	dc.w	6,22,0,0,1
btblk1:	dc.l	imag1
	dc.w	6,22,0,0,1

* TEDINFO structures

tinfo0:	dc.l	title2,null,null
	dc.w	5,6,2,$1180,0,-1,12,1
tinfo1:	dc.l	title4,null,null
	dc.w	5,6,2,$1180,0,-1,22,1

* Initialized position data for object #0

mebd1:	dc.w	$60,$16,$E8,$50
hibd1:	dc.w	$60,$26,$E8,$A0

* Object tree for dialog box

fntbox:	dc.w	-1,1,9,20,0,16
	dc.l	$00021100
boxdat:	dc.w	0,0,0,0

	dc.w	2,-1,-1,23,0,0
	dc.l	btblk0
	dc.w	1,1,5,1

	dc.w	3,-1,-1,23,0,0
	dc.l	btblk1
	dc.w	6,1,5,1

	dc.w	4,-1,-1,21,0,0
	dc.l	tinfo0
	dc.w	12,1,9,1

	dc.w	5,-1,-1,28,0,1
	dc.l	title1
	dc.w	12,2,14,1

	dc.w	6,-1,-1,21,0,0
	dc.l	tinfo1
	dc.w	12,3,16,1

	dc.w	7,-1,-1,28,0,0
	dc.l	title5
	dc.w	5,5,19,1

	dc.w	8,-1,-1,26,5,0
	dc.l	degbms
	dc.w	2,7,7,2

	dc.w	9,-1,-1,26,5,0
	dc.l	b8bms
	dc.w	11,7,7,2

	dc.w	0,-1,-1,26,$25,0
	dc.l	sysbms
	dc.w	20,7,7,2

	dc.l	fntbox

defnam:	dc.b	'FONT.DEF',0

ddir:	dc.b	'A:\*.FNT'
	ds.b	56
fdir:	dc.b	'A:\*.FN8'
	ds.b	56

	bss
	even

boxadr:	ds.l	1
fsavt:	ds.l	1
fsav1:	ds.l	1
fsav2:	ds.l	1
temp:	ds.l	1
itmadr:	ds.l	1
iasav:	ds.l	1

myid:	ds.w	1
handle:	ds.w	1
menuid:	ds.w	1
res:	ds.w	1
diflag:	ds.w	1
selobj:	ds.w	1
state:	ds.w	1
cx:	ds.w	1
cy:	ds.w	1
cw:	ds.w	1
ch:	ds.w	1

curdrv:	ds.w	1
file:	ds.w	8

mspipe:	ds.w	8

pathnm:	ds.b	64
curpth:	ds.b	64

buffer:	ds.b	$0810

fntdat:	ds.b	$1000

* GEM arrays

	.even
contrl:	ds.w	12
intin:	ds.w	128
intout:	ds.w	128
global:
apvrsn:	ds.w	1
apcont:	ds.w	1
apid:	ds.w	1
apprvt:	ds.l	1
apptre:	ds.l	1
ap1rsv:	ds.l	1
ap2rsv:	ds.l	1
ap3rsv:	ds.l	1
ap4rsv:	ds.l	1

addrin:	ds.w	128
addrout:ds.w	128

	even
	ds.l	1
	ds.l	256
ustk:	ds.l	1

	end