Richard Suchenwirth 2007-10-03 - Playing with the Critcl emulation of Odyce, I wanted another useful example and came up with this: a command to compare whether two photo images are equal or not:
critcl::tk 1
critcl::ccode {#include <string.h>}
critcl::cproc img_eq {Tcl_Interp* interp char* im1 char* im2} int {
Tk_PhotoHandle h1, h2;
struct Tk_PhotoImageBlock b1, b2;
int row, off1, off2;
int rowsize;
h1 = Tk_FindPhoto(interp,im1);
if (h1 == NULL) return -1;
h2 = Tk_FindPhoto(interp,im2);
if (h2 == NULL) return -1;
Tk_PhotoGetImage(h1,&b1);
Tk_PhotoGetImage(h2,&b2);
if (b1.height != b2.height) return 0;
if (b1.width != b2.width) return 0;
rowsize = b1.width * b1.pixelSize;
for(row = 0; row < b1.height; row++) {
off1 = b1.pitch * row;
off2 = b2.pitch * row;
if (0 != memcmp(b1.pixelPtr+off1, b2.pixelPtr+off2, rowsize))
return 0;
}
return 1;
}
# This shall be compared with the pure-Tcl solution from [Binary image compression challenge]:
proc photo'eq {im1 im2} {
#-- returns 1 if both images are exactly equal, else 0
set h [image height $im1]
if {[image height $im2] != $h} {return 0}
set w [image width $im1]
if {[image width $im2] != $w} {return 0}
for {set y 0} {$y<$h} {incr y} {
for {set x 0} {$x<$w} {incr x} {
if {[$im1 get $x $y] ne [$im2 get $x $y]} {return 0}
}
}
return 1
}
#-- while another competitor in pure-Tcl is very simple:
proc img'eq2 {im1 im2} {expr {[$im1 data] eq [$im2 data]}}
#-- Testing with the famous [teapot] image which comes with the [Tk] demos :^)
set im1 [image create photo -file [info script]/../teapot.ppm]
set im2 [image create photo]
$im2 copy $im1
puts "identical: expect 1"
puts tcc:[img_eq $im1 $im2],[time {img_eq $im1 $im2}]
puts Tcl:[photo'eq $im1 $im2],[time {photo'eq $im1 $im2}]
puts Tcl2:[img'eq2 $im1 $im2],[time {img'eq2 $im1 $im2}]
$im2 put purple -to 111 111
puts "different: expect 0"
puts tcc:[img_eq $im1 $im2],[time {img_eq $im1 $im2}]
puts Tcl:[photo'eq $im1 $im2],[time {photo'eq $im1 $im2}]
puts Tcl2:[img'eq2 $im1 $im2],[time {img'eq2 $im1 $im2}]This is what came out on my 200MHz W95 box - factors between 1276 and 1383:
identical: expect 1 tcc:1,5730 microseconds per iteration Tcl:1,7888562 microseconds per iteration Tcl2:1,2298478 microseconds per iteration different: expect 0 tcc:0,2190 microseconds per iteration Tcl:0,3893308 microseconds per iteration Tcl2:0,2283866 microseconds per iteration
So obviously, this is a good use case for tcc... Lessons learned:
Another test on my Win XP box at home brings comparable results, with factors between 364 and 1324:
identical: expect 1 tcc:1,170 microseconds per iteration Tcl:1,225065 microseconds per iteration Tcl2:1,124394 microseconds per iteration different: expect 0 tcc:0,265 microseconds per iteration Tcl:0,96593 microseconds per iteration Tcl2:0,121170 microseconds per iteration