Version 1 of colorsel

Updated 2008-03-06 17:21:43 by aleksanteri

aleksanteri, 6th of March 2008. I made this little color selector in a few hours when I was bored. Now I got it finished and decided to post it here :)

  # 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