home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 September / WIN95_09962.iso / vrml / cp2b2x.exe / DATA.Z / tcolor < prev    next >
Text File  |  1996-04-23  |  11KB  |  360 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. # tcolor --
  6. # This script implements a simple color editor, where you can
  7. # create colors using either the RGB, HSB, or CYM color spaces
  8. # and apply the color to existing applications.
  9. #
  10. # @(#) tcolor 1.9 95/09/07 11:13:21
  11.  
  12. wm title . "Color Editor"
  13.  
  14. # Global variables that control the program:
  15. #
  16. # colorSpace -            Color space currently being used for
  17. #                editing.  Must be "rgb", "cmy", or "hsb".
  18. # label1, label2, label3 -    Labels for the scales.
  19. # red, green, blue -        Current color intensities in decimal
  20. #                on a scale of 0-65535.
  21. # color -            A string giving the current color value
  22. #                in the proper form for x:
  23. #                #RRRRGGGGBBBB
  24. # updating -            Non-zero means that we're in the middle of
  25. #                updating the scales to load a new color,so
  26. #                information shouldn't be propagating back
  27. #                from the scales to other elements of the
  28. #                program:  this would make an infinite loop.
  29. # command -            Holds the command that has been typed
  30. #                into the "Command" entry.
  31. # autoUpdate -            1 means execute the update command
  32. #                automatically whenever the color changes.
  33. # name -            Name for new color, typed into entry.
  34.  
  35. set colorSpace hsb
  36. set red 65535
  37. set green 0
  38. set blue 0
  39. set color #ffff00000000
  40. set updating 0
  41. set autoUpdate 1
  42. set name ""
  43.  
  44. # Create the menu bar at the top of the window.
  45.  
  46. frame .menu -relief raised -borderwidth 2
  47. pack .menu -side top -fill x
  48. menubutton .menu.file -text File -menu .menu.file.m -underline 0
  49. menu .menu.file.m
  50. .menu.file.m add radio -label "RGB color space" -variable colorSpace \
  51.     -value rgb -underline 0 -command {changeColorSpace rgb}
  52. .menu.file.m add radio -label "CMY color space" -variable colorSpace \
  53.     -value cmy -underline 0 -command {changeColorSpace cmy}
  54. .menu.file.m add radio -label "HSB color space" -variable colorSpace \
  55.     -value hsb -underline 0 -command {changeColorSpace hsb}
  56. .menu.file.m add separator
  57. .menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
  58.     -value 1 -underline 0
  59. .menu.file.m add radio -label "Manual updates" -variable autoUpdate \
  60.     -value 0 -underline 0
  61. .menu.file.m add separator
  62. .menu.file.m add command -label "Exit program" -underline 0 \
  63.     -command "destroy ."
  64. pack .menu.file -side left
  65.  
  66. # Create the command entry window at the bottom of the window, along
  67. # with the update button.
  68.  
  69. frame .bot -relief raised -borderwidth 2
  70. pack .bot -side bottom -fill x
  71. label .commandLabel -text "Command:"
  72. entry .command -relief sunken -borderwidth 2 -textvariable command \
  73.     -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
  74. button .update -text Update -command doUpdate
  75. pack .commandLabel -in .bot -side left
  76. pack .update -in .bot -side right -pady .1c -padx .25c
  77. pack .command -in .bot -expand yes -fill x -ipadx 0.25c
  78.  
  79. # Create the listbox that holds all of the color names in rgb.txt,
  80. # if an rgb.txt file can be found.
  81.  
  82. frame .middle -relief raised -borderwidth 2
  83. pack .middle -side top -fill both
  84. foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
  85.     /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
  86.     /usr/openwin/lib/X11/rgb.txt} {
  87.     if ![file readable $i] {
  88.     continue;
  89.     }
  90.     set f [open $i]
  91.     frame .middle.left
  92.     pack .middle.left -side left -padx .25c -pady .25c
  93.     listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
  94.         -relief sunken -borderwidth 2 -exportselection false
  95.     bind .names <Double-1> {
  96.         tc_loadNamedColor [.names get [.names curselection]]
  97.     }
  98.     scrollbar .scroll -orient vertical -command ".names yview" \
  99.         -relief sunken -borderwidth 2
  100.     pack .names -in .middle.left -side left
  101.     pack .scroll -in .middle.left -side right -fill y
  102.     while {[gets $f line] >= 0} {
  103.     if {[llength $line] == 4} {
  104.         .names insert end [lindex $line 3]
  105.     }
  106.     }
  107.     close $f
  108.     break
  109. }
  110.  
  111. # Create the three scales for editing the color, and the entry for
  112. # typing in a color value.
  113.  
  114. frame .middle.middle
  115. pack .middle.middle -side left -expand yes -fill y
  116. frame .middle.middle.1
  117. frame .middle.middle.2
  118. frame .middle.middle.3
  119. frame .middle.middle.4
  120. pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes
  121. pack .middle.middle.4 -side top -expand yes -fill x
  122. foreach i {1 2 3} {
  123.     label .label$i -textvariable label$i
  124.     scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
  125.         -command tc_scaleChanged
  126.     pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
  127. }
  128. label .nameLabel -text "Name:"
  129. entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
  130.     -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
  131. pack .nameLabel -in .middle.middle.4 -side left
  132. pack .name -in .middle.middle.4 -side right -expand 1 -fill x
  133. bind .name <Return> {tc_loadNamedColor $name}
  134.  
  135. # Create the color display swatch on the right side of the window.
  136.  
  137. frame .middle.right
  138. pack .middle.right -side left -pady .25c -padx .25c -anchor s
  139. frame .swatch -width 2c -height 5c -background $color
  140. label .value -textvariable color -width 13 \
  141.     -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
  142. pack .swatch -in .middle.right -side top -expand yes -fill both
  143. pack .value -in .middle.right -side bottom -pady .25c
  144.  
  145. # The procedure below is invoked when one of the scales is adjusted.
  146. # It propagates color information from the current scale readings
  147. # to everywhere else that it is used.
  148.  
  149. proc tc_scaleChanged args {
  150.     global red green blue colorSpace color updating autoUpdate
  151.     if $updating {
  152.     return
  153.     }
  154.     if {$colorSpace == "rgb"} {
  155.     set red   [format %.0f [expr [.scale1 get]*65.535]]
  156.     set green [format %.0f [expr [.scale2 get]*65.535]]
  157.     set blue  [format %.0f [expr [.scale3 get]*65.535]]
  158.     } else {
  159.     if {$colorSpace == "cmy"} {
  160.         set red   [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
  161.         set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
  162.         set blue  [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
  163.     } else {
  164.         set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
  165.             [expr {[.scale2 get]/1000.0}] \
  166.             [expr {[.scale3 get]/1000.0}]]
  167.         set red [lindex $list 0]
  168.         set green [lindex $list 1]
  169.         set blue [lindex $list 2]
  170.     }
  171.     }
  172.     set color [format "#%04x%04x%04x" $red $green $blue]
  173.     .swatch config -bg $color
  174.     if $autoUpdate doUpdate
  175.     update idletasks
  176. }
  177.  
  178. # The procedure below is invoked to update the scales from the
  179. # current red, green, and blue intensities.  It's invoked after
  180. # a change in the color space and after a named color value has
  181. # been loaded.
  182.  
  183. proc tc_setScales {} {
  184.     global red green blue colorSpace updating
  185.     set updating 1
  186.     if {$colorSpace == "rgb"} {
  187.     .scale1 set [format %.0f [expr $red/65.535]]
  188.     .scale2 set [format %.0f [expr $green/65.535]]
  189.     .scale3 set [format %.0f [expr $blue/65.535]]
  190.     } else {
  191.     if {$colorSpace == "cmy"} {
  192.         .scale1 set [format %.0f [expr (65535-$red)/65.535]]
  193.         .scale2 set [format %.0f [expr (65535-$green)/65.535]]
  194.         .scale3 set [format %.0f [expr (65535-$blue)/65.535]]
  195.     } else {
  196.         set list [rgbToHsv $red $green $blue]
  197.         .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
  198.         .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
  199.         .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
  200.     }
  201.     }
  202.     set updating 0
  203. }
  204.  
  205. # The procedure below is invoked when a named color has been
  206. # selected from the listbox or typed into the entry.  It loads
  207. # the color into the editor.
  208.  
  209. proc tc_loadNamedColor name {
  210.     global red green blue color autoUpdate
  211.  
  212.     if {[string index $name 0] != "#"} {
  213.     set list [winfo rgb .swatch $name]
  214.     set red [lindex $list 0]
  215.     set green [lindex $list 1]
  216.     set blue [lindex $list 2]
  217.     } else {
  218.     case [string length $name] {
  219.         4 {set format "#%1x%1x%1x"; set shift 12}
  220.         7 {set format "#%2x%2x%2x"; set shift 8}
  221.         10 {set format "#%3x%3x%3x"; set shift 4}
  222.         13 {set format "#%4x%4x%4x"; set shift 0}
  223.         default {error "syntax error in color name \"$name\""}
  224.     }
  225.     if {[scan $name $format red green blue] != 3} {
  226.         error "syntax error in color name \"$name\""
  227.     }
  228.     set red [expr $red<<$shift]
  229.     set green [expr $green<<$shift]
  230.     set blue [expr $blue<<$shift]
  231.     }
  232.     tc_setScales
  233.     set color [format "#%04x%04x%04x" $red $green $blue]
  234.     .swatch config -bg $color
  235.     if $autoUpdate doUpdate
  236. }
  237.  
  238. # The procedure below is invoked when a new color space is selected.
  239. # It changes the labels on the scales and re-loads the scales with
  240. # the appropriate values for the current color in the new color space
  241.  
  242. proc changeColorSpace space {
  243.     global label1 label2 label3
  244.     if {$space == "rgb"} {
  245.     set label1 Red
  246.     set label2 Green
  247.     set label3 Blue
  248.     tc_setScales
  249.     return
  250.     }
  251.     if {$space == "cmy"} {
  252.     set label1 Cyan
  253.     set label2 Magenta
  254.     set label3 Yellow
  255.     tc_setScales
  256.     return
  257.     }
  258.     if {$space == "hsb"} {
  259.     set label1 Hue
  260.     set label2 Saturation
  261.     set label3 Brightness
  262.     tc_setScales
  263.     return
  264.     }
  265. }
  266.  
  267. # The procedure below converts an RGB value to HSB.  It takes red, green,
  268. # and blue components (0-65535) as arguments, and returns a list containing
  269. # HSB components (floating-point, 0-1) as result.  The code here is a copy
  270. # of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
  271. # by Foley and Van Dam.
  272.  
  273. proc rgbToHsv {red green blue} {
  274.     if {$red > $green} {
  275.     set max $red.0
  276.     set min $green.0
  277.     } else {
  278.     set max $green.0
  279.     set min $red.0
  280.     }
  281.     if {$blue > $max} {
  282.     set max $blue.0
  283.     } else {
  284.     if {$blue < $min} {
  285.         set min $blue.0
  286.     }
  287.     }
  288.     set range [expr $max-$min]
  289.     if {$max == 0} {
  290.     set sat 0
  291.     } else {
  292.     set sat [expr {($max-$min)/$max}]
  293.     }
  294.     if {$sat == 0} {
  295.     set hue 0
  296.     } else {
  297.     set rc [expr {($max - $red)/$range}]
  298.     set gc [expr {($max - $green)/$range}]
  299.     set bc [expr {($max - $blue)/$range}]
  300.     if {$red == $max} {
  301.         set hue [expr {.166667*($bc - $gc)}]
  302.     } else {
  303.         if {$green == $max} {
  304.         set hue [expr {.166667*(2 + $rc - $bc)}]
  305.         } else {
  306.         set hue [expr {.166667*(4 + $gc - $rc)}]
  307.         }
  308.     }
  309.     if {$hue < 0.0} {
  310.         set hue [expr $hue + 1.0]
  311.     }
  312.     }
  313.     return [list $hue $sat [expr {$max/65535}]]
  314. }
  315.  
  316. # The procedure below converts an HSB value to RGB.  It takes hue, saturation,
  317. # and value components (floating-point, 0-1.0) as arguments, and returns a
  318. # list containing RGB components (integers, 0-65535) as result.  The code
  319. # here is a copy of the code on page 616 of "Fundamentals of Interactive
  320. # Computer Graphics" by Foley and Van Dam.
  321.  
  322. proc hsbToRgb {hue sat value} {
  323.     set v [format %.0f [expr 65535.0*$value]]
  324.     if {$sat == 0} {
  325.     return "$v $v $v"
  326.     } else {
  327.     set hue [expr $hue*6.0]
  328.     if {$hue >= 6.0} {
  329.         set hue 0.0
  330.     }
  331.     scan $hue. %d i
  332.     set f [expr $hue-$i]
  333.     set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
  334.     set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
  335.     set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
  336.     case $i \
  337.         0 {return "$v $t $p"} \
  338.         1 {return "$q $v $p"} \
  339.         2 {return "$p $v $t"} \
  340.         3 {return "$p $q $v"} \
  341.         4 {return "$t $p $v"} \
  342.         5 {return "$v $p $q"}
  343.     error "i value $i is out of range"
  344.     }
  345. }
  346.  
  347. # The procedure below is invoked when the "Update" button is pressed,
  348. # and whenever the color changes if update mode is enabled.  It
  349. # propagates color information as determined by the command in the
  350. # Command entry.
  351.  
  352. proc doUpdate {} {
  353.     global color command
  354.     set newCmd $command
  355.     regsub -all %% $command $color newCmd
  356.     eval $newCmd
  357. }
  358.  
  359. changeColorSpace hsb
  360.