if 0 { 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 "select end thepic $im %x %y" bind $im "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 } ---- !!!!!! %|[Category Graphics] | [Category Image Processing]|% !!!!!!