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