[Richard Suchenwirth] 2003-07-25 - The following code was instigated by [kroc] [http://www.kroc.tk/tcl/gif_resize.htm]. It takes a graylevel [photo] [image] and produces a smaller one, by the specified factor, where the pixel values are averaged from the  original image, instead of the simple "picking" that ''image copy -subsample'' does.

 proc bin2gray {image subfactor} {
    set iota [lrange {- 0 1 2 3 4 5 6 7 8 9} 1 $subfactor]
    set h0 [image height $image]; set w0 [image width $image]
    set th [expr round(1.*$h0/$subfactor)]
    set tw [expr round(1.*$w0/$subfactor)]
    set res [image create photo -height $th -width $tw]
    for {set tx 0} {$tx<$tw} {incr tx} {
	for {set ty 0} {$ty<$th} {incr ty} {
	    set y [expr {$ty*$subfactor}]
	    set sum 0
	    foreach i $iota {
   	        set x [expr {$tx*$subfactor}]
		foreach j $iota {
		    incr sum [lindex [$image get $x $y] 0]
		    incr x
                    if {$x>=$w0} break
		}
		incr y
                if {$y>=$h0} break
	    }
	    set g [expr {round(1.0*$sum/($subfactor*$subfactor))}]
	    $res put [format #%02x%02x%02x $g $g $g] -to $tx $ty
	}
    }
    set res
 }

----
[Arts and crafts of Tcl-Tk programming]