;* $Revision Header built automatically *************** (do not edit) ************
;*
;* © Copyright by (none)
;*
;* File             : FlushFonts.asm
;* Created on       : Saturday, 02.04.94 16:15:37
;* Created by       : Arnold Schommer
;* Current revision : V1.3
;*
;*
;* Purpose
;* -------
;*   - removes all fonts from the memory, that are no more in use
;*
;* Revision V1.3
;* --------------
;* created on Friday, 18.06.93 16:32:38  by  Arnold Schommer.   LogMessage :
;*  -*-  changed on Saturday, 02.04.94 16:17:32  by  Arnold Schommer.   LogMessage :
;*   - converted DICE -> A68k
;*  -*-  created on Friday, 18.06.93 16:32:38  by  Arnold Schommer.     LogMessage :
;*   - works, but i had to use Graphics.StripFont(), what is not
;*     documented in the RKRM Autodocs & Includes. i used
;*     StripFont() on a NOT opened font. maybe this causes, maybe
;*     this avoids trouble. who (but cbm) knows ?
;*
;* Revision V1.2
;* --------------
;* created on Friday, 18.06.93 16:02:13  by  Arnold Schommer.   LogMessage :
;*   - also recognises TE0B_NOREMFONT
;*
;* Revision V1.1
;* --------------
;* created on Thursday, 17.06.93 23:50:31  by  Arnold Schommer.   LogMessage :
;*   - program runs, but fonts don't get removed.
;*     the fault seems to be in Graphics.RemFont(). as far as i
;*     understand, the TE0B_NOREMFONT is found set - but not by me !
;*     seems to be a strange feature of OpenDiskFont().
;*
;* Revision V1.0
;* --------------
;* created on Thursday, 17.06.93 22:34:41  by  Arnold Schommer.   LogMessage :
;*     --- Initial release ---
;*
;*********************************************************************************
REVISION  MACRO
          dc.b "1.3"
          ENDM
REVDATE   MACRO
          dc.b "02.04.94"
          ENDM
REVTIME   MACRO
          dc.b "16:17:32"
          ENDM
AUTHOR    MACRO
          dc.b "Arnold Schommer"
          ENDM
VERNUM    EQU  1
REVNUM    EQU  0
****************************************************************************
        NOLIST
        INCLUDE "exec/LVO.i"
        INCLUDE "dos/LVO.i"
        INCLUDE "dos/dosextens.i"
        INCLUDE "graphics/LVO.i"
        INCLUDE "exec/lists.i"
        INCLUDE "exec/ports.i"
        INCLUDE "graphics/gfxbase.i"
        INCLUDE "graphics/text.i"
        LIST
****************************************************************************

;Register-Variablen:

_GfxBase:       EQUR d7
_DOSBase:       EQUR d6
_ExecBase:      EQUR a5
WBMsg:          EQUR d5
_Output:        EQUR d4
to_remove:      EQUR a4
current:        EQUR a3

****************************************************************************

        SECTION prg,CODE

;Library-Namen kopieren:
_main:  move.l  _AbsExecBase,_ExecBase
        moveq   #0,WBMsg
        moveq   #RETURN_FAIL,d3
        move.l  WBMsg,a1        ;a1=0->eigener Task
        move.l  _ExecBase,a6
        CALL    FindTask        ;Wo darf man denn nachschauen ?
        move.l  d0,a4
        tst.l   pr_CLI(a4)      ;von CLI oder WB aus gestartet ?
        bne     fromCLI
;von WB aus:
        lea     pr_MsgPort(a4),a0
        CALL    WaitPort        ;auf Start-Message warten
        lea     pr_MsgPort(a4),a0
        CALL    GetMsg          ;muß nachher beantwortet werden
        move.l  d0,WBMsg
;Libraries öffnen:
fromCLI: OPENLIB DosName(pc)
        move.l  d0,_DOSBase
        beq     ende
        CALLDOS Output
        move.l  d0,_Output
        OPENLIB GfxName(pc)
        beq     CloseDos
        move.l  d0,_GfxBase
****************************************************************************
;das eigentliche Programm:
        move.l  _GfxBase,a0
        move.l  gb_TextFonts+LH_HEAD(a0),current
loop:   move.l  LN_SUCC(current),d0
        beq     endofmain
        move.l  current,to_remove
        move.l  d0,current
        move.l  LN_NAME(to_remove),a0
        bsr     puts
        btst.b  #FPB_DISKFONT,tf_Flags(to_remove)
        bne     2$
        lea     no_df(pc),a0
        bra     comment
2$:     tst.w   tf_Accessors(to_remove)
        beq     remove
        lea     used(pc),a0
        bra     comment
remove: move.l  _GfxBase,a6
        cmp.w   #36,LIB_VERSION(a6)
        blt     1$
        move.l  to_remove,a0
        CALL    StripFont
1$:     move.l  to_remove,a1
        CALL    RemFont
        lea     removed(pc),a0
comment: bsr    puts
        bra     loop
****************************************************************************
endofmain:
        moveq   #RETURN_OK,d3   ;alles ok
;die Libraries schließen
        CLOSELIB _GfxBase
CloseDos: CLOSELIB _DOSBase
;und wieder zurück
ende:   tst.l   WBMsg           ;war da was ?
        beq     toCLI           ;na dann halt nicht
;Message zur WB zurück
        move.l  _ExecBase,a6
        CALL    Forbid
        move.l  WBMsg,a1
        CALL    ReplyMsg
toCLI:  move.l  d3,d0           ;gab's Fehler ?
        rts
****************************************************************************
;Unterroutine: 0terminierten String ausgeben:
puts:   move.l  _DOSBase,a6
        move.l  _Output,d1
        move.l  a0,d2
1$:     tst.b   (a0)+
        bne     1$
        move.l  a0,d3
        sub.l   d2,d3
        subq.l  #1,d3
        JUMP    Write
****************************************************************************
;Versions-String
        dc.b    "$VER: FlushFonts "
        REVISION
        dc.b    " ("
        REVDATE
        dc.b    ")",0

DosName:        DOSNAME
GfxName:        GFXNAME
no_df:          dc.b " is no DiskFont",10,0
used:           dc.b " is still in use",10,0
removed:        dc.b " gets removed",10,0

        END
