add X11, limited Tk widget support
authorTony Cook <tony@develop-help.com>
Sat, 30 Dec 2006 05:22:09 +0000 (05:22 +0000)
committerTony Cook <tony@develop-help.com>
Sat, 30 Dec 2006 05:22:09 +0000 (05:22 +0000)
Makefile.PL
Screenshot.pm
Screenshot.xs
imss.h
scx11.c [new file with mode: 0644]
t/10win32.t
t/20x11.t [new file with mode: 0644]
t/30tkx11.t [new file with mode: 0644]
t/40tkwin32.t [new file with mode: 0644]

index a19828e..d3062af 100644 (file)
@@ -7,12 +7,12 @@ use File::Spec;
 my @objs = qw/Screenshot.o/;\r
 my @cflags;\r
 my @lflags;\r
-#if (find_header("X11.h") and find_lib("X11")) {\r
-#  push @objs, 'scx11.o';\r
-#  push @cflags, '-DSS_X11';\r
-#  push @lflags, '-lX11';\r
-#  print "Found X11\n";\r
-#}\r
+if (find_header("X11/X.h") and find_lib("X11")) {\r
+  push @objs, 'scx11.o';\r
+  push @cflags, '-DSS_X11';\r
+  push @lflags, '-lX11';\r
+  print "Found X11\n";\r
+}\r
 if (find_header('windows.h') and find_lib('gdi32')) {\r
   push @objs, 'scwin32.o';\r
   push @cflags, '-DSS_WIN32';\r
@@ -20,8 +20,7 @@ if (find_header('windows.h') and find_lib('gdi32')) {
   print "Found Win32\n";\r
 }\r
 \r
-unless (@objs) {\r
-  WriteEmptyMakefile();\r
+unless (@objs > 1) {\r
   die "Sorry, I can't find headers or libraries for a supported GUI\n"\r
 }\r
 \r
@@ -51,6 +50,8 @@ my @incs;
 sub header_search_path {\r
   @incs and return @incs;\r
 \r
+  push @incs, '/usr/include'\r
+    unless $^O eq 'MSWin32';\r
   push @incs, split /\Q$Config{path_sep}/, $ENV{INCLUDE}\r
     if $^O eq 'MSWin32' && $Config{cc} =~ /\bcl\b/ and $ENV{INCLUDE};\r
   push @incs, split ' ', $Config{locincpth}\r
@@ -67,6 +68,8 @@ my @libs;
 sub library_search_path {\r
   @libs and return @libs;\r
 \r
+  push @libs, '/usr/lib'\r
+    unless $^O eq 'MSWin32';\r
   push @libs, split /\Q$Config{path_sep}/, $ENV{LIB}\r
     if $^O eq 'MSWin32' && $Config{cc} =~ /\bcl\b/ and $ENV{LIB};\r
   push @libs, split ' ', $Config{loclibpth}\r
index 9cb4cc7..f2e2d23 100644 (file)
@@ -27,13 +27,13 @@ sub screenshot {
   # lose the class if called as a method\r
   @_ % 2 == 1 and shift;\r
 \r
-  my %opts = (decor => 1, @_);\r
+  my %opts = (decor => 0, display => 0, @_);\r
 \r
   my $result;\r
   if (!@_) {\r
     my $result =\r
       defined &win32 ? win32(0) :\r
-       defined &x11 ? x11(0) :\r
+       defined &x11 ? x11($opts{display}, 0) :\r
           die "No drivers enabled\n";\r
   }\r
   if (defined $opts{hwnd}) {\r
@@ -44,7 +44,38 @@ sub screenshot {
   elsif (defined $opts{id}) { # X11 window id\r
     defined &x11\r
       or die "X11 driver not enabled\n";\r
-    $result = x11($opts{id});\r
+    $result = x11($opts{display}, $opts{id});\r
+  }\r
+  elsif ($opts{widget}) {\r
+    # Perl/Tk widget\r
+    my $top = $opts{widget}->toplevel;\r
+    my $sys = $top->windowingsystem;\r
+    if ($sys eq 'win32') {\r
+      unless (defined &win32) {\r
+        Imager->_set_error("Win32 Tk and Win32 support not built");\r
+        return;\r
+      }\r
+      $result = win32(hex($opts{widget}->id));\r
+    }\r
+    elsif ($sys eq 'x11') {\r
+      unless (defined &x11) {\r
+        Imager->_set_error("X11 Tk and X11 support not built");\r
+        return;\r
+      }\r
+\r
+      my $id_hex = $opts{widget}->id;\r
+      print "id $id_hex\n";\r
+      $opts{widget}->can('frame') \r
+        and $id_hex = $opts{widget}->frame;\r
+      print "id $id_hex\n";\r
+      \r
+      # is there a way to get the display pointer from Tk?\r
+      $result = x11(0, hex($id_hex));\r
+    }\r
+    else {\r
+      Imager->_set_error("Unsupported windowing system '$sys'");\r
+      return;\r
+    }\r
   }\r
 \r
   unless ($result) {\r
@@ -63,7 +94,16 @@ sub have_x11 {
   defined &x11;\r
 }\r
 \r
-# everything else is XS\r
+sub x11_open {\r
+  my $display = _x11_open(@_);\r
+  unless ($display) {\r
+    Imager->_set_error(Imager->_error_as_msg);\r
+    return;\r
+  }\r
+\r
+  return $display;\r
+}\r
+\r
 1;\r
 \r
 __END__\r
@@ -74,13 +114,97 @@ Imager::Screenshot - screenshot to an Imager image
 \r
 =head1 SYNOPSIS\r
 \r
-  use Imager::Screenshot 'screeshot';\r
+  use Imager::Screenshot 'screenshot';\r
 \r
   # whole screen\r
   my $img = screenshot();\r
 \r
+  # Win32 window\r
+  my $img2 = screenshot(hwnd => $hwnd);\r
+\r
+  # X11 window\r
+  my $img3 = screenshot(display => $display, id => $window_id);\r
+\r
+  # X11 tools\r
+  my $display = Imager::Screenshot::x11_open();\r
+  Imager::Screenshot::x11_close($display);\r
+\r
+  # test for win32 support\r
+  if (Imager::Screenshot->have_win32) { ... }\r
+\r
+  # test for x11 support\r
+  if (Imager::Screenshot->have_x11) { ... }\r
+  \r
+\r
 =head1 DESCRIPTION\r
 \r
+Imager::Screenshot captures either a desktop or a specified window and\r
+returns the result as an Imager image.\r
+\r
+Currently the image is always returned as a 24-bit image.\r
+\r
+=over\r
+\r
+=item screenshot hwnd => I<window handle>\r
+\r
+=item screenshot hwnd => I<window handle>, decor => <capture decorations>\r
+\r
+Retrieve a screenshot under Win32, if I<window handle> is zero,\r
+capture the desktop.\r
+\r
+By default, window decorations are not captured, if the C<decor>\r
+parameter is set to true then window decorations are included.\r
+\r
+=item screenshot id => I<window id>\r
+\r
+=item screenshot id => I<window id>, display => I<display object>\r
+\r
+Retrieve a screenshot under X11, if I<id> is zero, capture the root\r
+window.  I<display object> is a integer version of an X11 C< Display *\r
+>, if this isn't supplied C<screenshot()> will attempt connect to the\r
+the display specified by $ENV{DISPLAY}.\r
+\r
+=item screenshot\r
+\r
+If no parameters are supplied:\r
+\r
+=over\r
+\r
+=item *\r
+\r
+if Win32 support is compiled, return screenshot(hwnd => 0).\r
+\r
+=item *\r
+\r
+if X11 support is compiled, return screenshot(id => 0).\r
+\r
+=item *\r
+\r
+otherwise, die.\r
+\r
+=back\r
+\r
+=item have_win32\r
+\r
+Returns true if Win32 support is available.\r
+\r
+=item have_x11\r
+\r
+Returns true if X11 support is available.\r
+\r
+=item Imager::Screenshot::x11_open\r
+\r
+=item Imager::Screenshot::x11_open I<display name>\r
+\r
+Attempts to open a connection to either the display name in\r
+$ENV{DISPLAY} or the supplied display name.  Returns a value suitable\r
+for the I<display> parameter of screenshot, or undef.\r
+\r
+=item Imager::Screenshot::x11_close I<display>\r
+\r
+Closes a display returned by Imager::Screenshot::x11_open().\r
+\r
+=back\r
 \r
 =head1 AUTHOR\r
 \r
index 41f691d..a22c2f7 100644 (file)
@@ -7,6 +7,8 @@
 \r
 DEFINE_IMAGER_CALLBACKS;\r
 \r
+#define imss__x11_open imss_x11_open\r
+\r
 MODULE = Imager::Screenshot  PACKAGE = Imager::Screenshot PREFIX = imss_\r
 \r
 PROTOTYPES: DISABLE\r
@@ -14,7 +16,7 @@ PROTOTYPES: DISABLE
 #ifdef SS_WIN32\r
 \r
 Imager\r
-imss_win32(hwnd, include_decor = 1)\r
+imss_win32(hwnd, include_decor = 0)\r
        unsigned hwnd\r
        int include_decor\r
 \r
@@ -23,9 +25,18 @@ imss_win32(hwnd, include_decor = 1)
 #ifdef SS_X11\r
 \r
 Imager\r
-imss_x11(window_id)\r
+imss_x11(display, window_id)\r
+        unsigned long display\r
        int window_id\r
 \r
+unsigned long\r
+imss__x11_open(display_name = NULL)\r
+        const char *display_name\r
+\r
+void\r
+imss_x11_close(display)\r
+        unsigned long display\r
+\r
 #endif\r
 \r
 BOOT:\r
diff --git a/imss.h b/imss.h
index f80a00b..fd725a4 100644 (file)
--- a/imss.h
+++ b/imss.h
@@ -5,6 +5,11 @@ extern i_img *
 imss_win32(unsigned hwnd, int include_decor);\r
 \r
 extern i_img *\r
-imss_x11(int window_id);\r
+imss_x11(unsigned long display, int window_id);\r
+\r
+extern unsigned long\r
+imss_x11_open(char const *display_name);\r
+extern void\r
+imss_x11_close(unsigned long display);\r
 \r
 #endif\r
diff --git a/scx11.c b/scx11.c
new file mode 100644 (file)
index 0000000..8e9b6bc
--- /dev/null
+++ b/scx11.c
@@ -0,0 +1,110 @@
+#include "imext.h"
+#include <X11/Xlib.h>
+
+static
+int
+my_handler(Display *display, XErrorEvent *error) {
+  char buffer[500];
+
+  XGetErrorText(display, error->error_code, buffer, sizeof(buffer));
+  i_push_error(error->error_code, buffer);
+}
+
+i_img *
+imss_x11(unsigned long display_ul, unsigned long window_id) {
+  Display *display = (Display *)display_ul;
+  int own_display = 0; /* non-zero if we connect */
+  GC gc;
+  XImage *image;
+  XWindowAttributes attr;
+  i_img *result;
+  i_color *line, *cp;
+  int x, y;
+  XColor *colors;
+  XErrorHandler old_handler;
+
+  i_clear_error();
+
+  /* we don't want the default noisy error handling */
+  old_handler = XSetErrorHandler(my_handler);
+
+  if (!display) {
+    display = XOpenDisplay(NULL);
+    ++own_display;
+    if (!display) {
+      XSetErrorHandler(old_handler);
+      i_push_error(0, "No display supplied and cannot connect");
+      return NULL;
+    }
+  }
+
+  if (!window_id) {
+    int screen = DefaultScreen(display);
+    window_id = RootWindow(display, 0);
+  }
+
+  if (!XGetWindowAttributes(display, window_id, &attr)) {
+    XSetErrorHandler(old_handler);
+    if (own_display)
+      XCloseDisplay(display);
+    i_push_error(0, "Cannot XGetWindowAttributes");
+    return NULL;
+  }
+
+  image = XGetImage(display, window_id, 0, 0, attr.width, attr.height,
+                    -1, ZPixmap);
+  if (!image) {
+    XSetErrorHandler(old_handler);
+    if (own_display)
+      XCloseDisplay(display);
+    i_push_error(0, "Cannot XGetImage");
+    return NULL;
+  }
+
+  result = i_img_8_new(attr.width, attr.height, 3);
+  line = mymalloc(sizeof(i_color) * attr.width);
+  colors = mymalloc(sizeof(XColor) * attr.width);
+  for (y = 0; y < attr.height; ++y) {
+    cp = line;
+    /* XQueryColors seems to be a round-trip, so do one big request
+       instead of one per pixel */
+    for (x = 0; x < attr.width; ++x) {
+      colors[x].pixel = XGetPixel(image, x, y);
+    }
+    XQueryColors(display, attr.colormap, colors, attr.width);
+    for (x = 0; x < attr.width; ++x) {
+      cp->rgb.r = colors[x].red >> 8;
+      cp->rgb.g = colors[x].green >> 8;
+      cp->rgb.b = colors[x].blue >> 8;
+      ++cp;
+    }
+    i_plin(result, 0, attr.width, y, line);
+  }
+
+  XSetErrorHandler(old_handler);
+  if (own_display)
+    XCloseDisplay(display);
+
+  return result;
+}
+
+unsigned long
+imss_x11_open(char const *display_name) {
+  XErrorHandler old_handler;
+  Display *display;
+
+  i_clear_error();
+  XSetErrorHandler(my_handler);
+  display = XOpenDisplay(display_name);
+  if (!display)
+    i_push_errorf(0, "Cannot connect to X server %s", XDisplayName(display_name));
+  
+  XSetErrorHandler(old_handler);
+
+  return (unsigned long)display;
+}
+
+void
+imss_x11_close(unsigned long display) {
+  XCloseDisplay((Display *)display);
+}
index b07139b..ce18b87 100644 (file)
@@ -1,13 +1,23 @@
 #!perl -w\r
 use strict;\r
-use Test::More tests => 1;\r
+use Test::More;\r
 \r
 use Imager::Screenshot 'screenshot';\r
 \r
 Imager::Screenshot->have_win32\r
-    or skip_all("No Win32 support");\r
+    or plan skip_all => "No Win32 support";\r
 \r
-my $im = screenshot(hwnd => 0);\r
+plan tests => 2;\r
+\r
+{\r
+  my $im = screenshot(hwnd => 0);\r
+  \r
+  ok($im, "got a screenshot");\r
+}\r
+\r
+{ # as a method\r
+  my $im = Imager::Screenshot->screenshot(hwnd => 0);\r
+\r
+  ok($im, "call as a method");\r
+}\r
 \r
-ok($im, "got a screenshot");\r
-$im->write(file => "foo.ppm");\r
diff --git a/t/20x11.t b/t/20x11.t
new file mode 100644 (file)
index 0000000..25c3798
--- /dev/null
+++ b/t/20x11.t
@@ -0,0 +1,45 @@
+#!perl -w\r
+use strict;\r
+use Test::More;\r
+\r
+use Imager::Screenshot 'screenshot';\r
+\r
+Imager::Screenshot->have_x11\r
+    or plan skip_all => "No X11 support";\r
+\r
+# can we connect to a display\r
+my $display = Imager::Screenshot::x11_open()\r
+  or plan skip_all => "Cannot connect to a display: ".Imager->errstr;\r
+\r
+plan tests => 5;\r
+\r
+{\r
+  # should automatically connect and grab the root window\r
+  my $im = screenshot(id => 0)\r
+    or print "# ", Imager->errstr, "\n";\r
+  \r
+  ok($im, "got a root screenshot, no display");\r
+}\r
+\r
+{\r
+  # use our supplied display\r
+  my $im = screenshot(display => $display, id => 0);\r
+  ok($im, "got a root screenshot, supplied display");\r
+}\r
+\r
+{\r
+  # use our supplied display - as a method\r
+  my $im = Imager::Screenshot->screenshot(display => $display, id => 0);\r
+  ok($im, "got a root screenshot, supplied display (method)");\r
+}\r
+\r
+{\r
+  # supply a junk window id\r
+  my $im = screenshot(display => $display, id => 0xFFFFFFF)\r
+    or print "# ", Imager->errstr, "\n";\r
+  ok(!$im, "should fail to get screenshot");\r
+  cmp_ok(Imager->errstr, '=~', 'BadWindow',\r
+         "check error");\r
+}\r
+\r
+Imager::Screenshot::x11_close($display);\r
diff --git a/t/30tkx11.t b/t/30tkx11.t
new file mode 100644 (file)
index 0000000..f60ce1f
--- /dev/null
@@ -0,0 +1,35 @@
+#!perl -w
+use strict;
+use Test::More;
+
+use Imager::Screenshot 'screenshot';
+
+Imager::Screenshot->have_x11
+  or plan skip_all => "No X11 support";
+
+my $display = Imager::Screenshot::x11_open()
+  or plan skip_all => "Cannot connect to display: ".Imager->errstr;
+
+Imager::Screenshot::x11_close($display);
+
+eval "use Tk;";
+$@
+  and plan skip_all => "Tk not available";
+
+my $mw = Tk::MainWindow->new;
+
+$mw->windowingsystem eq 'x11'
+  or plan skip_all => 'Tk windowing system not X11';
+
+plan tests => 1;
+
+my $im;
+$mw->Label(-text => "test: $0")->pack;
+$mw->after(100 =>
+           sub {
+             $im = screenshot(widget => $mw, decor => 1)
+               or print "# ", Imager->errstr, "\n";
+             $mw->destroy;
+           });
+MainLoop();
+ok($im, "grab from a Tk widget (X11)");
diff --git a/t/40tkwin32.t b/t/40tkwin32.t
new file mode 100644 (file)
index 0000000..810e21c
--- /dev/null
@@ -0,0 +1,31 @@
+#!perl -w
+use strict;
+use Test::More;
+
+use Imager::Screenshot 'screenshot';
+
+Imager::Screenshot->have_win32
+  or plan skip_all => "No Win32 support";
+
+eval "use Tk;";
+$@
+  and plan skip_all => "Tk not available";
+
+my $im;
+my $mw = Tk::MainWindow->new;
+
+$mw->windowingsystem eq 'win32'
+  or plan skip_all => 'Tk windowing system not Win32';
+
+plan tests => 1;
+
+$mw->Label(-text => "test: $0")->pack;
+$mw->after(100 =>
+           sub {
+             $im = screenshot(widget => $mw)
+               or print "# ", Imager->errstr, "\n";
+             $mw->destroy;
+           });
+MainLoop();
+ok($im, "grab from a Tk widget");
+