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