# id values as numbers ?
# struct forms ?

# XVideoShmPutImage arg order ...



# Copyright 2012, 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/>.

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

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

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


# /usr/share/doc/x11proto-video-dev/xv-protocol-v2.txt.gz
#
# /usr/include/X11/extensions/Xv.h
# /usr/include/X11/extensions/Xvproto.h
#
# /usr/share/xcb/xv.xml
# http://cgit.freedesktop.org/xcb/proto/tree/src/xv.xml
#     xcb
#
# /usr/include/X11/extensions/Xvlib.h
#     Xlib.
#
# /so/xorg/xorg-server-1.10.0/Xext/xvdisp.c
#     server source
#
# /usr/share/doc/x11proto-core-dev/x11protocol.txt.gz
#
# /usr/include/X11/extensions/vldXvMC.h
# /usr/include/X11/extensions/XvMC.h
# /usr/include/X11/extensions/XvMCproto.h

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


#------------------------------------------------------------------------------
# symbolic constants

my %const_arrays
  = (
     # not the same as the core GrabStatus enum
     XVideoGrabStatus => [ 'Success',        # 0
                           'BadExtension',   # 1 internal??
                           'AlreadyGrabbed', # 2
                           'InvalidTime',    # 3
                           'BadReply',       # 4 internal??
                           'BadAlloc',       # 5 internal??
                         ],
     
     XVideoNotifyReason => ['Started',   # 0
                            'Stopped',   # 1
                            'Busy',      # 2
                            'Preempted', # 3
                            'HardError', # 4
                           ],
     XVideoScanlineOrder => ['TopToBottom', # 0
                             'BottomToTop', # 1
                            ],
     XVideoImageFormatType => [ 'RGB', # 0
                                'YUV', # 1
                              ],
     XVideoImageFormatType => [ 'RGB', # 0
                                'YUV', # 1
                              ],
    );

my %const_hashes
  = (map { $_ => { X11::Protocol::make_num_hash($const_arrays{$_}) } }
     keys %const_arrays);

#------------------------------------------------------------------------------
# events

my $XVideoNotify_event
  = [ 'xCxxLLLx16',
      ['reason','XVideoNotifyReason'],
      'time',
      'drawable',
      'port',
    ];
my $XVideoPortNotify_event
  = [ 'xxxxLLLlx12',
      'time',
      'port',
      'attribute', # atom
      'value',     # INT32
    ];

#------------------------------------------------------------------------------
# requests

