REBOL [
    Title: "get-fonts-amiga"
    Date: 19-Oct-2002
    Name: get-fonts-amiga
    Version: 0.1.0
    File: %get-fonts-amiga.r
    Home: http://to-be-added-when-no-longer-homeless/
    Author: "Carl Read"
    Rights: "Public Domain"
    Needs: [REBOL/View 1.2.1]
    Tabs: 4
    Purpose: {To grab the names of the fonts available on AmigaOS and save
them as objects in a block for use by the request-font the
request-font.r script.
}
    History: [
    0.0.0 [15-Sep-2002 "First alpha version."] 
    0.0.1 [16-Sep-2002 "Second alpha version."] 
    0.0.2 [28-Sep-2002 "Third alpha version."] 
    0.1.0 [19-Oct-2002 "First beta version."]
]
    Language: English
    Email: carl@cybercraft.co.nz
    Category: [util vid view]
    Charset: ANSI
    Note: {
        1) This script should be placed in the same directory as the
        request-font.r script.

        2) The script when run saves a file called fonts-data.txt to the
        directory it was run from.  The request-font.r script needs to
        find this file whenever it is run, so this script needs to have
        been run at least once before request-font.r is run.

        3) The script should also be run after any modifications are made
        to the  system's fonts.  Doing this will keep the fonts-data.txt
        file up to date.

        3) * How to write versions of the get-fonts script for other OSs *

        All that's required of the script is that it extracts the font
        names from those available on the OS and saves them to a file
        called fonts-data.txt in the directory the script was run from.
        The objects should be made as follows...

        make object! [
            name: "font name"
        ]

        where "font name" is a string containing a font's name.

        How you write the script is up to you, but it should not add
        any words to the global context.  One way to do this is to
        hide the code in a function.  For example...

            do make function! [/local word1 word2 word3][
                ...
                code using word1, word2 and word3
                ...
            ]

        Note that the objects do not have to be sorted or checked
        for duplicates as this is done by the request-font.r script.

        The file-name of the script should reflect the OS it is
        written for.  ie, get-fonts-[OS-type].r.  At the time of
        writing (19-Oct-2002) two versions have been written for
        the Windows and Amiga OSs.  Their scripts are named
        get-fonts-windows.r and get-fonts-amiga.r.

        Check the list here...

        http://www.rebol.com/view-platforms.html

        for the OSs that still need a get-fonts-[OS-type].r script
        written for them...

    }
]

; Enclose code in function to prevent
; words being added to global context
;-------------------------------------

do make function! [/local names file][

    ; file-path to save block of fonts data to
    ;------------------------------------------

    file: join what-dir %fonts-data.txt

    ; Get contents of Amiga font directory
    ;--------------------------------------

    if error? try [names: read %/fonts/.][
        print "Error attempting to read Amiga fonts: directory!"
        halt
    ]

    ; Change file-names with a .font extension into an object
    ; and remove all other file and directory names from the block
    ;--------------------------------------------------------------

    forall names [
        either all [file? names/1  %.font = skip tail names/1 -5][
            names/1: make object! [
                name: to-string copy/part names/1 (length? names/1) - 5
            ]
        ][
            remove names names: back names
        ]
    ]

    ; Save block of fonts-data objects
    ;----------------------------------

    if error? try [save file head names][
        print "Error attempting to save block of Amiga fonts data"
        print ["to:" file]
        halt
    ]
]