initial screenshot attempt
authorTony Cook <tony@develop-help.com>
Fri, 22 Dec 2006 13:03:16 +0000 (13:03 +0000)
committerTony Cook <tony@develop-help.com>
Fri, 22 Dec 2006 13:03:16 +0000 (13:03 +0000)
Makefile.PL [new file with mode: 0644]
Screenshot.pm [new file with mode: 0644]
Screenshot.xs [new file with mode: 0644]
imss.h [new file with mode: 0644]
scwin32.c [new file with mode: 0644]
t/00load.t [new file with mode: 0644]
t/10win32.t [new file with mode: 0644]

diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..a19828e
--- /dev/null
@@ -0,0 +1,101 @@
+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
diff --git a/Screenshot.pm b/Screenshot.pm
new file mode 100644 (file)
index 0000000..9cb4cc7
--- /dev/null
@@ -0,0 +1,91 @@
+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
diff --git a/Screenshot.xs b/Screenshot.xs
new file mode 100644 (file)
index 0000000..41f691d
--- /dev/null
@@ -0,0 +1,32 @@
+#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
diff --git a/imss.h b/imss.h
new file mode 100644 (file)
index 0000000..f80a00b
--- /dev/null
+++ b/imss.h
@@ -0,0 +1,10 @@
+#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
diff --git a/scwin32.c b/scwin32.c
new file mode 100644 (file)
index 0000000..228d182
--- /dev/null
+++ b/scwin32.c
@@ -0,0 +1,80 @@
+#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
diff --git a/t/00load.t b/t/00load.t
new file mode 100644 (file)
index 0000000..6b88ec6
--- /dev/null
@@ -0,0 +1,5 @@
+#!perl -w\r
+use strict;\r
+use Test::More tests => 1;\r
+\r
+use_ok('Imager::Screenshot', 'screenshot');\r
diff --git a/t/10win32.t b/t/10win32.t
new file mode 100644 (file)
index 0000000..b07139b
--- /dev/null
@@ -0,0 +1,13 @@
+#!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