polish/test darwin support

diff --git a/Changes b/Changes
index 3a1fa7f433a68b602457c2bcb90c6618d247ee5e..09a7f941447dd8e5dea5af37ee50b489aabc48a1 100755 (executable)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+0.009_001
+
+- add Darwin (Apple Mac OS X) support
+
+- test release to see how broken it is
+

 0.009 15 Jun 2010
 
 - check for Win32 support with Devel::CheckLib if we don't find them
 0.009 15 Jun 2010
 
 - check for Win32 support with Devel::CheckLib if we don't find them

diff --git a/MANIFEST b/MANIFEST
index 6b7b8f1c94a97ba31ca399b235b1362775cbdc1c..e4b7769a26f4d65d9196c19a6f648e562e7abf38 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -10,6 +10,7 @@ ppport.h                      Support older perls
 README
 Screenshot.pm                  Main perl implementation
 Screenshot.xs                  Interface to C code
 README
 Screenshot.pm                  Main perl implementation
 Screenshot.xs                  Interface to C code

+scdarwin.c                     Darwin implementation

 scwin32.c                      Win32 implementation
 scx11.c                                X11 implementation
 t/00load.t                     Test - can we load the modules
 scwin32.c                      Win32 implementation
 scx11.c                                X11 implementation
 t/00load.t                     Test - can we load the modules


@@ -17,6 +18,7 @@ t/10win32.t                   Test - win32 implementation
 t/20x11.t                      Test - X11 implementation
 t/30tkx11.t                    Test - X11 implementation via Tk
 t/40tkwin32.t                  Test - Win32 implementation via Tk
 t/20x11.t                      Test - X11 implementation
 t/30tkx11.t                    Test - X11 implementation via Tk
 t/40tkwin32.t                  Test - Win32 implementation via Tk

+t/50darwin.t                   Test - Darwin implementation

 t/90pod.t                      Test - check POD is valid
 t/91podcover.t                 Test - check all functions are covered by POD
 t/92manifest.t                 Test - check we match the MANIFEST
 t/90pod.t                      Test - check POD is valid
 t/91podcover.t                 Test - check all functions are covered by POD
 t/92manifest.t                 Test - check we match the MANIFEST

diff --git a/Makefile.PL b/Makefile.PL
index 81388802bc94f83ce996e432e89335d230314b5f..b1f9a8bea24d4578ad1d1678b3fa9bf2ec4ac04b 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -43,6 +43,7 @@ if (find_header('windows.h', "Win32 header")
 }
 
 if ($^O eq "darwin") {
 }
 
 if ($^O eq "darwin") {

+  # this test is overly simple

   push @objs, "scdarwin.o";
   push @cflags, "-DSS_DARWIN";
   push @lddlflags, qw/-framework OpenGL -framework Cocoa/;
   push @objs, "scdarwin.o";
   push @cflags, "-DSS_DARWIN";
   push @lddlflags, qw/-framework OpenGL -framework Cocoa/;


@@ -68,7 +69,7 @@ my %opts =
    VERSION_FROM => 'Screenshot.pm',
    OBJECT => "@objs",
    PREREQ_PM => {
    VERSION_FROM => 'Screenshot.pm',
    OBJECT => "@objs",
    PREREQ_PM => {

-                'Imager'    => 0.54,
+                'Imager'    => 0.69,

                },
    INC => Imager::ExtUtils->includes,
    TYPEMAPS => [ Imager::ExtUtils->typemap ],
                },
    INC => Imager::ExtUtils->includes,
    TYPEMAPS => [ Imager::ExtUtils->typemap ],


@@ -81,7 +82,7 @@ if (@lddlflags) {
   $opts{LDDLFLAGS} = $Config{lddlflags} . " @lddlflags";
 }
 
   $opts{LDDLFLAGS} = $Config{lddlflags} . " @lddlflags";
 }
 

