Subversion Repositories or1k

#!/bin/sh

# the next line restarts using wish \

exec wish "$0" "$@"

# tcolor --

# This script implements a simple color editor, where you can

# create colors using either the RGB, HSB, or CYM color spaces

# and apply the color to existing applications.

#

# SCCS: @(#) tcolor 1.11 96/06/24 16:43:11

wm title . "Color Editor"

# Global variables that control the program:

#

# colorSpace -                  Color space currently being used for

#                               editing.  Must be "rgb", "cmy", or "hsb".

# label1, label2, label3 -      Labels for the scales.

# red, green, blue -            Current color intensities in decimal

#                               on a scale of 0-65535.

# color -                       A string giving the current color value

#                               in the proper form for x:

#                               #RRRRGGGGBBBB

# updating -                    Non-zero means that we're in the middle of

#                               updating the scales to load a new color,so

#                               information shouldn't be propagating back

#                               from the scales to other elements of the

#                               program:  this would make an infinite loop.

# command -                     Holds the command that has been typed

#                               into the "Command" entry.

# autoUpdate -                  1 means execute the update command

#                               automatically whenever the color changes.

# name -                        Name for new color, typed into entry.

set colorSpace hsb

set red 65535

set green 0

set blue 0

set color #ffff00000000

set updating 0

set autoUpdate 1

set name ""

# Create the menu bar at the top of the window.

frame .menu -relief raised -borderwidth 2

pack .menu -side top -fill x

menubutton .menu.file -text File -menu .menu.file.m -underline 0

menu .menu.file.m

.menu.file.m add radio -label "RGB color space" -variable colorSpace \

        -value rgb -underline 0 -command {changeColorSpace rgb}

.menu.file.m add radio -label "CMY color space" -variable colorSpace \

        -value cmy -underline 0 -command {changeColorSpace cmy}

.menu.file.m add radio -label "HSB color space" -variable colorSpace \

        -value hsb -underline 0 -command {changeColorSpace hsb}

.menu.file.m add separator

.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \

        -value 1 -underline 0

.menu.file.m add radio -label "Manual updates" -variable autoUpdate \

        -value 0 -underline 0

.menu.file.m add separator

.menu.file.m add command -label "Exit program" -underline 0 \

        -command "destroy ."

pack .menu.file -side left

# Create the command entry window at the bottom of the window, along

# with the update button.

frame .bot -relief raised -borderwidth 2

pack .bot -side bottom -fill x

label .commandLabel -text "Command:"

entry .command -relief sunken -borderwidth 2 -textvariable command \

        -font {Courier 12}

button .update -text Update -command doUpdate

pack .commandLabel -in .bot -side left

pack .update -in .bot -side right -pady .1c -padx .25c

pack .command -in .bot -expand yes -fill x -ipadx 0.25c

# Create the listbox that holds all of the color names in rgb.txt,

# if an rgb.txt file can be found.

frame .middle -relief raised -borderwidth 2

pack .middle -side top -fill both

foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt

        /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt

        /usr/openwin/lib/X11/rgb.txt} {

    if ![file readable $i] {

        continue;

    }

    set f [open $i]

    frame .middle.left

    pack .middle.left -side left -padx .25c -pady .25c

    listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \

            -relief sunken -borderwidth 2 -exportselection false

    bind .names  {

            tc_loadNamedColor [.names get [.names curselection]]

    }

    scrollbar .scroll -orient vertical -command ".names yview" \

            -relief sunken -borderwidth 2

    pack .names -in .middle.left -side left

    pack .scroll -in .middle.left -side right -fill y

    while {[gets $f line] >= 0} {

        if {[llength $line] == 4} {

            .names insert end [lindex $line 3]

        }

    }

    close $f

    break

}

# Create the three scales for editing the color, and the entry for

# typing in a color value.

frame .middle.middle

pack .middle.middle -side left -expand yes -fill y

frame .middle.middle.1

frame .middle.middle.2

frame .middle.middle.3

frame .middle.middle.4

pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes

pack .middle.middle.4 -side top -expand yes -fill x

foreach i {1 2 3} {

    label .label$i -textvariable label$i

    scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \

            -command tc_scaleChanged

    pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w

}

label .nameLabel -text "Name:"

entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \

        -font {Courier 12}

pack .nameLabel -in .middle.middle.4 -side left

pack .name -in .middle.middle.4 -side right -expand 1 -fill x

bind .name  {tc_loadNamedColor $name}

# Create the color display swatch on the right side of the window.

frame .middle.right

pack .middle.right -side left -pady .25c -padx .25c -anchor s

frame .swatch -width 2c -height 5c -background $color

label .value -textvariable color -width 13 -font {Courier 12}

pack .swatch -in .middle.right -side top -expand yes -fill both

pack .value -in .middle.right -side bottom -pady .25c

# The procedure below is invoked when one of the scales is adjusted.

# It propagates color information from the current scale readings

# to everywhere else that it is used.

proc tc_scaleChanged args {

    global red green blue colorSpace color updating autoUpdate

    if $updating {

        return

    }

    if {$colorSpace == "rgb"} {

        set red   [format %.0f [expr [.scale1 get]*65.535]]

        set green [format %.0f [expr [.scale2 get]*65.535]]

        set blue  [format %.0f [expr [.scale3 get]*65.535]]

    } else {

        if {$colorSpace == "cmy"} {

            set red   [format %.0f [expr {65535 - [.scale1 get]*65.535}]]

            set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]

            set blue  [format %.0f [expr {65535 - [.scale3 get]*65.535}]]

        } else {

            set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \

                    [expr {[.scale2 get]/1000.0}] \

                    [expr {[.scale3 get]/1000.0}]]

            set red [lindex $list 0]

            set green [lindex $list 1]

            set blue [lindex $list 2]

        }

    }

    set color [format "#%04x%04x%04x" $red $green $blue]

    .swatch config -bg $color

    if $autoUpdate doUpdate

    update idletasks

}

