#!/usr/bin/perl -w

# Copyright 2012 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 lib 'devel/lib';
$ENV{'DISPLAY'} ||= ":0";





BEGIN { require 5 }
use strict;
use X11::Protocol;
use Test;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings() }
END { MyTestHelpers::diag ("END"); }

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


my $test_count = (tests => 21)[1];
plan tests => $test_count;

require X11::Protocol;
MyTestHelpers::diag ("X11::Protocol version ", X11::Protocol->VERSION);

my $have_extension = 0;

my $display = $ENV{'DISPLAY'};
if (! defined $display) {
  foreach (1 .. $test_count) {
    skip ('No DISPLAY set', 1, 1);
  }
  exit 0;
}

# pass display arg so as not to get a "guess" warning
my $X;
if (! eval { $X = X11::Protocol->new ($display); }) {
  MyTestHelpers::diag ('Cannot connect to X server -- ',$@);
  foreach (1 .. $test_count) {
    skip ('Cannot connect to X server', 1, 1);
  }
  exit 0;
}
$X->QueryPointer($X->{'root'});  # sync

my ($major_opcode, $first_event, $first_error)
  = $X->QueryExtension('XFree86-VidModeExtension');
{
  if (! defined $major_opcode) {
    foreach (1 .. $test_count) {
      skip ('QueryExtension() no XFree86-VidModeExtension on the server', 1, 1);
    }
    exit 0;
  }
  MyTestHelpers::diag ("XFree86-VidModeExtension extension opcode=$major_opcode event=$first_event error=$first_error");
}

require X11::Protocol::Ext::XFree86_VidModeExtension;

if (! $X->init_extension ('XFree86-VidModeExtension')) {
  die "QueryExtension says XFree86-VidModeExtension avaiable, but init_extension() failed";
}
$X->QueryPointer($X->root); # sync




#------------------------------------------------------------------------------
# "XF86VidMode" errors

{
  ok ($X->num('Error','XF86VidModeBadClock'),          $first_error);
  ok ($X->num('Error','XF86VidModeBadHTimings'),       $first_error+1);
  ok ($X->num('Error','XF86VidModeBadVTimings'),       $first_error+2);
  ok ($X->num('Error','XF86VidModeModeUnsuitable'),    $first_error+3);
  ok ($X->num('Error','XF86VidModeExtensionDisabled'), $first_error+4);
  ok ($X->num('Error','XF86VidModeClientNotLocal'),    $first_error+5);
  ok ($X->num('Error','XF86VidModeZoomLocked'),        $first_error+6);
  ok ($X->num('Error',$first_error),   $first_error);
  ok ($X->num('Error',$first_error+6), $first_error+6);
  ok ($X->interp('Error',$first_error),   'XF86VidModeBadClock');
  ok ($X->interp('Error',$first_error+1), 'XF86VidModeBadHTimings');
  ok ($X->interp('Error',$first_error+2), 'XF86VidModeBadVTimings');
  ok ($X->interp('Error',$first_error+3), 'XF86VidModeModeUnsuitable');
  ok ($X->interp('Error',$first_error+4), 'XF86VidModeExtensionDisabled');
  ok ($X->interp('Error',$first_error+5), 'XF86VidModeClientNotLocal');
  ok ($X->interp('Error',$first_error+6), 'XF86VidModeZoomLocked');

  {
    local $X->{'do_interp'} = 0;
    ok ($X->interp('Error',$first_error),   $first_error);
    ok ($X->interp('Error',$first_error+3), $first_error+3);
  }
}


#------------------------------------------------------------------------------
# XF86VidModeQueryVersion

{
  my @ret = $X->XF86VidModeQueryVersion;
  MyTestHelpers::diag ("server XFree86_VidModeExtension version ", join('.',@ret));
  ok (scalar(@ret), 2);
}
$X->QueryPointer($X->root); # sync


#------------------------------------------------------------------------------
# XF86VidModeGetModeLine

