#!/usr/bin/env perl

use strict;
use warnings;
use Test::More;
use X11::Xlib ':all';
sub err(&) { my $code= shift; my $ret; { local $@= ''; eval { $code->() }; $ret= $@; } $ret }

plan skip_all => "No X11 Server available"
    unless $ENV{DISPLAY};
plan tests => 8;

my $TEST_DESTRUTIVE= !!$ENV{TEST_DESTRUTIVE};
sub skip_destructive($) {
    skip "TEST_DESTRUTIVE is false; skipping destrutive tests", shift
        unless $TEST_DESTRUTIVE;
}

my $dpy= new_ok( 'X11::Xlib', [], 'connect to X11' );

my ($min, $max);
XDisplayKeycodes($dpy, $min, $max);
ok( $min > 0 && $min <= $max,    'Got Min Keycode' );
ok( $max >= $min && $max <= 255, 'Got Max Keycode' );

sub save_temp {
    my ($name, $data)= @_;
    my $fname= sprintf("%s-%d.txt", $name, time);
    open my $fh, ">", $fname or die "open: $!";
    print $fh $data;
    close $fh;
    diag "Saved diagnostics to $fname";
}

subtest keysym_mapping => sub {
    # These values should never change.  Just make sure character
    # and non-character values work.  On my Xlib, unicode values often
    # become the text "Uxxxx" but sometimes have a symbolic name, so
    # probably bad to depend on the list of unicode symbolic names.
    is( XKeysymToString(0xFF09), "Tab", 'XKeysymToString Tab' );
    is( XKeysymToString(0xFFBE), "F1",  'XKeysymToString F1' );
    is( XStringToKeysym("Tab"), 0xFF09, 'XStringToKeysym Tab' );
    is( XStringToKeysym("F1"),  0xFFBE, 'XStringToKeysym F1' );
    
    for (
        [ 0x000FF09 => 0x000009, 'Tab' ],
        [ 0x000FF1B => 0x00001B, 'Esc' ],
        [ 0x000FF8D => 0x00000D, 'KP_Enter' ],
        [ 0x000FFE1 => undef,    'Shift_L' ],
        [ 0x0000034 => 0x000034, '4' ],
        [ 0x000004D => 0x00004D, 'M' ],
        [ 0x00002C6 => 0x000108, 'Ccircumflex' ],
        [ 0x00004B6 => 0x0030AB, 'Katakana KA' ],
        [ 0x10030AB => 0x0030AB, 'Katakana KA (direct Ucode mapping)' ],
        [ 0x0000000 => undef,    'Invalid KeySym' ],
    ) {
        my ($keysym, $codepoint, $desc)= @$_;
        if (defined $keysym) {
            is( keysym_to_codepoint($keysym), $codepoint, "keysym_to_codepoint: $desc" );
            is( keysym_to_char($keysym), $codepoint? chr($codepoint) : undef, "keysym_to_char: $desc" );
        }
        if (defined $codepoint and $desc !~ /^KP_/) {
            my $sym= $codepoint < 0x20 || $codepoint > 0xFF? 0x1000000 | $codepoint
                : $codepoint;
            is( codepoint_to_keysym($codepoint), $sym, "codepoint_to_keysym: $desc" );
            is( char_to_keysym(chr($codepoint)), $sym, "char_to_keysym: $desc" );
        }
    }
    is( codepoint_to_keysym(-1), undef, 'Invalid unicode codepoint' );
    is( char_to_keysym(''),      undef, 'Char of empty string' );
    done_testing;
};

subtest modmap => sub {
    my $modmap;
    is( err{ $modmap= $dpy->XGetModifierMapping() }, '', 'XGetModifierMapping' )
     && is( ref $modmap, 'ARRAY', '...is an array' )
     && is( join('', map ref, @$modmap), 'ARRAY'x 8, '...of arrays' )
     or diag(explain $modmap), die "XGetModifierMapping failed.  Not continuing";
    
    SKIP: {
        skip_destructive 2;
        # Seems like a bad idea, but need to test....
        is( err{ $dpy->XSetModifierMapping($modmap) }, '', 'XSetModifierMapping' );

        # Make sure we didn't change it
        my $modmap2= $dpy->XGetModifierMapping();
        is_deeply( $modmap2, $modmap, 'same as last time' )
            or BAIL_OUT "SORRY! We changed your X11 key modifiers!";
    }
    done_testing;
};

subtest keymap => sub {
    my @keysyms;
    is( err{ @keysyms= XGetKeyboardMapping($dpy, $min) }, '', 'XGetKeyboardMapping' );
    ok( @keysyms > 0, "Got keysyms for $min" );
    
    my $mapping;
    is( err{ $mapping= $dpy->load_keymap }, '', 'load_keymap' );
    ok( ref($mapping) eq 'ARRAY' && @$mapping > 0 && ref($mapping->[-1]) eq 'ARRAY', '...is array of arrays' )
        or save_temp("keymap-before", explain $mapping);
    
    SKIP: {
        skip_destructive 2;
        # Fingers crossed!
        is( err{ $dpy->save_keymap($mapping) }, '', 'save_keymap' )
            or save_temp("keymap-before", explain $mapping);
        
        # Make sure we didn't change it
        my $kmap2= $dpy->load_keymap;
        is_deeply( $mapping, $kmap2, 'same as before' )
            or do { save_temp("keymap-before", explain $mapping); save_temp("keymap-after", explain $kmap2); BAIL_OUT "Sorry! We dammaged your keymap.  You might need to log out to fix it"; };
    }    
    done_testing;
};

subtest keymap_wrapper => sub {
    # TODO: this is sloppy and doesn't prove much
    ok( my $keymap= $dpy->keymap );
    is( err{ $keymap->keymap_reload }, '', 'keymap_reload' );
    SKIP: {
        skip_destructive 1;
        is( err{ $keymap->keymap_save   }, '', 'keymap_save' );
    }
    is( err{ $keymap->modmap_sym_list('shift') }, '', 'modmap_sym_list' );
    SKIP: {
        skip_destructive 1;
        is( err{ $keymap->modmap_save   }, '', 'modmap_save' );
    }
    is( err{ $keymap->modmap_add_syms(control => 'Control_L') }, '', 'modmap_add_syms' );
    is( err{ $keymap->modmap_del_syms(control => 'Control_L') }, '', 'modmap_del_syms' );
    done_testing;
};

subtest xlib_lookup => sub {
    # Pick some key from the modmap.  Probably every keyboard has at least shift or control?
    ok( my $keycode= $dpy->XKeysymToKeycode(XStringToKeysym('A')), 'XKeysymToKeycode' );
    my $key_event= { type => KeyPress, keycode => $keycode, display => $dpy };
    my ($name, $keysym);
    is( err{ XLookupString($key_event, $name, $keysym) }, '', 'XLookupString' );
    like( $name, qr/\w/, 'XLookupString returned a name' );
    ok( $keysym > 0, 'XLookupString returned a keysym' );
    
    done_testing;
};