Example:Hough transform/Tcl
This is a programming example for the Hough transform programming task. If the task description is not listed here, refer back to that page.
package require Tk
set PI 3.1415927
proc HoughTransform {src trg {fieldColor "#000000"}} {
global PI
set w [image width $src]
set h [image height $src]
set targetH [expr {int(hypot($w, $h)/2)}]
# Configure the target buffer
$trg configure -width 360 -height $targetH
$trg put $fieldColor -to 0 0 359 [expr {$targetH-1}]
# Iterate over the target's space of pixels.
for {set rho 0} {$rho < $targetH} {incr rho} {
set row {}
for {set theta 0} {$theta < 360} {incr theta} {
set cos [expr {cos($theta/180.0*$PI)}]
set sin [expr {sin($theta/180.0*$PI)}]
set totalRed 0
set totalGreen 0
set totalBlue 0
set totalPix 0
# Sum the colors of the line with equation x*cos(θ) + y*sin(θ) = ρ
if {$theta<45 || ($theta>135 && $theta<225) || $theta>315} {
# For these half-quadrants, it's better to iterate by 'y'
for {set y 0} {$y<$h} {incr y} {
set x [expr {
$w/2 + ($rho - ($h/2-$y)*$sin)/$cos
}]
if {$x < 0 || $x >= $w} continue
set x [expr {round($x)}]
if {$x == $w} continue
incr totalPix
lassign [$src get $x $y] r g b
incr totalRed $r
incr totalGreen $g
incr totalBlue $b
}
} else {
# For the other half-quadrants, it's better to iterate by 'x'
for {set x 0} {$x<$w} {incr x} {
set y [expr {
$h/2 - ($rho - ($x-$w/2)*$cos)/$sin
}]
if {$y < 0 || $y >= $h} continue
set y [expr {round($y)}]
if {$y == $h} continue
incr totalPix
lassign [$src get $x $y] r g b
incr totalRed $r
incr totalGreen $g
incr totalBlue $b
}
}
# Convert the summed colors back into a pixel for insertion into
# the target buffer.
if {$totalPix > 0} {
set totalPix [expr {double($totalPix)}]
set col [format "#%02x%02x%02x" \
[expr {round($totalRed/$totalPix)}] \
[expr {round($totalGreen/$totalPix)}] \
[expr {round($totalBlue/$totalPix)}]]
} else {
set col $fieldColor
}
lappend row $col
}
$trg put [list $row] -to 0 $rho
}
}
Demonstration Code
Takes the name of the image to apply the transform to as an argument. If using PNG images,
or TkImg
# Demonstration code
if {[catch {
package require Tk 8.6; # Just for PNG format handler
}] == 1} then {catch {
package require Img
}}
# If neither Tk8.6 nor Img, then only GIF and PPM images can be loaded
set f [lindex $argv 0]
image create photo srcImg -file $f
image create photo targetImg
pack [labelframe .l1 -text Source] [labelframe .l2 -text Target]
pack [label .l1.i -image srcImg]
pack [label .l2.i -image targetImg]
# Postpone until after we've drawn ourselves
after idle HoughTransform srcImg targetImg [lrange $argv 1 end]
