Here's the Fixed dialect I've been working on. It's a dialect for pulling
apart fixed width data files and translating the strings into appropriate
Rebol values. With the use of my Associate functions (included), the dialect
can even combine split up values. Here's an example of the dialect (with
comments), which I'm using to cut up a DOS/Windows 3.1 database that my
local high school uses:

    Fields: [
        "Family Name" 20    ; Column name is a string!, width of the field
in characters is a integer!.
        "First Name" 25
        "Preferred" 12
        "Mail to Whom" 35
        "Invoices?" logic!    ; Converts "Y"/"N into logic value, no need
for size as it's automatic.
        "Reports?" logic!
        "Address" [25 20 20]    ; multiple lines automatically converted to
one Rebol string!
        "Telephone" 19 /with " -()"    ; refinement to 'trim function, to
get rid of extraneous characters in 'phone number.
        "Cellphone" 7 /with " -()"
        "Nationality" 3
        "Language" 2
        skip 4
        "Year" 2 integer!    ; Converts integer text into integer value.
        "Form" 4
        skip 4
        "Gender" char!    ; Same for char! values.
        "Birth" 8 date!    ; and for date! values. The "8" specifies how
much text to use for the date.
        "Enrollment" 5 issue!
        skip    ; Skip a single character
        "First Started" 8 date!
        "First Attended" 8 date!
        skip 3    ; Skip several characters.
        "Status" char!

        "Magic Marker" 3 binary!    ; Convert a binary value (key in BASIC
data).
        skip 2
        ]

Andrew Martin
ICQ: 26227169 http://valley.150m.com/
-><-



-- Attached file included as plaintext by Listar --
-- File: Fixed.r

Rebol [
        Name: 'Fixed
        Title: "Fixed"
        File: %Fixed.r
        Author: "Andrew Martin"
        eMail: [EMAIL PROTECTED]
        Web: http://valley.150m.com
        Date: 27/August/2002
        Version: 1.0.0
        Purpose: {Cuts up fixed width data file into Rebol values in an association.}
        Category: [util 1]
        ]

Fixed: function [
        {Cuts up fixed width data file into Rebol values in an association.}
        Data [string! binary!]  "The data file"
        Dialect [block!]        "The dialect controlling the cutting."
        ] [
        Values Field Width Widths Value Type Previous With
        ] [
        Values: make block! 200
        parse Dialect [
                any [
                        [
                                'skip (Width: 1) opt [set Width integer!] (
                                        Data: next at Data Width
                                        )
                                ]
                        | [
                                set Field string! (Width: 1 Type: string!) [
                                        [
                                                set Width integer! set Type [
                                                        'issue! | 'integer! | 'date! | 
'binary!
                                                        ] (
                                                        Value: attempt [load trim 
to-string copy/part Data Width]
                                                        )
                                                ]
                                        | [
                                                set Width integer! opt [/with set With 
string!] (
                                                        ;Value: trim to-string 
copy/part Data Width
                                                        Value: to-string copy/part 
Data Width
                                                        either With [
                                                                trim/with Value With
                                                                With: none
                                                                ][
                                                                trim Value
                                                                ]
                                                        )
                                                ]
                                        | [
                                                set Widths into [some integer!] (
                                                        Value: make string! 100
                                                        foreach Width Widths [
                                                                if not empty? Value [
                                                                        append Value 
newline
                                                                        ]
                                                                append Value trim 
to-string copy/part Data Width
                                                                Data: next at Data 
Width
                                                                ]
                                                        Width: 0
                                                        )
                                                ]
                                        | [
                                                'logic! (
                                                        Value: switch/default trim 
to-string copy/part Data Width [
                                                                "Y" [true]
                                                                "N" [none]
                                                                ] [
                                                                none
                                                                ]
                                                        )
                                                ]
                                        | [
                                                'char! (
                                                        Value: attempt [to-char trim 
to-string copy/part Data Width]
                                                        )
                                                ]
                                        ] (
                                        Data: at Data 1 + Width
                                        all [
                                                series? Value
                                                empty? Value
                                                Value: none
                                                ]
                                        Previous: associate? Values Field
                                        either Previous: associate? Values Field [
                                                either series? Previous [
                                                        append Previous Field
                                                        ] [
                                                        associate-many Values Field 
Value
                                                        ]
                                                ] [
                                                associate Values Field Value
                                                ]
                                        ;print rejoin [Field ": " mold Value "."]
                                        )
                                ]
                        | [
                                set Value any-type! (
                                        print rejoin ["Error: Couldn't understand: " 
mold Value "!"]
                                        halt
                                        )
                                ]
                        ]
                end
                ]
        reduce [Values Data]
        ]

-- Attached file included as plaintext by Listar --
-- File: Associate.r

Rebol [
        Name: 'Associate
        Title: "Associate"
        File: %Associate.r
        Author: "Andrew Martin"
        eMail: [EMAIL PROTECTED]
        Web: http://valley.150m.com
        Date: 15/August/2002
        Version: 1.2.0
        Purpose: "Provides an associative memory store."
        Category: [db util 4]
        ]

Associate?: function [
        Association [series! port! bitset!]
        Key [any-type!]
        ] [
        Associated
        ] [
        if found? Associated: select/only/skip Association :Key 2 [
                first Associated
                ]
        ]

Associate: function [
        Association [series! port! bitset!]
        Key [any-type!]
        Value [any-type!]
        ] [
        Associated
        ] [
        either found? Associated: find/only/skip Association :Key 2 [
                either none? :Value [
                        remove/part Associated 2
                        ] [
                        change/only next Associated :Value
                        ]
                ] [
                if not none? :Value [
                        repend Association [Key Value]
                        ]
                ]
        Association
        ]

Associate-Many: function [
        Association [series! port! bitset!]
        Key [any-type!]
        Value [any-type!]
        /Only   "Appends a block value as a block."
        ] [
        Associated
        ] [
        if none? :Value [
                return Associate Association :Key :Value
                ]
        either found? Associated: Associate? Association :Key [
                if not block? Associated [
                        Associated: reduce [Associated]
                        Associate Association :Key Associated
                        ]
                either Only [
                        insert/only tail Associated :Value
                        ] [
                        insert tail Associated :Value
                        ]
                ] [
                associate Association :Key :Value
                ]
        Association
        ]

Keys: func [Association [series! port! bitset!]][
        extract Association 2
        ]


-- 
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the 
subject, without the quotes.

Reply via email to