Rebol Programming/layout
USAGE:
[edit | edit source]LAYOUT specs /size pane-size /offset where /parent new /origin pos /styles list /keep /tight
DESCRIPTION:
[edit | edit source]Return a face with a pane built from style description dialect.
LAYOUT is a function value.
ARGUMENTS:
[edit | edit source]- specs -- Dialect block of styles, attributes, and layouts (Type: block)
REFINEMENTS:
[edit | edit source]- /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
[edit | edit source]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
]