Rebol Programming/layout

USAGE:

LAYOUT specs /size pane-size /offset where /parent new /origin pos /styles list /keep /tight 

DESCRIPTION:

Return a face with a pane built from style description dialect.

LAYOUT is a function value.

ARGUMENTS:

• specs -- Dialect block of styles, attributes, and layouts (Type: block)

REFINEMENTS:

• /size
  • pane-size -- Size (wide and high) of pane face (Type: pair)
• /offset
  • where -- Offset of pane face (Type: pair)
• /parent
  • new -- Face style for pane (Type: object word block)
• /origin
  • pos -- Set layout origin (Type: pair)
• /styles
  • list -- Block of styles to use (Type: block)
• /keep -- Keep style related data
• /tight -- Zero offset and origin

SOURCE CODE

layout: func [
    {Return a face with a pane built from style description dialect.} 
    specs [block!] "Dialect block of styles, attributes, and layouts" 
    /size pane-size [pair!] "Size (wide and high) of pane face" 
    /offset where [pair!] "Offset of pane face" 
    /parent new [object! word! block!] "Face style for pane" 
    /origin pos [pair!] "Set layout origin" 
    /styles list [block!] "Block of styles to use" 
    /keep "Keep style related data" 
    /tight "Zero offset and origin" 
    /local pane way space tabs var value args new-face pos-rule val facets start vid-rules max-off guide 
    def-style rtn word
][
    if tight [
        if not offset [offset: true where: 0x0] 
        if not origin [origin: true pos: 0x0]
    ] 
    new-face: make any [
        all [parent object? new new] 
        all [parent word? new get-style new] 
        vid-face
    ] any [all [parent block? new new] [parent: 'panel]] 
    if not parent [
        new-face/offset: any [
            all [offset where] 
            50x50
        ]
    ] 
    new-face/size: pane-size: any [
        all [size pane-size] 
        new-face/size 
        system/view/screen-face/size - (2 * new-face/offset)
    ] 
    new-face/pane: pane: copy [] 
    max-off: origin: where: either origin [pos] [20x20] 
    space: 8x8 way: 0x1 pos: guide: none tabs: 100x100 
    def-style: none 
    new-face/styles: styles: either styles [list] [copy vid-styles] 
    parse specs [some [thru 'style val: 
            [set word word! (if not find styles word [insert styles reduce [word none]]) 
                | none (error "Expected a style name" val)
            ]
        ]] 
    parse specs [some [thru 'styles val: [
                set word word! (
                    if all [value? word value: get word block? value] [
                        insert styles value
                    ]
                ) | none (error "Expected a style name" val)
            ]]] 
    rtn: [where: (max-off * reverse way) + (way * any [guide origin])] 
    vid-rules: [
        'return (do rtn) 
        | 'at [set pos pair! (where: pos) | none] 
        | 'space pos-rule (space: 1x1 * pos) 
        | 'pad pos-rule (
            value: either integer? pos [way * pos] [pos] 
            where: where + value 
            max-off: max-off + value
        ) 
        | 'across (if way <> 1x0 [way: 1x0 do rtn]) 
        | 'below (if way <> 0x1 [do rtn way: 0x1]) 
        | 'origin [set pos [pair! | integer!] (origin: pos * 1x1) | none] (where: max-off: origin) 
        | 'guide [set pos pair! (guide: pos do rtn) | none (guide: where)] (max-off: 0x0) 
        | 'tab (where: next-tab tabs way where) 
        | 'tabs [
            set value [block! | pair!] (tabs: value) | 
            set value integer! (tabs: value * 1x1)
        ] 
        | 'indent pos-rule (where/x: either integer? pos [where/x + pos] [pos/x]) 
        | 'style set def-style word! 
        | 'styles set value block! 
        | 'size set pos pair! (pane-size: new-face/size: pos size: true) 
        | 'backcolor set value tuple! (new-face/color: value) 
        | 'backeffect set value block! (new-face/effect: value) 
        | 'do set value block! (do :value)
    ] 
    pos-rule: [set pos [integer! | pair! | skip (error "Expected position or size:" :pos)]] 
    if empty? vid-words [
        foreach value vid-rules [if lit-word? :value [append vid-words to-word value]]
    ] 
    while [not tail? specs] [
        forever [
            value: first specs specs: next specs 
            if set-word? :value [var: :value break] 
            if not word? :value [error "Misplaced item:" :value break] 
            if find vid-words value [
                either value = 'style [
                    facets: reduce [first specs] 
                    specs: next specs
                ] [
                    set [specs facets] do-facets start: specs [] styles
                ] 
                if :var [set :var where var: none] 
                insert facets :value 
                if not parse facets vid-rules [error "Invalid args:" start] 
                break
            ] 
            new: select styles value 
            if not new [error "Unknown word or style:" value break] 
            set [specs facets] do-facets specs new/words styles 
            new: make new either val: select facets 'with [expand-specs new val] [[]] 
            new/style: value 
            new/pane-size: pane-size 
            new/styles: styles 
            new/flags: exclude new/flags state-flags 
            if not flag-face? new fixed [new/offset: where] 
            grow-facets new facets 
            track ["Style:" new/style "Offset:" new/offset "Size:" new/size] 
            either def-style [
                change next find styles def-style new 
                def-style: none
            ] [
                new/parent-face: none 
                if :var [new/var: bind to-word :var :var] 
                do bind new/init in new 'init 
                if new/parent-face [new: new/parent-face] 
                if :var [set :var new var: none] 
                append pane new 
                if not flag-face? new fixed [
                    max-off: maximum max-off new/size + space + where 
                    where: way * (new/size + space) + where
                ] 
                if all [warn any [new/offset/x > pane-size/x new/offset/y > pane-size/y]] [
                    error "Face offset outside the pane:" new/style
                ] 
                track ["Style:" new/style "Offset:" new/offset "Size:" new/size] 
                if not keep [
                    new/init: copy [] 
                    new/words: new/styles: new/facets: none
                ]
            ] 
            break
        ]
    ] 
    if not size [
        foreach face pane [if flag-face? face drop [face/size: 0x0]] 
        new-face/size: size: origin + second span? pane 
        foreach face pane [
            if flag-face? face drop [face/size: size] 
            face/pane-size: size
        ]
    ] 
    new-face
]