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