REBOL [
    Title: "Face Grid"
    Author: "Brett Handley"
    Version: 0.2.0
    Date: 28-Mar-2002
]

canvas-size: func [face [object!]] [
    either face/edge [
        face/size - (2 * face/edge/size)
    ][face/size]
]

face-grid-stylesheet: stylize [

    face-grid: face with [

        grid-facets: none ; Storage for grid attributes.
        cell-facets: none ; A hook for overriding facets.
        grow-size: false  ; Automatically expand grid.
        topleft-cell: 1x1 ; Address of the topleft cell to display.
        data: none

        init: [
            if not size [size: 300x60]
            if not grid-facets [grid-facets: copy []]
            if not find grid-facets 0x0 [append grid-facets copy [0x0 []]]
            if not select grid-facets/0x0 to-set-word 'size [
                append grid-facets/0x0 [size: 100x20]
            ]
            if not select grid-facets/0x0 to-set-word 'style [
                append grid-facets/0x0 [style: 'text]
            ]
            if not select grid-facets/0x0 to-set-word 'edge [
                append grid-facets/0x0 [
                    edge: context [
                        color: 110.120.130
                        image: effect: none
                        size: 1x1
                    ]
                ]
            ]
            if not :cell-facets [
                cell-facets: function [address facets] [row col val] [
                    if none? data [return true]
                    if greater? address/2 length? data [return false]
                    if not block? row: pick data address/2 [return false]
                    if greater? address/1 length? row [return false]
                    val: pick row address/1
                    either none? val [[text: copy {}]] [
                        compose [text: (form val)]
                    ]
                ]
            ]
            initialise-faces self
        ]

        get-pair: function [address [pair!] name] [
            result facets value
        ] [
            if not find [size offset] name [
                throw make error! "name must be one of 'size or 'offset."
            ]
            result: none
            repeat ref [0x0 1x0 0x1] [
                facets: select grid-facets ref * address
                if all [facets value: select facets to-set-word name] [
                    if not result [result: 0x0]
                    if value [result: add value multiply result reverse ref]
                ]
            ]
            result
        ]

        get-facets: function [address [pair!]] [
            facets value ofst cf
        ] [
            facets: compose [cell: (address) offset: none]
            repeat ref [0x0 1x0 0x1 1x1] [
                insert tail facets select grid-facets ref * address
            ]
            insert tail facets compose [size: (get-pair address 'size)]
            if ofst: get-pair address 'offset [
                insert tail facets reduce [to-set-word 'offset ofst]
            ]
            if not none? :cell-facets [
                cf: either function? :cell-facets [cell-facets address facets] [cell-facets]
                either logic? cf [
                    if not cf [return none]
                ] [
                    if block? cf [insert tail facets cf]
                ]
            ]
            facets
        ]

        create-cell: function [face address][fct cell-spec][
            if cell-spec: face/get-facets address [
                fct: context cell-spec
                make-face/spec/styles fct/style cell-spec copy face/styles
            ]
        ]

        initialise-faces: function [face] [
            cnv-size pt address max-size
            allocate-cell cell-o cell-s cell-f
            last-col last-row last-col? last-row?
        ] [

            if not face/pane [face/pane: copy []]
            clear face/pane

            last-col?: either face/grow-size [ does [none? cell-f] ][
                does [not within? pt 0x0 cnv-size] ]

            last-row?: either face/grow-size [ does [last-row] ][
                does [not within? pt 0x0 cnv-size] ]

            cnv-size: canvas-size face
            address: topleft-cell
            pt: 0x0 max-size: 0x0
            last-col: last-row: false

            forever [
                address/1: topleft-cell/1
                forever [
                    cell-f: create-cell face address
                    either cell-f [
                        cell-o: cell-f/offset
                        cell-s: cell-f/size
                    ][
                        cell-o: get-pair address 'offset
                        cell-s: get-pair address 'size
                    ]
                    pt: max pt 1x0 * any [cell-o pt]
                    either last-col? [
                        either last-col [last-row: true][last-col: true]
                        break
                    ][last-col: false]
                    max-size: max max-size add pt cell-s
                    cnv-size: max cnv-size max-size
                    if cell-f [
                        cell-f/offset: pt
                        insert tail face/pane cell-f
                    ]
                    pt: add pt 1x0 * cell-s
                    address: address + 1x0
                ]
                pt: max-size * 0x1
                address: address + 0x1
                if last-row? [break]
            ]

            if face/grow-size [
                face/size: max cnv-size max-size
                if face/edge [face/size: face/size + (2 * face/edge/size)]
            ]
        ]

    ]

]