[REBOL] New Color Requestor Source
From: carl::s::rebol::com at: 21-Dec-2002 11:09
The color requestor below fixes a few bugs... allows all values in 0-255 range for colors,
fixes bug if /color of NONE was given, and allows user to input a value into the text
field. It will be part of new releases.
The text field will accept: 1) a TUPLE color, 2) an integer (grayscale), 3) color word
(like RED, GREEN, BLUE, PURPLE, YELLOW, etc.)
Any changes or suggestions should be sent to http://www.rebol.com/feedback.html
req-color: context [
color-lay: x: t: r: g: b: none
mods: func [slid clr rgb] [
; Recompute slider value and gradient
slid/data: 1 - (rgb/:clr / 255)
slid/effect/4: poke rgb clr 0
slid/effect/3: poke rgb clr 255
]
refresh: does [
; Refresh all sliders and text window:
mods r 1 x/color
mods g 2 x/color
mods b 3 x/color
t/text: x/color
show [x t r g b]
]
setc: func [clr val][
; Set color value from slider decimal value:
x/color: poke x/color clr to-integer 255 * (1 - val)
refresh
]
set 'request-color func [
"Requests a color value."
/color clr /offset xy /local result
][
if none? :color-lay [
color-lay: layout [
across origin 5x4 space 8x2
x: box 80x30 ibevel return
t: field center middle 80 font-size 10 [
; Allow user to enter color tuple, integer, or color name.
value: attempt [load t/text]
all [word? value value? value value: get value]
if integer? value [value: 0.0.0 + max 0 min 255 value]
value: either tuple? value [to-tuple reduce [value/1 value/2 value/3]][0.0.0]
x/color: value
refresh
] return
pad 8
; Size: 256 + 4 (edge * 2) + 24 (dragger)
r: slider 16x284 gray red effect [gradient 0x1 255.0.0 0.0.0] [setc 1 r/data]
g: slider 16x284 gray green effect [gradient 0x1 0.255.0 0.0.0] [setc 2 g/data]
b: slider 16x284 gray blue effect [gradient 0x1 0.0.255 0.0.0] [setc 3 b/data]
return
pad 8 btn-enter "OK" 64 [result: x/color hide-popup]
return
pad 8 btn-cancel "None" escape 64 [hide-popup]
]
]
; Reset dragger sizes
foreach var [r g b] [var: get var var/pane/1/size/y: 24]
; Set initial color value:
x/color: either tuple? clr [clr][0.0.0]
refresh
either offset [inform/offset color-lay xy][inform color-lay]
result
]
]
request-color
