Commit | Line | Data |
---|---|---|
967e4c21 TC |
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); | |
cb2b4ace | 13 | $VERSION = '0.002'; |
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 | ||
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 | ||
f04a72ea TC |
169 | Note: taking a screenshot of a remote display is slow. |
170 | ||
967e4c21 TC |
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 |