#!/usr/NeWS/bin/psh
 %   Colortool -- By Hugh Daniel copyright (c) 1987 
 %	Permition is given to use, modify and disturibute.
 %	Colortool is derived from colortoy, and a wish to see lots of
 %	good colors on the screen.

  % Librarys
systemdict /Item known not { (NeWS/liteitem.ps) run } if

  % Definitions
/Hue		random def
/Sat		random def
/Brt		.8 def
/docolor	{hsbcolor} def
/colortooltextcolor	0 0 0 docolor def
/colortoolbackground	0 0 0 docolor def
/displaytext?	false def
/textfontname	/Times-Roman def
/textheight	10 def
/textfont	textfontname findfont textheight scalefont def
/changethebackground	true	def	% toggles to text if false

  % SubClasses
/RealTimeSliderItem SliderItem []
	classbegin
		/ItemLabelFont /Screen-Bold  findfont 14 scalefont def
		/ClientDown {
			SetSliderValue
        		ItemValue ItemPaintedValue ne {
        		    ItemPaintedValue ItemFillColor PaintSliderValue
 		           ItemValue ItemBorderColor PaintSliderValue
			} if
			NotifyUser
		} def
		/ClientUp {StopItem} def
	classend
def

  % Function to cerate a dictionary of ReadTimeSliderItem's
/inititems {
  % stack: - => -
	/items 3 dict dup begin	
		/hue_slider_item
			(Hue:) [0 100 Hue 100 mul] /Right
			/notify_hue win_can 250 22 
			/new RealTimeSliderItem send
	  	  dup /ItemFrame 1 put
		  0 44 /move 3 index send
		def
		/sat_slider_item
			(Sat:) [0 100 Sat 100 mul] /Right
			/notify_sat win_can 250 22 
			/new RealTimeSliderItem send
		  dup /ItemFrame 1 put
		  0 22  /move 3 index send
		def
		/brt_slider_item
			(Brt:) [0 100 Brt 100 mul] /Right
			/notify_brt win_can 250 22 
			/new RealTimeSliderItem send		
		  dup /ItemFrame 1 put
		  0 0 /move 3 index send
		def
	end def
} def

  % Functions that change colors components
/notify_hue { /Hue [ItemValue] 0 get .01 mul store updatepaine } def
/notify_sat { /Sat [ItemValue] 0 get .01 mul store updatepaine } def
/notify_brt { /Brt [ItemValue] 0 get .01 mul store /updatepaine win send } def

  % Updatepaine sets a clip path that excludes the slider items and reapints
  % the (background) canvas and any example text.
/updatepaine {
  % stack:
  % change over to the windows main canvas, else we write on the ItemCanvas ! %
	win_can setcanvas
	newpath
	/winX win /FrameWidth get def
	/winY win /FrameHeight get def
	0 66 moveto 0 winY lineto winX winY lineto winX 0 lineto 250 0 lineto
	250 66 lineto closepath
	clip
	changethebackground
	 	{/colortoolbackground Hue Sat Brt docolor store}
		{/colortooltextcolor Hue Sat Brt docolor store}
	ifelse
	colortoolbackground fillcanvas
	userdict /displaytext? get {exampletext} if		% 
} def

  % Moveitems exsists becaus if you change the window size thie items dont 
  % move unless you tell the to.  Notice that we have have some magic #'s
/moveitems {
  % stack:
	0 44 /move items /hue_slider_item get send
	0 22 /move items /sat_slider_item get send
	0 00 /move items /brt_slider_item get send
} def

  % Porocedure
/exampletext {
  % stack: 
	textfont setfont
	/horzsep textheight def
	win_can setcanvas newpath
	colortooltextcolor setcolor
	/next 80 def
	10 next moveto	Brt (....) cvs show
	/next next horzsep add def
	10 next moveto	Sat (....) cvs show
	/next next horzsep add def
	10 next moveto	Hue (....) cvs show
	currentdict /next undef
} def

  % Return most of the system default color varaibles to something usefull