{
  my @ret = $X->XF86VidModeGetModeLine(0);
  MyTestHelpers::diag ("XF86VidModeGetModeLine ",
                       join(' ',@ret[0..$#ret-2])); # not "private" bytes
  ok ($ret[0],  'dotclock');
  ok ($ret[1] =~ /^\d+$/, 1);
  ok ($ret[-2], 'private');
}
$X->QueryPointer($X->root); # sync


# #------------------------------------------------------------------------------
# # XF86VidModeGetVideoLL
# #
# # Have seen an x.org server on solaris give flags=1 from
# # XF86VidModeQueryDirectVideo() but then error XF86VidModeNoDirectVideoMode from an
# # attempt at XF86VidModeGetVideoLL().  So watch for an error here, not just from
# # $direct_video_available.
# 
# {
#   my $error;
#   my $orig_error_handler = $X->{'error_handler'};
#   local $X->{'error_handler'} = sub {
#     my ($X, $data) = @_;
#     ### error handler
#     ### $data
# 
#     my ($type, $seq, $info, $minor_op, $major_op) = unpack 'xCSLSC', $data;
#     my $typename = $X->interp('Error',$type);
#     if ($typename =~ /^XF86VidMode/) {
#       MyTestHelpers::diag ("XF86VidModeGetVideoLL error $typename");
#       $error = $typename;
#       $direct_video_available = 0;
#       $skip_if_no_direct_video = 'error from XF86VidModeGetVideoLL';
#       die "longjmp out to eval";
#     } else {
#       goto $orig_error_handler;
#     }
#   };
# 
#   my @ret;
#   if ($direct_video_available) {
#     if (eval {
#       @ret = $X->XF86VidModeGetVideoLL(0);
#       1;
#     }) {
#       MyTestHelpers::diag ("XF86VidModeGetVideoLL ", join(', ',@ret));
#       MyTestHelpers::diag ("  in hex ", join(', ',map{sprintf '%X',$_}@ret));
#     }
#   }
#   my $skip_if_error = (defined $error
#                        ? 'due to XF86VidModeGetVideoLL error reply'
#                        : undef);
#   skip ($skip_if_error,
#         scalar(@ret), 4);
# }
# $X->QueryPointer($X->root); # sync
# 
# 
# #------------------------------------------------------------------------------
# # XF86VidModeGetViewPortSize
# 
# {
#   my @ret;
#   if ($direct_video_available) {
#     @ret = $X->XF86VidModeGetViewPortSize(0);
#     MyTestHelpers::diag ("XF86VidModeGetViewPortSize ", join(', ',@ret));
#   }
#   skip ($skip_if_no_direct_video,
#         scalar(@ret), 2);
# }
# $X->QueryPointer($X->root); # sync
# 
# 
# #------------------------------------------------------------------------------
# # XF86VidModeGetVidPage
# 
# {
#   my $page = '';
#   if ($direct_video_available) {
#     $page = $X->XF86VidModeGetVidPage(0);
#     MyTestHelpers::diag ("XF86VidModeGetVidPage ", $page);
#   }
#   skip ($skip_if_no_direct_video,
#         $page =~ /^\d+$/, 1);
# }
# $X->QueryPointer($X->root); # sync
# 
# 
# #------------------------------------------------------------------------------
# # XF86VidModeDirectVideo
# 
# my $enabled = 1;
# {
#   my $orig_error_handler = $X->{'error_handler'};
#   local $X->{'error_handler'} = sub {
#     my ($X, $data) = @_;
#     ### error handler
#     ### $data
# 
#     my ($type, $seq, $info, $minor_op, $major_op) = unpack 'xCSLSC', $data;
#     my $typename = $X->interp('Error',$type);
#     if ($typename =~ /^XF86VidMode/) {
#       MyTestHelpers::diag ("XF86VidModeDirectVideo error $typename");
#       $enabled = 0;
#     } else {
#       goto $orig_error_handler;
#     }
#   };
# 
#   MyTestHelpers::diag ("XF86VidModeDirectVideo attempt ...");
#   $X->XF86VidModeDirectVideo(0, 0x02);
#   $X->QueryPointer($X->root); # sync
#   MyTestHelpers::diag ("XF86VidModeDirectVideo done");
# }
# 
# my $skip_if_not_enabled;
# if ($enabled) {
#   MyTestHelpers::diag ('DirectVideo enabled');
# } else {
#   MyTestHelpers::diag ('DirectVideo not enabled');
#   $skip_if_not_enabled = 'skip due to DirectVideo not enabled';
# }
# 
# #------------------------------------------------------------------------------
# # XF86VidModeGetVidPage / XF86VidModeSetVidPage
# 
# {
#   my $old_page = $X->XF86VidModeGetVidPage(0);
#   my $new_page = 0;
#   my $got_page;
#   if ($enabled) {
#     $X->XF86VidModeSetVidPage (0, 0);
#     $got_page = $X->XF86VidModeGetVidPage(0);
#   }
#   skip ($skip_if_not_enabled,
#         $got_page, $new_page,
#         'XF86VidModeSetVidPage page');
# }
# $X->QueryPointer($X->root); # sync
# 
# #------------------------------------------------------------------------------
# # XF86VidModeSetViewPort
# 
# {
#   if ($enabled) {
#     $X->XF86VidModeSetViewPort(0, 0,0);
#     $X->QueryPointer($X->root); # sync
#   }
#   skip ($skip_if_not_enabled,
#         1,1, 'XF86VidModeInstallColormap');
# }
# 
# #------------------------------------------------------------------------------
# # XF86VidModeInstallColormap
# 
# {
#   my $colormap = $X->default_colormap;
#   if ($enabled) {
#     $X->XF86VidModeInstallColormap(0, $colormap);
#   }
#   skip ($skip_if_not_enabled,
#         1,1, 'XF86VidModeInstallColormap');
# }
# $X->QueryPointer($X->root); # sync
# 
# 
# #------------------------------------------------------------------------------
# # XF86VidModeViewPortChanged
# 
# {
#   my $bool = 'x';
#   if ($enabled) {
#     $bool = $X->XF86VidModeViewPortChanged(0);
#     MyTestHelpers::diag ("XF86VidModeViewPortChanged ", $bool);
#   }
#   skip ($skip_if_not_enabled,
#         $bool =~ /^\d+$/, 1,
#         'XF86VidModeViewPortChanged return');
# }
# $X->QueryPointer($X->root); # sync

#------------------------------------------------------------------------------

exit 0;