[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 are ## the alpha range values used for the gradient 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 | image processing |% !!!!!!