namespace eval ::histo \
  {
    namespace export histo

    package require Tk

    proc histo {image {cmd -display}} \
    {
      # get options
      switch -glob -- $cmd \
      {
        -dis*   { set cmd -display }
        -exp*   { set cmd -export }
        default \
        { error "use\n\t[histo image ?-display|-export?" }
      }
      # get the image size
      set width [image width $image]
      set height [image height $image]
      if {$width * $height == 0} { error "bad image" }
      # count colors components
      for {set i 0} {$i < 256} {incr i} \
      { foreach c {r g b} { set counts($c:$i) 0 } }
      set max 0
      for {set y 0} {$y < $height} {incr y} \
      {
        for {set x 0} {$x < $width} {incr x} \
        {
          foreach {r g b} [$image get $x $y] break
          foreach c {r g b} \
          { 
            set n [incr counts($c:[set $c])] 
            if {$max < $n} { set max $n }
          }
        }
      }
      if {$cmd == "-display"} \
      {
      # display
        # compute the coef
        set coef [expr {256.0 / $max}]
        # create toplevel
        set t _$image
        toplevel .$t
        wm title .$t $image
        # draw the histogram
        set c .$t.c
        canvas $c -width [expr {256 * 3 + 40}] -height [expr {256 + 40}]
        set x0 9
        set y0 267
        $c create rectangle $x0 9 [incr x0 258] $y0 -outline black -fill white
        incr x0 8
        $c create rectangle $x0 9 [incr x0 258] $y0 -outline black -fill white
        incr x0 8
        $c create rectangle $x0 9 [incr x0 258] $y0 -outline black -fill white
        set y1 272
        set x0 10
        for {set i 0} {$i < 17} {incr i} \
        {
          $c create line $x0 $y0 $x0 $y1
          incr x0 16
        }
        set x0 276
        for {set i 0} {$i < 17} {incr i} \
        {
          $c create line $x0 $y0 $x0 $y1
          incr x0 16
        }
        set x0 542
        for {set i 0} {$i < 17} {incr i} \
        {
          $c create line $x0 $y0 $x0 $y1
          incr x0 16
        }
        incr y0 -1
        set xr 10
        set xg 276
        set xb 542
        for {set i 0} {$i < 256} {incr i} \
        {
          set yr [expr {10 + 256 - round($counts(r:$i) * $coef)}]
          set yg [expr {10 + 256 - round($counts(g:$i) * $coef)}]
          set yb [expr {10 + 256 - round($counts(b:$i) * $coef)}]
          $c create line $xr $y0 $xr $yr -fill red
          $c create line $xg $y0 $xg $yg -fill green
          $c create line $xb $y0 $xb $yb -fill blue
          incr xr; incr xg; incr xb
        }
        $c create text 10 276 -anchor nw -text "image: $image, max count: $max"
        pack $c
      } \
      else \
      {
      # export
        for {set i 0} {$i < 256} {incr i} \
        { foreach c {r g b} { lappend list$c $counts($c:$i) } }
        return [list $listr $listg $listb]
      }
    }
  }

# example
# -----------
# to download the image:
# http://perso.wanadoo.fr/maurice.ulis/tcl/image1.png

package require Tk
package require Img
wm withdraw .
namespace import ::histo::histo
histo [image create photo -file image1.png]