Screenshot.pm

   1 package Imager::Screenshot;\r
   2 use strict;\r
   3 use vars qw(@ISA $VERSION @EXPORT_OK);\r
   4 use Imager;\r
   5 require Exporter;\r
   6 \r
   7 push @ISA, 'Exporter';\r
   8 @EXPORT_OK = 'screenshot';\r
   9 \r
  10 BEGIN {\r
  11   require Exporter;\r
  12   @ISA = qw(Exporter);\r
  13   $VERSION = '0.001';\r
  14   eval {\r
  15     # try XSLoader first, DynaLoader has annoying baggage\r
  16     require XSLoader;\r
  17     XSLoader::load('Imager::Screenshot' => $VERSION);\r
  18     1;\r
  19   } or do {\r
  20     require DynaLoader;\r
  21     push @ISA, 'DynaLoader';\r
  22     bootstrap Imager::Screenshot $VERSION;\r
  23   }\r
  24 }\r
  25 \r
  26 sub screenshot {\r
  27   # lose the class if called as a method\r
  28   @_ % 2 == 1 and shift;\r
  29 \r
  30   my %opts = (decor => 0, display => 0, @_);\r
  31 \r
  32   my $result;\r
  33   if (!@_) {\r
  34     my $result =\r
  35       defined &win32 ? win32(0) :\r
  36         defined &x11 ? x11($opts{display}, 0) :\r
  37            die "No drivers enabled\n";\r
  38   }\r
  39   if (defined $opts{hwnd}) {\r
  40     defined &win32\r
  41       or die "Win32 driver not enabled\n";\r
  42     $result = win32($opts{hwnd}, $opts{decor});\r
  43   }\r
  44   elsif (defined $opts{id}) { # X11 window id\r
  45     defined &x11\r
  46       or die "X11 driver not enabled\n";\r
  47     $result = x11($opts{display}, $opts{id});\r
  48   }\r
  49   elsif ($opts{widget}) {\r
  50     # Perl/Tk widget\r
  51     my $top = $opts{widget}->toplevel;\r
  52     my $sys = $top->windowingsystem;\r
  53     if ($sys eq 'win32') {\r
  54       unless (defined &win32) {\r
  55         Imager->_set_error("Win32 Tk and Win32 support not built");\r
  56         return;\r
  57       }\r
  58       $result = win32(hex($opts{widget}->id));\r
  59     }\r
  60     elsif ($sys eq 'x11') {\r
  61       unless (defined &x11) {\r
  62         Imager->_set_error("X11 Tk and X11 support not built");\r
  63         return;\r
  64       }\r
  65 \r
  66       my $id_hex = $opts{widget}->id;\r
  67       print "id $id_hex\n";\r
  68       $opts{widget}->can('frame') \r
  69         and $id_hex = $opts{widget}->frame;\r
  70       print "id $id_hex\n";\r
  71       \r
  72       # is there a way to get the display pointer from Tk?\r
  73       $result = x11(0, hex($id_hex));\r
  74     }\r
  75     else {\r
  76       Imager->_set_error("Unsupported windowing system '$sys'");\r
  77       return;\r
  78     }\r
  79   }\r
  80 \r
  81   unless ($result) {\r
  82     Imager->_set_error(Imager->_error_as_msg());\r
  83     return;\r
  84   }\r
  85   \r
  86   return $result;\r
  87 }\r
  88 \r
  89 sub have_win32 {\r
  90   defined &win32;\r
  91 }\r
  92 \r
  93 sub have_x11 {\r
  94   defined &x11;\r
  95 }\r
  96 \r
  97 sub x11_open {\r
  98   my $display = _x11_open(@_);\r
  99   unless ($display) {\r
 100     Imager->_set_error(Imager->_error_as_msg);\r
 101     return;\r
 102   }\r
 103 \r
 104   return $display;\r
 105 }\r
 106 \r
 107 1;\r
 108 \r
 109 __END__\r
 110 \r
 111 =head1 NAME\r
 112 \r
 113 Imager::Screenshot - screenshot to an Imager image\r
 114 \r
 115 =head1 SYNOPSIS\r
 116 \r
 117   use Imager::Screenshot 'screenshot';\r
 118 \r
 119   # whole screen\r
 120   my $img = screenshot();\r
 121 \r
 122   # Win32 window\r
 123   my $img2 = screenshot(hwnd => $hwnd);\r
 124 \r
 125   # X11 window\r
 126   my $img3 = screenshot(display => $display, id => $window_id);\r
 127 \r
 128   # X11 tools\r
 129   my $display = Imager::Screenshot::x11_open();\r
 130   Imager::Screenshot::x11_close($display);\r
 131 \r
 132   # test for win32 support\r
 133   if (Imager::Screenshot->have_win32) { ... }\r
 134 \r
 135   # test for x11 support\r
 136   if (Imager::Screenshot->have_x11) { ... }\r
 137   \r
 138 \r
 139 =head1 DESCRIPTION\r
 140 \r
 141 Imager::Screenshot captures either a desktop or a specified window and\r
 142 returns the result as an Imager image.\r
 143 \r
 144 Currently the image is always returned as a 24-bit image.\r
 145 \r
 146 =over\r
 147 \r
 148 =item screenshot hwnd => I<window handle>\r
 149 \r
 150 =item screenshot hwnd => I<window handle>, decor => <capture decorations>\r
 151 \r
 152 Retrieve a screenshot under Win32, if I<window handle> is zero,\r
 153 capture the desktop.\r
 154 \r
 155 By default, window decorations are not captured, if the C<decor>\r
 156 parameter is set to true then window decorations are included.\r
 157 \r
 158 =item screenshot id => I<window id>\r
 159 \r
 160 =item screenshot id => I<window id>, display => I<display object>\r
 161 \r
 162 Retrieve a screenshot under X11, if I<id> is zero, capture the root\r
 163 window.  I<display object> is a integer version of an X11 C< Display *\r
 164 >, if this isn't supplied C<screenshot()> will attempt connect to the\r
 165 the display specified by $ENV{DISPLAY}.\r
 166 \r
 167 =item screenshot\r
 168 \r
 169 If no parameters are supplied:\r
 170 \r
 171 =over\r
 172 \r
 173 =item *\r
 174 \r
 175 if Win32 support is compiled, return screenshot(hwnd => 0).\r
 176 \r
 177 =item *\r
 178 \r
 179 if X11 support is compiled, return screenshot(id => 0).\r
 180 \r
 181 =item *\r
 182 \r
 183 otherwise, die.\r
 184 \r
 185 =back\r
 186 \r
 187 =item have_win32\r
 188 \r
 189 Returns true if Win32 support is available.\r
 190 \r
 191 =item have_x11\r
 192 \r
 193 Returns true if X11 support is available.\r
 194 \r
 195 =item Imager::Screenshot::x11_open\r
 196 \r
 197 =item Imager::Screenshot::x11_open I<display name>\r
 198 \r
 199 Attempts to open a connection to either the display name in\r
 200 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable\r
 201 for the I<display> parameter of screenshot, or undef.\r
 202 \r
 203 =item Imager::Screenshot::x11_close I<display>\r
 204 \r
 205 Closes a display returned by Imager::Screenshot::x11_open().\r
 206 \r
 207 =back\r
 208 \r
 209 =head1 AUTHOR\r
 210 \r
 211 Tony Cook <tonyc@cpan.org>\r
 212 \r
 213 =cut\r
 214 \r
 215 \r