############################################################################ # # 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