Converting between different colour formats

Excluding the use of named Unix colours, Gtk+ employs three numeric ways of describing colours: rgb, hex and decimal. The choice of modes is largely determined by the library being wrapped. Cairo, for instance, only accepts colours in decimal formats. Some conversion is handled in the gnocl sources but, here's a package of proc which will convert between all three formats and also make allowances for the extra alpha channel.

#---------------
# colour-conversions.tcl
#---------------
# William J Giddings
# 04-Mar-2013
#---------------
# Notes:
# Manipulate colour expresions.
#---------------

#---------------
# convert integer RGBA values to hexadecimal
#---------------
#
proc RGB2hex {clr} {    
    if { [llength $clr] == 4 } {
        scan $clr "%d %d %d %d" r g b a
        return [format "#%02x%02x%02x%02x" $r $g $b $a]
    } else {
        scan $clr "%d %d %d" r g b
        return [format "#%02x%02x%02x" $r $g $b]  
    }
    return -1
}

#---------------
# convert hexadecimal values to RGBA
#---------------
#
proc hex2RGB {clr} {
    scan [string range $clr 1 2] %x R
    scan [string range $clr 3 4] %x G
    scan [string range $clr 5 6] %x B

    if {[string length $clr] == 7} {
        return "$R $G $B"
    } else {
        scan [string range $clr 7 8] %x A
        return "$R $G $B $A"
    }
    return -1
}



#---------------
# express value in range as decimal between 0 and 1
#---------------
#
proc unitize {val {range 255} {places 3}} {    
    return [format "%1.${places}f" [expr ${val}.0/$range]]
}

#---------------
# convert integer RGBA list to Cairo decicmal colours
#---------------
#
proc RGB2Dec {clr} {
    if { [llength $clr] == 3} {    
        scan $clr "%d %d %d" r g b
        set r [unitize $r]
        set g [unitize $g]
        set b [unitize $b]  
        return "$r $g $b"
    } else {
        scan $clr "%d %d %d %d" r g b a
        set r [unitize $r]
        set g [unitize $g]
        set b [unitize $b]
        set a [unitize $a]
        return "$r $g $b $a"
    }

    return -1

}

#---------------
# convert hexadecimal colour values to Cairo decicmal colours
#---------------
#
proc HEX2Dec {clr} {
    return [RGB2Dec [hex2RGB $clr]]
}

#---------------
# convert decimal colour to RGB
#---------------
#
proc Dec2RGB {clr} {
    if {[llength $clr] == 3 } {
        scan $clr "%f %f %f" r g b
        set r [format %d [expr int($r * 255)]]
        set g [format %d [expr int($g * 255)]]
        set b [format %d [expr int($b * 255)]]
        return "$r $g $b"
    } else {
        scan $clr "%f %f %f %f" r g b a        
        set r [format %d [expr int($r * 255)]]
        set g [format %d [expr int($g * 255)]]
        set b [format %d [expr int($b * 255)]]
        set a [format %d [expr int($a * 255)]]        
        return "$r $g $b $a"
    }
    return -1
}

#---------------
# convert decimal colour to hexadecimal
#---------------
#
proc Dec2Hex {clr} {
    if {[llength $clr] == 3 } {
        scan $clr "%f %f %f" r g b a    
        set r [format %d [expr int($r * 255)]]
        set g [format %d [expr int($g * 255)]]
        set b [format %d [expr int($b * 255)]]        
        return [format "#%02x%02x%02x" $r $g $b]    
    } else {
        scan $clr "%f %f %f %f" r g b a        
        set r [format %d [expr int($r * 255)]]
        set g [format %d [expr int($g * 255)]]
        set b [format %d [expr int($b * 255)]]
        set a [format %d [expr int($a * 255)]]        
        return [format "#%02x%02x%02x%02x" $r $g $b $a]
    }
    return -1
}

#---------------
# test
#---------------
set color [RGB2hex "255 255 255"]
puts "1    $color"
set color [RGB2hex "255 255 255 128"]
puts "2    $color"
puts "3    [hex2RGB $color]"
puts "4    [RGB2Dec "255 255 255 127"]"
puts "5    [HEX2Dec #FF0000]"
puts "6    [Dec2RGB "1.0 1.0 1.0 0.5"]"
puts "7    [Dec2Hex "1.0 1.0 1.0 0.5"]"