Screenshot.pm

   1 package Imager::Screenshot;\r
   2 use strict;\r
   3 use vars qw(@ISA $VERSION @EXPORT_OK);\r
   4 use Imager;\r
   5 require Exporter;\r
   6 \r
   7 push @ISA, 'Exporter';\r
   8 @EXPORT_OK = 'screenshot';\r
   9 \r
  10 BEGIN {\r
  11   require Exporter;\r
  12   @ISA = qw(Exporter);\r
  13   $VERSION = '0.001';\r
  14   eval {\r
  15     # try XSLoader first, DynaLoader has annoying baggage\r
  16     require XSLoader;\r
  17     XSLoader::load('Imager::Screenshot' => $VERSION);\r
  18     1;\r
  19   } or do {\r
  20     require DynaLoader;\r
  21     push @ISA, 'DynaLoader';\r
  22     bootstrap Imager::Screenshot $VERSION;\r
  23   }\r
  24 }\r
  25 \r
  26 sub screenshot {\r
  27   # lose the class if called as a method\r
  28   @_ % 2 == 1 and shift;\r
  29 \r
  30   my %opts = (decor => 0, display => 0, @_);\r
  31 \r
  32   my $result;\r
  33   if (!@_) {\r
  34     my $result =\r
  35       defined &_win32 ? _win32(0) :\r
  36         defined &_x11 ? _x11($opts{display}, 0) :\r
  37            die "No drivers enabled\n";\r
  38   }\r
  39   if (defined $opts{hwnd}) {\r
  40     defined &_win32\r
  41       or die "Win32 driver not enabled\n";\r
  42     $result = _win32($opts{hwnd}, $opts{decor});\r
  43   }\r
  44   elsif (defined $opts{id}) { # X11 window id\r
  45     defined &_x11\r
  46       or die "X11 driver not enabled\n";\r
  47     $result = _x11($opts{display}, $opts{id});\r
  48   }\r
  49   elsif ($opts{widget}) {\r
  50     # Perl/Tk widget\r
  51     my $top = $opts{widget}->toplevel;\r
  52     my $sys = $top->windowingsystem;\r
  53     if ($sys eq 'win32') {\r
  54       unless (defined &_win32) {\r
  55         Imager->_set_error("Win32 Tk and Win32 support not built");\r
  56         return;\r
  57       }\r
  58       $result = _win32(hex($opts{widget}->id));\r
  59     }\r
  60     elsif ($sys eq 'x11') {\r
  61       unless (defined &_x11) {\r
  62         Imager->_set_error("X11 Tk and X11 support not built");\r
  63         return;\r
  64       }\r
  65 \r
  66       my $id_hex = $opts{widget}->id;\r
  67       $opts{widget}->can('frame') \r
  68         and $id_hex = $opts{widget}->frame;\r
  69       \r
  70       # is there a way to get the display pointer from Tk?\r
  71       $result = _x11(0, hex($id_hex));\r
  72     }\r
  73     else {\r
  74       Imager->_set_error("Unsupported windowing system '$sys'");\r
  75       return;\r
  76     }\r
  77   }\r
  78 \r
  79   unless ($result) {\r
  80     Imager->_set_error(Imager->_error_as_msg());\r
  81     return;\r
  82   }\r
  83   \r
  84   return $result;\r
  85 }\r
  86 \r
  87 sub have_win32 {\r
  88   defined &_win32;\r
  89 }\r
  90 \r
  91 sub have_x11 {\r
  92   defined &_x11;\r
  93 }\r
  94 \r
  95 sub x11_open {\r
  96   my $display = _x11_open(@_);\r
  97   unless ($display) {\r
  98     Imager->_set_error(Imager->_error_as_msg);\r
  99     return;\r
 100   }\r
 101 \r
 102   return $display;\r
 103 }\r
 104 \r
 105 1;\r
 106 \r
 107 __END__\r
 108 \r
 109 =head1 NAME\r
 110 \r
 111 Imager::Screenshot - screenshot to an Imager image\r
 112 \r
 113 =head1 SYNOPSIS\r
 114 \r
 115   use Imager::Screenshot 'screenshot';\r
 116 \r
 117   # whole screen\r
 118   my $img = screenshot();\r
 119 \r
 120   # Win32 window\r
 121   my $img2 = screenshot(hwnd => $hwnd);\r
 122 \r
 123   # X11 window\r
 124   my $img3 = screenshot(display => $display, id => $window_id);\r
 125 \r
 126   # X11 tools\r
 127   my $display = Imager::Screenshot::x11_open();\r
 128   Imager::Screenshot::x11_close($display);\r
 129 \r
 130   # test for win32 support\r
 131   if (Imager::Screenshot->have_win32) { ... }\r
 132 \r
 133   # test for x11 support\r
 134   if (Imager::Screenshot->have_x11) { ... }\r
 135   \r
 136 \r
 137 =head1 DESCRIPTION\r
 138 \r
 139 Imager::Screenshot captures either a desktop or a specified window and\r
 140 returns the result as an Imager image.\r
 141 \r
 142 Currently the image is always returned as a 24-bit image.\r
 143 \r
 144 =over\r
 145 \r
 146 =item screenshot hwnd => I<window handle>\r
 147 \r
 148 =item screenshot hwnd => I<window handle>, decor => <capture decorations>\r
 149 \r
 150 Retrieve a screenshot under Win32, if I<window handle> is zero,\r
 151 capture the desktop.\r
 152 \r
 153 By default, window decorations are not captured, if the C<decor>\r
 154 parameter is set to true then window decorations are included.\r
 155 \r
 156 =item screenshot id => I<window id>\r
 157 \r
 158 =item screenshot id => I<window id>, display => I<display object>\r
 159 \r
 160 Retrieve a screenshot under X11, if I<id> is zero, capture the root\r
 161 window.  I<display object> is a integer version of an X11 C< Display *\r
 162 >, if this isn't supplied C<screenshot()> will attempt connect to the\r
 163 the display specified by $ENV{DISPLAY}.\r
 164 \r
 165 =item screenshot\r
 166 \r
 167 If no parameters are supplied:\r
 168 \r
 169 =over\r
 170 \r
 171 =item *\r
 172 \r
 173 if Win32 support is compiled, return screenshot(hwnd => 0).\r
 174 \r
 175 =item *\r
 176 \r
 177 if X11 support is compiled, return screenshot(id => 0).\r
 178 \r
 179 =item *\r
 180 \r
 181 otherwise, die.\r
 182 \r
 183 =back\r
 184 \r
 185 =item have_win32\r
 186 \r
 187 Returns true if Win32 support is available.\r
 188 \r
 189 =item have_x11\r
 190 \r
 191 Returns true if X11 support is available.\r
 192 \r
 193 =item Imager::Screenshot::x11_open\r
 194 \r
 195 =item Imager::Screenshot::x11_open I<display name>\r
 196 \r
 197 Attempts to open a connection to either the display name in\r
 198 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable\r
 199 for the I<display> parameter of screenshot, or undef.\r
 200 \r
 201 =item Imager::Screenshot::x11_close I<display>\r
 202 \r
 203 Closes a display returned by Imager::Screenshot::x11_open().\r
 204 \r
 205 =back\r
 206 \r
 207 =head1 AUTHOR\r
 208 \r
 209 Tony Cook <tonyc@cpan.org>\r
 210 \r
 211 =cut\r
 212 \r
 213 \r