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

[Lars H]: The problem of drawing sloped lines on a raster is known to be surprisingly difficult. In [Metafont], a surprising amount of ingenuity is spent on avoiding lines that accidentally come out too thin or too thick.

[George Peter Staplin]:  Hmm, and I just realized that I reinvented hypot() with sqrt... Does [Knuth] document such things he? used in Metafont?

[Lars H]: Well, as the father of [Literate Programming], he would have been downright hypocritical if he hadn't. MF is very thoroughly documented, but the reference you'd want is probably rather John Hobby's [http://cm.bell-labs.com/who/hobby/index.html] Ph.D. thesis ''Digitized Brush Trajectories''. (Hobby is a former student of [Knuth]'s, and significant parts of the current MF are based on research of his.)

It should be remarked though, that this work is aimed primarily at monochromatic images. If plenty of colours are available, then [antialias]ing can be used to avoid many of the problems.

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

 #Copyright 2003, 2005 George Peter Staplin
 #You may use this under the same terms as Tcl.
 #Revision 3 (now with improved speed by elimination of pow($n,2))
 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(($xDiff * $xDiff) + ($yDiff * $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
  draw.line.on.image $img 30 20 33 23 purple

  pack [label .l -image $img]
 }
 main

(Note: wikit seems to have a bug, so this link doesn't display as [[1]] properly when enclosed with [[url]], 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 empty square brackets, as in "[[]]" ==> "[]".

[Lars H]: No, the g comes from a bug/malfeature in the Wikit parser -- bracketed links are treated as a special case of free text links, which makes them extra sensitive to things like look like trailing punctuation (such as the final ? above). The g is internal markup that doesn't get properly removed by the parser. See [Wikit Problems] for more details.


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