BAS 2008-01-03: For a project I am working on, it involved multimedia, and specifically photos. Apple has this photo reflection thing that I thought might be fun to emulate in Tcl/Tk. So, here it is. It's not going to win any speed races, but it was fun to do. I'd really like to get this done in C to make it fast. Here is the code, with a GUI wrapped around it to make it a demo:
(I need to upload a picture of the demo here)
package require Img
## ## Does a gradient blend of the background color ## and the image data. alpha1 and alpha2 specify ## the range of alpha values to use for the blend ## proc alphablend {data alpha1 alpha2} {
set row 0
set data2 [list]
set h [llength $data]
set step [expr {($alpha2 - $alpha1)/$h}]
lassign [winfo rgb .c [.c cget -background]] bgred bggreen bgblue
set alpha $alpha1
foreach ROW $data {
set col 0
set rowdata [list]
foreach COL $ROW {
scan $COL "#%02x%02x%02x" src(red) src(green) src(blue)
foreach color {red green blue} {
set $color [expr {round(($alpha * $src($color)) + (((1-$alpha) * [set bg$color])/256))}]
if {[set $color] > 255} {set $color 255}
if {[set $color] < 0} {set $color 0}
}
lappend rowdata [format #%02x%02x%02x $red $green $blue]
}
lappend data2 $rowdata
set alpha [expr {$alpha + $step}]
}
return $data2}
## ## Takes a source image, and reflects it ## proc reflect {srcimg} {
set w [image width $srcimg]
set h [image height $srcimg]
set ref_img [image create photo]
set ref_h [image height $ref_img]
set y1 [expr {(2*$h)/3}]
##
## We flip the image upside down
## and also just grab the bottom 1/3 of it
##
$ref_img copy $srcimg \
-subsample 1 -1 \
-from 0 $y1 $w $h
return $ref_img}
proc openColor {} {
set color [tk_chooseColor -initialcolor black]
if {$color eq ""} return
.c configure -background $color
loadimage
return}
proc openFile {} {
variable file
set file [tk_getOpenFile]
if {$file eq ""} return
loadimage
return}
proc loadimage {} {
variable img
variable pos
variable file
catch {image delete $img(main) $img(reflect)}
set img(main) [image create photo -file $file]
.c create image $pos(X) $pos(Y) \
-image $img(main) \
-anchor nw
set h [image height $img(main)]
set w [image width $img(main)]
.c configure -height [expr {2*$pos(Y) + (4*$h)/3}] -width [expr {2*$pos(X) + $w}]
set img(reflect) [reflect $img(main)]
set ndata [alphablend [$img(reflect) data] .5 0]
$img(reflect) blank
$img(reflect) put $ndata
.c create image $pos(X) [expr {$pos(Y) + [image height $img(main)]}] \
-image $img(reflect) \
-anchor nw
return}
proc gui {} {
variable bgcolor
menu .menu -tearoff off
. configure -menu .menu
.menu add cascade \
-label "File" \
-menu .menu.file
menu .menu.file -tearoff off
.menu.file add command \
-label "Open" \
-command openFile
.menu.file add command \
-label "Exit" \
-command exit
.menu add cascade \
-label "Config" \
-menu .menu.cfg
menu .menu.cfg -tearoff off
.menu.cfg add command \
-label "Color" \
-command openColor
canvas .c \
-background $bgcolor \
-width 450 \
-height 450
pack .c \
-fill both \
-expand 1}
## ## Some defaults ## set bgcolor black set pos(X) 50 set pos(Y) 50
set file ""
gui
| graphics |
|---|