macintosh@felix.UUCP (12/21/86)
[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