# we need tk.
package require Tk

################################################################################
# procedures - the stuff working in the background
################################################################################

proc colorup {amount} {
    # clear the entrybox
    .viewhex delete 0 end
    
    # get hexadecimal numbers
    set red [dectohex [.red get]]
    set green [dectohex [.green get]]
    set blue [dectohex [.blue get]]
    
    # build the color code
    set rgb "#$red$green$blue"
    
    # display the color code
    .view configure -bg $rgb
    .viewhex insert end $rgb
}

proc entryup {} {
    set rgb [.viewhex get]
    
    # check length of $rgb
    switch -- [string length $rgb] {
        7 {
            # 7 - #rrggbb. check that # is the first character
            regexp {(.).+} $rgb -> hashchar
            if { $hashchar != "#"} {
                return 1;
            }
        }
        
        4 {
            # 4 - #rgb. check syntax and extend it
            if [regexp {#(.)(.)(.)} $rgb -> num1 num2 num3] {
                set rgb "#$num1$num1$num2$num2$num3$num3"
            } else  {
                return 1;
            }
        }
        
        default {
            # neither 7 or 4. we quit here
            return 1;
        }
    }
    
    # extract $red, $green and $blue from $rgb
    regexp {#(..)(..)(..)} $rgb -> red green blue
    
    # convert $red, $green and $blue from dec to hex
    set red [hextodec $red]
    set green [hextodec $green]
    set blue [hextodec $blue]
    
    # set the scales' values
    .red set $red
    .green set $green
    .blue set $blue
}

proc dectohex {amount} {
    # initialize $sixteens
    set sixteens 0
    
    # make $sixteens $amount / 16, and $amount the remainder of it
    while {$amount >= 16} {
        set sixteens [expr $sixteens + 1]
        set amount [expr $amount - 16]
    }
    
    # change amounts into hex
    switch -- $amount {
        15 { set amount F; }
        14 { set amount E; }
        13 { set amount D; }
        12 { set amount C; }
        11 { set amount B; }
        10 { set amount A; }
        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { }
        
        default {
            set amount 0;
        }
    }
    
    switch -- $sixteens {
        15 { set sixteens F; }
        14 { set sixteens E; }
        13 { set sixteens D; }
        12 { set sixteens C; }
        11 { set sixteens B; }
        10 { set sixteens A; }
        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { }
        
        default {
            set sixteens 0;
        }
    }
    
    # return the amount back
    return $sixteens$amount
}

proc hextodec {amount} {
    # separate the two chars from each other
    regexp {(.)(.)} $amount -> num1 num2
    
    # convert
    switch -- $num1 {
        F - f { set num1 15; }
        E - e { set num1 14; }
        D - d { set num1 13; }
        C - c { set num1 12; }
        B - b { set num1 11; }
        A - a { set num1 10; }
        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { }
        
        default {
            set num1 0;
        }
    }
    
    switch -- $num2 {
        F - f { set num2 15; }
        E - e { set num2 14; }
        D - d { set num2 13; }
        C - c { set num2 12; }
        B - b { set num2 11; }
        A - a { set num2 10; }
        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { }
        
        default {
            set num2 0;
        }
    }
    
    # build the number and return it
    return [expr ($num1 * 16) + $num2]
}

################################################################################
# gui code
################################################################################

# set the window title
wm title . "colorsel 0.1"

# labels
label .redlabel   -text "Red"
label .greenlabel -text "Green"
label .bluelabel  -text "Blue"

# scales
scale .red   -from 0 -to 255 -length 350 -orient horizontal -command "colorup"
scale .green -from 0 -to 255 -length 350 -orient horizontal -command "colorup"
scale .blue  -from 0 -to 255 -length 350 -orient horizontal -command "colorup"

# color canvas
canvas .view -bg #000000 -width 128 -height 64

# hexacode
entry .viewhex -width 12
.viewhex insert end "#000000"

# grid all these up
grid .redlabel   -row 0 -column 0
grid .greenlabel -row 1 -column 0
grid .bluelabel  -row 2 -column 0

grid .red   -row 0 -column 1
grid .green -row 1 -column 1
grid .blue  -row 2 -column 1

grid .view    -row 0 -column 2 -rowspan 2
grid .viewhex -row 2 -column 2

# bind the entrybox to [entryup]
bind .viewhex <KeyRelease> entryup

package require Tk

proc colorup amount {
    .viewhex delete 0 end
    
    set rgb #
    # get hexadecimal numbers and build the color code
    append rgb [format %02X [.red get]]
    append rgb [format %02X [.green get]]
    append rgb [format %02X [.blue get]]
    
    # display the color code
    .view configure -bg $rgb
    .viewhex insert end $rgb
}

proc entryup {} {
    set rgb [.viewhex get]
    
    switch -regexp -matchvar m $rgb {
        {^#([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$} {
            set values [lrange $m 1 end]
        }
        {^#([[:xdigit:]])([[:xdigit:]])([[:xdigit:]])$} {
            set values [lmap x [lrange $m 1 end] {string cat $x $x}]
        }
        default {return 1}
    }

    foreach w {.red .green .blue} val $values {
        $w set [scan $val %x]
    }
}

# gui code

# set the window title
wm title . "colorsel 0.2"

# labels
label .redlabel   -text Red
label .greenlabel -text Green
label .bluelabel  -text Blue

# scales
scale .red   -from 0 -to 255 -length 350 -orient horizontal -command colorup
scale .green -from 0 -to 255 -length 350 -orient horizontal -command colorup
scale .blue  -from 0 -to 255 -length 350 -orient horizontal -command colorup

# color canvas
canvas .view -bg #000000 -width 128 -height 64

# hexacode
entry .viewhex -width 12

# grid all these up
grid .redlabel   .red   .view
grid .greenlabel .green ^
grid .bluelabel  .blue  .viewhex

# bind the entrybox to [entryup]
bind .viewhex <KeyRelease> entryup