🚀 go-pugleaf

[AppliFont Desk Accessory (source)]

#!/bin/sh
# shar:	Shell Archiver
#	Run the following text with /bin/sh to create:
#	applifont.asm
sed 's/^X//' << 'SHAR_EOF' > applifont.asm
X; AppliFont Desk Accessory
X; gives the ability to change the default application font
X
X	include	sysequ.d
X	include toolequ.d
X	include mactraps.d
X	
X	portrect	equ	$10	; from quickequ
X	
X	dsubid		equ	1
X
X	mymenu		equ	-11111
X	menuhoff	equ	0
X	name		equ	menuhoff+4
X	fnum		equ	name+256
X	errect		equ	fnum+2
X	rescid		equ	errect+8
X	resctype	equ	rescid+2
X	dialid		equ	resctype+4
X	itemhit		equ	dialid+2
X	gporttemp	equ	itemhit+2
X	
X	storage		equ	gporttemp+4
X	
X	aboutitem	equ	1
X	buttonitem	equ	1
X	
X	
XEntry
X	dc.w	$400		; Allow control
X	dc.w	0		; no periodic
X	dc.w	$0fff		; allow standard events
X	dc.w	mymenu		; Font menu
X	
X	dc.w	open-entry
X	dc.w	done-entry	; no prime routine
X	dc.w	control-entry
X	dc.w	done-entry	; no status
X	dc.w	close-entry
X	
X	string_format	3
XTitle
X	dc.w	'Select Application Font'
X	
X	.align	2
X
Xopen
X	movem.l	a2-a4,-(sp)
X	move.l	a1,a4
X	tst.l	dctlwindow(a4)	; been here yet?
X	bne	gotawindow
X	
X	; get storage
X	; function newhandle(size:d0):a0
X	move.l	#storage,d0
X	_newhandle
X	move.l	a0,dctlstorage(a4)
X	
X	_hlock
X	
X	move.l	dctlstorage(a4),a2
X	move.l	(a2),a2
X	
X	clr.w	rescid(a2)
X	clr.l	resctype(a2)
X	
X	; recover handle to DRVR
X	lea	entry,a0
X	_recoverhandle
X	
X	; get id
X	move.l	a0,-(sp)
X	pea	rescid(a2)
X	pea	resctype(a2)
X	pea	name(a2)
X	_getresinfo
X	
X	; calc
X	move.w	rescid(a2),d0
X	asl.w	#5,d0
X	add.w	#$c000,d0		; mark as owned resource
X	add.w	#dsubid,d0		; add subid of dialog
X	move.w	d0,dialid(a2)
X	
X	move.l	dctlstorage(a4),a0
X	_hunlock
X	
X	; alloc window
X	clr.l	-(sp)		; result
X	clr.l	-(sp)		; alloc storage on heap
X	pea	dabounds
X	pea	title
X	clr.w	-(sp)		; invisible
X	move.w	#rdocproc,-(sp)	; DA window proc
X	move.l	#-1,-(sp)	; front window
X	move.w	#$0100,-(sp)	; has goaway box
X	clr.l	-(sp)		; refcon is 0
X	_newwindow
X	move.l	(sp)+,a0
X	move.l	a0,dctlwindow(a4)
X	
X	move.l	dctlrefnum(a4),windowkind(a0)	; mark as system window
X	
X	; new menu
X	clr.l	-(sp)
X	move.w	#mymenu,-(sp)
X	pea	menutitle
X	_newmenu
X	move.l	(sp)+,a3	; menuhandle
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	move.l	a3,menuhoff(a0)
X	
X	move.l	a3,-(sp)
X	pea	menuitems
X	_appendmenu
X
X	;append fonts
X	move.l	a3,-(sp)
X	move.l	#'FONT',-(sp)
X	_addresmenu
X
Xgotawindow
X	movem.l	(sp)+,a2-a4
Xdone
X	clr.w	d0
X	rts
X
Xclose
X	move.l	a4,-(sp)
X	move.l	a1,a4
X	; dispose window
X	move.l	dctlwindow(a4),-(sp)
X	_disposwindow	; [sic]
X	clr.l	dctlwindow(a4)		; mark free
X	; deletemenu
X	move.w	#mymenu,-(sp)
X	_deletemenu
X	_drawmenubar
X	
X	; disposehandles
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	move.l	menuhoff(a0),a0
X	_disposhandle
X
X	move.l	dctlstorage(a4),a0
X	_disposhandle
X	
X	move.l	(sp)+,a4
X	bra.s	done
X	
Xcontrol
X	movem.l	a3/a4,-(sp)
X	move.l	a1,a4
X	move.l	a0,a3
X	
X	move.w	cscode(a3),d0	; get cntl code
X	sub.w	#64,d0		; adjust range
X	cmp.w	#0,d0		; event
X	beq.s	doevent
X	cmp.w	#3,d0		; menu
X	beq	domenu
X	
X	; allow only event and menu
X	
Xctldone
X	move.l	a4,a1
X	move.l	a3,a0
X	movem.l	(sp)+,a4/a3
X	bra	done
X
Xdoevent
X	move.l	a3,-(sp)
X	move.l	csparam(a3),a3
X	move.w	evtnum(a3),d0
X	add.w	d0,d0
X	move.w	eventtable(d0),d0
X	jmp	eventtable(d0)
X
Xeventtable
X	dc.w	ctlevtdone-eventtable		; null (x)
X	dc.w	ctlevtdone-eventtable		; mousedown (x)
X	dc.w	ctlevtdone-eventtable		; mouseup (x)
X	dc.w	ctlevtdone-eventtable		; keydown (x)
X	dc.w	ctlevtdone-eventtable		; keyup (x)
X	dc.w	ctlevtdone-eventtable		; autokey (x)
X	dc.w	doupdate-eventtable		; update
X	dc.w	ctlevtdone-eventtable		; disk (x)
X	dc.w	doactivate-eventtable		; activate 
X	dc.w	ctlevtdone-eventtable		; abort (x)
X	dc.w	ctlevtdone-eventtable		; network (x)
X	dc.w	ctlevtdone-eventtable		; iodriver (x)
X
Xctlevtdone
X	move.l	(sp)+,a3
X	bra	ctldone
X
Xdoupdate
X	; beginupdate(wptr)
X	move.l	dctlwindow(a4),-(sp)
X	_beginupdate
X	
X	bsr.s	drawcontents
X	
X	; endupdate(wptr)
X	move.l	dctlwindow(a4),-(sp)
X	_endupdate
X	
X	bra	ctlevtdone
X	
Xdrawcontents
X	move.l	dctlwindow(a4),-(sp)
X	_setport
X	
X	move.l	dctlwindow(a4),a0
X	pea	portrect(a0)
X	_eraserect
X	
X	move.w	#20,-(sp)
X	move.w	#20,-(sp)
X	_moveto
X	
X	pea	'Application Font Changer,  By Jim Hamilton'
X	_drawstring
X	
X	move.w	#20,-(sp)
X	move.w	#40,-(sp)
X	_moveto
X	
X	pea	'Use the AppliFont menu to select the desired font.'
X	_drawstring
X	
X	move.w	#20,-(sp)
X	move.w	#60,-(sp)
X	_moveto
X	
X	pea	'Change effective on next application launch'
X	_drawstring
X	
X	move.l	dctlwindow(a4),-(sp)
X	_setport
X	
X	move.w	#20,-(sp)
X	move.w	#95,-(sp)
X	_moveto
X	
X	pea	'Current Default Application Font:  '
X	_drawstring
X
X; get current ap font from system param area
X	lea	SPFont,a0
X	move.w	(a0),d0
X	addq.w	#1,d0		; stored value is font number minus 1
X	move.w	d0,-(sp)
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	pea	name(a0)
X	_getfname
X	
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	pea	name(a0)
X	_drawstring
X
X	rts
X
Xdoactivate
X	btst	#0,evtmeta+1(a3)
X	beq.s	dodeactivate
X	
X	; show menu
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	move.l	menuhoff(a0),-(sp)
X	clr.w	-(sp)
X	_insertmenu
X	
X	_drawmenubar
X	
X	bra	ctlevtdone
X
Xdodeactivate
X	move.w	#mymenu,-(sp)
X	_deletemenu
X	_drawmenubar
X	
X	bra	ctlevtdone
X
Xdomenu
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	move.w	csparam+2(a3),d0	; Menu item number
X	cmp.w	#aboutitem,d0
X	beq.s	doaboutdialog
X	
X	move.l	menuhoff(a0),-(sp)	; menu handle
X	move.w	d0,-(sp)		; Menu item number
X	pea	name(a0)		; space for font name
X	_getitem
X	
X	move.l	dctlstorage(a4),a0
X	move.l	(a0),a0
X	pea	name(a0)
X	pea	fnum(a0)
X	_getfnum
X
X; write new ap font in system param area
X	move.l	a3,-(sp)
X	move.l	dctlstorage(a4),a3
X	move.l	(a3),a3
X	move.w	fnum(a3),d0
X	subq.w	#1,d0		; stored value is font number minus 1
X	lea	SPFont,a1
X	move.w	d0,(a1)		; change font in parameter ram
X	
X	lea	SPValid,a0	; "Inside Macintosh" says to load A0 and D0
X	move.l	#-1,d0		; with these values "for historical reasons"
X	_writeparam
X	
X	move.l	dctlwindow(a4),a3
X	move.l	a3,-(sp)
X	_setport
X	
X	pea	portrect(a3)
X	_invalrect
X	
X	move.l	(sp)+,a3	; restore
X	
X	bra	ctldone
X
Xdoaboutdialog
X
X	move.l	a3,-(sp)
X	move.l	dctlstorage(a4),a3
X	move.l	(a3),a3
X	
X	; save current port
X	pea	gporttemp(a3)
X	_getport
X	
X	; function getnewdialog (dialogid:integer; dstor:ptr;
X	;	behind:windowptr) : dialogptr
X	clr.l	-(sp)
X	move.w	dialid(a3),-(sp)	; identify rsrc # for dialog
X	clr.l	-(sp)			; alloc storage on heap
X	move.l	#-1,-(sp)		; dialog goes on top
X	_getnewdialog
X	move.l	(sp),-(sp)		; copy handle for close
X	
X	; procedure setport (gp:grafport)
X	_setport
X	
Xwaitforok
X	; procedure modaldialog (filterproc: procptr; var itemhit:integer);
X	clr.l	-(sp)
X	pea	itemhit(a3)
X	_modaldialog
X	
X	move.w	itemhit(a3),d0
X	cmp.w	#buttonitem,d0		; was it ok button?
X	bne	waitforok
X	
X	; procedure clodedialog (thedialog: dialogptr);
X	_closedialog			; handle already on stack
X	
X	; reset the grafport
X	; procedure setport( gp: grafport);
X	move.l	gporttemp(a3),-(sp)
X	_setport
X	
X	move.l	(sp)+,a3
X	
X	bra	ctldone
X
X	
XDAbounds	dc.w	100,50,250,450
X
Xmenutitle	dc.w	'AppliFont'
X
Xmenuitems	dc.w	'About AppliFont...;(-'
X
X	End
X	
SHAR_EOF
exit