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 
X ray 
# 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
}