[ulis], 2003-12-06. A proc to expand an image. [http://perso.wanadoo.fr/maurice.ulis/tcl/expand1.png] [http://perso.wanadoo.fr/maurice.ulis/tcl/expand2.png] [http://perso.wanadoo.fr/maurice.ulis/tcl/expand3.png] ---- '''How it works''' It works by linear interpolation: p x- 0 -x- 1 -x- 2 -x <- pixels of original image | \ \ \ | \ \ \ | \ \ \ <- pixels correspondence | \ \ \ | \ \ \ P x- 0 -x- 1 -x- 2 -x- 3 -x- 4 -x <- pixels of expanded image | . | . . | . | | 3 . 2 |1. 3 .1| 2 . 3 | | - . - |-. - .-| - . - | <- weights | 3 . 3 |3. 3 .3| 3 . 3 | P0 = p0 * 3/3 P1 = p0 * 2/3 + p1 * 1/3 P2 = P1 * 3/3 P3 = P1 * 1/3 + p2 * 2/3 P4 = P2 * 3/3 Each pixel of the expanded image is the sum of the (linearly) corresponding pixels of the original image, weighted as above. Integer coefficients can be optimized (the pixels are block-duplicated). Fractional coefficients result in a blurred image that need to be slightly crisped. ---- '''The proc''' namespace eval ::expand \ { namespace export expand package require Tk package require Img proc expand {image coef} \ { # check coef if {$coef < 1.0} \ { error "bad coef \"$coef\": should be not less than 1.0" } if {$coef - int($coef) < 1.e-4} \ { return [optim $image [expr {int($coef)}]] } # get the old image content set width [image width $image] set height [image height $image] if {$width * $height == 0} { error "bad image" } set data [$image data] # create corresponding planes for {set y 0} {$y < $height} {incr y} \ { set r:row {} set g:row {} set b:row {} for {set x 0} {$x < $width} {incr x} \ { foreach {r g b} [winfo rgb . [lindex $data $y $x]] break foreach c {r g b} { lappend $c:row [expr [set $c] / 256] } } foreach c {r g b} { lappend $c:data [set $c:row] } } # compute the new image content set Width [expr {round($width * $coef)}] set Height [expr {round($height * $coef)}] set ey 0 set y2 0 set cy2 $Height for {set Y 0} {$Y < $Height} {incr Y} \ { set r:Row {} set g:Row {} set b:Row {} # y1 is the top coordinate in the old image set y1 $y2 set cy1 [expr {$Height - $cy2}] incr ey $height set y2 [expr {$ey / $Height}] set cy2 [expr {$ey % $Height}] if {$y1 == $y2} { set cy1 $cy2 } set ex 0 set x2 0 set cx2 $Width for {set X 0} {$X < $Width} {incr X} \ { set x1 $x2 set cx1 [expr {$Width - $cx2}] incr ex $width set x2 [expr {$ex / $Width}] set cx2 [expr {$ex % $Width}] if {$x1 == $x2} { set cx1 $cx2 } # compute pixel foreach c {r g b} { set $c 0; set _$c 0 } for {set y $y1} {$y <= $y2} {incr y} \ { # compute y coef switch $y \ $y1 { set cy $cy1 } \ $y2 { set cy $cy2 } \ default { set cy $height } if {$cy == 0} { continue } if {$cy > $height} { set cy $height } for {set x $x1} {$x <= $x2} {incr x} \ { # compute x coef switch $x \ $x1 { set cx $cx1 } \ $x2 { set cx $cx2 } \ default { set cx $width } if {$cx == 0} { continue } if {$cx > $width} { set cx $width } # weight each initial pixel by cx & cy set cxy [expr {$cx * $cy / double($width) / $height}] foreach c {r g b} \ { set comp [lindex [set $c:data] $y $x] incr $c [expr {round($comp * $cxy)}] set _$c [expr {[set _$c] + $cxy}] } } } set _ {} foreach c {r g b} \ { set comp [set $c] if {$comp > 255} { set comp 255 } lappend $c:Row $comp lappend _ [set _$c] } } foreach c {r g b} { lappend $c:Data [set $c:Row] } } # crisping for {set Y 0} {$Y < $Height} {incr Y} \ { set Row {} for {set X 0} {$X < $Width} {incr X} \ { if {$X == 0 || $X == $Width - 1 || $Y == 0 || $Y == $Height - 1} \ { foreach c {r g b} { set $c [lindex [set $c:Data] $Y $X] } } \ else \ { foreach c {r g b} \ { set c00 [lindex [set $c:Data] [expr {$Y - 1}] [expr {$X - 1}]] set c01 [lindex [set $c:Data] [expr {$Y - 1}] [expr {$X - 0}]] set c02 [lindex [set $c:Data] [expr {$Y - 1}] [expr {$X + 1}]] set c10 [lindex [set $c:Data] [expr {$Y + 0}] [expr {$X - 1}]] set c11 [lindex [set $c:Data] [expr {$Y + 0}] [expr {$X - 0}]] set c12 [lindex [set $c:Data] [expr {$Y + 0}] [expr {$X + 1}]] set c20 [lindex [set $c:Data] [expr {$Y + 1}] [expr {$X - 1}]] set c21 [lindex [set $c:Data] [expr {$Y + 1}] [expr {$X - 0}]] set c22 [lindex [set $c:Data] [expr {$Y + 1}] [expr {$X + 1}]] set cc [expr {int(1.4 * $c11 - 0.05 * ($c00 + $c01 + $c02 + $c10 + $c12 + $c20 + $c21 + $c22))}] if {$cc < 0} { set cc 0 } if {$cc > 255} { set cc 255 } set $c $cc } } lappend Row [format #%02x%02x%02x $r $g $b] } lappend Data $Row } # create the new image set Image [image create photo] # fill the new image $Image put $Data # return the new image return $Image } # integral expand proc optim {image coef} \ { set coef [expr {int($coef)}] if {$coef == 1} { return $image } set width [image width $image] set height [image height $image] set data [$image data] set data2 {} for {set y 0} {$y < $height} {incr y} \ { set row [lindex $data $y] set row2 {} for {set x 0} {$x < $width} {incr x} \ { set pixel [lindex $row $x] for {set i 0} {$i < $coef} {incr i} \ { lappend row2 $pixel } } for {set j 0} {$j < $coef} {incr j} \ { lappend data2 $row2 } } set image2 [image create photo] $image2 put $data2 return $image2 } } ---- '''The demo''' # to download the image: # http://perso.wanadoo.fr/maurice.ulis/tcl/image.png image create photo Photo -file image.png namespace import ::expand::expand wm withdraw . set n 0 foreach coef {1.0 1.2 1.4} \ { set image [expand Photo $coef] toplevel .$n wm title .$n "expand $coef" canvas .$n.c -bd 0 -highlightt 0 .$n.c create image 0 0 -anchor nw -image $image foreach {- - width height} [.$n.c bbox all] break .$n.c config -width $width -height $height pack .$n.c update incr n } ---- '''See also''' * [Blurring] (an image) * [Shrinking an image] ---- [Category Graphics] | [Category Image Processing] | [Category Example]