Rebol Programming/choose
USAGE:
editCHOOSE choices function /style styl /window winf /offset xy /across
DESCRIPTION:
editGenerates a choice selector menu, vertical or horizontal.
CHOOSE is a function value.
ARGUMENTS
edit- choices -- Block of items to display (Type: block)
- function -- Function to call on selection (Type: function none)
REFINEMENTS
edit- /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
editchoose: 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 ]