[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?

 #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

----
[Category Graphics] | [Arts and crafts of Tcl-Tk programming]