Yet another color-picker

color-picker2.red

Red [
	Description: "Yet another color-picker"
	Date: 9-May-2019
]
context [
	colors: [] 
	colors2: [pen off translate 260x280 []]
	i: 9 
	j: 256 / (i - 1) 
	img: none
	
	collect/into [
		repeat r i [repeat g i [repeat b i [
			keep as-color 
				either r > 1 [r - 1 * j - 1][r - 1 * j]
				either g > 1 [g - 1 * j - 1][g - 1 * j] 
				either b > 1 [b - 1 * j - 1][b - 1 * j] 
		]]]
	] clear colors
	
	adjust: func [cmp a b c d e f /local cent][
		collect/into [
			forall colors [
				if cmp [colors/1/1 a b colors/1/2 c d colors/1/3 e f][
					rx: colors/1/1 * (cosine 150)
					bx: colors/1/3 * (cosine 30)
					ry: colors/1/1 * (sine 150)
					gy: colors/1/2 * (sine -90)
					by: colors/1/3 * (sine 150)
					cent: as-pair rx + bx ry + gy + by
					keep/only reduce ['fill-pen colors/1 'circle cent 13]
				]
			]
		] clear colors2/5
	]
	
	adjust :any := 0 := 0 := 0

	draw-img: func [bg][
		img: draw 520x560 compose [fill-pen (bg) box 0x0 519x559]
		img: draw img colors2
	]
	
	draw-img white

	redraw: func [bg][
		draw-img bg
		im/image: img
	]
	
	set 'pick-color has [color _cmp cmp a b c d e f _a _b _c _d _e _f sel][
		view [
			style dl: drop-list data ["<=" "<" "=" "<>" ">" ">="] 40 select 3
			style dn: drop-list data ["0" "31" "63" "95" "127" "159" "191" "223" "255" ""] 50 select 1
			style tx: text 15 right
			_cmp: drop-list 50 data ["all" "any"] select 2
			pad 0x5 tx "R:" pad 0x-5 _a: dl _b: dn
			pad 0x5 tx "G:" pad 0x-5 _c: dl _d: dn
			pad 0x5 tx "B:" pad 0x-5 _e: dl _f: dn
			return
			im: image img all-over 
			on-over [face/parent/text: form pick img event/offset] 
			on-down [write-clipboard form sel/data: color: pick img event/offset]
			below 
			button "Adjust" [
				either _b/selected = 10 [a: :<> b: -1][
					a: get to-word pick _a/data _a/selected
					b: to-integer pick _b/data _b/selected
				]
				either _d/selected = 10 [c: :<> d: -1][
					c: get to-word pick _c/data _c/selected
					d: to-integer pick _d/data _d/selected
				]
				either _f/selected = 10 [e: :<> f: -1][
					e: get to-word pick _e/data _e/selected
					f: to-integer pick _f/data _f/selected
				]
				cmp: get to-word pick _cmp/data _cmp/selected
				
				adjust :cmp :a b :c d :e f
				
				redraw sel/data
			]
			button "Reverse" [reverse colors2/5 redraw sel/data]
			button "Background" [redraw sel/data]
			sel: field 80 "255.255.255"
		]
		color
	]
]()