my $reqs =
  [
   ['XVideoQueryExtension',  # 0
    \&_request_empty,
    sub {
      my ($X, $data) = @_;
      return unpack 'x8SS', $data;
    }],
   
   ['XVideoQueryAdaptors',  # 1
    \&_request_card32s,  # ($X, $window)
    sub {
      my ($X, $data) = @_;
      ### XVideoQueryAdaptors() reply ...
      
      # use Data::HexDump::XXD;
      # print scalar(Data::HexDump::XXD::xxd($data));
      # print "\n";
      
      my ($num_adaptors) = unpack 'x8S', $data;
      ### $num_adaptors
      
      my $pos = 32;
      my @ret;
      foreach (1 .. $num_adaptors) {
        ### $pos
        my ($port_base, $name_len, $num_ports, $num_formats, $type)
          = unpack 'LSSSC', substr($data,$pos,12);
        $pos += 12;
        
        my $name = substr($data,$pos,$name_len);
        $pos += $name_len + X11::Protocol::padding($name_len);
        
        my @formats;
        foreach (1 .. $num_formats) {
          my %h;
          @h{'visual','depth'} = unpack 'LC', substr($data,$pos,8);
          push @formats, \%h;
          $pos += 8;
        }
        
        push @ret, { port_base => $port_base,
                     name      => $name,
                     num_ports => $num_ports,
                     formats   => \@formats,
                     type      => $type };
      }
      return @ret;
    } ],
   
   ['XVideoQueryEncodings',  # 2
    \&_request_card32s,  # ($X, $port)
    sub {
      my ($X, $data) = @_;
      ### XVideoQueryEncodings() reply length: length($data)
      
      # use Data::HexDump::XXD;
      # print scalar(Data::HexDump::XXD::xxd($data));
      # print "\n";
      
      my ($num_encodings) = unpack 'x8S', $data;
      ### $num_encodings
      
      my $pos = 32;
      my @ret;
      foreach (1 .. $num_encodings) {
        ### $pos
        my ($encoding, $name_len,
            $width,$height,
            $rate_numerator,$rate_denominator)
          = unpack 'LSSSxxLL', substr($data,$pos,20);
        $pos += 20;
        
        my $name = substr($data,$pos,$name_len);
        $pos += $name_len + X11::Protocol::padding($name_len);
        
        push @ret, { encoding         => $encoding,
                     name             => $name,
                     width            => $width,
                     height           => $height,
                     rate_numerator   => $rate_numerator,
                     rate_denominator => $rate_denominator,
                   };
      }
      return @ret;
    }],
   
   ['XVideoGrabPort',  # 3
    sub {
      my ($X, $port, $time) = @_;
      return pack 'LL', $port, _num_time($time);
    },
    sub {
      my ($X, $data) = @_;
      my ($status) = unpack 'xC', $data;
      return $X->interp('XVideoGrabStatus',$status);
    } ],
   
   ['XVideoUngrabPort',  # 4
    sub {
      my ($X, $port, $time) = @_;
      return pack 'LL', $port, _num_time($time);
    } ],
   
   do {
     my $put = sub {
       shift;
       # ($X, $port, $drawable, $gc,
       #  $vid_x,$vid_y,$vid_w,$vid_h,
       #  $drw_x,$drw_y,$drw_w,$drw_h)
       return pack 'LLLssSSssSS', @_;
     };
     
     (
      ['XVideoPutVideo',  # 5
       $put ],
      
      ['XVideoPutStill',  # 6
       $put ],
      
      ['XVideoGetVideo',  # 7
       $put ],
      
      ['XVideoGetStill',  # 8
       $put ],
     )
   },
   
   ['XVideoStopVideo',  # 9
    \&_request_card32s ],
   
   do {
     my $select = sub {
       shift; # ($X, $drawable, $onoff)
       return pack 'LCxxx', @_;
     };
     
     (
      ['XVideoSelectVideoNotify',  # 10
       $select ],
      
      ['XVideoSelectPortNotify',  # 11
       $select ],
     )
   },
   
   ['XVideoQueryBestSize',  # 12
    sub {
      shift; # ($X, $port, $vid_w,$vid_h, $drw_w,$drw_h, $motion)
      return pack 'LSSSSCxxx', @_;
    } ],
   
   ['XVideoSetPortAttribute',  # 13
    sub {
      shift; # ($X, $port, $atom, $value)
      return pack 'LLl', @_;
    } ],
   
   ['XVideoGetPortAttribute',  # 14
    sub {
      shift; # ($X, $port, $atom)
      return pack 'Ll', @_;
    },
    sub {
      my ($X, $data) = @_;
      return unpack 'x8l', $data;
    }],
   
   ['XVideoQueryPortAttributes',  # 15
    \&_request_card32s,
    sub {
      my ($X, $data) = @_;
      my ($num_attributes, $text_len) = unpack 'x8LL', $data;
      
      my $pos = 32;
      my @ret;
      foreach (1 .. $num_attributes) {
        my %h;
        (@h{'flags','min','max'}, my $name_len)
          = unpack 'LllL', substr($data,$pos,16);
        $pos += 16;
        
        $h{'name'} = unpack 'Z*', substr($data,$pos,$name_len);
        $pos += $name_len + X11::Protocol::padding($name_len);
        
        push @ret, \%h;
      }
      return @ret;
    }],
   
   ['XVideoListImageFormats',  # 16
    \&_request_card32s,
    sub {
      my ($X, $data) = @_;
      my ($num_attributes, $text_len) = unpack 'x8LL', $data;
      
      # use Data::HexDump::XXD;
      # print scalar(Data::HexDump::XXD::xxd($data));
      # print "\n";
      
      my $pos = 32;
      my @ret;
      foreach (1 .. $num_attributes) {
        my %h;
        @h{ # hash slice
          qw(id
             type
             byte_order
             guid
             bpp
             num_planes
             
             depth
             
             red_mask
             green_mask
             blue_mask
             format
             
             y_sample_bits
             u_sample_bits
             v_sample_bits
             horz_y_period
             horz_u_period
             horz_v_period
             vert_y_period
             vert_u_period
             vert_v_period
             
             comp_order
             scanline_order
           )} = unpack 'LCCxxa16CCxxCxxxLLLCxxxL9Z32C', substr($data,$pos,128);
        $pos += 128;
        
        $h{'type'}
          = $X->interp('XVideoImageFormatType', $h{'type'});
        $h{'scanline_order'}
          = $X->interp('XVideoScanlineOrder', $h{'scanline_order'});
        $h{'byte_order'}
          = $X->interp('Significance', $h{'byte_order'});
        
        push @ret, \%h;
      }
      return @ret;
    }],
   
   ['XVideoQueryImageAttributes',  # 17
    sub {
      shift; # ($X, $port, $image_id, $width, $height)
      return pack 'LLSS', @_;
    },
    sub {
      my ($X, $data) = @_;
      my ($num_planes, $data_size, $width, $height) = unpack 'x8LLSS', $data;
      return ($data_size, $width, $height,
              unpack "L$num_planes", substr($data,32));
    }],
   
   ['XVideoPutImage',  # 18
    sub {
      shift;
      # ($X, $port, $drawable, $gc, $id,
      #  $src_x,$src_y,$src_w,$src_h,
      #  $drw_x,$drw_y,$drw_w,$drw_h,
      #  $width,$height)
      return pack 'LLLLssSSssSSSS', @_;
    } ],
   
   # FIXME: args cf ShmPutImage ?
   ['XVideoShmPutImage',  # 19
    sub {
      shift;
      # ($X, $port, $drawable, $gc, $shmseg, $id, $offset
      #  $src_x,$src_y,$src_w,$src_h,
      #  $drw_x,$drw_y,$drw_w,$drw_h,
      #  $width,$height, $send_event)
      return pack 'LLLLLLssSSssSSSS', @_;
    } ],
  ];

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

  # Constants
  %{$X->{'ext_const'}}     = (%{$X->{'ext_const'}     ||= {}}, %const_arrays);
  %{$X->{'ext_const_num'}} = (%{$X->{'ext_const_num'} ||= {}}, %const_hashes);

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

  # Errors
  _ext_const_error_install ($X, $error_num,
                            'XVideoPort',     # 0
                            'XVideoEncoding', # 1

                            # FIXME: this one in new enough protocol ?
                            'XVideoControl',  # 2
                           );

  # Events
  $X->{'ext_const'}{'Events'}[$event_num] = 'XVideoNotify';
  $X->{'ext_events'}[$event_num] = $XVideoNotify_event;
  $event_num++;
  $X->{'ext_const'}{'Events'}[$event_num] = 'XVideoPortNotify';
  $X->{'ext_events'}[$event_num] = $XVideoPortNotify_event;

  return bless { }, $class;
}

