- add support for getting a subimage of the window
[imager-screenshot.git] / Screenshot.pm
index fb43237..28b6e24 100644 (file)
@@ -27,24 +27,28 @@ sub screenshot {
   # lose the class if called as a method
   @_ % 2 == 1 and shift;
 
-  my %opts = (decor => 0, display => 0, @_);
+  my %opts = 
+    (
+     decor => 0, 
+     display => 0, 
+     left => 0, 
+     top => 0,
+     right => 0,
+     bottom => 0,
+     @_);
 
   my $result;
-  if (!@_) {
-    my $result =
-      defined &_win32 ? _win32(0) :
-       defined &_x11 ? _x11($opts{display}, 0) :
-          die "No drivers enabled\n";
-  }
   if (defined $opts{hwnd}) {
     defined &_win32
       or die "Win32 driver not enabled\n";
-    $result = _win32($opts{hwnd}, $opts{decor});
+    $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
+                    $opts{right}, $opts{bottom});
   }
   elsif (defined $opts{id}) { # X11 window id
     defined &_x11
       or die "X11 driver not enabled\n";
-    $result = _x11($opts{display}, $opts{id});
+    $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
+                  $opts{right}, $opts{bottom});
   }
   elsif ($opts{widget}) {
     # Perl/Tk widget
@@ -55,7 +59,8 @@ sub screenshot {
         Imager->_set_error("Win32 Tk and Win32 support not built");
         return;
       }
-      $result = _win32(hex($opts{widget}->id));
+      $result = _win32(hex($opts{widget}->id), $opts{decor}, 
+                      $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
     }
     elsif ($sys eq 'x11') {
       unless (defined &_x11) {
@@ -68,13 +73,22 @@ sub screenshot {
         and $id_hex = $opts{widget}->frame;
       
       # is there a way to get the display pointer from Tk?
-      $result = _x11(0, hex($id_hex));
+      $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
+                    $opts{right}, $opts{bottom});
     }
     else {
       Imager->_set_error("Unsupported windowing system '$sys'");
       return;
     }
   }
+  else {
+    $result =
+      defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
+                              $opts{right}, $opts{bottom}) :
+       defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
+                            $opts{right}, $opts{bottom}) :
+          die "No drivers enabled\n";
+  }
 
   unless ($result) {
     Imager->_set_error(Imager->_error_as_msg());
@@ -170,7 +184,7 @@ Note: taking a screenshot of a remote display is slow.
 
 =item screenshot
 
-If no parameters are supplied:
+If no C<id> or C<hwnd> parameter is supplied:
 
 =over
 
@@ -188,6 +202,46 @@ otherwise, die.
 
 =back
 
+You can also supply the following parameters to retrieve a subset of
+the window:
+
+=over
+
+=item *
+
+left
+
+=item *
+
+top
+
+=item *
+
+right
+
+=item *
+
+bottom
+
+=back
+
+If left or top is negative, then treat that as from the right/bottom
+edge of the window.
+
+If right ot bottom is zero or negative then treat as from the
+right/bottom edge of the window.
+
+So setting all 4 values to 0 retrieves the whole window.
+
+  # a 10-pixel wide right edge of the window
+  my $right_10 = screenshot(left => -10, ...);
+
+  # the top-left 100x100 portion of the window
+  my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
+
+  # 10x10 pixel at the bottom right corner
+  my $bott_right_10 = screenshot(left => -10, top => -10, ...);
+
 =item have_win32
 
 Returns true if Win32 support is available.
@@ -210,6 +264,19 @@ Closes a display returned by Imager::Screenshot::x11_open().
 
 =back
 
+=head1 CAVEATS
+
+It's possible to have more than one grab driver available, for
+example, Win32 and X11, and which is used can have an effect on the
+result.
+
+Under Win32, if there's a screesaver running, then you grab the
+results of the screensaver.
+
+Grabbing the root window on a rootless server (eg. Cygwin/X) may not
+grab the background.  In fact, when I tested under Cygwin/X I got the
+xterm window contents even when the Windows screensaver was running.
+
 =head1 LICENSE
 
 Imager::Screenshot is licensed under the same terms as Perl itself.