-# avoid "... isn't numberic in numeric gt ..." warnings for dev versions
+# avoid "... isn't numeric in numeric gt ..." warnings for dev versions

 my $eu_mm_version = eval $ExtUtils::MakeMaker::VERSION;
 if ($eu_mm_version > 6.06) {
   $opts{AUTHOR} = 'Tony Cook <tonyc@cpan.org>';
 my $eu_mm_version = eval $ExtUtils::MakeMaker::VERSION;
 if ($eu_mm_version > 6.06) {
   $opts{AUTHOR} = 'Tony Cook <tonyc@cpan.org>';


@@ -100,11 +101,11 @@ if ($eu_mm_version >= 6.46) {
     {
      configure_requires => 
      {
     {
      configure_requires => 
      {

-      Imager => "0.54"
+      Imager => "0.69"

      },
      build_requires => 
      {
      },
      build_requires => 
      {

-      Imager => "0.54",
+      Imager => "0.69",

       "Test::More" => "0.47",
      }
     };
       "Test::More" => "0.47",
      }
     };

diff --git a/README b/README
index eef6fe8c69a4d8e0675d804852b77a2b7bde5f7b..d0ccb6f72efc81857bcca3d8e7ccfac72107e60b 100755 (executable)
--- a/README
+++ b/README
@@ -7,6 +7,8 @@ Requires:
     SDK header files and libraries for Win32 support
   and/or
     X11 header files and libraries for X11 support.
     SDK header files and libraries for Win32 support
   and/or
     X11 header files and libraries for X11 support.

+  and/or
+    OS X header files and libraries (supplied with Xcode)

   A C compiler compatible with that used to build perl itself.
 
 Optional:
   A C compiler compatible with that used to build perl itself.
 
 Optional:


@@ -26,6 +28,7 @@ Tested under:
  - Win32 (mingw)
  - Win32/X11 (cygwin as of Jan 1 2007)
  - X11 (Debian Linux)
  - Win32 (mingw)
  - Win32/X11 (cygwin as of Jan 1 2007)
  - X11 (Debian Linux)

+ - Mac OS X 10.6.4.

 
 License:
 
 
 License:
 

diff --git a/Screenshot.pm b/Screenshot.pm
index 768c6a97d07361c152ef6ec226c9f95761570061..6508fd63fdb456c775da76a223184729cd2667e6 100644 (file)
--- a/Screenshot.pm
+++ b/Screenshot.pm
@@ -50,6 +50,11 @@ sub screenshot {
     $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
                   $opts{right}, $opts{bottom});
   }
     $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
                   $opts{right}, $opts{bottom});
   }

