File Coverage

blib/lib/X11/Protocol/Ext/DOUBLE_BUFFER.pm
Criterion Covered Total %
statement 19 40 47.5
branch 0 4 0.0
condition 0 3 0.0
subroutine 7 12 58.3
pod 0 1 0.0
total 26 60 43.3


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2017 Kevin Ryde
2              
3             # This file is part of X11-Protocol-Other.
4             #
5             # X11-Protocol-Other is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # X11-Protocol-Other is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with X11-Protocol-Other. If not, see .
17              
18              
19             # /usr/share/doc/x11proto-xext-dev/dbe.txt.gz
20             # /usr/share/doc/x11proto-core-dev/x11protocol.txt.gz
21             # /usr/include/X11/extensions/dbe.h
22             # /usr/include/X11/extensions/dbeproto.h
23             # Protocol.
24             #
25             # /usr/share/doc/libxext-dev/dbelib.txt.gz
26             # /so/xfree/xfree86-3.3.2.3a/lib/Xext/Xdbe.c
27             # Xlib.
28             #
29             # /so/xfree/xfree86-3.3.2.3a/programs/Xserver/dbe/dbe.c
30             # /so/xorg/xorg-server-1.10.0/dbe/dbe.c
31             # Server.
32              
33              
34 1     1   479 BEGIN { require 5 }
35             package X11::Protocol::Ext::DOUBLE_BUFFER;
36 1     1   3 use strict;
  1         1  
  1         23  
37 1     1   3 use Carp;
  1         1  
  1         66  
38 1     1   637 use X11::Protocol;
  1         14530  
  1         64  
39              
40 1     1   8 use vars '$VERSION', '@CARP_NOT';
  1         2  
  1         66  
41             $VERSION = 30;
42             @CARP_NOT = ('X11::Protocol');
43              
44             # uncomment this to run the ### lines
45             #use Smart::Comments;
46              
47              
48             # these not documented yet ...
49 1     1   3 use constant CLIENT_MAJOR_VERSION => 1;
  1         1  
  1         74  
50 1     1   3 use constant CLIENT_MINOR_VERSION => 0;
  1         1  
  1         527  
51              
52             my $reqs =
53             [
54             [ 'DbeGetVersion', # 0
55             sub {
56             my ($X, $client_major, $client_minor) = @_;
57             ### DbeGetVersion request
58             return pack 'CCxx', $client_major, $client_minor;
59             },
60             sub {
61             my ($X, $data) = @_;
62             return unpack 'x8CC', $data;
63             }],
64              
65             [ 'DbeAllocateBackBufferName', # 1
66             sub {
67             my ($X, $window, $buffer, $action_hint) = @_;
68             ### DbeAllocateBackBufferName request
69             return pack 'LLCxxx',
70             $window, $buffer, $X->num('DbeSwapAction',$action_hint);
71             } ],
72              
73             [ 'DbeDeallocateBackBufferName', # 2
74             \&_request_card32s ], # ($X,$buffer)
75              
76             [ 'DbeSwapBuffers', # 3
77             sub {
78             my $X = shift; # ($X, $window,$action, $window,$action, ...)
79             my $ret = pack 'L', scalar(@_)/2; # number of pairs
80             while (@_) {
81             $ret .= pack 'LCxxx', shift, $X->num('DbeSwapAction',shift);
82             }
83             return $ret;
84             }],
85              
86             [ 'DbeBeginIdiom', # 4
87             \&_request_empty ],
88             [ 'DbeEndIdiom', # 5
89             \&_request_empty ],
90              
91             [ 'DbeGetVisualInfo', # 6
92             sub {
93             ### DbeGetVisualInfo request ...
94             my $X = shift; # ($X, $window, $window, ...)
95             ### num_windows: scalar(@_)
96             ### windows: @_
97             return pack 'L*', scalar(@_), @_; # (num_windows, window, window, ...)
98             },
99             sub {
100             my ($X, $data) = @_;
101             ### DbeGetVisualInfo reply ...
102              
103             my $num_screens = unpack 'x8L', $data;
104             ### $num_screens
105              
106             my $pos = 32;
107             # Maybe should return single aref in scalar context.
108             # The map{} ends up giving a count in scalar context (or does it?).
109             return map {
110             my $num_visuals = unpack 'L', substr($data,$pos,4);
111             $pos += 4;
112             [ map { my ($visual_id, $depth, $performance)
113             = unpack 'LCC', substr($data,($pos+=8)-8,6);
114             $visual_id => [ $depth, $performance ] }
115             1 .. $num_visuals ]
116             } 1 .. $num_screens;
117             }],
118              
119             [ 'DbeGetBackBufferAttributes', # 7
120             \&_request_card32s, # ($X,$buffer)
121             sub {
122             my ($X, $data) = @_;
123             return _interp_none($X, unpack('x8L',$data));
124             }],
125              
126             ];
127              
128             my $DbeSwapAction_array = ['Undefined', 'Background', 'Untouched', 'Copied'];
129             my $DbeSwapAction_hash
130             = { X11::Protocol::make_num_hash($DbeSwapAction_array) };
131              
132             sub new {
133 0     0 0   my ($class, $X, $request_num, $event_num, $error_num) = @_;
134             ### DOUBLE_BUFFER new() ...
135              
136             # Constants
137 0           $X->{'ext_const'}->{'DbeSwapAction'} = $DbeSwapAction_array;
138 0           $X->{'ext_const_num'}->{'DbeSwapAction'} = $DbeSwapAction_hash;
139              
140 0           _ext_requests_install ($X, $request_num, $reqs);
141              
142             # Protocol spec says must negotiate version or the extension may or may
143             # not work.
144 0           my ($server_major, $server_minor) = $X->req('DbeGetVersion', 1, 0);
145             ### $server_major
146             ### $server_minor
147 0           return bless { major => $server_major,
148             minor => $server_minor,
149             }, $class;
150             }
151              
152             sub _ext_requests_install {
153 0     0     my ($X, $request_num, $reqs) = @_;
154              
155 0           $X->{'ext_request'}->{$request_num} = $reqs;
156 0           my $href = $X->{'ext_request_num'};
157 0           my $i;
158 0           foreach $i (0 .. $#$reqs) {
159 0           $href->{$reqs->[$i]->[0]} = [$request_num, $i];
160             }
161             }
162              
163             sub _request_empty {
164 0 0   0     if (@_ > 1) {
165 0           croak "No parameters in this request";
166             }
167 0           return '';
168             }
169              
170             sub _request_card32s {
171 0     0     shift;
172             ### _request_card32s(): @_
173 0           return pack 'L*', @_;
174             }
175              
176             sub _interp_none {
177 0     0     my ($X, $xid) = @_;
178 0 0 0       if ($X->{'do_interp'} && $xid == 0) {
179 0           return 'None';
180             } else {
181 0           return $xid;
182             }
183             }
184              
185             1;
186             __END__