Rebol Programming/choose

= USAGE: = CHOOSE choices function /style styl /window winf /offset xy /across

= DESCRIPTION: = Generates a choice selector menu, vertical or horizontal.

CHOOSE is a function value. = ARGUMENTS =
 * choices -- Block of items to display (Type: block)
 * function -- Function to call on selection (Type: function none)

= REFINEMENTS =
 * /style
 * styl -- The style choice button (Type: object)
 * /window
 * winf -- The parent window to appear in (Type: object)
 * /offset
 * xy -- Offset of choice box (Type: pair)
 * /across -- Use horizontal layout

= SOURCE CODE = choose: func [ {Generates a choice selector menu, vertical or horizontal.} choices [block!] "Block of items to display" function [function! none!] "Function to call on selection" /style styl [object!] "The style choice button" /window winf [object!] "The parent window to appear in" /offset xy [pair!] "Offset of choice box" /across "Use horizontal layout" /local t oset up down wsize edg ][   set [way mway iway] pick y 0x1 1x0] [x 1x0 0x1 none? across if none? window [winf: system/view/screen-face] if none? style [styl: get-style 'button] edg: any [all [styl/edge styl/edge/size] 0x0] iter-face: make styl [ size: size - (2 * edg) pane-parent: styl window: winf feel: vid-feel/choice-iterator texts: choices flat-texts: [] action: :function selected: false selectable: true edge: none if colors = vid-colors/body [colors/1: color] if not block? colors [colors: vid-colors/body] color: colors/1 ]    item-size: iter-face/size either find choices block! [       clear iter-face/flat-texts foreach x choices [append iter-face/flat-texts x]   ] [iter-face/flat-texts: choices] self/size: (item-size * mway * length? iter-face/flat-texts) + (item-size * iway) + (2 * (t: any [all [edge edge/size] 0x0])) either offset [self/offset: xy] [ oset: (either window [styl/offset] [screen-offset? styl]) + (any [all [styl/edge styl/edge/size] 0x0]) - t        t: any [find iter-face/flat-texts styl/text iter-face/flat-texts] up: (index? t) - 1 * item-size/:way down: ((subtract length? iter-face/flat-texts index? t) + 1 * item-size/:way) wsize: get in find-window winf 'size self/offset: (any [               all [up < (oset/:way - 4) down < (wsize/:way - oset/:way - 4)                     oset - ((mway * ((index? t) - 1) * item-size/:way))                ]                 all [up < (oset/:way - 4) if wsize/:way > (up + down + 8) [                        edg: (to-integer ((wsize/:way - oset/:way - 4) / item-size/:way)) * item-size/:way                         oset - ((up + down - edg) * mway)                    ]]                 oset - (oset - 4 * mway / iter-face/size/:way * iter-face/size/:way)            ]) ]    show-popup/window/away self winf do-events ]