#------------------------------------------------------------------------------
# generic

sub _request_empty {
  # ($X)
  if (@_ > 1) {
    croak "No parameters in this request";
  }
  return '';
}
sub _request_card32s {
  shift;
  ### _request_card32s(): @_
  return pack 'L*', @_;
}

sub _num_time {
  my ($time) = @_;
  if (defined $time && $time eq 'CurrentTime') {
    return 0;
  } else {
    return $time;
  }
}
sub _num_none {
  my ($xid) = @_;
  if (defined $xid && $xid eq "None") {
    return 0;
  } else {
    return $xid;
  }
}

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 _ext_const_error_install {
  my $X = shift;  # ($X, $errname1,$errname2,...)
  ### _ext_const_error_install: @_
  my $error_num = shift;
  my $aref = $X->{'ext_const'}{'Error'}  # copy
    = [ @{$X->{'ext_const'}{'Error'} || []} ];
  my $href = $X->{'ext_const_num'}{'Error'}  # copy
    = { %{$X->{'ext_const_num'}{'Error'} || {}} };
  my $i;
  foreach $i (0 .. $#_) {
    $aref->[$error_num + $i] = $_[$i];
    $href->{$_[$i]} = $error_num + $i;
  }
}

1;
__END__

=for stopwords XID Ryde

=head1 NAME

X11::Protocol::Ext::XVideo - video modes

=head1 SYNOPSIS

 use X11::Protocol;
 my $X = X11::Protocol->new;
 $X->init_extension('XFree86-VidModeExtension')
   or print "XFree86-VidModeExtension extension not available";

=head1 DESCRIPTION

The XFree86-VidModeExtension extension ...

=head1 REQUESTS

The following requests are made available with an C<init_extension()>, as
per L<X11::Protocol/EXTENSIONS>.

    my $is_available = $X->init_extension('XFree86-VidModeExtension');

=head2 XFree86-VidModeExtension 1.0

=over

=item C<($server_major, $server_minor) = $X-E<gt>XVideoQueryVersion ()>

Return the DGA protocol version implemented by the server.

=item C<@adaptors = $X-E<gt>XVideoQueryAdaptors ($window)>

Return a list of available video adaptors

    { name      => string,
      port_base => integer,
      num_ports => integer,
      type      => integer bits,
      formats   => [ { visual => integer visual ID,
                       depth  => integer,
                     },
                     ...
                   ],
    }

C<name> is a string describing the adaptor.

C<port_base> is the first port number for use as C<$port> below, and there
are C<num_ports> many ports.

The C<type> bits give the adaptor capabilities,

    0x01    Input
    0x02    Output
    0x04    Video
    0x08    Still
    0x10    Image

C<formats> is an arrayref of hashrefs giving the supported visuals for the
adaptor.  Each C<depth> is the depth of the visual, the same as in the core
C<$X> information.

