Example:Hough transform/Tcl: Difference between revisions
Content added Content deleted
(remove libheader. I think the category part is screwing up SMW embed.) |
m (Fixed syntax highlighting.) |
||
(5 intermediate revisions by 3 users not shown) | |||
Line 1: | Line 1: | ||
[[implementation of task::Hough transform| ]] |
|||
{{Programming-example-page|Hough transform|language=Tcl}} |
|||
< |
<syntaxhighlight lang="tcl">package require Tk |
||
set PI 3.1415927 |
set PI 3.1415927 |
||
Line 74: | Line 75: | ||
$trg put [list $row] -to 0 $rho |
$trg put [list $row] -to 0 $rho |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
===Demonstration Code=== |
===Demonstration Code=== |
||
Line 80: | Line 81: | ||
{{works with|Tk|8.6}} or TkImg |
{{works with|Tk|8.6}} or TkImg |
||
< |
<syntaxhighlight lang="tcl"># Demonstration code |
||
if {[catch { |
if {[catch { |
||
package require Tk 8.6; # Just for PNG format handler |
package require Tk 8.6; # Just for PNG format handler |
||
Line 95: | Line 96: | ||
pack [label .l2.i -image targetImg] |
pack [label .l2.i -image targetImg] |
||
# Postpone until after we've drawn ourselves |
# Postpone until after we've drawn ourselves |
||
after idle HoughTransform srcImg targetImg [lrange $argv 1 end]</ |
after idle HoughTransform srcImg targetImg [lrange $argv 1 end]</syntaxhighlight> |
||
[[Image:Hough-Pentagon-Tcl-Results.gif|thumb|left|360x200px|Image produced by Tcl implementation of the Hough transform when applied to the sample pentagon image.]] |
[[Image:Hough-Pentagon-Tcl-Results.gif|thumb|left|360x200px|Image produced by Tcl implementation of the Hough transform when applied to the sample pentagon image.]] |
Latest revision as of 22:53, 30 August 2022
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]