wanted: program to process Windows Font files

[mnrvovrfc]

Press [ESC] if you are afraid this goes on too long LOL.

Code: (Select All)

dim as long ff, i, l, x, y, siz
dim as _byte goon
redim sf$(1 to 500)

chr255$ = chr$(255)

afile$ = "/tmp/fontlist.txt"
adir$ = "/usr/share/fonts"
zomd$ = "ls -1R " + adir$ + " > " + afile$
shell zomd$

l = 0
cudi$ = ""
ff = freefile
open afile$ for input as ff
do until eof(ff)
    line input #ff, a$
    if a$ = "" then _continue
    if right$(a$, 1) = ":" then
        cudi$ = left$(a$, len(a$) - 1) + "/"
    else
        a$ = cudi$ + a$
        print a$
        if _fileexists(a$) then
            l = l + 1
            sf$(l) = a$
        else
            print a$; " NOT FOUND! Something is wrong."
        end if
    end if
    if l >= 500 then exit do
loop
close ff
if l = 0 then
    print "I'm sorry, I couldn't find any fonts installed in the system!"
    print "It must be the programmer's fault!"
    end
end if

screen _newimage(800, 600, 32)
_TITLE "Check font..."
redim _preserve sf$(1 to l)
do
    for i = 1 to l
        for siz = 8 to 72 step 4
            if _keydown(27) then exit do
            m$ = "M"
            han = _loadfont(sf$(i), siz)
            if han > 0 then
ON ERROR GOTO ancienterrmusic
                if _fontwidth(han) = 0 then m$ = ""
                'if _printwidth("W") <> _printwidth("l") then m$ = ""
                goon = 1
                _font han
                if goon = 0 then _continue
                x = int(rnd * 700 + 1)
                y = int(rnd * 500 + 1)
                a$ = chr$(int(rnd * 95 + 33))
                _printstring(x, y), a$
                _font 14
                _freefont han
                entr$ = entr$ + sf$(i) + str$(siz) + m$ + chr255$
ON ERROR GOTO 0
            end if
        next
    next
loop while 0
if _keydown(27) then system
$CONSOLE
_DEST _CONSOLE
for i = 1 to len(entr$)
    a$ = mid$(entr$, i, 1)
    if a$ = chr255$ then print else print a$;
next
print
system

ancienterrmusic:
goon = 0
resume next

This program recurses directories in "/usr/share/fonts". So Linux only.
I added the test for "L = 0" because the "out of memory" runtime error was making me haywire. Oh well I should have asked the compiler to enable range-checking...
I should have checked more extensively if the "ON ERROR GOTO" / "RESUME" amounted to anything.