| 1 | REBOL [
|
|---|
| 2 | Title: "RebGUI layout function"
|
|---|
| 3 | Owner: "Ashley G. Trüter"
|
|---|
| 4 | Purpose: "Parse / layout a block of widgets, attributes and keywords."
|
|---|
| 5 | History: {
|
|---|
| 6 | 16 Added reduce/only logic to evaluate words / paths without need for compose
|
|---|
| 7 | 17 Added opt clause to handle ()
|
|---|
| 8 | 47 Fixed locale bug (select changed to select/skip)
|
|---|
| 9 | 48 Incorporated Cyphre's changes
|
|---|
| 10 | 55 Removed init2 logic (previously used by splitter)
|
|---|
| 11 | 65 Removed reset-action and text-align logic
|
|---|
| 12 | Corrected at bug (max-height is no longer reset to zero)
|
|---|
| 13 | tool-tip renamed tip
|
|---|
| 14 | Added #L (lateral) and #V (vertical) span directives
|
|---|
| 15 | 66 color now accepts none! in addition to tuple!
|
|---|
| 16 | pad and data now handle paren!
|
|---|
| 17 | 69 Added 'here to local words
|
|---|
| 18 | Fixed 'after to always return unless no widget
|
|---|
| 19 | Fixed nasty layout/only bug - should not inherit window effect
|
|---|
| 20 | 74 Added 'text-color and 'text-style [bold italic underline]
|
|---|
| 21 | 81 Changed an either not to either for attribute-show?
|
|---|
| 22 | 93 Added on-edit
|
|---|
| 23 | 94 Changed on-click to trigger on 'up
|
|---|
| 24 | Changed on-alt-click to trigger on 'alt-up
|
|---|
| 25 | 95 Added on keyword so multiple handlers can be specified at once
|
|---|
| 26 | 100 Copy option block
|
|---|
| 27 | 110 Added url!
|
|---|
| 28 | 111 Added on-resize
|
|---|
| 29 | }
|
|---|
| 30 | ]
|
|---|
| 31 |
|
|---|
| 32 | layout: make function! [
|
|---|
| 33 | spec [block!] "Block of widgets, attributes and keywords"
|
|---|
| 34 | /only "Do not change face offset"
|
|---|
| 35 | /local
|
|---|
| 36 | view-face
|
|---|
| 37 | here
|
|---|
| 38 | margin-size indent-width xy gap-size max-width max-height last-widget widget-face arg append-widget left-to-right?
|
|---|
| 39 | after-count after-limit
|
|---|
| 40 | word
|
|---|
| 41 | widget
|
|---|
| 42 | button-size
|
|---|
| 43 | field-size
|
|---|
| 44 | label-size
|
|---|
| 45 | text-size
|
|---|
| 46 | action-alt-click
|
|---|
| 47 | action-away
|
|---|
| 48 | action-click
|
|---|
| 49 | action-dbl-click
|
|---|
| 50 | action-edit
|
|---|
| 51 | action-focus
|
|---|
| 52 | action-key
|
|---|
| 53 | action-over
|
|---|
| 54 | action-resize
|
|---|
| 55 | action-scroll
|
|---|
| 56 | action-unfocus
|
|---|
| 57 | attribute-size
|
|---|
| 58 | attribute-span
|
|---|
| 59 | attribute-text
|
|---|
| 60 | attribute-text-color
|
|---|
| 61 | attribute-text-style
|
|---|
| 62 | attribute-color
|
|---|
| 63 | attribute-image
|
|---|
| 64 | attribute-effect
|
|---|
| 65 | attribute-data
|
|---|
| 66 | attribute-tip
|
|---|
| 67 | attribute-edge
|
|---|
| 68 | attribute-font
|
|---|
| 69 | attribute-para
|
|---|
| 70 | attribute-feel
|
|---|
| 71 | attribute-rate
|
|---|
| 72 | attribute-show?
|
|---|
| 73 | attribute-options
|
|---|
| 74 | attribute-keycode
|
|---|
| 75 | ] [
|
|---|
| 76 | margin-size: xy: sizes/cell * as-pair sizes/margin sizes/margin
|
|---|
| 77 | gap-size: sizes/cell * as-pair sizes/gap sizes/gap
|
|---|
| 78 |
|
|---|
| 79 | indent-width: 0
|
|---|
| 80 | max-width: xy/x
|
|---|
| 81 | max-height: xy/y
|
|---|
| 82 |
|
|---|
| 83 | left-to-right?: true
|
|---|
| 84 | after-count: 1
|
|---|
| 85 | after-limit: 10000
|
|---|
| 86 |
|
|---|
| 87 | view-face: make rebface [
|
|---|
| 88 | pane: copy [] ; copy needed to prevent "face in more than one pane" errors
|
|---|
| 89 | color: colors/page
|
|---|
| 90 | effect: all [not only effects/window]
|
|---|
| 91 | options: copy [activate-on-show]
|
|---|
| 92 | keycodes: copy []
|
|---|
| 93 | ]
|
|---|
| 94 |
|
|---|
| 95 | word:
|
|---|
| 96 | widget:
|
|---|
| 97 | button-size:
|
|---|
| 98 | field-size:
|
|---|
| 99 | label-size:
|
|---|
| 100 | text-size:
|
|---|
| 101 | action-alt-click:
|
|---|
| 102 | action-away:
|
|---|
| 103 | action-click:
|
|---|
| 104 | action-dbl-click:
|
|---|
| 105 | action-edit:
|
|---|
| 106 | action-focus:
|
|---|
| 107 | action-key:
|
|---|
| 108 | action-over:
|
|---|
| 109 | action-resize:
|
|---|
| 110 | action-scroll:
|
|---|
| 111 | action-unfocus:
|
|---|
| 112 | attribute-size:
|
|---|
| 113 | attribute-span:
|
|---|
| 114 | attribute-text:
|
|---|
| 115 | attribute-text-color:
|
|---|
| 116 | attribute-text-style:
|
|---|
| 117 | attribute-color:
|
|---|
| 118 | attribute-image:
|
|---|
| 119 | attribute-effect:
|
|---|
| 120 | attribute-data:
|
|---|
| 121 | attribute-tip:
|
|---|
| 122 | attribute-edge:
|
|---|
| 123 | attribute-font:
|
|---|
| 124 | attribute-para:
|
|---|
| 125 | attribute-feel:
|
|---|
| 126 | attribute-rate:
|
|---|
| 127 | attribute-show?:
|
|---|
| 128 | attribute-options:
|
|---|
| 129 | attribute-keycode: none
|
|---|
| 130 |
|
|---|
| 131 | ; append widgets and set attributes
|
|---|
| 132 |
|
|---|
| 133 | append-widget: make function! [] [
|
|---|
| 134 | if widget [
|
|---|
| 135 | insert tail view-face/pane make widgets/:widget [
|
|---|
| 136 | type: either widgets/:widget/type = 'face [widget] [widgets/:widget/type]
|
|---|
| 137 | offset: xy
|
|---|
| 138 | size: sizes/cell * any [
|
|---|
| 139 | if attribute-size [either pair? attribute-size [attribute-size] [as-pair attribute-size size/y]]
|
|---|
| 140 | if widget = 'bar [as-pair max-width - margin-size/x / sizes/cell size/y]
|
|---|
| 141 | if all [button-size widget = 'button] [either pair? button-size [button-size] [as-pair button-size size/y]]
|
|---|
| 142 | if all [field-size widget = 'field] [either pair? field-size [field-size] [as-pair field-size size/y]]
|
|---|
| 143 | if all [label-size widget = 'label] [either pair? label-size [label-size] [as-pair label-size size/y]]
|
|---|
| 144 | if all [text-size widget = 'text] [either pair? text-size [text-size] [as-pair text-size size/y]]
|
|---|
| 145 | size
|
|---|
| 146 | ]
|
|---|
| 147 | span: any [attribute-span span]
|
|---|
| 148 | text: any [attribute-text text] [text: copy text]
|
|---|
| 149 | effect: any [attribute-effect effect]
|
|---|
| 150 | data: either any [attribute-data = false data = false] [false] [any [attribute-data data]]
|
|---|
| 151 | rate: any [attribute-rate rate]
|
|---|
| 152 | show?: either none? attribute-show? [show?] [attribute-show?]
|
|---|
| 153 | options: copy any [attribute-options options]
|
|---|
| 154 | color: any [attribute-color color]
|
|---|
| 155 | image: any [attribute-image image]
|
|---|
| 156 | ; locale substitutions
|
|---|
| 157 | text: translate text
|
|---|
| 158 | data: translate data
|
|---|
| 159 | ; tooltip (set to string! or none! to clear USEAGE text)
|
|---|
| 160 | tip: attribute-tip
|
|---|
| 161 | ; text color & style
|
|---|
| 162 | if attribute-text-color [
|
|---|
| 163 | font: make any [font widgets/default-font] [color: attribute-text-color]
|
|---|
| 164 | ]
|
|---|
| 165 | if attribute-text-style [
|
|---|
| 166 | font: make any [font widgets/default-font] [style: attribute-text-style]
|
|---|
| 167 | ]
|
|---|
| 168 | ; edge / font / para / feel objects
|
|---|
| 169 | if attribute-edge [edge: make any [edge widgets/default-edge] attribute-edge]
|
|---|
| 170 | if attribute-font [font: make any [font widgets/default-font] attribute-font]
|
|---|
| 171 | if attribute-para [para: make any [para widgets/default-para] attribute-para]
|
|---|
| 172 | if attribute-feel [feel: make feel attribute-feel]
|
|---|
| 173 | ; action object
|
|---|
| 174 | action: make action []
|
|---|
| 175 | all [action-alt-click action/on-alt-click: make function! [face /local var] action-alt-click]
|
|---|
| 176 | all [action-away action/on-away: make function! [face /local var] action-away]
|
|---|
| 177 | all [action-click action/on-click: make function! [face /local var] action-click]
|
|---|
| 178 | all [action-dbl-click action/on-dbl-click: make function! [face /local var] action-dbl-click]
|
|---|
| 179 | all [action-edit action/on-edit: make function! [face /local var] action-edit]
|
|---|
| 180 | all [action-focus action/on-focus: make function! [face /local var] action-focus]
|
|---|
| 181 | all [action-key action/on-key: make function! [face event /local var] action-key]
|
|---|
| 182 | all [action-over action/on-over: make function! [face /local var] action-over]
|
|---|
| 183 | all [action-resize action/on-resize: make function! [face /local var] action-resize]
|
|---|
| 184 | all [action-scroll action/on-scroll: make function! [face scroll /page /local var] action-scroll]
|
|---|
| 185 | all [action-unfocus action/on-unfocus: make function! [face /local var] action-unfocus]
|
|---|
| 186 | ; action block and associated engage feel
|
|---|
| 187 | if any [
|
|---|
| 188 | get in action 'on-alt-click
|
|---|
| 189 | get in action 'on-click
|
|---|
| 190 | get in action 'on-dbl-click
|
|---|
| 191 | get in action 'on-edit
|
|---|
| 192 | get in action 'on-key
|
|---|
| 193 | get in action 'on-scroll
|
|---|
| 194 | ][
|
|---|
| 195 | unless get in feel 'engage [
|
|---|
| 196 | feel: make feel [
|
|---|
| 197 | engage: make function! [face act event] [
|
|---|
| 198 | case [
|
|---|
| 199 | event/double-click [face/action/on-dbl-click face]
|
|---|
| 200 | act = 'up [face/action/on-click face]
|
|---|
| 201 | act = 'alt-up [face/action/on-alt-click face]
|
|---|
| 202 | act = 'key [
|
|---|
| 203 | face/action/on-key face event
|
|---|
| 204 | face/action/on-edit face
|
|---|
| 205 | ]
|
|---|
| 206 | act = 'scroll-line [face/action/on-scroll face event/offset]
|
|---|
| 207 | act = 'scroll-page [face/action/on-scroll/page face event/offset]
|
|---|
| 208 | ]
|
|---|
| 209 | ]
|
|---|
| 210 | ]
|
|---|
| 211 | ]
|
|---|
| 212 | ]
|
|---|
| 213 | ; action block and associated over feel
|
|---|
| 214 | if any [
|
|---|
| 215 | get in action 'on-away
|
|---|
| 216 | get in action 'on-over
|
|---|
| 217 | ][
|
|---|
| 218 | unless get in feel 'over [
|
|---|
| 219 | feel: make feel [
|
|---|
| 220 | over: make function! [face into pos] [
|
|---|
| 221 | either into [face/action/on-over face] [face/action/on-away face]
|
|---|
| 222 | ]
|
|---|
| 223 | ]
|
|---|
| 224 | ]
|
|---|
| 225 | ]
|
|---|
| 226 | ]
|
|---|
| 227 | last-widget: last view-face/pane
|
|---|
| 228 | ; keycode attached?
|
|---|
| 229 | if attribute-keycode [
|
|---|
| 230 | insert tail view-face/keycodes reduce [attribute-keycode last-widget]
|
|---|
| 231 | ]
|
|---|
| 232 | ; any init required?
|
|---|
| 233 | last-widget/init ; execute
|
|---|
| 234 | last-widget/init: none ; free
|
|---|
| 235 | ; 1st reverse item?
|
|---|
| 236 | unless left-to-right? [
|
|---|
| 237 | last-widget/offset/x: last-widget/offset/x - last-widget/size/x
|
|---|
| 238 | ]
|
|---|
| 239 | xy: last-widget/offset
|
|---|
| 240 | ; max vertical size
|
|---|
| 241 | max-height: max max-height xy/y + last-widget/size/y
|
|---|
| 242 | ; horizontal pos adjustments
|
|---|
| 243 | if left-to-right? [
|
|---|
| 244 | xy/x: xy/x + last-widget/size/x
|
|---|
| 245 | max-width: max max-width xy/x
|
|---|
| 246 | ]
|
|---|
| 247 | ; after limit reached?
|
|---|
| 248 | after-count: either after-count < after-limit [
|
|---|
| 249 | ; spacing
|
|---|
| 250 | xy/x: xy/x + either left-to-right? [gap-size/x] [negate gap-size/x]
|
|---|
| 251 | after-count + 1
|
|---|
| 252 | ][
|
|---|
| 253 | xy: as-pair margin-size/x + indent-width max-height + gap-size/y
|
|---|
| 254 | after-count: 1
|
|---|
| 255 | ]
|
|---|
| 256 | if :word [set :word last-widget]
|
|---|
| 257 | word:
|
|---|
| 258 | widget:
|
|---|
| 259 | action-alt-click:
|
|---|
| 260 | action-away:
|
|---|
| 261 | action-click:
|
|---|
| 262 | action-dbl-click:
|
|---|
| 263 | action-edit:
|
|---|
| 264 | action-focus:
|
|---|
| 265 | action-key:
|
|---|
| 266 | action-over:
|
|---|
| 267 | action-resize:
|
|---|
| 268 | action-scroll:
|
|---|
| 269 | action-unfocus:
|
|---|
| 270 | attribute-size:
|
|---|
| 271 | attribute-span:
|
|---|
| 272 | attribute-text:
|
|---|
| 273 | attribute-text-color:
|
|---|
| 274 | attribute-text-style:
|
|---|
| 275 | attribute-color:
|
|---|
| 276 | attribute-image:
|
|---|
| 277 | attribute-effect:
|
|---|
| 278 | attribute-data:
|
|---|
| 279 | attribute-tip:
|
|---|
| 280 | attribute-edge:
|
|---|
| 281 | attribute-font:
|
|---|
| 282 | attribute-para:
|
|---|
| 283 | attribute-feel:
|
|---|
| 284 | attribute-rate:
|
|---|
| 285 | attribute-show?:
|
|---|
| 286 | attribute-options:
|
|---|
| 287 | attribute-keycode: none
|
|---|
| 288 | ]
|
|---|
| 289 | ]
|
|---|
| 290 |
|
|---|
| 291 | parse reduce/only spec words [ ; AGT 25-May-2006
|
|---|
| 292 | any [
|
|---|
| 293 | opt [here: set arg paren! (here/1: do arg) :here] [ ; AGT 25-May-2006
|
|---|
| 294 | 'return (
|
|---|
| 295 | append-widget
|
|---|
| 296 | xy: as-pair margin-size/x + indent-width max-height + gap-size/y
|
|---|
| 297 | left-to-right?: true
|
|---|
| 298 | after-limit: 10000
|
|---|
| 299 | )
|
|---|
| 300 | | 'reverse (
|
|---|
| 301 | append-widget
|
|---|
| 302 | xy: as-pair max-width max-height + gap-size/y
|
|---|
| 303 | left-to-right?: false
|
|---|
| 304 | after-limit: 10000
|
|---|
| 305 | )
|
|---|
| 306 | | 'after set arg integer! (
|
|---|
| 307 | ; return unless this is first widget
|
|---|
| 308 | if widget [
|
|---|
| 309 | append-widget
|
|---|
| 310 | xy: as-pair margin-size/x + indent-width max-height + gap-size/y
|
|---|
| 311 | ]
|
|---|
| 312 | after-count: 1
|
|---|
| 313 | after-limit: arg
|
|---|
| 314 | )
|
|---|
| 315 | | 'button-size [set arg integer! | set arg pair! | | set arg none!] (button-size: arg)
|
|---|
| 316 | | 'field-size [set arg integer! | set arg pair! | | set arg none!] (field-size: arg)
|
|---|
| 317 | | 'label-size [set arg integer! | set arg pair! | | set arg none!] (label-size: arg)
|
|---|
| 318 | | 'text-size [set arg integer! | set arg pair! | | set arg none!] (text-size: arg)
|
|---|
| 319 | | 'pad [set arg integer! | set arg paren!] (
|
|---|
| 320 | append-widget
|
|---|
| 321 | all [paren? arg arg: do arg]
|
|---|
| 322 | arg: either left-to-right? [arg * sizes/cell] [negate arg * sizes/cell]
|
|---|
| 323 | either after-count = 1 [xy/y: xy/y + arg] [xy/x: xy/x + arg]
|
|---|
| 324 | )
|
|---|
| 325 | | 'do set arg block! (view-face/init: make function! [face /local var] arg)
|
|---|
| 326 | | 'margin set arg pair! (append-widget margin-size: xy: arg * sizes/cell)
|
|---|
| 327 | | 'indent set arg integer! (
|
|---|
| 328 | append-widget
|
|---|
| 329 | indent-width: arg * sizes/cell
|
|---|
| 330 | xy/x: margin-size/x + indent-width
|
|---|
| 331 | )
|
|---|
| 332 | | 'space set arg pair! (append-widget gap-size: arg * sizes/cell)
|
|---|
| 333 | | 'tight (append-widget margin-size: xy: gap-size: 0x0)
|
|---|
| 334 | | 'at set arg pair! (append-widget xy: arg * sizes/cell + margin-size after-limit: 10000)
|
|---|
| 335 | | 'effect [set arg word! | set arg block!] (attribute-effect: arg)
|
|---|
| 336 | | 'options set arg block! (attribute-options: arg)
|
|---|
| 337 | | 'data set arg any-type! (attribute-data: either paren? arg [do arg] [arg])
|
|---|
| 338 | | 'edge set arg block! (attribute-edge: arg)
|
|---|
| 339 | | 'font set arg block! (attribute-font: arg)
|
|---|
| 340 | | 'para set arg block! (attribute-para: arg)
|
|---|
| 341 | | 'feel set arg block! (attribute-feel: arg)
|
|---|
| 342 | | 'on set arg block! (
|
|---|
| 343 | action-click: any [action-click select arg 'click]
|
|---|
| 344 | action-alt-click: any [action-alt-click select arg 'alt-click]
|
|---|
| 345 | action-dbl-click: any [action-dbl-click select arg 'dbl-click]
|
|---|
| 346 | action-away: select arg 'away
|
|---|
| 347 | action-edit: select arg 'edit
|
|---|
| 348 | action-focus: select arg 'focus
|
|---|
| 349 | action-key: select arg 'key
|
|---|
| 350 | action-over: select arg 'over
|
|---|
| 351 | action-resize: select arg 'resize
|
|---|
| 352 | action-scroll: select arg 'scroll
|
|---|
| 353 | action-unfocus: select arg 'unfocus
|
|---|
| 354 | )
|
|---|
| 355 | | 'on-alt-click set arg block! (action-alt-click: arg)
|
|---|
| 356 | | 'on-away set arg block! (action-away: arg)
|
|---|
| 357 | | 'on-click set arg block! (action-click: arg)
|
|---|
| 358 | | 'on-dbl-click set arg block! (action-dbl-click: arg)
|
|---|
| 359 | | 'on-edit set arg block! (action-edit: arg)
|
|---|
| 360 | | 'on-focus set arg block! (action-focus: arg)
|
|---|
| 361 | | 'on-key set arg block! (action-key: arg)
|
|---|
| 362 | | 'on-over set arg block! (action-over: arg)
|
|---|
| 363 | | 'on-resize set arg block! (action-resize: arg)
|
|---|
| 364 | | 'on-scroll set arg block! (action-scroll: arg)
|
|---|
| 365 | | 'on-unfocus set arg block! (action-unfocus: arg)
|
|---|
| 366 | | 'rate [set arg integer! | set arg time!] (attribute-rate: arg)
|
|---|
| 367 | | 'tip set arg string! (attribute-tip: arg)
|
|---|
| 368 | | 'text-color set arg tuple! (attribute-text-color: arg)
|
|---|
| 369 | | 'bold (attribute-text-style: 'bold)
|
|---|
| 370 | | 'italic (attribute-text-style: 'italic)
|
|---|
| 371 | | 'underline (attribute-text-style: 'underline)
|
|---|
| 372 | | [set arg integer! | set arg pair!] (attribute-size: arg)
|
|---|
| 373 | | set arg issue! (attribute-span: sort arg)
|
|---|
| 374 | | set arg string! (attribute-text: arg)
|
|---|
| 375 | | [set arg tuple! | set arg none!] (attribute-color: arg)
|
|---|
| 376 | | set arg image! (attribute-image: arg)
|
|---|
| 377 | | set arg file! (attribute-image: load arg)
|
|---|
| 378 | | set arg url! (attribute-data: arg)
|
|---|
| 379 | | set arg block! (
|
|---|
| 380 | case [
|
|---|
| 381 | none? action-click [action-click: arg]
|
|---|
| 382 | none? action-alt-click [action-alt-click: arg]
|
|---|
| 383 | none? action-dbl-click [action-dbl-click: arg]
|
|---|
| 384 | ]
|
|---|
| 385 | )
|
|---|
| 386 | | set arg logic! (attribute-show?: arg)
|
|---|
| 387 | | set arg char! (attribute-keycode: arg)
|
|---|
| 388 | | set arg set-word! (append-widget word: :arg)
|
|---|
| 389 | | set arg word! (append-widget widget: arg)
|
|---|
| 390 | ]]
|
|---|
| 391 | ]
|
|---|
| 392 |
|
|---|
| 393 | append-widget
|
|---|
| 394 |
|
|---|
| 395 | ; any main init to do?
|
|---|
| 396 | view-face/init view-face ; execute
|
|---|
| 397 | view-face/init: none ; free
|
|---|
| 398 |
|
|---|
| 399 | view-face/size: margin-size + as-pair max-width max-height
|
|---|
| 400 |
|
|---|
| 401 | unless only [
|
|---|
| 402 | ; any post-size span adjustment required?
|
|---|
| 403 | foreach face view-face/pane [span-size face view-face/size margin-size]
|
|---|
| 404 | ; center-face if no offset provided
|
|---|
| 405 | all [
|
|---|
| 406 | zero? view-face/offset
|
|---|
| 407 | view-face/offset: max 0x0 view*/screen-face/size - view-face/size / 2
|
|---|
| 408 | ]
|
|---|
| 409 | ]
|
|---|
| 410 |
|
|---|
| 411 | view-face
|
|---|
| 412 | ] |
|---|
