Image Compare

Keith Vetter 2016-04-26 : Here's a tool that lets you compare two images. It displays them overlapping in the same window with a sliding bar between them. The original image is to the left of the sliding bar and the new image is to the right.

My original approach used two label widgets, the place geometry manager and varied the width of the labels. But this led to some unsightly screen flicker. Instead, I create the two images on a canvas and vary the size of the left image.

This tool is designed to be called from the command line with the names of two images. For demo purposes, if you give it no parameters it will use the teapot image from the tk demos directory.

ICompareScreenShot

#! /usr/bin/env tclsh
##+##########################################################################
#
# iCompare.tcl -- compares two images with sliding bar between them
# by Keith Vetter 2016-04-26
#

package require Tk
package require Img

wm title . "Image Compare"

proc ShowSplitImage {img1 img2} {
    set iw [expr {max([image width $img1], [image width $img2])}]
    set ih [expr {max([image height $img1], [image height $img2])}]
    set img_partial [image create photo -height $ih]

    canvas .c -width $iw -height $ih -bd 0 -highlightthickness 0
    pack .c -side top

    .c create image 0 0 -image $img2 -anchor nw
    .c create image 0 0 -image $img_partial -anchor nw
    .c create line 0 0 0 $ih -tag line -width 1 -fill red

    MoveSplit [expr {$iw/2}] $ih $img_partial $img1 $iw $ih
    bind .c <Motion> [list MoveSplit %x %y $img_partial $img1 $iw $ih]
}

proc MoveSplit {x y img_partial img_full iw ih} {
    set x [expr {max(1, min($x, $iw))}]
    set old_width [image width $img_partial]
    $img_partial config -width $x
    if {$x > $old_width} {
        $img_partial copy $img_full
    }
    .c coords line [list $x 0 $x $ih]
}

################################################################

# DEMO CODE
if {[llength $argv] == 0} {
    set fname [file join $tk_library demos images teapot.ppm]
    if {! [file exists $fname]} { error "missing demo image" }
    set img1 [image create photo -file $fname]
    set img2 [image create photo -file $fname -palette 16]
    ShowSplitImage $img1 $img2
    focus -force .
    return
}

if {[llength $argv] != 2} {
    puts stderr "usage: splitImageViewer <image1> <image2>"
    exit
}
lassign $argv fname1 fname2
set img1 [image create photo -file $fname1]
set img2 [image create photo -file $fname2]
ShowSplitImage $img1 $img2

focus -force .
return

Category Image Processing