orkb@stl.stc.co.uk (Owen Benson) (07/18/89)
I posted this a couple of weeks ago but it got stopped as I had
made a few mistakes (the copyright notice was wrong, etc.). So, having
fixed those problems (and a little bug I found _after_ posting it...)
here it is (again, if anyone got it the first time).
This is a little utility which allows a user to choose a colour
by clicking on a colour-wheel item. It provides both RGB and HSB values
for the chosen colour.
I have built this using a few objects I have built over the last
10 months. I included these objects in the hope they will make it easier
for others to build applications in NeWS. The most useful object to this
end is the Pane item which manages a set of other items. This means you
never again need create a dictionary in userdict, do a forkitems on it
or overwrite PaintClient with {items paintitems ...}!!
The ColorWindow is an example of how you can create a window
with managed items using the objects provided here.
Have Fun!
P.S. I found reading long names all in lower case (e.g. paintclient)
a real pain; instead I use underscore separators between the words
(e.g. paint_client). If you use the Lite items and windows this does
make it difficult to remember which names use which style; I got around
this by building a set of items and windows which are consistent in all
using underscores. Perhaps one day my boss will let me post them...
--- cut here ---------- cut here ---------- cut here ---------- cut here ---
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# item_subset.ps
# window_subset.ps
# test_color
# This archive created: Tue Jul 18 10:49:20 1989
export PATH; PATH=/bin:$PATH
if test -f 'item_subset.ps'
then
echo shar: will not over-write existing file "'item_subset.ps'"
else
cat << \SHAR_EOF > 'item_subset.ps'
% item_subset.ps %
% 7/7/89 %
% ORKB %
% Copyright 1989 Owen R K Benson %
systemdict /Item known not {(NeWS/liteitem.ps) run} if
systemdict begin
Item /destroy {/NotifyUser null store} put
end
% ============================= ORKItem =============================
% I use this as my base item. It has a different font to Item
% and has several more access procedures (to stop me directly
% accessing object variables from outside the object).
/ORKItem Item
dictbegin
/ItemWidth 0 def
/ItemHeight 0 def
dictend
classbegin
% class variables
/ItemFont /Helvetica findfont 14 scalefont def
/ItemFrame 1 def
% private methods
% public methods
/set_fill_color { % color | gray_level => -
/ItemFillColor exch def
} def
/set_border_color { % color | gray_level => -
/ItemBorderColor exch def
} def
/set_text_color { % color | gray_level => -
/ItemTextColor exch def
} def
/set_border_width { % int => -
/ItemFrame exch def
} def
/width { % - => int
ItemWidth
} def
/height { % - => int
ItemHeight
} def
/center { % - => xc yc
ItemWidth null ne {
/location self send
exch ItemWidth 2 div add exch ItemHeight 2 div add
} {0 0} ifelse
} def
/move_center { % xc yc => -
exch ItemWidth 2 div sub exch ItemHeight 2 div sub /move self send
} def
/move_by { % xdiff ydiff => -
/location self send
exch 4 -1 roll add 3 1 roll add /move self send
} def
/set_value { % true | false => -
/ItemValue exch store
} def
/get_value { % - => true | false
ItemValue
} def
/to_top { % - => - (puts item on top)
ItemCanvas canvastotop
} def
/to_bottom { % - => - (puts item on bottom)
ItemCanvas canvastobottom
} def
/destroy { % - => -
} def
classend def
% ============================= Pane =============================
% This is a compound item. It manages other items (so you
% don't have to keep building dictionaries and doing
% forkitems etc. on them).
% It manages either a dict or an array of items. Using a
% dict allows you to get at items by name rather than
% position but is not as flexible in determining visual/
% event ordering as an array.
/Pane ORKItem
dictbegin
/ItemList null def % [ item ... ] | dict
/ItemListMgr null def
dictend
classbegin
% class variables
% private methods
/PaintItem {
/PaintBackground self send
/PaintChildren self send
} def
/PaintBackground { % - => -
} def
/PaintChildren { % - => -
ItemList null ne {
ItemList type /arraytype eq {
ItemList {/paint exch send pause} forall
} {
ItemList {exch pop /paint exch send pause} forall
} ifelse
} if
} def
/UnManageItems { % - => -
ItemListMgr null ne {ItemListMgr killprocess} if
/ItemListMgr null store
} def
/ManageItems { % - => -
/UnManageItems self send
ItemList length 0 gt {/ItemListMgr ItemList forkitems store} if
} def
/makestartinterests { % - => interests (returns the start interests)
[
/Damaged {/paint /Self GetFromCurrentEvent send}
null ItemCanvas eventmgrinterest
dup /Self self PutInEventMgrInterest
]
} def
% public methods
/set_items { % [ item ... ] | dict => -
/clear_items self send
dup type /arraytype eq {
/ItemList [] store
} {
/ItemList nulldict store
} ifelse
/add_items self send
} def
/add_items { % [ item ... ] | dict => -
/UnManageItems self send
ItemList type /arraytype eq {
1 dict begin
{
/tmp exch cvx exec def
[ItemList aload pop tmp] /ItemList exch store
} forall
end
} {
/ItemList ItemList 3 -1 roll append store
} ifelse
/ManageItems self send
} def
/insert_items { % [ item ... ] pos => - (pos is ignored if ItemList is a dict)
/UnManageItems self send
ItemList type /arraytype eq {
2 dict begin
/pos exch def
/arr exch def
0 1 arr length 1 sub {
arr 1 index get cvx exec arr 3 1 roll put
} for
pos 1 ItemList length 1 sub {
/to_top ItemList 3 -1 roll get send
} for
/ItemList
ItemList 0 pos getinterval arr append
ItemList pos ItemList length pos sub getinterval append
store
end
} {
pop /ItemList ItemList 3 -1 roll append store
} ifelse
/ManageItems self send
} def
/remove_item { % int | item => -
/UnManageItems self send
2 dict begin
/item exch def
/nl [] def
dup type /integertype eq {
0 1 ItemList length 1 sub {
dup item ne
{/nl nl [ItemList 5 -1 roll get] append store}
{ItemList exch get /destroy exch send} ifelse
} forall
} {
ItemList {
dup item ne {/nl nl [4 -1 roll] append store}
{/destroy exch send} ifelse
} forall
} ifelse
/ItemList nl store
/ManageItems self send
end
} def
/clear_items { % - => -
/UnManageItems self send
ItemList null ne {
ItemList type /arraytype eq {
ItemList {/destroy exch send pause} forall
} {
ItemList {exch pop /destroy exch send pause} forall
} ifelse
/ItemList null store
} if
} def
/get_canvas { % - => item_canvas
ItemCanvas
} def
/get_item { % int | name => item
ItemList exch get
} def
/get_all { % - => [ item ... ] | dict
ItemList null ne {ItemList} {[]} ifelse
} def
/map { % - => -
/map super send
ItemList null ne {
ItemList type /arraytype eq {
ItemList {/map exch send pause} forall
} {
ItemList {exch pop /map exch send pause} forall
} ifelse
} if
} def
/unmap { % - => -
ItemList null ne {
ItemList type /arraytype eq {
ItemList {/unmap exch send pause} forall
} {
ItemList {exch pop /unmap exch send pause} forall
} ifelse
} if
/unmap super send
} def
/destroy { % - => -
/clear_items self send
} def
classend def
% ============================= StaticText =============================
% Displays a string. NO interactive behaviour.
/StaticText ORKItem
dictbegin
/Label nullstring def
/ItemFillColor .9 def
dictend
classbegin
% class variables
% private methods
/PaintItem { % - => -
ItemFillColor fillcanvas
ItemFont setfont
ItemTextColor setshade
2
ItemHeight ItemFont fontheight sub 2 idiv ItemFont fontdescent add
moveto Label show
} def
/makestartinterests { % - => interests (returns the start interests)
[
/Damaged {/paint /Self GetFromCurrentEvent send}
null ItemCanvas eventmgrinterest
dup /Self self PutInEventMgrInterest
]
} def
% public methods
/new { % label parentcanvas => instance
/new super send begin
/Label exch store
/ItemFont /Helvetica findfont 14 scalefont store
Label length 0 gt {/auto_shape self send} if
currentdict
end
} def
/reshape { % x y w h => -
ItemFont fontheight max /reshape super send
} def
/auto_shape { % - => -
0 0
gsave ItemFont setfont Label stringwidth pop 4 add grestore
ItemFont fontheight
/reshape self send
} def
/set_text { % string | int | float => -
256 string cvs /Label exch store
} def
/set_font { % font => -
/ItemFont exch store
} def
classend def
SHAR_EOF
fi # end of overwriting check
if test -f 'window_subset.ps'
then
echo shar: will not over-write existing file "'window_subset.ps'"
else
cat << \SHAR_EOF > 'window_subset.ps'
% window_subset.ps %
% 30/6/89 %
% ORKB %
% Copyright 1989 Owen R K Benson %
(item_subset.ps) run
% ============================= ItemsWindow =============================
% A window with a Pane item filling its ClientCanvas. This allows
% an application to make a window and add a bunch of items to it
% for display/management/etc. It keeps things tidier than always
% overwriting the PaintClient procedure with {items paintitems...}
/ItemsWindow DefaultWindow
dictbegin
/ClientControlArea null def % a Pane compound item
dictend
classbegin
% class variables
/ClientFillColor .9 def
% private methods
/PaintClient { % - => -
/PaintBackground self send
/PaintItems self send
} def
/PaintItems { % - => -
/paint ClientControlArea send
} def
/PaintBackground { % - => -
ClientFillColor fillcanvas
} def
/CreateClientControlArea { % - => -
/ClientControlArea ClientCanvas /new Pane send store
} def
% public methods
/new { % type parent => instance
/new super send begin
/CheckCanvases self send
/CreateClientControlArea self send
/auto_shape self send
currentdict
end
} def
/reshape { % x y w h => -
/reshape super send
0 0 ClientWidth ClientHeight /reshape ClientControlArea send
} def
/auto_shape { % - => -
400 400 100 100 /reshape self send
} def
/paint_background { % - => -
gsave ClientCanvas setcanvas /PaintBackground self send grestore
} def
/get_items_canvas { % - => client_control_area_canvas
/get_canvas ClientControlArea send
} def
/set_items { % [ item ... ] | dict => -
/set_items ClientControlArea send
} def
/add_items { % [ item ... ] | dict => -
/add_items ClientControlArea send
} def
/get_item { % int | name => item
/get_item ClientControlArea send
} def
/get_all_items { % - => [ item ... ]
/get_all ClientControlArea send
} def
/clear_items { % - => -
/clear_items ClientControlArea send
} def
/remove_item { % item => -
/remove_item ClientControlArea send
} def
/destroy { % - => -
ClientControlArea null ne {/destroy ClientControlArea send} if
/ClientControlArea null store
/destroy super send
} def
classend def
SHAR_EOF
fi # end of overwriting check
if test -f 'test_color'
then
echo shar: will not over-write existing file "'test_color'"
else
cat << \SHAR_EOF > 'test_color'
#! /usr/NeWS/bin/psh
% test_color %
% 30/6/89 %
% ORKB %
% Copyright 1989 Owen R K Benson %
% A little application to demonstrate a few of the objects I have built.
% This displays a colour-wheel and allows the user to click/drag over it
% to change the displayed colour. It provides both RGB and HSB values for
% the selected colour.
(window_subset.ps) run
% ================================= ColorWheel =====================================
/ColorWheel ORKItem
dictbegin
/Hue 0 def
/Saturation 1 def
/Brightness 1 def
/NumSegments 64 def
/WheelCanvas null def
/ItemFillColor .9 def
dictend
classbegin
% class variables
% private methods
/PaintItem { % - => -
FixClient? {/PaintWheel self send} if
gsave ItemWidth ItemHeight scale
WheelCanvas imagecanvas
grestore
/PaintPoint self send
} def
/PaintWheel { % - => - (paint a colour wheel at the current brightness)
gsave WheelCanvas setcanvas
ItemFillColor fillcanvas
ItemWidth ItemHeight scale
4 dict begin
/seg_ang 360 NumSegments div def
0 1 4 {
/saturation exch 4 div 1 exch sub def
/radius saturation 2.5 div .1 add def
0 1 NumSegments 1 sub {
dup NumSegments div saturation Brightness sethsbcolor
/ta exch seg_ang mul def
.5 .5 moveto
.5 .5 radius ta ta seg_ang add arc
closepath fill pause
} for
} for
end
grestore
/FixClient? false store
} def
/PaintPoint { % - => - (paint a square to indicate the current colour)
gsave
ItemWidth 2 div ItemHeight 2 div translate
Hue rotate
Saturation 1 sub -1 3 3 rectpath
Brightness .4 lt {1} {0} ifelse setgray stroke
grestore
} def
/ClientDown { % - => - (set the current colour)
2 dict begin
/x CurrentEvent /XLocation get ItemWidth 2 div sub def
/y CurrentEvent /YLocation get ItemHeight 2 div sub def
x x mul y y mul add sqrt /Saturation exch 100 min store
x 0 ne {y x div arctan} {y 0 ge {90} {-90} ifelse} ifelse
x 0 lt {180 sub dup 0 lt {360 add} if} if
/Hue exch store
end
/paint self send
NotifyUser
} def
/ClientDrag { % - => -
/ClientDown self send
} def
/ClientUp { % - => -
/StopItem self send
} def
% public methods
/new { % notify parent_canvas => instance
/new super send begin
/NotifyUser exch cvx store
/FixClient? true store
/WheelCanvas ItemCanvas newcanvas store
WheelCanvas /Retained true put
currentdict
end
} def
/reshape { % x y w h => -
/reshape super send
gsave ItemCanvas setcanvas
0 0 ItemWidth ItemHeight rectpath WheelCanvas reshapecanvas
grestore
} def
/set_hue { % float => -
/Hue exch store
} def
/set_saturation { % float => -
/Saturation exch store
} def
/set_brightness { % float => -
/Brightness exch store
/FixClient? true store
} def
/get_hue { % - => float
Hue 360 div
} def
/get_saturation { % - => float
Saturation 100 div
} def
/get_brightness { % - => float
Brightness
} def
classend def
% ================================= ColorWindow ====================================
/ColorWindow ItemsWindow
dictbegin
/Hue 0 def
/Sat 0 def
/Bright 1 def
/Red 1 def
/Green 1 def
/Blue 1 def
dictend
classbegin
% class variables
/FrameLabel (Color Test) def
/IconLabel (ColorTest) def
% private methods
/PaintClient { % - => -
/PaintClient super send
/PaintColor self send
} def
/PaintColor { % - => - (paint a rectangle fill with the current colour)
gsave ClientCanvas setcanvas
210 ClientHeight 212 sub 110 20 rectpath
gsave Hue Sat Bright hsbcolor setshade fill grestore
0 setgray stroke
grestore
} def
/CreateItems { % - => - (create the items to be managed by the window)
[
[/hue_saturation /send cvx self exch] /get_items_canvas self send
/new ColorWheel send
5 30 200 200 /reshape 5 index send
() [0 100 Bright 100 mul] /Left [/brightness /send cvx self exch]
/get_items_canvas self send /new SliderItem send
5 5 200 20 /reshape 5 index send
(Red) /get_items_canvas self send /new StaticText send
210 193 /move 3 index send
Red 4 string cvs /get_items_canvas self send /new StaticText send
290 193 30 0 /reshape 5 index send
(Green) /get_items_canvas self send /new StaticText send
210 170 /move 3 index send
Green 4 string cvs /get_items_canvas self send /new StaticText send
290 170 30 0 /reshape 5 index send
(Blue) /get_items_canvas self send /new StaticText send
210 147 /move 3 index send
Blue 4 string cvs /get_items_canvas self send /new StaticText send
290 147 30 0 /reshape 5 index send
(Hue) /get_items_canvas self send /new StaticText send
210 113 /move 3 index send
Hue 4 string cvs /get_items_canvas self send /new StaticText send
290 113 30 0 /reshape 5 index send
(Saturation) /get_items_canvas self send /new StaticText send
210 90 /move 3 index send
Sat 4 string cvs /get_items_canvas self send /new StaticText send
290 90 30 0 /reshape 5 index send
(Brightness) /get_items_canvas self send /new StaticText send
210 67 /move 3 index send
Bright 4 string cvs /get_items_canvas self send /new StaticText send
290 67 30 0 /reshape 5 index send
] /set_items self send
} def
/SetColor { % - => - (called when H S or B has been altered)
Red 4 string cvs /set_text 3 /get_item self send send
Green 4 string cvs /set_text 5 /get_item self send send
Blue 4 string cvs /set_text 7 /get_item self send send
Hue 4 string cvs /set_text 9 /get_item self send send
Sat 4 string cvs /set_text 11 /get_item self send send
Bright 4 string cvs /set_text 13 /get_item self send send
3 2 13 {/paint exch /get_item self send send} for
gsave ClientCanvas setcanvas
/PaintColor self send
grestore
} def
% public methods
/new { % parent => -
/new super send begin
/CreateItems self send
/auto_shape self send
currentdict
end
} def
/auto_shape { % - => - (default position is centered on screen)
349 314 355 272 /reshape self send
} def
/hue_saturation { % - => - (called from the ColorWheel item)
/Hue /get_hue 0 /get_item self send send store
/Sat /get_saturation 0 /get_item self send send store
/Bright /get_brightness 0 /get_item self send send store
gsave
Hue Sat Bright hsbcolor setcolor currentrgbcolor
/Blue exch store
/Green exch store
/Red exch store
grestore
/SetColor self send
} def
/brightness { % - => - (called from the SliderItem item)
/Bright /getvalue 1 /get_item self send send 100 div store
Bright /set_brightness 0 /get_item self send send
/paint 0 /get_item self send send
/SetColor self send
} def
/flipiconic { % - => - (sets icon fill colour to currently selected colour)
/IconFillColor Hue Sat Bright hsbcolor def
/flipiconic super send
Iconic? {/paint self send} if
} def
classend def
/main { % - => -
/win framebuffer /new ColorWindow send def
/map win send
} def
main
SHAR_EOF
chmod +x 'test_color'
fi # end of overwriting check
# End of shell archive
exit 0
:-----:-----:-----:-----:-----:-----:-----:-----:-----:-----:-----:-----:
Owen R K Benson
STC Technology Ltd JANET: orkb@stl.stc.co.uk
London Road, Harlow, Essex, England Tel: (0279) 29531 x2363