#!/usr/local/bin/perl -w
my
@writeopt
= ([],[-grayscale],[-progressive],[
-quality
=> 13],[
-smooth
=> 12]);
plan
tests
=> 7*
@writeopt
+6;
ok($@,
''
,
"Cannot load Tk::JPEG::Lite"
);
my
$file
= (
@ARGV
) ?
shift
:
't/testimg.jpg'
;
my
$mw
= MainWindow->new;
my
$image
;
eval
{
$image
=
$mw
->Photo(
'-format'
=>
'jpeg'
,
-file
=>
$file
)};
ok($@,
''
,
"Error $@"
);
ok(
$image
->width,227,
"Wrong width"
);
ok(
$image
->height,149,
"Wrong height"
);
my
$l
=
$mw
->Label(
-image
=>
$image
,
-bd
=> 0,
-padx
=> 0,
-pady
=> 0)->
pack
;
$mw
->update;
ok(
$l
->width,227,
"Wrong width"
);
ok(
$l
->height,149,
"Wrong height"
);
my
$image2
;
foreach
my
$opt
(
@writeopt
)
{
unlink
(
"testout.jpg"
)
if
-f
"testout.jpg"
;
eval
{
$image
->
write
(
"testout.jpg"
,
-format
=> [
'jpeg'
,
@$opt
]) };
ok($@,
''
,
"Error $@"
);
my
$ok
= (-s
"testout.jpg"
) ? 1 : 0;
ok(
$ok
,1,
"File has no size"
);
eval
{
$image2
=
$mw
->Photo(
'-format'
=>
'jpeg'
,
-file
=>
"testout.jpg"
)};
ok($@,
''
,
"Error $@"
);
ok(
$image2
->width,227,
"Wrong width"
);
ok(
$image2
->height,149,
"Wrong height"
);
$l
->configure(
-image
=>
$image2
);
$mw
->update;
ok(
$l
->width,227,
"Wrong width"
);
ok(
$l
->height,149,
"Wrong height"
);
}
$mw
->
after
(1000,[
destroy
=>
$mw
]);
MainLoop;
END
{
unlink
"testout.jpg"
if
-f
"testout.jpg"
;
}