Version 4 of Photo reflection

Updated 2008-01-03 18:19:12 by bas

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

Category Graphics Category Image Processing