/return_to_normal_colors {
  % stack:
	/textcolor		00 00 00	rgbcolor store
	/DefaultRootGrayOrColor .55 .5 .7	rgbcolor store
	/backgroundcolor 	1 1 1		rgbcolor store
	/bordercolor		00 00 00	rgbcolor store
	/colortooltextcolor		textcolor	def
	{
		/MenuTextColor		0 0 0 rgbcolor store
		/MenuFillColor		1 1 1 rgbcolor store
		/MenuBorderColor	0 0 0 rgbcolor store
	} LiteMenu send
	{
		/ShadowColor		.5 .5 .5 rgbcolor def
	} LitePullRightMenu send
	{
		/ItemTextColor		0 0 0 rgbcolor store
		/ItemFillColor		1 1 1 rgbcolor store
		/ItemBorderColor	0 0 0 rgbcolor store
	} Item send
	{
		/FrameTextColor		0 0 0 rgbcolor store
		/FrameFillColor		1 1 1 rgbcolor store
		/FrameBorderColor	0 0 0 rgbcolor store
		/KeyFocusColor		0 0 0 rgbcolor store
		/ClientFillColor	1 1 1 rgbcolor store
		/IconTextColor		0 0 0 rgbcolor store
		/IconFillColor		1 1 1 rgbcolor store
		/IconBorderColor	0 0 0 rgbcolor store
	} LiteWindow send
	RealTimeSliderItem /ItemTextColor undef
	RealTimeSliderItem /ItemFillColor undef
	RealTimeSliderItem /ItemBorderColor undef
} def

 %	Turn the screen to White on Black for many things
/thetextiswhite {
	/textcolor		1 1 1 	rgbcolor store
	/backgroundcolor 	0 0 0	rgbcolor store
	/bordercolor		1 1 1	rgbcolor store
	/colortooltextcolor		textcolor	def
	{
		/MenuTextColor		1 1 1 rgbcolor store
		/MenuFillColor		0 0 0 rgbcolor store
		/MenuBorderColor	1 1 1 rgbcolor store
	} LiteMenu send
	{
		/ShadowColor		.5 .5 .5 rgbcolor def
	} LitePullRightMenu send
	{
		/ItemTextColor		1 1 1 rgbcolor store
		/ItemFillColor		0 0 0 rgbcolor store
		/ItemBorderColor	1 1 1 rgbcolor store
	} Item send
	{
		/FrameTextColor		1 1 1 rgbcolor store
		/FrameFillColor		0 0 0 rgbcolor store
		/FrameBorderColor	1 1 1 rgbcolor store
		/KeyFocusColor		1 1 1 rgbcolor store
		/ClientFillColor	0 0 0 rgbcolor store
		/IconTextColor		1 1 1 rgbcolor store
		/IconFillColor		0 0 0 rgbcolor store
		/IconBorderColor	1 1 1 rgbcolor store
	} LiteWindow send
	{ /paint self send } AllWin
} def	

  % Different text sizes for the example text
/textsize_menu
	[(6) (8) (10) (12) (14) (20) (24) (32) (48) (72)]
	[ { /textfont textfontname findfont
		/textheight currentkey cvi store
		textheight scalefont store
		updatepaine
} ] /new DefaultMenu send def		

  % Chouse random colors for different things
/rainbowmenu [
  % stack: 
	(--- Rainbow Colors ---) {nullproc}
	(Everything!) {
		/textcolor {random random random rgbcolor} store
		/DefaultRootGrayOrColor{random random random rgbcolor} store
		/bordercolor {random random random rgbcolor} store
		/backgroundcolor {random random random rgbcolor} store
		{
			/MenuTextColor {random random random rgbcolor} store
			/MenuFillColor {random random random rgbcolor} store
			/MenuBorderColor {random random random rgbcolor} store
		} LiteMenu send
		{
			/ShadowColor	{random random random rgbcolor} def
		} LitePullRightMenu send
			{
			/ItemTextColor {random random random rgbcolor} store
			/ItemFillColor {random random random rgbcolor} store
			/ItemBorderColor {random random random rgbcolor} store
		} Item send
		{
			/IconTextColor {random random random rgbcolor} store
			/IconFillColor {random random random rgbcolor} store
			/IconBorderColor {random random random rgbcolor} store
			/FrameTextColor {random random random rgbcolor} store
			/FrameFillColor {random random random rgbcolor} store
			/FrameBorderColor {random random random rgbcolor} store
		} LiteWindow send
	}
	(Text)
		{/textcolor {random random random rgbcolor} store}
	(Background)
		{/DefaultRootGrayOrColor{random random random rgbcolor} store}
	(---)	{nullproc}
	(Menu Text)
		{LiteMenu /MenuTextColor {random random random rgbcolor} put}
	(Menu Fill)
		{LiteMenu /MenuFillColor {random random random rgbcolor} put}
	(Menu Border)
		{LiteMenu /MenuBorderColor {random random random rgbcolor} put}
	(Menu Shadow)
		{LitePullRightMenu /ShadowColor {random random random rgbcolor} put}
	(---)	{nullproc}
	(Item Text)
		{Item /ItemTextColor {random random random rgbcolor} put}
	(Item Fill)
		{Item /ItemFillColor {random random random rgbcolor} put}
	(Item Border)
		{Item /ItemBorderColor {random random random rgbcolor} put}
	(---)	{nullproc}
	(Icon Text)
		{LiteWindow /IconTextColor {random random random rgbcolor} put}
	(Icon Fill)
		{LiteWindow /IconFillColor {random random random rgbcolor} put}
	(Icon Border)
		{LiteWindow /IconBorderColor {random random random rgbcolor} put}
] /new DefaultMenu send def

  % Sub menus for the setting of systems defaults.  These have to be set up first.
