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
|
############################################################################
#
# File: hvc.icn
#
# Subject: Program to pick colors for Tek HVC space
#
# Author: Gregg M. Townsend
#
# Date: November 14, 1994
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# hvc is a simple color picker using HVC space. The three sliders
# control hue, value, and chroma from left to right.
#
############################################################################
#
# Requires: Version 9 graphics under X11R5
#
############################################################################
#
# Links: button, slider, evmux, graphics
#
############################################################################
link button
link slider
link evmux
link graphics
$define BevelWidth 2
$define WindowMargin 10
record hvcrec(h, v, c)
global settings, colr, sl, win
global w, h, m
procedure main(args)
local opts, cwin, ww, hh
win := Window("size=300,250", "font=Helvetica,bold,14", args)
w := WAttrib("width")
h := WAttrib("height")
m := WindowMargin
# a mutable color for displaying the selected color
# use a new binding to avoid disturbing fg/bg of win.
colr := NewColor(win) | stop("can't allocate mutable color")
cwin := Clone(win)
Bg(cwin, colr)
Color(win, colr, "TekHVC:0/0/0") |
stop("can't set HVC colors -- need X11R5")
ww := w - 3 * (m + 20) - 2 * m
hh := h - 30 - 4 * m
BevelRectangle(win, m, m, ww, hh, -BevelWidth)
EraseArea(cwin, m+BevelWidth, m+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
# set up sliders to control the colors
settings := hvcrec(0.50, 0.75, 0.25) # initial positions
sl := hvcrec(
slider(win, sethvc, 1, w-3*m-60, m, 20, h-2*m, 0.0, settings.h, 1.0),
slider(win, sethvc, 2, w-2*m-40, m, 20, h-2*m, 0.0, settings.v, 1.0),
slider(win, sethvc, 3, w-m-20, m, 20, h-2*m, 0.0, settings.c, 1.0))
setcolor() # download the colors
# set up sensors for quitting
quitsensor(win) # q or Q
button(win, "QUIT", argless, exit, m, h - m - 20, 60, 20)
# enter event loop
evmux(win)
end
procedure sethvc(win, i, v) # set color component i to value v
settings[i] := v
setcolor()
end
procedure setcolor() # set the color in the color map
local hue, value, chroma, s
hue := integer(360 * settings.h + 0.5)
value := integer(100 * settings.v + 0.5)
chroma := integer(100 * settings.c + 0.5)
s := "TekHVC:" || hue || "/" || value || "/" || chroma
Color(win, colr, s)
GotoXY(win, m, h - 20 - 2 * m)
write(win, left(s, 20))
return
end
|
