instead of using the Imager type typemap entry use the Imager::ImgRef
[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.004';
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       $opts{widget}->can('frame') 
73         and $id_hex = $opts{widget}->frame;
74       
75       # is there a way to get the display pointer from Tk?
76       $result = _x11($opts{display}, hex($id_hex), $opts{left}, $opts{top},
77                      $opts{right}, $opts{bottom});
78     }
79     else {
80       Imager->_set_error("Unsupported windowing system '$sys'");
81       return;
82     }
83   }
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   }
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
188
189 If no C<id> or C<hwnd> parameter is supplied:
190
191 =over
192
193 =item *
194
195 if Win32 support is compiled, return screenshot(hwnd => 0).
196
197 =item *
198
199 if X11 support is compiled, return screenshot(id => 0).
200
201 =item *
202
203 otherwise, die.
204
205 =back
206
207 You can also supply the following parameters to retrieve a subset of
208 the window:
209
210 =over
211
212 =item *
213
214 left
215
216 =item *
217
218 top
219
220 =item *
221
222 right
223
224 =item *
225
226 bottom
227
228 =back
229
230 If left or top is negative, then treat that as from the right/bottom
231 edge of the window.
232
233 If right ot bottom is zero or negative then treat as from the
234 right/bottom edge of the window.
235
236 So setting all 4 values to 0 retrieves the whole window.
237
238   # a 10-pixel wide right edge of the window
239   my $right_10 = screenshot(left => -10, ...);
240
241   # the top-left 100x100 portion of the window
242   my $topleft_100 = screenshot(right => 100, bottom => 100, ...);
243
244   # 10x10 pixel at the bottom right corner
245   my $bott_right_10 = screenshot(left => -10, top => -10, ...);
246
247 =item have_win32
248
249 Returns true if Win32 support is available.
250
251 =item have_x11
252
253 Returns true if X11 support is available.
254
255 =item Imager::Screenshot::x11_open
256
257 =item Imager::Screenshot::x11_open I<display name>
258
259 Attempts to open a connection to either the display name in
260 $ENV{DISPLAY} or the supplied display name.  Returns a value suitable
261 for the I<display> parameter of screenshot, or undef.
262
263 =item Imager::Screenshot::x11_close I<display>
264
265 Closes a display returned by Imager::Screenshot::x11_open().
266
267 =back
268
269 =head1 TAGS
270
271 screenshot() sets a number of tags in the images it returns, these are:
272
273 =over
274
275 =item *
276
277 ss_left - the distance between the left side of the window and the
278 left side of the captured area.  The same value as the I<left>
279 parameter when that is positive.
280
281 =item *
282
283 ss_top - the distance between the top side of the window the top side
284 of the captured area.  The same value at the I<top> parameter when
285 that is positive.
286
287 =item *
288
289 ss_window_width - the full width of the window.
290
291 =item *
292
293 ss_window_height - the full height of the window.
294
295 =item *
296
297 ss_type - the type of capture done, either "Win32" or "X11".
298
299 =back
300
301 To cheaply get the window size you can capture a single pixel:
302
303   my $im = screenshot(right => 1, bottom => 1);
304   my $window_width  = $im->tags(name => 'ss_window_width');
305   my $window_height = $im->tags(name => 'ss_window_height');
306
307 =head1 CAVEATS
308
309 It's possible to have more than one grab driver available, for
310 example, Win32 and X11, and which is used can have an effect on the
311 result.
312
313 Under Win32, if there's a screesaver running, then you grab the
314 results of the screensaver.
315
316 Grabbing the root window on a rootless server (eg. Cygwin/X) may not
317 grab the background that you see.  In fact, when I tested under
318 Cygwin/X I got the xterm window contents even when the Windows
319 screensaver was running.  The root window captured appeared to be that
320 generated by my window manager.
321
322 =head1 LICENSE
323
324 Imager::Screenshot is licensed under the same terms as Perl itself.
325
326 =head1 AUTHOR
327
328 Tony Cook <tonyc@cpan.org>
329
330 =cut
331
332