File Coverage

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

Criterion	Covered	Total	%
statement	16	38	42.1
branch	0	2	0.0
condition	0	3	0.0
subroutine	6	12	50.0
pod	0	1	0.0
total	22	56	39.2

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


# /usr/share/doc/x11proto-composite-dev/compositeproto.txt.gz
# http://cgit.freedesktop.org/xorg/proto/compositeproto/plain/compositeproto.txt
#
# /usr/include/X11/extensions/Xcomposite.h       Xlib
# /usr/include/X11/extensions/composite.h        constants
# /usr/include/X11/extensions/compositeproto.h   structs
#
# http://ktown.kde.org/~fredrik/composite_howto.html
#
# server side source:
#     http://cgit.freedesktop.org/xorg/xserver/tree/composite/compext.c
#


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

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

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


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

my $reqs =
  [
   ['CompositeQueryVersion',  # 0
    sub {
      my ($X, $major, $minor) = @_;
      ### CompositeQueryVersion request
      return pack 'LL', $major, $minor;
    },
    sub {
      my ($X, $data) = @_;
      ### CompositeQueryVersion reply
      return unpack 'x8LL', $data;

      # Any interest in holding onto the version?
      #  my ($server_major, $server_minor) = unpack 'x8LL', $data;
      # ### $server_major
      # ### $server_minor
      # my $self;
      # if ($self = $self->{'ext'}{'Composite'}->[3]) {
      #   $self->{'major'} = $server_major;
      #   $self->{'minor'} = $server_minor;
      # }
      # return ($server_major, $server_minor);
    }],

   ['CompositeRedirectWindow',  # 1
    \&_request_window_and_update ],

   ['CompositeRedirectSubwindows',  # 2
    \&_request_window_and_update ],

   ['CompositeUnredirectWindow',  # 3
    \&_request_window_and_update ],

   ['CompositeUnredirectSubwindows',  # 4
    \&_request_window_and_update ],

   ['CompositeCreateRegionFromBorderClip',  # 5
    \&_request_xids ], # ($X, $region, $window)

   #----------------------------------------------
   # version 0.2

   ['CompositeNameWindowPixmap',  # 6
    \&_request_xids ], # ($X, $window, $pixmap)

   #----------------------------------------------
   # version 0.3

   ['CompositeGetOverlayWindow',  # 7
    \&_request_xids, # ($X, $window)
    sub {
      my ($X, $data) = @_;
      ### CompositeGetOverlayWindow reply
      return unpack 'x8L', $data;
    }],

   ['CompositeReleaseOverlayWindow',  # 8
    \&_request_xids ], # ($X, $window)

   #----------------------------------------------
   # version 0.4

   # these untested, probably not working

   # ['CompositeRedirectCoordinate',  # 9
   #  sub {
   #    my ($X, $window, $bool) = @_;
   #    ### CompositeRedirectCoordinate request
   #    return pack 'LL', $major, $minor;
   #  },
   # ['CompositeTransformCoordinate',  # 10
   #  sub {
   #    my $X = shift;
   #    my $serial = shift;
   #    my $x = shift;
   #    my $y = shift;
   #    # FIXME: padding ?
   #    return pack('Lss', $serial, $x, $y) . join ('', map {pack 'Lss', @$_});
   #  },

  ];

sub _request_window_and_update {
  my ($X, $window, $update) = @_;
  ### _request_window_and_update()
  return pack ('LCxxx',
               $window,
               $X->num('CompositeUpdate',$update));
}

my $CompositeUpdate_array = [ 'Automatic', 'Manual' ];
my $CompositeUpdate_hash =
  { X11::Protocol::make_num_hash($CompositeUpdate_array) };

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

  # Constants
  $X->{'ext_const'}->{'CompositeUpdate'} = $CompositeUpdate_array;
  $X->{'ext_const_num'}->{'CompositeUpdate'} = $CompositeUpdate_hash;

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

  # Events
  # untested, probably not working
  #
  # $X->{'ext_const'}{'Events'}[$event_num] = 'CompositeTransformCoordinate';
  # $X->{'ext_events'}[$event_num] =
  #   [ sub {
  #       my $X = shift;
  #       my $data = shift;
  #       ### CompositeTransformCoordinate unpack: @_[1..$#_]
  #       my ($window, $serial, $x, $y) = unpack 'xxxxLLss', $data;
  #
  #       return (@_,
  #               name     => 'CompositeTransformCoordinate',
  #               serial   => $serial,
  #               window   => $window,
  #               x        => $x,
  #               y        => $y,
  #               coordinates => [ map {unpack 'Lss', substr($data,$_*8,8)} 4 .. length($data)/8 ],
  #              );
  #     }, sub {
  #       my ($X, %h) = @_;
  #       return (pack('x4LLss',
  #                    $h{'window'},
  #                    $h{'serial'},
  #                    $h{'x'},
  #                    $h{'y'})
  #                   . join('',map{pack 'Lss', @$_} $h{'coordinates'}),
  #               1); # "do_seq" put in sequence number
  #     } ];

  # Any need to negotiate the version before using?
  #  my ($major, $minor) = $X->req('CompositeQueryVersion',
  #                                              CLIENT_MAJOR_VERSION,
  #                                              CLIENT_MINOR_VERSION);
  # if ($major != 1) {
  #   carp "Unrecognised Composite major version, got $major want 1";
  #   return 0;
  # }
  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_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__