+  elsif (defined $opts{darwin}) { # as long as it's there
+    defined &_darwin
+      or die "Darwin driver not enabled\n";
+    $result = _darwin($opts{left}, $opts{top}, $opts{right}, $opts{bottom});
+  }

   elsif ($opts{widget}) {
     # Perl/Tk widget
     my $top = $opts{widget}->toplevel;
   elsif ($opts{widget}) {
     # Perl/Tk widget
     my $top = $opts{widget}->toplevel;


@@ -108,6 +113,10 @@ sub have_x11 {
   defined &_x11;
 }
 
   defined &_x11;
 }
 

+sub have_darwin {
+  defined &_darwin;
+}
+

 sub x11_open {
   my $display = _x11_open(@_);
   unless ($display) {
 sub x11_open {
   my $display = _x11_open(@_);
   unless ($display) {


@@ -153,6 +162,9 @@ Imager::Screenshot - screenshot to an Imager image
   # test for x11 support
   if (Imager::Screenshot->have_x11) { ... }
   
   # test for x11 support
   if (Imager::Screenshot->have_x11) { ... }
   

+  # test for Darwin (Mac OS X) support
+  if (Imager::Screenshot->have_darwin) { ... }
+  

 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 


@@ -184,6 +196,20 @@ the display specified by $ENV{DISPLAY}.
 
 Note: taking a screenshot of a remote display is slow.
 
 
 Note: taking a screenshot of a remote display is slow.
 

+=item screenshot darwin => 0
+
+Retrieve a screenshot under Mac OS X.  The only supported value for
+the C<darwin> parameter is C<0>.
+
+For a screen capture to be taken, the current user using
+Imager:Screenshot must be the currently logged in user on the display.
+
+If you're using fast user switching, the current user must be the
+active user.
+
+Note: this means you can ssh into a Mac OS X box and screenshot from
+the ssh session, if you're the current user on the display.
+

 =item screenshot widget => I<widget>
 
 =item screenshot widget => I<widget>, display => I<display>
 =item screenshot widget => I<widget>
 
 =item screenshot widget => I<widget>, display => I<display>


@@ -209,6 +235,10 @@ if Win32 support is compiled, return screenshot(hwnd => 0).
 
 =item *
 
 
 =item *
 

+if Darwin support is compiled, return screenshot(darwin => 0).
+
+=item *
+

 if X11 support is compiled, return screenshot(id => 0).
 
 =item *
 if X11 support is compiled, return screenshot(id => 0).
 
 =item *


@@ -270,6 +300,10 @@ Returns true if Win32 support is available.
 
 Returns true if X11 support is available.
 
 
 Returns true if X11 support is available.
 

+=item have_darwin
+
+Returns true if Darwin support is available.
+

 =item Imager::Screenshot::x11_open
 
 =item Imager::Screenshot::x11_open I<display name>
 =item Imager::Screenshot::x11_open
 
 =item Imager::Screenshot::x11_open I<display name>


@@ -328,8 +362,12 @@ 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.
 
 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.
+Under Win32 or OS X, if there's a screesaver running, then you grab
+the results of the screensaver.
+
+On OS X, you can grab the display from an ssh session as long as the
+ssh session is under the same user as the currently active user on the
+display.

 
 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
 grab the background that you see.  In fact, when I tested under
 
 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
 grab the background that you see.  In fact, when I tested under


@@ -355,12 +393,6 @@ Future plans include:
 
 =item *
 
 
 =item *
 

-OS X support - I need to find out which APIs to use to do this.  I
-found some information on the APIs used for this, but don't have a Mac
-I can test on.
-
-=item *
-

 window name searches - currently screenshot() requires a window
 identifier of some sort, it would be more usable if we could supply
 some other identifier, either a window title or a window class name.
 window name searches - currently screenshot() requires a window
 identifier of some sort, it would be more usable if we could supply
 some other identifier, either a window title or a window class name.

diff --git a/scdarwin.c b/scdarwin.c
index 30512d06d76f8826ae4f042b225d1d8cc11f393b..5eca0f172eec38e654af072200b2841abe2ea800 100644 (file)
--- a/scdarwin.c
+++ b/scdarwin.c
@@ -32,6 +32,10 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
   i_clear_error();
 
   disp = CGMainDisplayID();
   i_clear_error();
 
   disp = CGMainDisplayID();

+  if (!disp) {
+    i_push_error(0, "No main display");
+    return NULL;
+  }

   
   /* for now, only interested in the first display */
   rect = CGDisplayBounds(disp);
   
   /* for now, only interested in the first display */
   rect = CGDisplayBounds(disp);


@@ -75,7 +79,7 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
     return NULL;
   }
   if (!npix) {
     return NULL;
   }
   if (!npix) {

-    i_push_error(0, "No pixel format found");
+    i_push_error(0, "No pixel format found - hidden display?");

     return NULL;
   }
 
     return NULL;
   }
 


@@ -112,7 +116,7 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
 
     glReadBuffer(GL_FRONT);
     glReadPixels(left, screen_height - top - height, width, height,
 
     glReadBuffer(GL_FRONT);
     glReadPixels(left, screen_height - top - height, width, height,

-                GL_BGRA, GL_UNSIGNED_INT_8_8_8_8_REV, buf);
+                GL_RGBA, GL_UNSIGNED_BYTE, buf);

 
     /* transfer */
     while (y >= 0) {
 
     /* transfer */
     while (y >= 0) {


@@ -122,6 +126,12 @@ imss_darwin(i_img_dim left, i_img_dim top, i_img_dim right, i_img_dim bottom) {
     }
     
     free(buf);
     }
     
     free(buf);

+
+    i_tags_setn(&im->tags, "ss_window_width", width);
+    i_tags_setn(&im->tags, "ss_window_height", height);
+    i_tags_set(&im->tags, "ss_type", "Darwin", 6);
+    i_tags_setn(&im->tags, "ss_left", left);
+    i_tags_setn(&im->tags, "ss_top", top);

   }
 
   /* clean up */
   }
 
   /* clean up */

diff --git a/t/50darwin.t b/t/50darwin.t
new file mode 100644 (file)
index 0000000..0a2d46b
--- /dev/null
+++ b/t/50darwin.t
@@ -0,0 +1,35 @@
+#!perl -w
+use strict;
+use Test::More;
+
+use Imager::Screenshot 'screenshot';
+
+++$|;
+
+Imager::Screenshot->have_darwin
+  or plan skip_all => "No darwin support";
+
+my $im = screenshot(darwin => 0, right => 1, bottom => 1);
+unless ($im) {
+  my $err = Imager->errstr;
+  $err =~ /No pixel format found/
+    or plan skip_all => "Probably an inactive user";
+  $err =~ /No main display/
+    or plan skip_all => "User doen't have a display";
+}
+
+plan tests => 7;
+
+{
+  my $im = screenshot(darwin => 0);
+  ok($im, "got an image");
+  is($im->getchannels, 3, "we have some color");
+
+  is($im->tags(name => "ss_window_width"), $im->getwidth,
+     "check ss_window_width tag");
+  is($im->tags(name => 'ss_window_height'), $im->getheight,
+     "check ss_window_height tag");
+  is($im->tags(name => 'ss_left'), 0, "check ss_left tag");
+  is($im->tags(name => 'ss_top'), 0, "check ss_top tag");
+  is($im->tags(name => 'ss_type'), 'Darwin', "check ss_type tag");
+}