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.004';
  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   # RT #24992 - the Imager typemap entry is broken pre-0.56, so
  99   # wrap it here
 100   return bless { IMG => $result }, "Imager";
 101 }
 102
 103 sub have_win32 {
 104   defined &_win32;
 105 }
 106
 107 sub have_x11 {
 108   defined &_x11;
 109 }
 110
 111 sub x11_open {
 112   my $display = _x11_open(@_);
 113   unless ($display) {
 114     Imager->_set_error(Imager->_error_as_msg);
 115     return;
 116   }
 117
 118   return $display;
 119 }
 120
 121 sub x11_close {
 122   _x11_close(shift);
 123 }
 124
 125 1;
 126
 127 __END__
 128
 129 =head1 NAME
 130
 131 Imager::Screenshot - screenshot to an Imager image
 132
 133 =head1 SYNOPSIS
 134
 135   use Imager::Screenshot 'screenshot';
 136
 137   # whole screen
 138   my $img = screenshot();
 139
 140   # Win32 window
 141   my $img2 = screenshot(hwnd => $hwnd);
 142
 143   # X11 window
 144   my $img3 = screenshot(display => $display, id => $window_id);
 145
 146   # X11 tools
 147   my $display = Imager::Screenshot::x11_open();
 148   Imager::Screenshot::x11_close($display);
 149
 150   # test for win32 support
 151   if (Imager::Screenshot->have_win32) { ... }
 152
 153   # test for x11 support
 154   if (Imager::Screenshot->have_x11) { ... }
 155
 156
 157 =head1 DESCRIPTION
 158
 159 Imager::Screenshot captures either a desktop or a specified window and
 160 returns the result as an Imager image.
 161
 162 Currently the image is always returned as a 24-bit image.
 163
 164 =over
 165
 166 =item screenshot hwnd => I<window handle>
 167
 168 =item screenshot hwnd => I<window handle>, decor => <capture decorations>
 169
 170 Retrieve a screenshot under Win32, if I<window handle> is zero,
 171 capture the desktop.
 172
 173 By default, window decorations are not captured, if the C<decor>
 174 parameter is set to true then window decorations are included.
 175
 176 =item screenshot id => I<window id>
 177
 178 =item screenshot id => I<window id>, display => I<display object>
 179
 180 Retrieve a screenshot under X11, if I<id> is zero, capture the root
 181 window.  I<display object> is a integer version of an X11 C< Display *
 182 >, if this isn't supplied C<screenshot()> will attempt connect to the
 183 the display specified by $ENV{DISPLAY}.
 184
 185 Note: taking a screenshot of a remote display is slow.
 186
 187 =item screenshot
 188
 189 If no C<id> or C<hwnd> parameter is supplied:
 190
 191 =over
 192
 193 =item *
 194
 195 if Win32 support is compiled, return screenshot(hwnd => 0).
 196
 197 =item *
 198
 199 if X11 support is compiled, return screenshot(id => 0).
 200
 201 =item *
 202
 203 otherwise, die.
 204
 205 =back
 206
 207 You can also supply the following parameters to retrieve a subset of
 208 the window:
 209
 210 =over
 211
 212 =item *
 213
 214 left
 215
 216 =item *
 217
 218 top
 219
 220 =item *
 221
 222 right
 223
 224 =item *
 225
 226 bottom
 227
 228 =back
 229
 230 If left or top is negative, then treat that as from the right/bottom
 231 edge of the window.
 232
 233 If right ot bottom is zero or negative then treat as from the
 234 right/bottom edge of the window.
 235
 236 So setting all 4 values to 0 retrieves the whole window.
 237
 238   # a 10-pixel wide right edge of the window
 239   my $right_10 = screenshot(left => -10, ...);
 240
 241   # the top-left 100x100 portion of the window
 242   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
 243
 244   # 10x10 pixel at the bottom right corner
 245   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
 246
 247 =item have_win32
 248
 249 Returns true if Win32 support is available.
 250
 251 =item have_x11
 252
 253 Returns true if X11 support is available.
 254
 255 =item Imager::Screenshot::x11_open
 256
 257 =item Imager::Screenshot::x11_open I<display name>
 258
 259 Attempts to open a connection to either the display name in
 260 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
 261 for the I<display> parameter of screenshot, or undef.
 262
 263 =item Imager::Screenshot::x11_close I<display>
 264
 265 Closes a display returned by Imager::Screenshot::x11_open().
 266
 267 =back
 268
 269 =head1 TAGS
 270
 271 screenshot() sets a number of tags in the images it returns, these are:
 272
 273 =over
 274
 275 =item *
 276
 277 ss_left - the distance between the left side of the window and the
 278 left side of the captured area.  The same value as the I<left>
 279 parameter when that is positive.
 280
 281 =item *
 282
 283 ss_top - the distance between the top side of the window the top side
 284 of the captured area.  The same value at the I<top> parameter when
 285 that is positive.
 286
 287 =item *
 288
 289 ss_window_width - the full width of the window.
 290
 291 =item *
 292
 293 ss_window_height - the full height of the window.
 294
 295 =item *
 296
 297 ss_type - the type of capture done, either "Win32" or "X11".
 298
 299 =back
 300
 301 To cheaply get the window size you can capture a single pixel:
 302
 303   my $im = screenshot(right => 1, bottom => 1);
 304   my $window_width  = $im->tags(name => 'ss_window_width');
 305   my $window_height = $im->tags(name => 'ss_window_height');
 306
 307 =head1 CAVEATS
 308
 309 It's possible to have more than one grab driver available, for
 310 example, Win32 and X11, and which is used can have an effect on the
 311 result.
 312
 313 Under Win32, if there's a screesaver running, then you grab the
 314 results of the screensaver.
 315
 316 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
 317 grab the background that you see.  In fact, when I tested under
 318 Cygwin/X I got the xterm window contents even when the Windows
 319 screensaver was running.  The root window captured appeared to be that
 320 generated by my window manager.
 321
 322 =head1 LICENSE
 323
 324 Imager::Screenshot is licensed under the same terms as Perl itself.
 325
 326 =head1 AUTHOR
 327
 328 Tony Cook <tonyc@cpan.org>
 329
 330 =cut
 331
 332