< Rebol Programming
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
]
This article is issued from Wikibooks. The text is licensed under Creative Commons - Attribution - Sharealike. Additional terms may apply for the media files.