=item C<@encodings = $X-E<gt>XVideoQueryEncodings ($port)>

        { encoding         => $encoding,
          name             => string,
          width            => integer,
          height           => integer,
          rate_numerator   => integer,
          rate_denominator => integer,
        }

=item C<$status = $X-E<gt>XVideoGrabPort ($port, $time)>

Grab C<$port>.  This means only video requests from the grabbing client are
processed.  The C<$status> result is an XVideoGrabStatus enum string

    "Success"             # 0
    "AlreadyGrabbed"      # 2
    "InvalidTime"         # 3

"AlreadyGrabbed" means another client has grabbed the port.  "InvalidTime"
means the given C<$time> is older than one of the following actions on the
port by another client,

    GrabPort, UngrabPort, PutVideo, PutStill, GetVideo, GetStill

C<$time> mechanism prevents a lagged client from making a mess of subsequent
actions by another client.  C<"CurrentTime"> can be given to skip the time
check.

=item C<$X-E<gt>XVideoUngrabPort ($port, $time)>

Ungrab C<$port>, allowing other clients to use it.  If C<$time> is before
than latest action on C<$port> then the request is ignored.
C<"CurrentTime"> can be given to always ungrab.

=item C<$X-E<gt>XVideoPutVideo ($port, $drawable, $gc, $video_x,$video_y,$video_width,$video_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h)>

=item C<$X-E<gt>XVideoPutStill ($port, $drawable, $gc, $video_x,$video_y,$video_width,$video_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h)>

=item C<$X-E<gt>XVideoGetVideo ($port, $drawable, $gc, $video_x,$video_y,$video_width,$video_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h)>

=item C<$X-E<gt>XVideoGetStill ($port, $drawable, $gc, $video_x,$video_y,$video_width,$video_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h)>

=item C<$X-E<gt>XVideoStopVideo ($port, $drawable)>

Stop any video for C<$port> and C<$drawable>.  If C<$port> is on a different
drawable or not running at all then the request is ignored.

=item C<$X-E<gt>XVideoSelectVideoNotify ($drawable, $onoff)>

=item C<$X-E<gt>XVideoSelectPortNotify ($drawable, $onoff)>

=item C<$X-E<gt>XVideoQueryBestSize ($port, $video_width,$video_height, $drawable_w,$drawable_h, $motion)>

=item C<$X-E<gt>XVideoSetPortAttribute ($port, $atom, $value)>

=item C<$value = $X-E<gt>XVideoGetPortAttribute ($port, $atom)>

Get or set an attribute on C<$port>.  The attribute name is C<$atom> (an
atom integer) and C<$value> is a signed INT32.

=item C<@attrs = $X-E<gt>XVideoQueryPortAttributes ($port)>

Return a list of available attributes on C<$port>.  Each return value is a
hashref

    {
      name  => string,
      flags => integer,
      min   => integer,
      max   => integer,
    }

The flag bits are

    0x01   attribute is gettable
    0x02   attribute is settable

=item C<@formats = $X-E<gt>XVideoListImageFormats ($port)>

    {
      id          => integer,
      type        => enum "RGB" or "YUV"
      byte_order  => enum "LeastSignificant" or "MostSignificant"
      guid        =>
      bpp         =>
      num_planes  =>

      depth       => integer,

      red_mask    => integer,
      green_mask  => integer,
      blue_mask   => integer,
      format      => integer,

      y_sample_bits => integer,
      u_sample_bits => integer,
      v_sample_bits => integer,
      horz_y_period => integer,
      horz_u_period => integer,
      horz_v_period => integer,
      vert_y_period => integer,
      vert_u_period => integer,
      vert_v_period => integer,

      comp_order     => ,
      scanline_order => enum "TopToBottom" or "BottomToTop"

    }

=item C<($data_size, $width, $height, @...) = $X-E<gt>XVideoQueryImageAttributes ($port, $image_id, $width, $height)>

=item C<$X-E<gt>XVideoPutImage ($port, $drawable, $gc, $id, $src_x,$src_y,$src_width,$src_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h, $width,$height)>

=item C<$X-E<gt>XVideoShmPutImage ($port, $drawable, $gc, $shmseg, $id, $offset, $video_x,$video_y,$video_width,$video_height, $drawable_x,$drawable_y,$drawable_w,$drawable_h)>

=back

=head1 SEE ALSO

L<X11::Protocol>

F</usr/share/doc/x11proto-video-dev/xv-protocol-v2.txt.gz>

=head1 HOME PAGE

L<http://user42.tuxfamily.org/x11-protocol-other/index.html>

=head1 LICENSE

Copyright 2012, 2013 Kevin Ryde

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/>.

=cut