home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 14 / hacker14.iso / programacao / pythonwin / python.exe / TCOLOR < prev    next >
Encoding:
Text File  |  2001-10-29  |  11.3 KB  |  367 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. # RCS: @(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $
  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. if {$tcl_platform(platform) eq "unix"} {
  45.     option add *Entry.background white
  46. }
  47.  
  48. # Create the menu bar at the top of the window.
  49.  
  50. . configure -menu [menu .menu]
  51. menu .menu.file
  52. .menu add cascade  -menu .menu.file  -label File  -underline 0
  53. .menu.file add radio -label "RGB color space" -variable colorSpace \
  54.     -value rgb -underline 0 -command {changeColorSpace rgb}
  55. .menu.file add radio -label "CMY color space" -variable colorSpace \
  56.     -value cmy -underline 0 -command {changeColorSpace cmy}
  57. .menu.file add radio -label "HSB color space" -variable colorSpace \
  58.     -value hsb -underline 0 -command {changeColorSpace hsb}
  59. .menu.file add separator
  60. .menu.file add radio -label "Automatic updates" -variable autoUpdate \
  61.     -value 1 -underline 0
  62. .menu.file add radio -label "Manual updates" -variable autoUpdate \
  63.     -value 0 -underline 0
  64. .menu.file add separator
  65. .menu.file add command -label "Exit program" -underline 0 -command {exit}
  66.  
  67. # Create the command entry window at the bottom of the window, along
  68. # with the update button.
  69.  
  70. labelframe .command -text "Command:" -padx {1m 0}
  71. entry .command.e -relief sunken -borderwidth 2 -textvariable command \
  72.     -font {Courier 12}
  73. button .command.update -text Update -command doUpdate
  74. pack .command.update -side right -pady .1c -padx {.25c 0}
  75. pack .command.e -expand yes -fill x -ipadx 0.25c
  76.  
  77.  
  78. # Create the listbox that holds all of the color names in rgb.txt,
  79. # if an rgb.txt file can be found.
  80.  
  81. grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}
  82.  
  83. grid columnconfigure . {1 2} -weight 1
  84. grid rowconfigure . 0 -weight 1
  85. foreach i {
  86.     /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
  87.     /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
  88.     /usr/openwin/lib/X11/rgb.txt
  89. } {
  90.     if {![file readable $i]} {
  91.     continue;
  92.     }
  93.     set f [open $i]
  94.     labelframe .names -text "Select:" -padx .1c -pady .1c
  95.     grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
  96.     grid columnconfigure . 0 -weight 1
  97.     listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
  98.         -relief sunken -borderwidth 2 -exportselection false
  99.     bind .names.lb <Double-1> {
  100.         tc_loadNamedColor [.names.lb get [.names.lb curselection]]
  101.     }
  102.     scrollbar .names.s -orient vertical -command ".names.lb yview" \
  103.         -relief sunken -borderwidth 2
  104.     pack .names.lb .names.s -side left -fill y -expand 1
  105.     while {[gets $f line] >= 0} {
  106.     if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
  107.         .names.lb insert end $col
  108.     }
  109.     }
  110.     close $f
  111.     break
  112. }
  113.  
  114. # Create the three scales for editing the color, and the entry for
  115. # typing in a color value.
  116.  
  117. frame .adjust
  118. foreach i {1 2 3} {
  119.     label .adjust.l$i -textvariable label$i -pady 0
  120.     labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
  121.     scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
  122.         -command tc_scaleChanged
  123.     pack .scale$i -in .adjust.$i
  124.     pack .adjust.$i
  125. }
  126. grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c
  127.  
  128. labelframe .name -text "Name:" -padx 1m -pady 1m
  129. entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
  130.     -font {Courier 12}
  131. pack .name.e -side right -expand 1 -fill x
  132. bind .name.e <Return> {tc_loadNamedColor $name}
  133. grid .name   -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
  134.  
  135. # Create the color display swatch on the right side of the window.
  136.  
  137. labelframe .sample -text "Color:" -padx 1m -pady 1m
  138. frame .sample.swatch -width 2c -height 5c -background $color
  139. label .sample.value -textvariable color -width 13 -font {Courier 12}
  140. pack .sample.swatch -side top -expand yes -fill both
  141. pack .sample.value -side bottom -pady .25c
  142. grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2
  143.  
  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.     switch $colorSpace {
  155.     rgb {
  156.         set red   [format %.0f [expr {[.scale1 get]*65.535}]]
  157.         set green [format %.0f [expr {[.scale2 get]*65.535}]]
  158.         set blue  [format %.0f [expr {[.scale3 get]*65.535}]]
  159.     }
  160.     cmy {
  161.         set red   [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
  162.         set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
  163.         set blue  [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
  164.     }
  165.     hsb {
  166.         set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
  167.             [expr {[.scale2 get]/1000.0}] \
  168.             [expr {[.scale3 get]/1000.0}]]
  169.         set red [lindex $list 0]
  170.         set green [lindex $list 1]
  171.         set blue [lindex $list 2]
  172.     }
  173.     }
  174.     set color [format "#%04x%04x%04x" $red $green $blue]
  175.     .sample.swatch config -bg $color
  176.     if {$autoUpdate} doUpdate
  177.     update idletasks
  178. }
  179.  
  180. # The procedure below is invoked to update the scales from the
  181. # current red, green, and blue intensities.  It's invoked after
  182. # a change in the color space and after a named color value has
  183. # been loaded.
  184.  
  185. proc tc_setScales {} {
  186.     global red green blue colorSpace updating
  187.     set updating 1
  188.     switch $colorSpace {
  189.     rgb {
  190.         .scale1 set [format %.0f [expr {$red/65.535}]]
  191.         .scale2 set [format %.0f [expr {$green/65.535}]]
  192.         .scale3 set [format %.0f [expr {$blue/65.535}]]
  193.     }
  194.     cmy {
  195.         .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
  196.         .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
  197.         .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
  198.     }
  199.     hsb {
  200.         set list [rgbToHsv $red $green $blue]
  201.         .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
  202.         .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
  203.         .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
  204.     }
  205.     }
  206.     set updating 0
  207. }
  208.  
  209. # The procedure below is invoked when a named color has been
  210. # selected from the listbox or typed into the entry.  It loads
  211. # the color into the editor.
  212.  
  213. proc tc_loadNamedColor name {
  214.     global red green blue color autoUpdate
  215.  
  216.     if {[string index $name 0] != "#"} {
  217.     set list [winfo rgb .sample.swatch $name]
  218.     set red [lindex $list 0]
  219.     set green [lindex $list 1]
  220.     set blue [lindex $list 2]
  221.     } else {
  222.     switch [string length $name] {
  223.         4  {set format "#%1x%1x%1x"; set shift 12}
  224.         7  {set format "#%2x%2x%2x"; set shift 8}
  225.         10 {set format "#%3x%3x%3x"; set shift 4}
  226.         13 {set format "#%4x%4x%4x"; set shift 0}
  227.         default {error "syntax error in color name \"$name\""}
  228.     }
  229.     if {[scan $name $format red green blue] != 3} {
  230.         error "syntax error in color name \"$name\""
  231.     }
  232.     set red   [expr {$red<<$shift}]
  233.     set green [expr {$green<<$shift}]
  234.     set blue  [expr {$blue<<$shift}]
  235.     }
  236.     tc_setScales
  237.     set color [format "#%04x%04x%04x" $red $green $blue]
  238.     .sample.swatch config -bg $color
  239.     if {$autoUpdate} doUpdate
  240. }
  241.  
  242. # The procedure below is invoked when a new color space is selected.
  243. # It changes the labels on the scales and re-loads the scales with
  244. # the appropriate values for the current color in the new color space
  245.  
  246. proc changeColorSpace space {
  247.     global label1 label2 label3
  248.     switch $space {
  249.     rgb {
  250.         set label1 "Adjust Red:"
  251.         set label2 "Adjust Green:"
  252.         set label3 "Adjust Blue:"
  253.         tc_setScales
  254.         return
  255.     }
  256.     cmy {
  257.         set label1 "Adjust Cyan:"
  258.         set label2 "Adjust Magenta:"
  259.         set label3 "Adjust Yellow:"
  260.         tc_setScales
  261.         return
  262.     }
  263.     hsb {
  264.         set label1 "Adjust Hue:"
  265.         set label2 "Adjust Saturation:"
  266.         set label3 "Adjust Brightness:"
  267.         tc_setScales
  268.         return
  269.     }
  270.     }
  271. }
  272.  
  273. # The procedure below converts an RGB value to HSB.  It takes red, green,
  274. # and blue components (0-65535) as arguments, and returns a list containing
  275. # HSB components (floating-point, 0-1) as result.  The code here is a copy
  276. # of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
  277. # by Foley and Van Dam.
  278.  
  279. proc rgbToHsv {red green blue} {
  280.     if {$red > $green} {
  281.     set max [expr {double($red)}]
  282.     set min [expr {double($green)}]
  283.     } else {
  284.     set max [expr {double($green)}]
  285.     set min [expr {double($red)}]
  286.     }
  287.     if {$blue > $max} {
  288.     set max [expr {double($blue)}]
  289.     } elseif {$blue < $min} {
  290.     set min [expr {double($blue)}]
  291.     }
  292.     set range [expr {$max-$min}]
  293.     if {$max == 0} {
  294.     set sat 0
  295.     } else {
  296.     set sat [expr {($max-$min)/$max}]
  297.     }
  298.     if {$sat == 0} {
  299.     set hue 0
  300.     } else {
  301.     set rc [expr {($max - $red)/$range}]
  302.     set gc [expr {($max - $green)/$range}]
  303.     set bc [expr {($max - $blue)/$range}]
  304.     if {$red == $max} {
  305.         set hue [expr {($bc - $gc)/6.0}]
  306.     } elseif {$green == $max} {
  307.         set hue [expr {(2 + $rc - $bc)/6.0}]
  308.     } else {
  309.         set hue [expr {(4 + $gc - $rc)/6.0}]
  310.     }
  311.     if {$hue < 0.0} {
  312.         set hue [expr {$hue + 1.0}]
  313.     }
  314.     }
  315.     return [list $hue $sat [expr {$max/65535}]]
  316. }
  317.  
  318. # The procedure below converts an HSB value to RGB.  It takes hue, saturation,
  319. # and value components (floating-point, 0-1.0) as arguments, and returns a
  320. # list containing RGB components (integers, 0-65535) as result.  The code
  321. # here is a copy of the code on page 616 of "Fundamentals of Interactive
  322. # Computer Graphics" by Foley and Van Dam.
  323.  
  324. proc hsbToRgb {hue sat value} {
  325.     set v [format %.0f [expr {65535.0*$value}]]
  326.     if {$sat == 0} {
  327.     return "$v $v $v"
  328.     } else {
  329.     set hue [expr {$hue*6.0}]
  330.     if {$hue >= 6.0} {
  331.         set hue 0.0
  332.     }
  333.     scan $hue. %d i
  334.     set f [expr {$hue-$i}]
  335.     set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
  336.     set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
  337.     set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
  338.     switch $i {
  339.         0 {return "$v $t $p"}
  340.         1 {return "$q $v $p"}
  341.         2 {return "$p $v $t"}
  342.         3 {return "$p $q $v"}
  343.         4 {return "$t $p $v"}
  344.         5 {return "$v $p $q"}
  345.         default {error "i value $i is out of range"}
  346.     }
  347.     }
  348. }
  349.  
  350. # The procedure below is invoked when the "Update" button is pressed,
  351. # and whenever the color changes if update mode is enabled.  It
  352. # propagates color information as determined by the command in the
  353. # Command entry.
  354.  
  355. proc doUpdate {} {
  356.     global color command
  357.     set newCmd $command
  358.     regsub -all %% $command $color newCmd
  359.     eval $newCmd
  360. }
  361.  
  362. changeColorSpace hsb
  363.  
  364. # Local Variables:
  365. # mode: tcl
  366. # End:
  367.