AppliFont Desk Accessory (source)
maci...@felix.uucp
#!/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