- add support for getting a subimage of the window
[imager-screenshot.git] / Screenshot.pm
CommitLineData
967e4c21
TC
1package Imager::Screenshot;
2use strict;
3use vars qw(@ISA $VERSION @EXPORT_OK);
4use Imager;
5require Exporter;
6
7push @ISA, 'Exporter';
8@EXPORT_OK = 'screenshot';
9
10BEGIN {
11 require Exporter;
12 @ISA = qw(Exporter);
e681bf09 13 $VERSION = '0.003';
967e4c21
TC
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
26sub screenshot {
27 # lose the class if called as a method
28 @_ % 2 == 1 and shift;
29
87cd516f
TC
30 my %opts =
31 (
32 decor => 0,
33 display => 0,
34 left => 0,
35 top => 0,
36 right => 0,
37 bottom => 0,
38 @_);
967e4c21
TC
39
40 my $result;
967e4c21
TC
41 if (defined $opts{hwnd}) {
42 defined &_win32
43 or die "Win32 driver not enabled\n";
87cd516f
TC
44 $result = _win32($opts{hwnd}, $opts{decor}, $opts{left}, $opts{top},
45 $opts{right}, $opts{bottom});
967e4c21
TC
46 }
47 elsif (defined $opts{id}) { # X11 window id
48 defined &_x11
49 or die "X11 driver not enabled\n";
87cd516f
TC
50 $result = _x11($opts{display}, $opts{id}, $opts{left}, $opts{top},
51 $opts{right}, $opts{bottom});
967e4c21
TC
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 }
87cd516f
TC
62 $result = _win32(hex($opts{widget}->id), $opts{decor},
63 $opts{left}, $opts{top}, $opts{right}, $opts{bottom});
967e4c21
TC
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 $opts{widget}->can('frame')
73 and $id_hex = $opts{widget}->frame;
74
75 # is there a way to get the display pointer from Tk?
87cd516f
TC
76 $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
77 $opts{right}, $opts{bottom});
967e4c21
TC
78 }
79 else {
80 Imager->_set_error("Unsupported windowing system '$sys'");
81 return;
82 }
83 }
87cd516f
TC
84 else {
85 $result =
86 defined &_win32 ? _win32(0, $opts{decor}, $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 }
967e4c21
TC
92
93 unless ($result) {
94 Imager->_set_error(Imager->_error_as_msg());
95 return;
96 }
97
98 return $result;
99}
100
101sub have_win32 {
102 defined &_win32;
103}
104
105sub have_x11 {
106 defined &_x11;
107}
108
109sub 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
119sub x11_close {
120 _x11_close(shift);
121}
122
1231;
124
125__END__
126
127=head1 NAME
128
129Imager::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
157Imager::Screenshot captures either a desktop or a specified window and
158returns the result as an Imager image.
159
160Currently 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
168Retrieve a screenshot under Win32, if I<window handle> is zero,
169capture the desktop.
170
171By default, window decorations are not captured, if the C<decor>
172parameter 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
178Retrieve a screenshot under X11, if I<id> is zero, capture the root
179window. 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
181the display specified by $ENV{DISPLAY}.
182
f04a72ea
TC
183Note: taking a screenshot of a remote display is slow.
184
967e4c21
TC
185=item screenshot
186
87cd516f 187If no C<id> or C<hwnd> parameter is supplied:
967e4c21
TC
188
189=over
190
191=item *
192
193if Win32 support is compiled, return screenshot(hwnd => 0).
194
195=item *
196
197if X11 support is compiled, return screenshot(id => 0).
198
199=item *
200
201otherwise, die.
202
203=back
204
87cd516f
TC
205You can also supply the following parameters to retrieve a subset of
206the window:
207
208=over
209
210=item *
211
212left
213
214=item *
215
216top
217
218=item *
219
220right
221
222=item *
223
224bottom
225
226=back
227
228If left or top is negative, then treat that as from the right/bottom
229edge of the window.
230
231If right ot bottom is zero or negative then treat as from the
232right/bottom edge of the window.
233
234So setting all 4 values to 0 retrieves the whole window.
235
236 # a 10-pixel wide right edge of the window
237 my $right_10 = screenshot(left => -10, ...);
238
239 # the top-left 100x100 portion of the window
240 my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
241
242 # 10x10 pixel at the bottom right corner
243 my $bott_right_10 = screenshot(left => -10, top => -10, ...);
244
967e4c21
TC
245=item have_win32
246
247Returns true if Win32 support is available.
248
249=item have_x11
250
251Returns true if X11 support is available.
252
253=item Imager::Screenshot::x11_open
254
255=item Imager::Screenshot::x11_open I<display name>
256
257Attempts to open a connection to either the display name in
258$ENV{DISPLAY} or the supplied display name. Returns a value suitable
259for the I<display> parameter of screenshot, or undef.
260
261=item Imager::Screenshot::x11_close I<display>
262
263Closes a display returned by Imager::Screenshot::x11_open().
264
265=back
266
87cd516f
TC
267=head1 CAVEATS
268
269It's possible to have more than one grab driver available, for
270example, Win32 and X11, and which is used can have an effect on the
271result.
272
273Under Win32, if there's a screesaver running, then you grab the
274results of the screensaver.
275
276Grabbing the root window on a rootless server (eg. Cygwin/X) may not
277grab the background. In fact, when I tested under Cygwin/X I got the
278xterm window contents even when the Windows screensaver was running.
279
967e4c21
TC
280=head1 LICENSE
281
282Imager::Screenshot is licensed under the same terms as Perl itself.
283
284=head1 AUTHOR
285
286Tony Cook <tonyc@cpan.org>
287
288=cut
289
290