# The procedure below is invoked to update the scales from the

# current red, green, and blue intensities.  It's invoked after

# a change in the color space and after a named color value has

# been loaded.

proc tc_setScales {} {

    global red green blue colorSpace updating

    set updating 1

    if {$colorSpace == "rgb"} {

        .scale1 set [format %.0f [expr $red/65.535]]

        .scale2 set [format %.0f [expr $green/65.535]]

        .scale3 set [format %.0f [expr $blue/65.535]]

    } else {

        if {$colorSpace == "cmy"} {

            .scale1 set [format %.0f [expr (65535-$red)/65.535]]

            .scale2 set [format %.0f [expr (65535-$green)/65.535]]

            .scale3 set [format %.0f [expr (65535-$blue)/65.535]]

        } else {

            set list [rgbToHsv $red $green $blue]

            .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]

            .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]

            .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]

        }

    }

    set updating 0

}

# The procedure below is invoked when a named color has been

# selected from the listbox or typed into the entry.  It loads

# the color into the editor.

proc tc_loadNamedColor name {

    global red green blue color autoUpdate

    if {[string index $name 0] != "#"} {

        set list [winfo rgb .swatch $name]

        set red [lindex $list 0]

        set green [lindex $list 1]

        set blue [lindex $list 2]

    } else {

        case [string length $name] {

            4 {set format "#%1x%1x%1x"; set shift 12}

            7 {set format "#%2x%2x%2x"; set shift 8}

            10 {set format "#%3x%3x%3x"; set shift 4}

            13 {set format "#%4x%4x%4x"; set shift 0}

            default {error "syntax error in color name \"$name\""}

        }

        if {[scan $name $format red green blue] != 3} {

            error "syntax error in color name \"$name\""

        }

        set red [expr $red<<$shift]

        set green [expr $green<<$shift]

        set blue [expr $blue<<$shift]

    }

    tc_setScales

    set color [format "#%04x%04x%04x" $red $green $blue]

    .swatch config -bg $color

    if $autoUpdate doUpdate

}

# The procedure below is invoked when a new color space is selected.

# It changes the labels on the scales and re-loads the scales with

# the appropriate values for the current color in the new color space

proc changeColorSpace space {

    global label1 label2 label3

    if {$space == "rgb"} {

        set label1 Red

        set label2 Green

        set label3 Blue

        tc_setScales

        return

    }

    if {$space == "cmy"} {

        set label1 Cyan

        set label2 Magenta

        set label3 Yellow

        tc_setScales

        return

    }

    if {$space == "hsb"} {

        set label1 Hue

        set label2 Saturation

        set label3 Brightness

        tc_setScales

        return

    }

}

# The procedure below converts an RGB value to HSB.  It takes red, green,

# and blue components (0-65535) as arguments, and returns a list containing

# HSB components (floating-point, 0-1) as result.  The code here is a copy

# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"

# by Foley and Van Dam.

proc rgbToHsv {red green blue} {

    if {$red > $green} {

        set max $red.0

        set min $green.0

    } else {

        set max $green.0

        set min $red.0

    }

    if {$blue > $max} {

        set max $blue.0

    } else {

        if {$blue < $min} {

            set min $blue.0

        }

    }

    set range [expr $max-$min]

    if {$max == 0} {

        set sat 0

    } else {

        set sat [expr {($max-$min)/$max}]

    }

    if {$sat == 0} {

        set hue 0

    } else {

        set rc [expr {($max - $red)/$range}]

        set gc [expr {($max - $green)/$range}]

        set bc [expr {($max - $blue)/$range}]

        if {$red == $max} {

            set hue [expr {.166667*($bc - $gc)}]

        } else {

            if {$green == $max} {

                set hue [expr {.166667*(2 + $rc - $bc)}]

            } else {

                set hue [expr {.166667*(4 + $gc - $rc)}]

            }

        }

        if {$hue < 0.0} {

            set hue [expr $hue + 1.0]

        }

    }

    return [list $hue $sat [expr {$max/65535}]]

}

# The procedure below converts an HSB value to RGB.  It takes hue, saturation,

# and value components (floating-point, 0-1.0) as arguments, and returns a

# list containing RGB components (integers, 0-65535) as result.  The code

# here is a copy of the code on page 616 of "Fundamentals of Interactive

# Computer Graphics" by Foley and Van Dam.

proc hsbToRgb {hue sat value} {

    set v [format %.0f [expr 65535.0*$value]]

    if {$sat == 0} {

        return "$v $v $v"

    } else {

        set hue [expr $hue*6.0]

        if {$hue >= 6.0} {

            set hue 0.0

        }

        scan $hue. %d i

        set f [expr $hue-$i]

        set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]

        set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]

        set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]

        case $i \

            1 {return "$q $v $p"} \

            2 {return "$p $v $t"} \

            3 {return "$p $q $v"} \

            4 {return "$t $p $v"} \

            5 {return "$v $p $q"}

        error "i value $i is out of range"

    }

}

# The procedure below is invoked when the "Update" button is pressed,

# and whenever the color changes if update mode is enabled.  It

# propagates color information as determined by the command in the

# Command entry.

proc doUpdate {} {

    global color command

    set newCmd $command

    regsub -all %% $command $color newCmd

    eval $newCmd

}

changeColorSpace hsb