## 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:
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
}```