The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Identity;
use Test::Refcount;

use Tickit::Pen;

# Immutable pens
{
   my $pen = Tickit::Pen::Immutable->new( fg => 3 );

   isa_ok( $pen, "Tickit::Pen", '$pen isa Tickit::Pen' );

   is( "$pen", "Tickit::Pen::Immutable{fg=3}", '"$pen"' );

   is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs' );

   ok( $pen->hasattr( 'fg' ), '$pen has fg' );
   is( $pen->getattr( 'fg' ), 3, '$pen fg' );

   ok( !$pen->hasattr( 'bg' ), '$pen has no bg' );
   is( $pen->getattr( 'bg' ), undef, '$pen bg undef' );

   ok( $pen->equiv( $pen ), '$pen is equiv to itself' );
   ok( $pen->equiv( Tickit::Pen::Immutable->new( fg => 3 ) ), '$pen is equiv to another one the same' );

   my $pen2 = Tickit::Pen::Immutable->new( fg => 3, b => 1 );

   ok( $pen->equiv_attr( $pen2, 'fg' ), '$pen has equiv_attr fg another' );
   ok( !$pen->equiv( $pen2 ), '$pen is not equiv to a different one' );
}

# Mutable pens
{
   my $warnings = "";
   local $SIG{__WARN__} = sub { $warnings .= join " ", @_ };

   my $pen = Tickit::Pen::Mutable->new;

   is( "$pen", "Tickit::Pen::Mutable{}", '"$pen" empty' );

   is_deeply( { $pen->getattrs }, {}, '$pen initial attrs' );
   ok( !$pen->hasattr( 'fg' ), '$pen initially lacks fg' );
   is( $pen->getattr( 'fg' ), undef, '$pen fg initially undef' );

   $pen->chattr( fg => 3 );

   is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs after chattr' );
   ok( $pen->hasattr( 'fg' ), '$pen now has fg' );
   is( $pen->getattr( 'fg' ), 3, '$pen fg after chattr' );

   is( "$pen", "Tickit::Pen::Mutable{fg=3}", '"$pen" after chattr' );

   is_deeply( { $pen->as_mutable->getattrs }, { $pen->getattrs }, '$pen->as_mutable attrs' );

   $pen->chattr( fg => "blue" );

   is_deeply( { $pen->getattrs }, { fg => 4 }, '$pen attrs fg named' );
   is( $pen->getattr( 'fg' ), 4, '$pen fg named' );

   $pen->chattr( fg => "hi-blue" );

   is_deeply( { $pen->getattrs }, { fg => 12 }, '$pen attrs fg named high-intensity' );
   is( $pen->getattr( 'fg' ), 12, '$pen fg named high-intensity' );

   $pen->delattr( 'fg' );

   is_deeply( { $pen->getattrs }, {}, '$pen attrs after delattr' );
   is( $pen->getattr( 'fg' ), undef, '$pen fg after delattr' );

   my %attrs = ( b => 1, na => 5 );

   $pen->chattrs( \%attrs );

   is_deeply( { $pen->getattrs }, { b => 1 }, '$pen attrs after chattrs' );
   is_deeply( \%attrs, { na => 5 }, '%attrs after chattrs' );

   $pen->chattr( fg => "red" );
}

my $bluepen  = Tickit::Pen::Immutable->new( fg => 4 );
my $otherpen = Tickit::Pen::Immutable->new( fg => 1, bg => 2 );

{
   my $copy = $bluepen->as_mutable;

   is_deeply( { $copy->copy_from( $otherpen )->getattrs },
              { fg => 1, bg => 2 },
              'pen ->copy_from overwrites attributes' );
}

{
   my $copy = $bluepen->as_mutable;

   is_deeply( { $copy->default_from( $otherpen )->getattrs },
              { fg => 4, bg => 2 },
              'pen ->default_from does not overwrite attributes' );
}

my $norv_pen = Tickit::Pen->new( rv => 0 );
$norv_pen->default_from( Tickit::Pen->new( rv => 1 ) );
is_deeply( { $norv_pen->getattrs },
           { rv => '' },
           'pen ->default_from does not overwrite defined-but-false attributes' );

# RGB8 in pens
{
   my $pen = Tickit::Pen->new(
      fg => 15,
      "fg:rgb8" => "#f0f0f0",
   );

   ok( $pen->hasattr( "fg:rgb8" ), '$pen has fg:rgb8' );
   is( $pen->getattr( "fg:rgb8" ), "#F0F0F0", '$pen fg:rgb8 attr value' );

   $pen->chattr( "fg:rgb8" => "#F1F2F3" );
   is( $pen->getattr( "fg:rgb8" ), "#F1F2F3", '$pen fg:rgb8 attr new value' );

   is_deeply( { $pen->getattrs },
              { fg => 15, "fg:rgb8" => "#F1F2F3" },
              '$pen->getattrs' );

   $pen->chattr( "fg:rgb8" => undef );
   ok( !$pen->hasattr( "fg:rgb8" ), '$pen has no fg:rgb8' );
}

done_testing;