/windows_defaults_menu [
	(Window Backgrounds) {
		{/ClientFillColor Hue Sat Brt docolor store} LiteWindow send
		{/paint self send } AllWin
	}
	(Window Frame Text) {
		{ /FrameTextColor Hue Sat Brt docolor store } LiteWindow send
		{ /paint self send } AllWin
	}
	(Window Frame Fill) {
		{ /FrameFillColor Hue Sat Brt docolor store } LiteWindow send
		{ /paint self send } AllWin
	}
	(Window Frame Borders) {
		{ /FrameBorderColor Hue Sat Brt docolor store } LiteWindow send
		{ /paint self send } AllWin
	}
	(Window Focus Bar) {
		{ /KeyFocusColor Hue Sat Brt docolor store } LiteWindow send
		{ /paint self send } AllWin
	}
] /new DefaultMenu send def

/items_defaults_menu [
	(Item Text)	{Item /ItemTextColor Hue Sat Brt docolor put}
	(Item Fill)	{Item /ItemFillColor Hue Sat Brt docolor put}
	(Item Border)	{Item /ItemBorderColor Hue Sat Brt docolor put}
] /new DefaultMenu send def

/menus_defaults_menu [
	(Menu Text)	{LiteMenu /MenuTextColor Hue Sat Brt docolor put}
	(Menu Fill)	{LiteMenu /MenuFillColor Hue Sat Brt docolor put}
	(Menu Border)	{LiteMenu /MenuBorderColor Hue Sat Brt docolor put}
	(Menu Shadow)	{LitePullRightMenu /ShadowColor Hue Sat Brt docolor put}
] /new DefaultMenu send def

/icons_defaults_menu [
	(Icon Text)	{{ /IconTextColor Hue Sat Brt docolor store } LiteWindow send }
	(Icon Fill)	{{ /IconFillColor Hue Sat Brt docolor store } LiteWindow send }
	(Icon Border)	{{ /IconBorderColor Hue Sat Brt docolor store } LiteWindow send }
] /new DefaultMenu send def

  % Menu Definition to change system wide default colors (runtime only)
/systemdefaultsmenu [
  % stack: - => -
	(Text Color) {
		/textcolor Hue Sat Brt docolor store
		{ /paint self send } AllWin
	}
	(Root Background) {
		/DefaultRootGrayOrColor [Hue Sat Brt docolor] cvx store
		PaintRoot
	}
	(Mixed Borders) {
		% Used by some things like clocks
		/bordercolor Hue Sat Brt docolor store
		{ /paint self send } AllWin
	}
	(Mixed Backgrounds) {
		/backgroundcolor Hue Sat Brt docolor store
		{ /WindowFillColor Hue Sat Brt docolor store} LiteWindow send
		{ /paint self send } AllWin
	}
	(Windows...)	windows_defaults_menu
	(Icons...)	icons_defaults_menu
	(Menus...)	menus_defaults_menu
	(Items...)	items_defaults_menu
] /new DefaultMenu send def

  % Menu Definition to change the colors in this window only
/thiswindowmenu [
  % stack:
	(Text Color) {
		/colortooltextcolor Hue Sat Brt docolor store
		updatepaine
	}
	(Frame Text Color) {
		{ /FrameTextColor Hue Sat Brt docolor def } win send
		/paint win send }
	(Frame Fill Color) {
		{ /FrameFillColor Hue Sat Brt docolor def } win send
		/paint win send }
	(Frame Border Color) {
		{ /FrameBorderColor Hue Sat Brt docolor def } win send
		/paint win send }
	(-----) {nullproc}
	(Item Text Color) {
		{ /ItemTextColor Hue Sat Brt docolor def }
			RealTimeSliderItem send
		/PaintClient win send }
	(Item Fill Color) {
		{ /ItemFillColor Hue Sat Brt docolor def }
			RealTimeSliderItem send
		/PaintClient win send }
	(Item Border Color) {
		{ /ItemBorderColor Hue Sat Brt docolor def }
			RealTimeSliderItem send
		/PaintClient win send }
	(-------) {nullproc}
	(Icon Text Color) {
		{ /IconTextColor Hue Sat Brt docolor def } win send }
	(Icon Fill Color) {
		{ /IconFillColor Hue Sat Brt docolor def } win send }
	(Icon Border Color) {
		{ /IconBorderColor Hue Sat Brt docolor def } win send }
] /new DefaultMenu send def	

