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