Expanding an image
ulis, 2003-12-06. A proc to expand an image.
David Easton, 2003-12-8, improved colour plane creation speed
ulis, 2004-02-05. Added expand2, a proc that manages also the alpha channel. (to be improved for coef > 1.25)
(Original photo: to fill)
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 expand2
package require Tk
package require Img
# expand without transparency
proc expand {image coef} \
{
# check coef
if {$coef < 1.0} \
{ error "bad coef \"$coef\": should not be 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" }
# 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} [$image get $x $y] break
foreach c {r g b} { lappend $c:row [set $c] }
}
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
}
# expand with transparency
proc expand2 {image coef} \
{
# check coef
if {$coef < 1.0} \
{ error "bad coef \"$coef\": should not be 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" }
# create corresponding planes
for {set y 0} {$y < $height} {incr y} \
{
set r:row {}
set g:row {}
set b:row {}
set t:row {}
for {set x 0} {$x < $width} {incr x} \
{
foreach {r g b} [$image get $x $y] break
set t [$image transparency get $x $y]
set t [expr {$t * 256}]
foreach c {r g b t} { lappend $c:row [set $c] }
}
foreach c {r g b t} { 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 {}
set t: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 t} { 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 t} \
{
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 t} \
{
set comp [set $c]
if {$comp > 255} { set comp 255 }
lappend $c:Row $comp
lappend _ [set _$c]
}
}
foreach c {r g b t} { lappend $c:Data [set $c:Row] }
}
# crisping
for {set Y 0} {$Y < $Height} {incr Y} \
{
set Row {}
set tRow {}
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 t} \
{
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 tRow [expr {round($t)}]
}
lappend Data $Row
lappend tData $tRow
}
# create the new image
set Image [image create photo]
# fill the new image
$Image put $Data
# set transparency
for {set Y 0} {$Y < $Height} {incr Y} \
{
for {set X 0} {$X < $Width} {incr X} \
{
set t [lindex $tData $Y $X]
set t [expr {$t > 128 ? 1 : 0}]
$Image transparency set $X $Y $t
}
}
# return the new image
return $Image
}
}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
bind .$n.c <Destroy> exit
update
incr n
}See also
- Blurring an image
- Crisping an image
- Embossing an image
- Fast image resizing - David Easton 2004-04-29
- Image Processing with HSV
- Image scaling
- Photo image rotation
- Shrinking an image
- TkPhotoLab
- TclMagick - which can do all this stuff, but much, much faster.