1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
############################################################################
#
# File: hsvpick.icn
#
# Subject: Program to pick RGB or HSV colors
#
# Author: Gregg M. Townsend
#
# Date: November 14, 1994
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# hsvpick is a simple HSV color picker. The three sliders on the
# left control red, green, blue; the sliders on the right control
# hue, saturation, value. The equivalent hexadecimal specification
# is displayed in the center.
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# Links: button, slider, evmux, graphics
#
############################################################################
link button
link slider
link evmux
link graphics
$define BevelWidth 2
$define WindowMargin 10
record valrec(r, g, b, h, s, v)
global sl # the six sliders
global val # the six values [0.0 - 1.0]
global w, h, m, l # geometry options
global sw # slider width
global colr # selected color
procedure main(args)
local cwin, x, y, ww, hh
# create window
Window("size=420,300", args)
m := WindowMargin # size of outside margins
w := w := WAttrib("width") - 2 * m # usable width
h := WAttrib("height") - 2 * m # usable height
l := WAttrib("leading") # leading
sw := 20 # set slider width
# get mutable color to display the selected color
# use a new binding to avoid disturbing fg/bg of &window.
colr := NewColor(&window) | stop("can't allocate mutable color")
cwin := Clone(&window)
Bg(cwin, colr)
# draw the area showing the color itself
x := 4 * m + 3 * sw
y := m
ww := w - 6 * sw - 6 * m
hh := h - m - 3 * l
BevelRectangle(x, y, ww, hh, -BevelWidth)
EraseArea(cwin, x+BevelWidth, y+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
# set up sliders to control the colors
val := valrec(0.75, 0.625, 0.50, 0.0, 0.0, 0.0) # initial values
sl := valrec(
slider(&window, setval, 1, m, m, sw, h, 0.0, val.r, 1.0),
slider(&window, setval, 2, sw + 2 * m, m, sw, h, 0.0, val.g, 1.0),
slider(&window, setval, 3, 2 * sw + 3 * m, m, sw, h, 0.0, val.b, 1.0),
slider(&window, setval, 4, w - m - 3 * sw, m, sw, h, 0.0, val.h, 1.0),
slider(&window, setval, 5, w - 2 * sw, m, sw, h, 0.0, val.s, 1.0),
slider(&window, setval, 6, w + m - sw, m, sw, h, 0.0, val.v, 1.0))
sethsv() # set hsv from rgb
setcolor() # download the colors
# set up sensors for quitting
quitsensor(&window) # q or Q
button(&window, "QUIT", argless, exit, m + w / 2 - 30, m + h - 20, 60, 20)
# enter event loop
evmux(&window)
end
procedure setval(win, i, v) # set color component i to value v
val[i] := v
if i < 4 then
sethsv() # rgb slider moved; set hsv values
else
setrgb() # hsv slider moved; set rgv values
setcolor() # set color, update display
return
end
procedure sethsv() # set hsv from rgb values
# based on Foley et al, 2/e, p.592
local min, max, d
min := val.r; min >:= val.g; min >:= val.b # minimum
max := val.r; max <:= val.g; max <:= val.b # maximum
d := max - min # difference
val.v := max # v is max of all values
if max > 0 then
val.s := d / max
else
val.s := 0 # sat is (max-min)/max
if val.s > 0 then {
if val.g = max then
val.h := 2 + (val.b - val.r) / d # yellow through cyan
else if val.b = max then
val.h := 4 + (val.r - val.g) / d # cyan through magenta
else if val.g < val.b then
val.h := 6 + (val.g - val.b) / d # magenta through red
else
val.h := (val.g - val.b) / d # red through yellow
}
val.h /:= 6 # scale to 0.0 - 1.0
# set sliders to reflect calculated values
slidervalue(sl.h, val.h)
slidervalue(sl.s, val.s)
slidervalue(sl.v, val.v)
return
end
procedure setrgb() # set rgb from hsv values
# based on Foley et al, 2/e, p.593
local h, f, i, p, q, t, v
if val.s = 0.0 then
val.r := val.g := val.b := val.v # achromatic
else {
h := val.h * 6.0 # hue [0.0 - 6.0)
if h >= 6.0 then
h := 0.0
i := integer(h)
f := h - i
v := val.v
p := val.v * (1.0 - val.s)
q := val.v * (1.0 - f * val.s)
t := val.v * (1.0 - (1.0 - f) * val.s)
case i of {
0: { val.r := v; val.g := t; val.b := p } # red - yellow
1: { val.r := q; val.g := v; val.b := p } # yellow - green
2: { val.r := p; val.g := v; val.b := t } # green - cyan
3: { val.r := p; val.g := q; val.b := v } # cyan - blue
4: { val.r := t; val.g := p; val.b := v } # blue - magenta
5: { val.r := v; val.g := p; val.b := q } # magenta - red
}
}
# set sliders to reflect calculated values
slidervalue(sl.r, val.r)
slidervalue(sl.g, val.g)
slidervalue(sl.b, val.b)
return
end
procedure setcolor() # set the color in the color map
local s, x
# build and display hex color spec, and set color
s := "#" || hexv(val.r) || hexv(val.g) || hexv(val.b)
Color(colr, s)
GotoXY(m + w / 2 - TextWidth(s) / 2, m + h - 2 * l)
WWrites(s)
# display r, g, b values
x := 4 * m + 3 * sw
GotoXY(x, m + h - 2 * l)
WWrites("r: ", right(integer(65535 * val.r), 5))
GotoXY(x, m + h - l)
WWrites("g: ", right(integer(65535 * val.g), 5))
GotoXY(x, m + h)
WWrites("b: ", right(integer(65535 * val.b), 5))
# display h, s, v values
x := w - 2 * m - 3 * sw - TextWidth("h: 000")
GotoXY(x, m + h - 2 * l)
WWrites("h: ", right(integer(360 * val.h), 3))
GotoXY(x, m + h - l)
WWrites("s: ", right(integer(100 * val.s), 3))
GotoXY(x, m + h)
WWrites("v: ", right(integer(100 * val.v), 3))
return
end
procedure hexv(v) # two-hex-digit specification of v
static hextab
initial {
every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
}
return hextab [integer(255 * v + 1.5)]
end
|
