New Color Requestor Source

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