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 ]