Screenshot.pm

   1 package Imager::Screenshot;
   2 use strict;
   3 use vars qw(@ISA $VERSION @EXPORT_OK);
   4 use Imager;
   5 require Exporter;
   6
   7 push @ISA, 'Exporter';
   8 @EXPORT_OK = 'screenshot';
   9
  10 BEGIN {
  11   require Exporter;
  12   @ISA = qw(Exporter);
  13   $VERSION = '0.003';
  14   eval {
  15     # try XSLoader first, DynaLoader has annoying baggage
  16     require XSLoader;
  17     XSLoader::load('Imager::Screenshot' => $VERSION);
  18     1;
  19   } or do {
  20     require DynaLoader;
  21     push @ISA, 'DynaLoader';
  22     bootstrap Imager::Screenshot $VERSION;
  23   }
  24 }
  25
  26 sub screenshot {
  27   # lose the class if called as a method
  28   @_ % 2 == 1 and shift;
  29
  30   my %opts =
  31     (
  32      decor => 0,
  33      display => 0,
  34      left => 0,
  35      top => 0,
  36      right => 0,
  37      bottom => 0,
  38      @_);
  39
  40   my $result;
  41   if (defined $opts{hwnd}) {
  42     defined &_win32
  43       or die "Win32 driver not enabled\n";
  44     $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
  45                      $opts{right}, $opts{bottom});
  46   }
  47   elsif (defined $opts{id}) { # X11 window id
  48     defined &_x11
  49       or die "X11 driver not enabled\n";
  50     $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
  51                    $opts{right}, $opts{bottom});
  52   }
  53   elsif ($opts{widget}) {
  54     # Perl/Tk widget
  55     my $top = $opts{widget}->toplevel;
  56     my $sys = $top->windowingsystem;
  57     if ($sys eq 'win32') {
  58       unless (defined &_win32) {
  59         Imager->_set_error("Win32 Tk and Win32 support not built");
  60         return;
  61       }
  62       $result = _win32(hex($opts{widget}->id), $opts{decor},
  63                        $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
  64     }
  65     elsif ($sys eq 'x11') {
  66       unless (defined &_x11) {
  67         Imager->_set_error("X11 Tk and X11 support not built");
  68         return;
  69       }
  70
  71       my $id_hex = $opts{widget}->id;
  72       $opts{widget}->can('frame')
  73         and $id_hex = $opts{widget}->frame;
  74
  75       # is there a way to get the display pointer from Tk?
  76       $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
  77                      $opts{right}, $opts{bottom});
  78     }
  79     else {
  80       Imager->_set_error("Unsupported windowing system '$sys'");
  81       return;
  82     }
  83   }
  84   else {
  85     $result =
  86       defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
  87                                $opts{right}, $opts{bottom}) :
  88         defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
  89                              $opts{right}, $opts{bottom}) :
  90            die "No drivers enabled\n";
  91   }
  92
  93   unless ($result) {
  94     Imager->_set_error(Imager->_error_as_msg());
  95     return;
  96   }
  97
  98   return $result;
  99 }
 100
 101 sub have_win32 {
 102   defined &_win32;
 103 }
 104
 105 sub have_x11 {
 106   defined &_x11;
 107 }
 108
 109 sub x11_open {
 110   my $display = _x11_open(@_);
 111   unless ($display) {
 112     Imager->_set_error(Imager->_error_as_msg);
 113     return;
 114   }
 115
 116   return $display;
 117 }
 118
 119 sub x11_close {
 120   _x11_close(shift);
 121 }
 122
 123 1;
 124
 125 __END__
 126
 127 =head1 NAME
 128
 129 Imager::Screenshot - screenshot to an Imager image
 130
 131 =head1 SYNOPSIS
 132
 133   use Imager::Screenshot 'screenshot';
 134
 135   # whole screen
 136   my $img = screenshot();
 137
 138   # Win32 window
 139   my $img2 = screenshot(hwnd => $hwnd);
 140
 141   # X11 window
 142   my $img3 = screenshot(display => $display, id => $window_id);
 143
 144   # X11 tools
 145   my $display = Imager::Screenshot::x11_open();
 146   Imager::Screenshot::x11_close($display);
 147
 148   # test for win32 support
 149   if (Imager::Screenshot->have_win32) { ... }
 150
 151   # test for x11 support
 152   if (Imager::Screenshot->have_x11) { ... }
 153
 154
 155 =head1 DESCRIPTION
 156
 157 Imager::Screenshot captures either a desktop or a specified window and
 158 returns the result as an Imager image.
 159
 160 Currently the image is always returned as a 24-bit image.
 161
 162 =over
 163
 164 =item screenshot hwnd => I<window handle>
 165
 166 =item screenshot hwnd => I<window handle>, decor => <capture decorations>
 167
 168 Retrieve a screenshot under Win32, if I<window handle> is zero,
 169 capture the desktop.
 170
 171 By default, window decorations are not captured, if the C<decor>
 172 parameter is set to true then window decorations are included.
 173
 174 =item screenshot id => I<window id>
 175
 176 =item screenshot id => I<window id>, display => I<display object>
 177
 178 Retrieve a screenshot under X11, if I<id> is zero, capture the root
 179 window.  I<display object> is a integer version of an X11 C< Display *
 180 >, if this isn't supplied C<screenshot()> will attempt connect to the
 181 the display specified by $ENV{DISPLAY}.
 182
 183 Note: taking a screenshot of a remote display is slow.
 184
 185 =item screenshot
 186
 187 If no C<id> or C<hwnd> parameter is supplied:
 188
 189 =over
 190
 191 =item *
 192
 193 if Win32 support is compiled, return screenshot(hwnd => 0).
 194
 195 =item *
 196
 197 if X11 support is compiled, return screenshot(id => 0).
 198
 199 =item *
 200
 201 otherwise, die.
 202
 203 =back
 204
 205 You can also supply the following parameters to retrieve a subset of
 206 the window:
 207
 208 =over
 209
 210 =item *
 211
 212 left
 213
 214 =item *
 215
 216 top
 217
 218 =item *
 219
 220 right
 221
 222 =item *
 223
 224 bottom
 225
 226 =back
 227
 228 If left or top is negative, then treat that as from the right/bottom
 229 edge of the window.
 230
 231 If right ot bottom is zero or negative then treat as from the
 232 right/bottom edge of the window.
 233
 234 So setting all 4 values to 0 retrieves the whole window.
 235
 236   # a 10-pixel wide right edge of the window
 237   my $right_10 = screenshot(left => -10, ...);
 238
 239   # the top-left 100x100 portion of the window
 240   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
 241
 242   # 10x10 pixel at the bottom right corner
 243   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
 244
 245 =item have_win32
 246
 247 Returns true if Win32 support is available.
 248
 249 =item have_x11
 250
 251 Returns true if X11 support is available.
 252
 253 =item Imager::Screenshot::x11_open
 254
 255 =item Imager::Screenshot::x11_open I<display name>
 256
 257 Attempts to open a connection to either the display name in
 258 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
 259 for the I<display> parameter of screenshot, or undef.
 260
 261 =item Imager::Screenshot::x11_close I<display>
 262
 263 Closes a display returned by Imager::Screenshot::x11_open().
 264
 265 =back
 266
 267 =head1 CAVEATS
 268
 269 It's possible to have more than one grab driver available, for
 270 example, Win32 and X11, and which is used can have an effect on the
 271 result.
 272
 273 Under Win32, if there's a screesaver running, then you grab the
 274 results of the screensaver.
 275
 276 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
 277 grab the background.  In fact, when I tested under Cygwin/X I got the
 278 xterm window contents even when the Windows screensaver was running.
 279
 280 =head1 LICENSE
 281
 282 Imager::Screenshot is licensed under the same terms as Perl itself.
 283
 284 =head1 AUTHOR
 285
 286 Tony Cook <tonyc@cpan.org>
 287
 288 =cut
 289
 290