/textmenu [
	(Display Text) {
		userdict /displaytext? displaytext? not put
		updatepaine
	}
	(Color Text)		{ /changethebackground false store}
	(Color Background)	{ /changethebackground true store}
	(Text Size...)	textsize_menu
] /new DefaultMenu send def

  % Function:
/main {
  % stack: 
	/win framebuffer /new DefaultWindow send def	% Creat win
	{						% Twiddle instance vars
	  /FrameLabel ( Color Tool ) def 			% Label frame
	  /PaintClient {				% 
		moveitems				%
		updatepaine				%
		items paintitems} def			%
	  /IconLabel (Color  Tool) def		% Lable Item
	  /IconImage /galaxy def			% Chose Icon
	  /BorderLeft 3 def				% 
	  /BorderRight 3 def				%
	  /BorderBottom 3 def				%
	  /ClientMinWidth 250 def			% Does not work?
	  /ClientMinHeight 66 def			% Seems to work
	  ColorDisplay? {
	    /IconTextColor .5 .6 .9 hsbcolor def		%
	    /IconFillColor .1 .4 .67 hsbcolor def		%
	  } { 
	    /IconTextColor 0 0 1 hsbcolor def
	  } ifelse
	  /ClientMenu [					% Create menus
		(HSB) {
			/docolor {hsbcolor} store
		{ /ItemLabel (Hue:) def } items /hue_slider_item get send
		{ /ItemLabel (Sat:) def } items /sat_slider_item get send
		{ /ItemLabel (Brt:) def } items /brt_slider_item get send
			updatepaine /PaintClient win send
		}
		(RGB) {			% change over to RGB sliders
			/docolor {rgbcolor} store
		{ /ItemLabel (Red:) def } items /hue_slider_item get send
		{ /ItemLabel (Grn:) def } items /sat_slider_item get send
		{ /ItemLabel (Blu:) def } items /brt_slider_item get send
			updatepaine /PaintClient win send
		}
		(Gray) {		% Try grays only
			% You know, its kind of dumb to use Hue insted of Brt
			% but that is the way of user interface.
			/docolor { pop pop 0 exch 0 exch hsbcolor } store
		{ /ItemLabel (Gry:) def } items /hue_slider_item get send
		{ /ItemLabel (Nil:) def } items /sat_slider_item get send
		{ /ItemLabel (Nil:) def } items /brt_slider_item get send
			/Hue 0 def /Sat 0 def
			items begin
			{/ItemValue 0 def} sat_slider_item send
			{/ItemValue 0 def} brt_slider_item send
			end
			updatepaine /PaintClient win send
		}
		(System Colors...)	systemdefaultsmenu
		(Local Colors...)	thiswindowmenu
		(Text...)		textmenu
		(Rainbows...)		rainbowmenu
		(White on Black)	{ thetextiswhite }
		(Redraw Screen) {PaintRoot {/paint self send} AllWin }
		(Normalize)
			{ return_to_normal_colors
			PaintRoot
			{/paint self send} AllWin }
		(Bye) {currentprocess killprocessgroup}	% 
	  ] /new DefaultMenu send def			% Install menu
	} win send					% Install inits
	/reshapefromuser win send			% Size window
	/win_can win /ClientCanvas get def		% 
	inititems
	ColorDisplay? not {
			/docolor { pop pop 0 exch 0 exch hsbcolor } store
		{ /ItemLabel (Gry:) def } items /hue_slider_item get send
		{ /ItemLabel (Nil:) def } items /sat_slider_item get send
		{ /ItemLabel (Nil:) def } items /brt_slider_item get send
			/Hue random def /Sat 0 def /Brt 0 def
			items begin
			{/ItemValue 0 def}   sat_slider_item send
			{/ItemValue 0 def}   brt_slider_item send
			end
%			updatepaine /PaintClient win send
	} if
	/map win send
  % Split off threds to deal with the Items.
	/item_manager_process items forkitems def
} def	

main

% Nothing uses litetext.ps sept liteitems, and who really knows about them...
% News needs a color to rgb/hsb color set converter, if saveing is not enough
%  do to the trick, it would be usefull in most any case. Hugh/Gnu

% change item font so that is even spaces?

% Notes:
%	Color map access, fewer colors

EOF
