Graph An Image

Graphing an image - what is the 'brightness' of the pixels along a line in an image. Displayed as a simple graph.

On startup requests you to find an image file (in jpeg, png or gif format) on your system and displays the image.

Press the left-mouse at the start pixel and drag to the end pixel for your graph. The graph will show variation of brightness and R,G,B colour along the displayed line.

Suggested images: Weather map http://www.sonoma.edu/users/r/rohwedde/archives/cyclone.gif

X ray http://www.onlinetelemedicine.com/html/product/sam_images/X-Ray.jpg

  # GWM 10.11.07
  # display an image and graph of the lightness of each pixel along a line.
  package require Tk
  global down ;# saves start point for use
  set down 0

  proc graph {im sp endp} {
    catch {destroy .graph}
    # create a graph
    pack [canvas .graph -height 255 -width [image width $im] ]
    set xs [lindex $sp 0]
    set ys [lindex $sp 1]
    set xe [lindex $endp 0]
    set ye [lindex $endp 1]
    set dist [expr {hypot($xe-$xs,$ye-$ys)}]
    if {$dist>0} {
        set dx [expr {($xe-$xs)/double([image width $im])}]
        set dy [expr { ($ye-$ys)/double([image width $im])}]
        set i 0
        while {$i<[image width $im]} {
            set x [expr {$xs+$i*$dx}]
            set y [expr {$ys+$i*$dy}]
            catch {
                set rgb [$im get [expr {int($x)}] [expr {int($y)}]]
                set br [expr {sqrt(pow([lindex $rgb 0],2)+pow([lindex $rgb 1],2)+pow([lindex $rgb 2],2))}]
                lappend lin $i [expr {256-$br/1.732}]
                ;# sqrt(3) to normalise to unit brightness after adding 3 coluors
                lappend linred $i [expr {256-[lindex $rgb 0]}]
                lappend lingr $i [expr {256-[lindex $rgb 1]}]
                lappend linblu $i [expr {256-[lindex $rgb 2]}]
            }
            incr i
        }
        # draw the graphs of mean brightness, and r-g-b brightness.
        .graph create line $lin -fill black
        .graph create line $linred -fill red
        .graph create line $lingr -fill green
        .graph create line $linblu -fill blue
    }
  }

  proc select {type im canv x y} { ;# respond to mouse event.
    global sp ;# saves start point for use
    global down ;# button down - update scene
    switch $type {
        {start} {
            set down 1
            set sp [list $x $y]
        }
        {end} {
            set down 0
            set endp [list $x $y]
            graph $im $sp $endp
        }
        {motion} {
            if {$down} { ;# draw a line showing the path for the analysis
                catch {$canv delete line}
                set lnp $sp
                lappend lnp $x $y
                $canv create line $lnp -fill orange -tags line
            }
        }
    }
  }

  proc showpic {f} {
    switch -- [string tolower [file extension $f]] {
        {.jpg} -
        {.jpeg} { package require "img::jpeg" }
        {.png} {package require "img::png"}
        {.gif} {package require "img::gif"}
        default { tk_messageBox -message "File $f unknown extension [string tolower [file extension $f]]" }
    }

    image create photo thepic -file $f
    set im [canvas .image  -height [image height thepic] -width [image width thepic] ]
    $im create image 0 0 -ancho nw -image thepic
    pack $im
    bind $im <1> "select start thepic $im %x %y"
    bind $im <ButtonRelease-1> "select end thepic $im %x %y"
    bind $im <Motion> "select motion thepic $im %x %y"
  }

  set pic [tk_getOpenFile -initialdir "C:/tcl/geoff samples" \
         -filetypes {
                {{JPEG, png or gif Files}      {.jpg .gif .png}        }
            } ]
  if {[file exists $pic]} {
    showpic $pic
  }