Richard Suchenwirth 2005-12-22 - The title says it all. Drawing lines in Tk is of course easiest in a canvas, but sometimes you might need to modify photo images, e.g. used for buttons or labels. The following function allows to draw a straight line (and, by repeated application, unfilled polygons) of selectable color (default: black) and width (default: 1).
proc photo'line {im x0 y0 x1 y1 args} {
array set "" {-color black -width 1}
array set "" $args
set dx [expr {$x1-$x0}]
set dy [expr {$y1-$y0}]
set dw [expr {$(-width)/2.}]
if {abs($dx)>abs($dy)} {
set d [expr {double($dy)/$dx}]
for {set x $x0} {$x<=$x1} {incr x} {
$im put $(-color) \
-to $x [expr {round($y0-$dw)}] \
[expr {$x+1}] [expr {round($y0+$dw)}]
set y0 [expr {$y0 + $d}]
}
} else {
set d [expr {double($dx)/$dy}]
for {set y $y0} {$y<=$y1} {incr y} {
$im put $(-color) \
-to [expr {round($x0-$dw)}] $y \
[expr {round($x0+$dw)}] [expr {$y+1}]
set x0 [expr {$x0 + $d}]
}
}
}#-- Testing:
package require Tk pack [canvas .c] set im [image create photo] $im put white -to 0 0 100 100 .c create image 5 5 -image $im -anchor nw photo'line $im 10 10 90 10 -color red -width 2 photo'line $im 10 10 90 90 -color green photo'line $im 10 10 10 90 -color blue -width 3
George Peter Staplin - I wrote some code years ago with the same purpose on the hypot page as an example. My version is actually shorter than yours, which is a surprise. :)
#Copyright 2003 George Peter Staplin
#You may use this under the same terms as Tcl.
proc draw.line.on.image {img x1 y1 x2 y2 color} {
set xDiff [expr {$x2 - $x1}]
set yDiff [expr {$y2 - $y1}]
set numPixels [expr {hypot($xDiff,$yDiff)}]
set xRatio [expr {$xDiff / $numPixels}]
set yRatio [expr {$yDiff / $numPixels}]
for {set p 0} {$p < $numPixels} {incr p} {
set x [expr {round($xRatio * $p) + $x1}]
set y [expr {round($yRatio * $p) + $y1}]
$img put $color -to $x $y [expr {$x + 1}] [expr {$y + 1}]
}
}
proc main {} {
set img [image create photo -width 300 -height 300]
draw.line.on.image $img 10 10 100 100 green
draw.line.on.image $img 50 20 50 200 blue
draw.line.on.image $img 40 50 300 50 maroon
pack [label .l -image $img]
}
main RS: I agree that using hypot makes simpler code by just using one loop - but my version above also caters for different line widths. If you add that, it'll cost you another line or two :)
George Peter Staplin: Unfortunately my version has a problem... "suchenwi GPS: I liked the hypot solution for line drawing - though it may create a bit too many steps sometimes, e.g. hypot(3,4)=5." I'll have to think of a better solution that works in all cases. I think the ratios are a good way to go (unless you hate floating point, or it's too much of a performance problem), so I'll probably keep those and work on a better way to measure digital lines I suppose.
George Peter Staplin - Here's my solution based on the comp.graphics.algorithms FAQ answer for finding the distance for a point to a line.
(Note: wikit seems to have a bug, so this link doesn't display as [1] properly, and there's a leading g for some reason.) http://www.exaflop.org/docs/cgafaq/cga1.html#Subject%201.02:%20How%20do%20I%20find%20the%20distance%20from%20a%20point%20to%20a%20line ?
HJG the g comes from blanks between square brackets, as in "".
#Copyright 2003, 2005 George Peter Staplin
#You may use this under the same terms as Tcl.
package require Tk
proc draw.line.on.image {img x1 y1 x2 y2 color} {
set xDiff [expr {$x2 - $x1}]
set yDiff [expr {$y2 - $y1}]
set numPixels [expr {sqrt(pow($xDiff,2) + pow($yDiff,2))}]
set xRatio [expr {$xDiff / $numPixels}]
set yRatio [expr {$yDiff / $numPixels}]
for {set p 0} {$p < $numPixels} {incr p} {
set x [expr {round($xRatio * $p) + $x1}]
set y [expr {round($yRatio * $p) + $y1}]
$img put $color -to $x $y [expr {$x + 1}] [expr {$y + 1}]
}
}
proc main {} {
set img [image create photo -width 300 -height 300]
draw.line.on.image $img 10 10 100 100 green
draw.line.on.image $img 50 20 50 200 blue
draw.line.on.image $img 40 50 300 50 maroon
draw.line.on.image $img 30 20 33 23 purple
pack [label .l -image $img]
}
main