t/30tkx11.t

   1 #!perl -w
   2 use strict;
   3 use Test::More;
   4
   5 use Imager::Screenshot 'screenshot';
   6
   7 Imager::Screenshot->have_x11
   8   or plan skip_all => "No X11 support";
   9
  10 my $display = Imager::Screenshot::x11_open()
  11   or plan skip_all => "Cannot connect to display: ".Imager->errstr;
  12
  13 Imager::Screenshot::x11_close($display);
  14
  15 eval "use Tk;";
  16 $@
  17   and plan skip_all => "Tk not available";
  18
  19 my $mw = Tk::MainWindow->new;
  20
  21 $mw->can('windowingsystem')
  22   or plan skip_all => 'Cannot determine windowing system';
  23 $mw->windowingsystem eq 'x11'
  24   or plan skip_all => 'Tk windowing system not X11';
  25
  26 eval { $mw->geometry('+10+10'); };
  27
  28 plan tests => 2;
  29
  30 my ($im_mw, $im_label);
  31 my $label = $mw->Label(-text => "test: $0")->pack;
  32 $label->waitVisibility;
  33 $mw->after(100 =>
  34            sub {
  35              $im_mw = screenshot(widget => $mw, decor => 1)
  36                or print "# mw: ", Imager->errstr, "\n";
  37              $im_label = screenshot(widget => $label)
  38                or print "# label: ", Imager->errstr, "\n";
  39              $mw->destroy;
  40            });
  41 MainLoop();
  42 ok($im_mw, "grab from a Tk widget (X11)");
  43 ok($im_label, "grab label from a Tk widget (X11)");