0.007 release
[imager-screenshot.git] / Screenshot.pm
1 package Imager::Screenshot;
2 use strict;
3 use vars qw(@ISA $VERSION @EXPORT_OK);
4 use Imager;
5 require Exporter;
6
7 push @ISA, 'Exporter';
8 @EXPORT_OK = 'screenshot';
9
10 BEGIN {
11   require Exporter;
12   @ISA = qw(Exporter);
13   $VERSION = '0.007';
14   eval {
15     # try XSLoader first, DynaLoader has annoying baggage
16     require XSLoader;
17     XSLoader::load('Imager::Screenshot' => $VERSION);
18     1;
19   } or do {
20     require DynaLoader;
21     push @ISA, 'DynaLoader';
22     bootstrap Imager::Screenshot $VERSION;
23   }
24 }
25
26 sub screenshot {
27   # lose the class if called as a method
28   @_ % 2 == 1 and shift;
29
30   my %opts = 
31     (
32      decor => 0, 
33      display => 0, 
34      left => 0, 
35      top => 0,
36      right => 0,
37      bottom => 0,
38      @_);
39
40   my $result;
41   if (defined $opts{hwnd}) {
42     defined &_win32
43       or die "Win32 driver not enabled\n";
44     $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
45                      $opts{right}, $opts{bottom});
46   }
47   elsif (defined $opts{id}) { # X11 window id
48     defined &_x11
49       or die "X11 driver not enabled\n";
50     $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
51                    $opts{right}, $opts{bottom});
52   }
53   elsif ($opts{widget}) {
54     # Perl/Tk widget
55     my $top = $opts{widget}->toplevel;
56     my $sys = $top->windowingsystem;
57     if ($sys eq 'win32') {
58       unless (defined &_win32) {
59         Imager->_set_error("Win32 Tk and Win32 support not built");
60         return;
61       }
62       $result = _win32(hex($opts{widget}->id), $opts{decor}, 
63                        $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
64     }
65     elsif ($sys eq 'x11') {
66       unless (defined &_x11) {
67         Imager->_set_error("X11 Tk and X11 support not built");
68         return;
69       }
70
71       my $id_hex = $opts{widget}->id;
72       
73       # is there a way to get the display pointer from Tk?
74       $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
75                      $opts{right}, $opts{bottom});
76     }
77     else {
78       Imager->_set_error("Unsupported windowing system '$sys'");
79       return;
80     }
81   }
82   else {
83     $result =
84       defined &_win32 ? _win32(0, $opts{decor}, $opts{left}, $opts{top},
85                                $opts{right}, $opts{bottom}) :
86         defined &_x11 ? _x11($opts{display}, 0, $opts{left}, $opts{top},
87                              $opts{right}, $opts{bottom}) :
88            die "No drivers enabled\n";
89   }
90
91   unless ($result) {
92     Imager->_set_error(Imager->_error_as_msg());
93     return;
94   }
95
96   # RT #24992 - the Imager typemap entry is broken pre-0.56, so
97   # wrap it here
98   return bless { IMG => $result }, "Imager";
99 }
100
101 sub have_win32 {
102   defined &_win32;
103 }
104
105 sub have_x11 {
106   defined &_x11;
107 }
108
109 sub x11_open {
110   my $display = _x11_open(@_);
111   unless ($display) {
112     Imager->_set_error(Imager->_error_as_msg);
113     return;
114   }
115
116   return $display;
117 }
118
119 sub x11_close {
120   _x11_close(shift);
121 }
122
123 1;
124
125 __END__
126
127 =head1 NAME
128
129 Imager::Screenshot - screenshot to an Imager image
130
131 =head1 SYNOPSIS
132
133   use Imager::Screenshot 'screenshot';
134
135   # whole screen
136   my $img = screenshot();
137
138   # Win32 window
139   my $img2 = screenshot(hwnd => $hwnd);
140
141   # X11 window
142   my $img3 = screenshot(display => $display, id => $window_id);
143
144   # X11 tools
145   my $display = Imager::Screenshot::x11_open();
146   Imager::Screenshot::x11_close($display);
147
148   # test for win32 support
149   if (Imager::Screenshot->have_win32) { ... }
150
151   # test for x11 support
152   if (Imager::Screenshot->have_x11) { ... }
153   
154
155 =head1 DESCRIPTION
156
157 Imager::Screenshot captures either a desktop or a specified window and
158 returns the result as an Imager image.
159
160 Currently the image is always returned as a 24-bit image.
161
162 =over
163
164 =item screenshot hwnd => I<window handle>
165
166 =item screenshot hwnd => I<window handle>, decor => <capture decorations>
167
168 Retrieve a screenshot under Win32, if I<window handle> is zero,
169 capture the desktop.
170
171 By default, window decorations are not captured, if the C<decor>
172 parameter is set to true then window decorations are included.
173
174 =item screenshot id => I<window id>
175
176 =item screenshot id => I<window id>, display => I<display object>
177
178 Retrieve a screenshot under X11, if I<id> is zero, capture the root
179 window.  I<display object> is a integer version of an X11 C< Display *
180 >, if this isn't supplied C<screenshot()> will attempt connect to the
181 the display specified by $ENV{DISPLAY}.
182
183 Note: taking a screenshot of a remote display is slow.
184
185 =item screenshot widget => I<widget>
186
187 =item screenshot widget => I<widget>, display => I<display>
188
189 =item screenshot widget => I<widget>, decor => I<capture decorations>
190
191 Retrieve a screenshot of a Tk widget, under Win32 or X11, depending on
192 how Tk has been built.
193
194 If Tk was built for X11 then the display parameter applies.
195
196 If Tk was built for Win32 then the decor parameter applies.
197
198 =item screenshot
199
200 If no C<id>, C<hwnd> or C<widget> parameter is supplied:
201
202 =over
203
204 =item *
205
206 if Win32 support is compiled, return screenshot(hwnd => 0).
207
208 =item *
209
210 if X11 support is compiled, return screenshot(id => 0).
211
212 =item *
213
214 otherwise, die.
215
216 =back
217
218 You can also supply the following parameters to retrieve a subset of
219 the window:
220
221 =over
222
223 =item *
224
225 left
226
227 =item *
228
229 top
230
231 =item *
232
233 right
234
235 =item *
236
237 bottom
238
239 =back
240
241 If left or top is negative, then treat that as from the right/bottom
242 edge of the window.
243
244 If right ot bottom is zero or negative then treat as from the
245 right/bottom edge of the window.
246
247 So setting all 4 values to 0 retrieves the whole window.
248
249   # a 10-pixel wide right edge of the window
250   my $right_10 = screenshot(left => -10, ...);
251
252   # the top-left 100x100 portion of the window
253   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
254
255   # 10x10 pixel at the bottom right corner
256   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
257
258 =item have_win32
259
260 Returns true if Win32 support is available.
261
262 =item have_x11
263
264 Returns true if X11 support is available.
265
266 =item Imager::Screenshot::x11_open
267
268 =item Imager::Screenshot::x11_open I<display name>
269
270 Attempts to open a connection to either the display name in
271 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
272 for the I<display> parameter of screenshot, or undef.
273
274 =item Imager::Screenshot::x11_close I<display>
275
276 Closes a display returned by Imager::Screenshot::x11_open().
277
278 =back
279
280 =head1 TAGS
281
282 screenshot() sets a number of tags in the images it returns, these are:
283
284 =over
285
286 =item *
287
288 ss_left - the distance between the left side of the window and the
289 left side of the captured area.  The same value as the I<left>
290 parameter when that is positive.
291
292 =item *
293
294 ss_top - the distance between the top side of the window the top side
295 of the captured area.  The same value at the I<top> parameter when
296 that is positive.
297
298 =item *
299
300 ss_window_width - the full width of the window.
301
302 =item *
303
304 ss_window_height - the full height of the window.
305
306 =item *
307
308 ss_type - the type of capture done, either "Win32" or "X11".
309
310 =back
311
312 To cheaply get the window size you can capture a single pixel:
313
314   my $im = screenshot(right => 1, bottom => 1);
315   my $window_width  = $im->tags(name => 'ss_window_width');
316   my $window_height = $im->tags(name => 'ss_window_height');
317
318 =head1 CAVEATS
319
320 It's possible to have more than one grab driver available, for
321 example, Win32 and X11, and which is used can have an effect on the
322 result.
323
324 Under Win32, if there's a screesaver running, then you grab the
325 results of the screensaver.
326
327 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
328 grab the background that you see.  In fact, when I tested under
329 Cygwin/X I got the xterm window contents even when the Windows
330 screensaver was running.  The root window captured appeared to be that
331 generated by my window manager.
332
333 Grabbing a window with other windows overlaying it will capture the
334 content of those windows where they hide the window you want to
335 capture.  You may want to raise the window to top.  This may be a
336 security concern if the overlapping windows contain any sensitive
337 information - true for any screen capture.
338
339 =head1 LICENSE
340
341 Imager::Screenshot is licensed under the same terms as Perl itself.
342
343 =head1 TODO
344
345 Future plans include:
346
347 =over
348
349 =item *
350
351 OS X support - I need to find out which APIs to use to do this.  I
352 found some information on the APIs used for this, but don't have a Mac
353 I can test on.
354
355 =item *
356
357 window name searches - currently screenshot() requires a window
358 identifier of some sort, it would be more usable if we could supply
359 some other identifier, either a window title or a window class name.
360
361 =back
362
363 =head1 AUTHOR
364
365 Tony Cook <tonyc@cpan.org>
366
367 =cut
368
369