1#!/usr/local/bin/perl -w
2
3# Copyright 2011, 2012, 2017 Kevin Ryde
4
5# This file is part of X11-Protocol-Other.
6#
7# X11-Protocol-Other is free software; you can redistribute it and/or
8# modify it under the terms of the GNU General Public License as published
9# by the Free Software Foundation; either version 3, or (at your option) any
10# later version.
11#
12# X11-Protocol-Other is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
15# Public License for more details.
16#
17# You should have received a copy of the GNU General Public License along
18# with X11-Protocol-Other.  If not, see <http://www.gnu.org/licenses/>.
19
20
21# Usage: perl damage-duplicate.pl
22#        perl damage-duplicate.pl --id 0x120000f
23#
24# This is an example of duplicating the contents of a window in real-time by
25# listening for changes to it with the DAMAGE extension.
26#
27# A new $window toplevel displays the contents of a $source window.  The key
28# feature of the damage extension is that it reports when $source changes.
29# Without that, a duplicating program like this would have to re-copy every
30# 1 second or something like that.
31#
32# The source window can be given as an XID with the "--id" command line
33# option, otherwise an X11::Protocol::ChooseWindow is run so you can click
34# on a window like xwininfo does.
35#
36# Details:
37#
38# In the event_handler() code care is taken not to do anything which reads a
39# reply.  This is because reading the reply may also read and process other
40# events, which would call event_handler() recursively and possibly
41# endlessly.  Any event handler should bear that in mind.  In this program
42# the danger would be that if the $source window is changing rapidly and so
43# causing a new DamageNotify event to come very soon after each
44# DamageSubtract().
45#
46# The $gc used for copying has "graphics_expose" off, which means any parts
47# not available in the source window are cleared to the destination
48# background colour.  This happens when the source is overlapped etc by
49# other windows.
50#
51# In the core protocol there's no easy way to get content from $source when
52# it's overlapped, since the server generally doesn't keep the contents or
53# generate expose events for obscured parts of windows.
54#
55# If the "Composite" extension is available then it retains content of
56# overlapped windows.  CompositeRedirectWindow() in the setups is all that's
57# needed to have full $source contents available for the CopyArea()s.
58#
59# For simplicity the entire source area is copied whenever it changes.  In a
60# more sophisticated program the "$parts_region" of changes from the damage
61# object could be a clip mask for the CopyArea().  Changes outside the
62# duplicated area would then still go back and forward as DamageNotify and
63# CopyArea, but the server would see from the clip region no actual drawing
64# required.
65#
66# If $window is bigger than the $source then the excess is cleared.  Some
67# care is taken to clear only the excess area, not the whole of $window,
68# since the latter way would make it flash to black and then to the copied
69# $source.  On a fast screen you might not notice, but on a slow screen or
70# if the server is bogged down then such flashing is very unattractive.
71#
72# Shortcomings:
73#
74# The created $window is always on the same screen as $source and uses the
75# same depth, visual and colormap.  Doing so means a simple CopyArea
76# suffices to copy the contents across.
77#
78# If source and destination were different depth, visual or colormap then
79# pixel colour conversions would be required.  If the destination was on a
80# different server or different screen then some data transfers with
81# GetImage() and PutImage() would be needed as well as pixel conversions.
82# (X11::Protocol::Ext::MIT_SHM might do that through shared memory if the
83# program is on the same machine as the server.)
84#
85# Duplicating the root window is specifically disallowed here.  The problem
86# is that a draw to $window is a change to the root contents, so generates
87# another DamageNotify, which does another draw, in an infinite loop.  It
88# might work if attention was paid to what parts of the root had changed.
89# Changes to the part of the root which is unobscured parts of $window will
90# be due to the duplicating drawing and so don't require any further
91# drawing.
92#
93
94BEGIN { require 5 }
95use strict;
96use Getopt::Long;
97use X11::AtomConstants;
98use X11::CursorFont;
99use X11::Protocol;
100use X11::Protocol::WM;
101
102# uncomment this to run the ### lines
103#use Smart::Comments;
104
105my $X = X11::Protocol->new (':0');
106
107if (! $X->init_extension('DAMAGE')) {
108  print "DAMAGE extension not available on the server\n";
109  exit 1;
110}
111
112#------------------------------------------------------------------------------
113# command line
114
115my $source;       # source window to duplicate
116my $verbose = 1;
117GetOptions ('id=s'     => \$source,
118            'verbose+' => \$verbose)
119  or exit 1;
120
121#------------------------------------------------------------------------------
122# source window, from command line or chosen
123
124my $popup_time;
125
126if (defined $source) {
127  # command line --id=XID
128  $source = oct($source);  # oct() for hex 0xA0000F style as well as decimal
129} else {
130  require X11::Protocol::ChooseWindow;
131  print "Click on a window to duplicate ...\n";
132  $source = X11::Protocol::ChooseWindow->choose (X => $X);
133  print "  got it\n";
134}
135
136if ($verbose) {
137  printf "Source window %d (0x%X)\n", $source, $source;
138}
139if ($source == $X->root) {
140  print "Cannot duplicate root window\n";
141  exit 1;
142}
143
144#------------------------------------------------------------------------------
145
146# use the Composite extension, if available, to keep the contents of $source
147# if it's overlapped by other windows.
148if ($X->init_extension('Composite')) {
149  $X->CompositeRedirectWindow ($source, 'Automatic');
150}
151
152#------------------------------------------------------------------------------
153
154my %source_geom = $X->GetGeometry($source);
155my %source_attr = $X->GetWindowAttributes($source);
156
157# create new output window to show a duplicate of $source
158# same depth, visual, colormap
159my $window = $X->new_rsrc;
160$X->CreateWindow ($window,
161                  $X->root,         # parent
162                  'InputOutput',    # class
163                  $source_geom{'depth'},
164                  $source_attr{'visual'},
165                  0,0,              # x,y
166                  100,100,          # w,h initial size
167                  0,                # border
168                  colormap         => $source_attr{'colormap'},
169                  background_pixel => $X->black_pixel,
170                  event_mask       => $X->pack_event_mask('Exposure'),
171                 );
172X11::Protocol::WM::set_wm_class ($X, $window,
173                                 'damage-duplicate', 'DamageDuplicate');
174X11::Protocol::WM::set_wm_name ($X, $window, 'Duplicate Window'); # title
175X11::Protocol::WM::set_wm_icon_name ($X, $window, 'Duplicate');
176X11::Protocol::WM::set_wm_client_machine_from_syshostname ($X, $window);
177X11::Protocol::WM::set_net_wm_pid ($X, $window);
178X11::Protocol::WM::set_net_wm_user_time($X, $window, $popup_time);
179$X->MapWindow ($window);
180
181# select ConfigureNotify from $source, to know when it resizes
182$X->ChangeWindowAttributes
183  ($source,
184   event_mask => $X->pack_event_mask('StructureNotify'));
185
186# the damage object to monitor $source
187# creating this gives DamageNotify events
188my $damage = $X->new_rsrc;
189$X->DamageCreate ($damage, $source, 'NonEmpty');
190
191my $gc = $X->new_rsrc;
192$X->CreateGC ($gc, $window,
193              subwindow_mode => 'IncludeInferiors',
194              # no "graphics exposures", don't want GraphicsExpose events if
195              # a part of the $X->CopyArea is obscured
196              graphics_exposures => 0);
197
198sub event_handler {
199  my (%h) = @_;
200  my $name = $h{'name'};
201  ### event_handler()
202  ### $name
203  if ($name eq 'ConfigureNotify') {
204    # $source has resized
205    ### height: $h{'height'}
206    my $width = $h{'width'};    # of $source
207    my $height = $h{'height'};
208    # clear any excess if $source has shrunk
209    $X->ClearArea ($window, $width,0, 0,0);  # to left of $width
210    $X->ClearArea ($window, 0,$height, 0,0); # below $height
211    # copy any extra if $source has expanded
212    $X->CopyArea ($source, $window, $gc,
213                  0,0,                       # src x,y
214                  $h{'width'},$h{'height'},  # src w,h
215                  0,0);                      # dst x,y
216
217  } elsif ($name eq 'DamageNotify') {
218    # $source has been drawn into
219    my $rect = $h{'geometry'};
220    my ($root_x, $root_y, $width, $height) = @$rect;
221    ### $rect
222    $X->DamageSubtract ($damage, 'None', 'None');
223    $X->CopyArea ($source, $window, $gc,
224                  0,0,         # src x,y
225                  $width,$height,
226                  0,0);        # dst x,y
227
228  } elsif ($name eq 'Expose') {
229    # our $window revealed, draw it
230    $X->CopyArea ($source, $window, $gc,
231                  $h{'x'},$h{'y'},           # src x,y
232                  $h{'width'},$h{'height'},  # src w,h
233                  $h{'x'},$h{'y'});          # dst x,y
234  }
235}
236
237$X->{'event_handler'} = \&event_handler;
238for (;;) {
239  $X->handle_input;
240}
241exit 0;
242