1#!/usr/bin/env perl
2# $XTermId: setpos.pl,v 1.18 2019/05/26 23:19:29 tom Exp $
3# -----------------------------------------------------------------------------
4# Copyright 2019 by Thomas E. Dickey
5#
6#                         All Rights Reserved
7#
8# Permission is hereby granted, free of charge, to any person obtaining a
9# copy of this software and associated documentation files (the
10# "Software"), to deal in the Software without restriction, including
11# without limitation the rights to use, copy, modify, merge, publish,
12# distribute, sublicense, and/or sell copies of the Software, and to
13# permit persons to whom the Software is furnished to do so, subject to
14# the following conditions:
15#
16# The above copyright notice and this permission notice shall be included
17# in all copies or substantial portions of the Software.
18#
19# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
20# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
22# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
23# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
24# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
25# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
26#
27# Except as contained in this notice, the name(s) of the above copyright
28# holders shall not be used in advertising or otherwise to promote the
29# sale, use or other dealings in this Software without prior written
30# authorization.
31# -----------------------------------------------------------------------------
32# Exercise CSI 3/13 t which set/get the window position.
33
34use strict;
35
36use Getopt::Std;
37use IO::Handle;
38
39$| = 1;
40
41our ( $opt_a, $opt_n, $opt_p, $opt_v, $opt_x, $opt_8 );
42our $default_y = 100;
43our $default_x = 150;
44
45sub main::HELP_MESSAGE() {
46    printf STDERR <<EOF
47Usage: $0 [options]
48Options:
49  -8      use 8-bit controls
50  -a      test position/report for middle and four corners
51  -n N    repeat unless -a option used (default: 3)
52  -p Y,X  use this position rather than $default_y,$default_x
53  -v      verbose
54  -x      report xwininfo's position for \$WINDOWID
55EOF
56      ;
57    exit 1;
58}
59
60$Getopt::Std::STANDARD_HELP_VERSION = 1;
61&getopts('an:p:vx8') || &main::HELP_MESSAGE;
62
63our $repeat = 3;
64$repeat = $opt_n if ($opt_n);
65&main::HELP_MESSAGE unless ( $repeat =~ /^\d+$/ );
66
67our $CSI = "\x1b\[";
68$CSI = "\x9b" if ($opt_8);
69
70if ($opt_p) {
71    &main::HELP_MESSAGE unless ( $opt_p =~ /^[-]?\d+,[-]?\d+$/ );
72    my @coord = split /,/, $opt_p;
73    $default_y = $coord[0];
74    $default_x = $coord[1];
75}
76
77our $wm_name = "unknown";
78our @extents;
79
80sub no_reply($) {
81    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
82    autoflush TTY 1;
83    my $old = `stty -g`;
84    system "stty raw -echo min 0 time 5";
85
86    print TTY @_;
87    close TTY;
88    system "stty $old";
89}
90
91sub get_reply($) {
92    open TTY, "+</dev/tty" or die("Cannot open /dev/tty\n");
93    autoflush TTY 1;
94    my $old = `stty -g`;
95    system "stty raw -echo min 0 time 5";
96
97    print TTY @_;
98    my $reply = <TTY>;
99    close TTY;
100    system "stty $old";
101    if ( defined $reply ) {
102        die("^C received\n") if ( "$reply" eq "\003" );
103    }
104    return $reply;
105}
106
107sub read_cmd($) {
108    my $cmd = shift;
109    my @result;
110    if ( open my $fh, "$cmd |" ) {
111        @result = <$fh>;
112        close $fh;
113        chomp @result;
114    }
115    return @result;
116}
117
118sub get_xprop($$) {
119    my $id   = shift;
120    my $name = shift;
121    my @data = &read_cmd("xprop -id $id");
122    my $prop = "";
123    for my $n ( 0 .. $#data ) {
124        if ( $data[$n] =~ /$name\([^)]+\) =/ ) {
125            $prop = $data[$n];
126            $prop =~ s/^[^=]*=\s*//;
127            $prop =~ s/"//g;
128            last;
129        }
130    }
131    return $prop;
132}
133
134sub visible($) {
135    my $reply = $_[0];
136    my $n;
137    my $result = "";
138    for ( $n = 0 ; $n < length($reply) ; ) {
139        my $c = substr( $reply, $n, 1 );
140        if ( $c =~ /[[:print:]]/ ) {
141            $result .= $c;
142        }
143        else {
144            my $k = ord substr( $reply, $n, 1 );
145            if ( ord $k == 0x1b ) {
146                $result .= "\\E";
147            }
148            elsif ( $k == 0x7f ) {
149                $result .= "^?";
150            }
151            elsif ( $k == 32 ) {
152                $result .= "\\s";
153            }
154            elsif ( $k < 32 ) {
155                $result .= sprintf( "^%c", $k + 64 );
156            }
157            elsif ( $k > 128 ) {
158                $result .= sprintf( "\\%03o", $k );
159            }
160            else {
161                $result .= chr($k);
162            }
163        }
164        $n += 1;
165    }
166
167    return $result;
168}
169
170sub limited($) {
171    my $value = shift;
172    if ( $value >= 65536 ) {
173        $value %= 65536;
174    }
175    if ( $value >= 32768 ) {
176        $value -= 65536;
177    }
178    return $value;
179}
180
181sub check_position($$$) {
182    my $name   = shift;
183    my $expect = shift;
184    my $actual = shift;
185    printf " ?%s:%d", $name, $expect if ( $expect != $actual );
186}
187
188sub report_position() {
189    my $reply = &get_reply( sprintf "%s13t", $CSI );
190    my $status = 0;
191    my @result;
192    if ( index( $reply, $CSI ) == 0 ) {
193        $reply = substr( $reply, length($CSI) );
194        $status = 1;
195    }
196    if ( $reply =~ /^3;\d+;\d+t$/ ) {
197        my $y = $reply;
198        $y =~ s/^3;(\d+);.*/$1/;
199        my $x = $reply;
200        $x =~ s/^3;\d+;(\d+).*/$1/;
201        $result[0] = &limited($y);
202        $result[1] = &limited($x);
203        printf "OK ->%s ->%d,%d", &visible($reply), $result[0], $result[1];
204    }
205    else {
206        printf "ERR ->%s", &visible($reply);
207    }
208    if ( $opt_x and $ENV{WINDOWID} ) {
209        my @actual = `xwininfo -id $ENV{WINDOWID} | grep " upper-left [XY]:"`;
210        for my $n ( 0 .. $#actual ) {
211            $actual[$n] =~ s/^.*:\s+//;
212        }
213        if ( $#actual == 3 ) {
214            printf " abs(%d,%d) rel(%d,%d)", $actual[0], $actual[1],
215              $actual[2], $actual[3]
216              if ($opt_v);
217            my $expect_y;
218            my $expect_x;
219            if ( $wm_name =~ /^gnome/i ) {
220                $expect_x = $actual[0] - ( $extents[0] + $extents[1] );
221                $expect_y = $actual[1] - ( $extents[2] + $extents[3] );
222            }
223            elsif ( $#extents == 3
224                and ( $wm_name !~ /^fvwm/i )
225                and ( $wm_name !~ /^enlightenment/i ) )
226            {
227                $expect_x = $actual[0] - ( $extents[0] );
228                $expect_y = $actual[1] - ( $extents[2] );
229            }
230            else {
231                $expect_x = $actual[0] - $actual[2];
232                $expect_y = $actual[1] - $actual[3];
233            }
234            if ( $#result > 0 ) {
235                &check_position( "X", $expect_x, $result[0] );
236                &check_position( "Y", $expect_y, $result[1] );
237            }
238        }
239    }
240    printf "\n";
241    return @result;
242}
243
244sub update_position() {
245    my @pos = @{ $_[0] };
246    printf "** update %d,%d\n", $pos[0], $pos[1];
247    $pos[0] += 65536 if ( $pos[0] < 0 );
248    $pos[1] += 65536 if ( $pos[1] < 0 );
249    &no_reply( sprintf "%s3;%d;%dt", $CSI, $pos[0], $pos[1] );
250}
251
252sub update_and_report($) {
253    my @pos = @{ $_[0] };
254    &update_position( \@pos );
255    sleep 1 if ($opt_a);
256    return &report_position;
257}
258
259sub get_screensize() {
260    my $reply = &get_reply( sprintf "%s15t", $CSI );
261    my @result;
262    if ( index( $reply, $CSI ) == 0 ) {
263        $reply = substr( $reply, length($CSI) );
264        if ( $reply =~ /^5;\d+;\d+t$/ ) {
265            my $y = $reply;
266            $y =~ s/^5;(\d+);.*/$1/;
267            my $x = $reply;
268            $x =~ s/^5;\d+;(\d+).*/$1/;
269            $result[0] = $x;
270            $result[1] = $y;
271        }
272    }
273    return @result;
274}
275
276sub doit() {
277    my @old = &report_position;
278    if ($opt_a) {
279        my @size = &get_screensize;
280        if (@size) {
281            printf "Screen %dx%d\n", $size[0], $size[1];
282            my $ulx = -$default_x;
283            my $uly = -$default_y;
284            my $lrx = $size[0] - $default_x;
285            my $lry = $size[1] - $default_y;
286            &update_and_report( [ $ulx, $uly ] );
287            &update_and_report( [ $ulx, $lry ] );
288            &update_and_report( [ $lrx, $lry ] );
289            &update_and_report( [ $lrx, $uly ] );
290            &update_position( \@old );
291        }
292    }
293    else {
294        my @pos = ( $default_y, $default_x );
295        for my $n ( 1 .. $repeat ) {
296            @pos = &update_and_report( \@pos );
297        }
298    }
299}
300
301printf "\x1b G" if ($opt_8);
302
303if ( $opt_x and $ENV{WINDOWID} ) {
304    my $extents = &get_xprop( $ENV{WINDOWID}, "_NET_FRAME_EXTENTS" );
305    if ( $extents ne "" ) {
306        @extents = split /,\s*/, $extents;
307        printf "** has EWMH extents: $extents\n";
308        my $supwin = `xprop -root '_NET_SUPPORTING_WM_CHECK'`;
309        if ( $supwin ne "" ) {
310            $supwin =~ s/^.*(0x[[:xdigit:]]+).*/$1/;
311            $wm_name = &get_xprop( $supwin, "_NET_WM_NAME" );
312            $wm_name = "unknown" unless ( $wm_name ne "" );
313            printf "** using \"$wm_name\"\n";
314        }
315    }
316}
317
318&doit;
319
320printf "\x1b F" if ($opt_8);
321
3221;
323