File: scroll-new-window.pl

package info (click to toggle)
libx11-protocol-other-perl 28-1%2Bdeb8u1
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 1,692 kB
  • ctags: 556
  • sloc: perl: 17,055; ansic: 624; sh: 238; lisp: 143; makefile: 39
file content (101 lines) | stat: -rw-r--r-- 3,443 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#!/usr/bin/perl -w

# Copyright 2013 Kevin Ryde

# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use Time::HiRes;
use X11::Protocol;
use X11::Protocol::WM;

use lib 'devel', '.';

# uncomment this to run the ### lines
use Smart::Comments;

{
  my $X = X11::Protocol->new (':0');
  $X->{'event_handler'} = sub {
    my (%h) = @_;
    ### event_handler: \%h
  };

  my $window = $X->new_rsrc;
  $X->CreateWindow ($window,
                    $X->root,         # parent
                    'InputOutput',
                    0,                # depth, from parent
                    'CopyFromParent', # visual
                    0,0,              # x,y
                    100,100,          # width,height
                    0,                # border
                    background_pixel => $X->black_pixel,
                    event_mask       => $X->pack_event_mask('ButtonPress',
                                                            'ButtonMotion',
                                                            'PointerMotion',
                                                            'EnterWindow',
                                                            'LeaveWindow',
                                                            'FocusChange',
                                                            'OwnerGrabButton',
                                                           ),
                   );
  $X->MapWindow ($window);
  $X->flush;

  my $target = time() + 2;
  for (;;) {
    Time::HiRes::usleep(100);
    while (fh_readable ($X->{'connection'}->fh)) {
      ### handle_input
      $X->handle_input;
    }
    if (defined $target && time() > $target) {
      $target = undef;
      my %p = $X->QueryPointer($X->root);
      ### %p
      my $x = $p{'root_x'};
      my $y = $p{'root_y'};
      my $win2 = $X->new_rsrc;
      $X->CreateWindow ($win2,
                        $X->root,         # parent
                        'InputOutput',
                        0,                # depth, from parent
                        'CopyFromParent', # visual
                        $x-30,$y-30,              # x,y
                        60,60,          # width,height
                        0,                # border
                        background_pixel => $X->black_pixel,
                       );
      X11::Protocol::WM::set_wm_normal_hints ($X, $win2,
                                              user_position => 1,
                                              user_size => 1,
                                             );
      $X->MapWindow ($win2);
      $X->flush;
    }
  }
  exit 0;
}

sub fh_readable {
  my ($fh) = @_;
  require IO::Select;
  my $s = IO::Select->new;
  $s->add($fh);
  my @ready = $s->can_read(1);
  return scalar(@ready);
}