--- /dev/null
+use strict;\r
+use ExtUtils::MakeMaker;\r
+use Imager::ExtUtils;\r
+use Config;\r
+use File::Spec;\r
+\r
+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('windows.h') and find_lib('gdi32')) {\r
+ push @objs, 'scwin32.o';\r
+ push @cflags, '-DSS_WIN32';\r
+ push @lflags, '-lgdi32' if $^O eq 'cygwin';\r
+ print "Found Win32\n";\r
+}\r
+\r
+unless (@objs) {\r
+ WriteEmptyMakefile();\r
+ die "Sorry, I can't find headers or libraries for a supported GUI\n"\r
+}\r
+\r
+my %opts = \r
+ (\r
+ NAME => 'Imager::Screenshot',\r
+ VERSION_FROM => 'Screenshot.pm',\r
+ OBJECT => "@objs",\r
+ PREREQ_PM => {\r
+ 'Imager' => 0.54,\r
+ },\r
+ INC => Imager::ExtUtils->includes,\r
+ TYPEMAPS => [ Imager::ExtUtils->typemap ],\r
+ );\r
+\r
+$opts{LIBS} = "@lflags" if @lflags;\r
+$opts{INC} .= " @cflags" if @cflags;\r
+\r
+if ($ExtUtils::MakeMaker::VERSION > 6.06) {\r
+ $opts{AUTHOR} = 'Tony Cook <tonyc@cpan.org>';\r
+ $opts{ABSTRACT} = 'Screen/Window capture to Imager images';\r
+}\r
+\r
+WriteMakefile(%opts);\r
+\r
+my @incs;\r
+sub header_search_path {\r
+ @incs and return @incs;\r
+\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
+ if $Config{locincpth};\r
+ push @incs, split /\Q$Config{path_sep}/, $Config{incpath}\r
+ if $Config{incpath};\r
+\r
+ @incs = grep -d, @incs;\r
+\r
+ @incs;\r
+}\r
+\r
+my @libs;\r
+sub library_search_path {\r
+ @libs and return @libs;\r
+\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
+ if $Config{loclibpth};\r
+ push @libs, split /\Q$Config{path_sep}/, $Config{libpth}\r
+ if $Config{libpth};\r
+\r
+ @libs = grep -d, @libs;\r
+\r
+ @libs;\r
+}\r
+\r
+\r
+sub _find_file {\r
+ my ($name, @where) = @_;\r
+\r
+ grep -f File::Spec->catfile($_, $name), @where;\r
+}\r
+\r
+sub find_header {\r
+ _find_file($_[0], header_search_path());\r
+}\r
+\r
+sub find_lib {\r
+ my $name = shift;\r
+ if ($^O eq 'MSWin32') {\r
+ return _find_file($name . $Config{_a}, library_search_path());\r
+ }\r
+ else {\r
+ return _find_file("lib" . $name . $Config{_a}, library_search_path());\r
+ }\r
+}\r
--- /dev/null
+package Imager::Screenshot;\r
+use strict;\r
+use vars qw(@ISA $VERSION @EXPORT_OK);\r
+use Imager;\r
+require Exporter;\r
+\r
+push @ISA, 'Exporter';\r
+@EXPORT_OK = 'screenshot';\r
+\r
+BEGIN {\r
+ require Exporter;\r
+ @ISA = qw(Exporter);\r
+ $VERSION = '0.001';\r
+ eval {\r
+ # try XSLoader first, DynaLoader has annoying baggage\r
+ require XSLoader;\r
+ XSLoader::load('Imager::Screenshot' => $VERSION);\r
+ 1;\r
+ } or do {\r
+ require DynaLoader;\r
+ push @ISA, 'DynaLoader';\r
+ bootstrap Imager::Screenshot $VERSION;\r
+ }\r
+}\r
+\r
+sub screenshot {\r
+ # lose the class if called as a method\r
+ @_ % 2 == 1 and shift;\r
+\r
+ my %opts = (decor => 1, @_);\r
+\r
+ my $result;\r
+ if (!@_) {\r
+ my $result =\r
+ defined &win32 ? win32(0) :\r
+ defined &x11 ? x11(0) :\r
+ die "No drivers enabled\n";\r
+ }\r
+ if (defined $opts{hwnd}) {\r
+ defined &win32\r
+ or die "Win32 driver not enabled\n";\r
+ $result = win32($opts{hwnd}, $opts{decor});\r
+ }\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
+ }\r
+\r
+ unless ($result) {\r
+ Imager->_set_error(Imager->_error_as_msg());\r
+ return;\r
+ }\r
+ \r
+ return $result;\r
+}\r
+\r
+sub have_win32 {\r
+ defined &win32;\r
+}\r
+\r
+sub have_x11 {\r
+ defined &x11;\r
+}\r
+\r
+# everything else is XS\r
+1;\r
+\r
+__END__\r
+\r
+=head1 NAME\r
+\r
+Imager::Screenshot - screenshot to an Imager image\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Imager::Screenshot 'screeshot';\r
+\r
+ # whole screen\r
+ my $img = screenshot();\r
+\r
+=head1 DESCRIPTION\r
+\r
+\r
+=head1 AUTHOR\r
+\r
+Tony Cook <tonyc@cpan.org>\r
+\r
+=cut\r
+\r
+\r
--- /dev/null
+#include "EXTERN.h"\r
+#include "perl.h"\r
+#include "XSUB.h"\r
+#include "imext.h"\r
+#include "imperl.h"\r
+#include "imss.h"\r
+\r
+DEFINE_IMAGER_CALLBACKS;\r
+\r
+MODULE = Imager::Screenshot PACKAGE = Imager::Screenshot PREFIX = imss_\r
+\r
+PROTOTYPES: DISABLE\r
+\r
+#ifdef SS_WIN32\r
+\r
+Imager\r
+imss_win32(hwnd, include_decor = 1)\r
+ unsigned hwnd\r
+ int include_decor\r
+\r
+#endif\r
+\r
+#ifdef SS_X11\r
+\r
+Imager\r
+imss_x11(window_id)\r
+ int window_id\r
+\r
+#endif\r
+\r
+BOOT:\r
+ PERL_INITIALIZE_IMAGER_CALLBACKS;
\ No newline at end of file
--- /dev/null
+#ifndef IMSS_H\r
+#define IMSS_H\r
+\r
+extern i_img *\r
+imss_win32(unsigned hwnd, int include_decor);\r
+\r
+extern i_img *\r
+imss_x11(int window_id);\r
+\r
+#endif\r
--- /dev/null
+#include "imext.h"\r
+#include <windows.h>\r
+#include <string.h>\r
+\r
+i_img *\r
+imss_win32(unsigned hwnd_u, int include_decor) {\r
+ HWND hwnd = (HWND)hwnd_u;\r
+ HDC wdc, bmdc;\r
+ RECT rect;\r
+ HBITMAP work_bmp, old_dc_bmp;\r
+ int width, height;\r
+ BITMAPINFO bmi;\r
+ unsigned char *di_bits;\r
+ i_img *result = NULL;\r
+\r
+ i_clear_error();\r
+\r
+ if (!hwnd)\r
+ hwnd = GetDesktopWindow();\r
+\r
+ if (include_decor) {\r
+ wdc = GetWindowDC(hwnd);\r
+ GetWindowRect(hwnd, &rect);\r
+ }\r
+ else {\r
+ wdc = GetDC(hwnd);\r
+ GetClientRect(hwnd, &rect);\r
+ }\r
+ if (!wdc) {\r
+ i_push_error(0, "Cannot get window DC - invalid hwnd?");\r
+ return NULL;\r
+ }\r
+\r
+ width = rect.right - rect.left;\r
+ height = rect.bottom - rect.top;\r
+ work_bmp = CreateCompatibleBitmap(wdc, width, height);\r
+ bmdc = CreateCompatibleDC(wdc);\r
+ old_dc_bmp = SelectObject(bmdc, work_bmp);\r
+ BitBlt(bmdc, 0, 0, width, height, wdc, 0, 0, SRCCOPY);\r
+\r
+ /* make a dib */\r
+ memset(&bmi, 0, sizeof(bmi));\r
+ bmi.bmiHeader.biSize = sizeof(bmi);\r
+ bmi.bmiHeader.biWidth = width;\r
+ bmi.bmiHeader.biHeight = -height;\r
+ bmi.bmiHeader.biPlanes = 1;\r
+ bmi.bmiHeader.biBitCount = 32;\r
+ bmi.bmiHeader.biCompression = BI_RGB;\r
+\r
+ di_bits = mymalloc(4 * width * height);\r
+ if (GetDIBits(bmdc, work_bmp, 0, height, di_bits, &bmi, DIB_RGB_COLORS)) {\r
+ i_color *line = mymalloc(sizeof(i_color) * width);\r
+ i_color *cp;\r
+ int x, y;\r
+ unsigned char *ch_pp = di_bits;\r
+ result = i_img_8_new(width, height, 3);\r
+\r
+ for (y = 0; y < height; ++y) {\r
+ cp = line;\r
+ for (x = 0; x < width; ++x) {\r
+ cp->rgb.b = *ch_pp++;\r
+ cp->rgb.g = *ch_pp++;\r
+ cp->rgb.r = *ch_pp++;\r
+ ch_pp++;\r
+ cp++;\r
+ }\r
+ i_plin(result, 0, width, y, line);\r
+ }\r
+ myfree(line);\r
+ }\r
+\r
+ /* clean up */\r
+ myfree(di_bits);\r
+ SelectObject(bmdc, old_dc_bmp);\r
+ DeleteDC(bmdc);\r
+ DeleteObject(work_bmp);\r
+ ReleaseDC(hwnd, wdc);\r
+\r
+ return result;\r
+}\r
--- /dev/null
+#!perl -w\r
+use strict;\r
+use Test::More tests => 1;\r
+\r
+use_ok('Imager::Screenshot', 'screenshot');\r
--- /dev/null
+#!perl -w\r
+use strict;\r
+use Test::More tests => 1;\r
+\r
+use Imager::Screenshot 'screenshot';\r
+\r
+Imager::Screenshot->have_win32\r
+ or skip_all("No Win32 support");\r
+\r
+my $im = screenshot(hwnd => 0);\r
+\r
+ok($im, "got a screenshot");\r
+$im->write(file => "foo.ppm");\r
projects / imager-screenshot.git / commitdiff