File Coverage

blib/lib/X11/Protocol/Ext/XINERAMA.pm

Criterion	Covered	Total	%
statement	16	37	43.2
branch	0	4	0.0
condition	0	3	0.0
subroutine	6	12	50.0
pod	0	1	0.0
total	22	57	38.6

# Copyright 2011, 2012, 2013, 2014, 2017 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 .

BEGIN { require 5 }
package X11::Protocol::Ext::XINERAMA;
use strict;
use Carp;

use vars '$VERSION', '@CARP_NOT';
$VERSION = 31;
@CARP_NOT = ('X11::Protocol');

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

# /usr/include/X11/extensions/panoramiXproto.h
#    Protocol structs etc.
#    http://cgit.freedesktop.org/xorg/proto/xineramaproto/tree/panoramiXproto.h
#
# /usr/include/X11/extensions/Xinerama.h
# /usr/include/X11/extensions/panoramiXext.h
#    Xlib.
#
# http://www.kernel.org/doc/als1999/Conference/IMcCartney/xinerama.html
#
# XINERAMA 1.0 in X11R6.4
# XINERAMA 1.1 in X11R6.7
#

### XINERAMA.pm loads

# these not documented yet ...
use constant CLIENT_MAJOR_VERSION => 1;
use constant CLIENT_MINOR_VERSION => 1;

my $reqs =
  [
   [ 'PanoramiXQueryVersion',  # 0
     sub {
       my ($X, $major, $minor) = @_;
       ### PanoramiXQueryVersion
       return pack 'CCxx', $major, $minor;
     },
     sub {
       my ($X, $data) = @_;
       return unpack 'x8SS', $data;
     }],

   [ 'PanoramiXGetState',  # 1
     \&_request_xids, # ($X, $window)
     sub {
       my ($X, $data) = @_;
       ### PanoramiXGetState reply
       ### state and window: unpack 'xCx6L', $data

       # Reply "window" field may be set only in XINERAMA 1.1, not the
       # X11R6.4 1.0.  It's a copy of the request, so think can ignore.
       return unpack 'xC', $data;
     }],

   [ 'PanoramiXGetScreenCount',  # 2
     \&_request_xids, # ($X, $window)
     sub {
       my ($X, $data) = @_;
       ### PanoramiXGetScreenCount reply: unpack "C*", $data
       ### count and window: unpack 'xCx6L', $data

       # Reply "window" field may be set only in XINERAMA 1.1, not the
       # X11R6.4 1.0.  It's a copy of the request, so think can ignore.
       return unpack 'xC', $data;
     }],

   [ 'PanoramiXGetScreenSize',  # 3
     # ($X, $window, $screen)
     # $screen is an integer not an xid, so ought not allow 'None' there
     \&_request_xids,
     sub {
       my ($X, $data) = @_;
       ### PanoramiXGetScreenSize reply
       ### w,h,win,screen: unpack 'x8L*', $data

       # Reply "window" and "screen" fields may be set only in XINERAMA 1.1,
       # not the X11R6.4 1.0.  They're a copy of the request, so think can
       # ignore.
       return unpack 'x8LL', $data;  # ($width,$height)
     }],

   #------------
   # version 1.1

   ["XineramaIsActive",  # 4
    \&_request_empty,  # ($X)
    sub {
      my ($X, $data) = @_;
      return unpack 'x8L', $data;
    }],

   ["XineramaQueryScreens",  # 5
    \&_request_empty,  # ($X)
    sub {
      my ($X, $data) = @_;
      ### XineramaQueryScreens reply: unpack 'x8L*', $data
      my $num = unpack 'x8L', $data;
      map {[ unpack 'ssSS', substr($data, 32+8*$_, 8) ]} 0 .. $num-1;
    }],
  ];

sub new {
  my ($class, $X, $request_num, $event_num, $error_num) = @_;
  ### XINERAMA new()

  _ext_requests_install ($X, $request_num, $reqs);

  # Any need to negotiate?
  # my ($major, $minor) = $X->req('PanoramiXQueryVersion',
  #                               CLIENT_MAJOR_VERSION, CLIENT_MINOR_VERSION);
  # ### $major
  # ### $minor

  return bless {
                # major => $major,
                # minor => $minor,
               }, $class;
}

sub _ext_requests_install {
  my ($X, $request_num, $reqs) = @_;

  $X->{'ext_request'}->{$request_num} = $reqs;
  my $href = $X->{'ext_request_num'};
  my $i;
  foreach $i (0 .. $#$reqs) {
    $href->{$reqs->[$i]->[0]} = [$request_num, $i];
  }
}

sub _request_empty {
  if (@_ > 1) {
    croak "No parameters in this request";
  }
  return '';
}

sub _request_xids {
  my $X = shift;
  ### _request_xids(): @_
  return _request_card32s ($X, map {_num_none($_)} @_);
}
sub _request_card32s {
  shift;
  ### _request_card32s(): @_
  return pack 'L*', @_;
}
sub _num_none {
  my ($xid) = @_;
  if (defined $xid && $xid eq 'None') {
    return 0;
  } else {
    return $xid;
  }
}

1;
__END__