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
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
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
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
# 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
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
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
\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
\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
#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
#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
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
--- /dev/null
+#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);
+}
#!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
--- /dev/null
+#!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
--- /dev/null
+#!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)");
--- /dev/null
+#!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");
+
projects / imager-screenshot.git / commitdiff