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
]