1#!/usr/bin/perl
2
3use v5.14;
4use warnings;
5
6use Test::More;
7use Test::Refcount;
8
9use Tickit::Pen;
10
11# Immutable pens
12{
13   my $pen = Tickit::Pen::Immutable->new( fg => 3 );
14
15   isa_ok( $pen, "Tickit::Pen", '$pen isa Tickit::Pen' );
16
17   is( "$pen", "Tickit::Pen::Immutable{fg=3}", '"$pen"' );
18
19   is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs' );
20
21   ok( $pen->hasattr( 'fg' ), '$pen has fg' );
22   is( $pen->getattr( 'fg' ), 3, '$pen fg' );
23
24   ok( !$pen->hasattr( 'bg' ), '$pen has no bg' );
25   is( $pen->getattr( 'bg' ), undef, '$pen bg undef' );
26
27   ok( $pen->equiv( $pen ), '$pen is equiv to itself' );
28   ok( $pen->equiv( Tickit::Pen::Immutable->new( fg => 3 ) ), '$pen is equiv to another one the same' );
29
30   my $pen2 = Tickit::Pen::Immutable->new( fg => 3, b => 1 );
31
32   ok( $pen->equiv_attr( $pen2, 'fg' ), '$pen has equiv_attr fg another' );
33   ok( !$pen->equiv( $pen2 ), '$pen is not equiv to a different one' );
34}
35
36# Mutable pens
37{
38   my $warnings = "";
39   local $SIG{__WARN__} = sub { $warnings .= join " ", @_ };
40
41   my $pen = Tickit::Pen::Mutable->new;
42
43   is( "$pen", "Tickit::Pen::Mutable{}", '"$pen" empty' );
44
45   is_deeply( { $pen->getattrs }, {}, '$pen initial attrs' );
46   ok( !$pen->hasattr( 'fg' ), '$pen initially lacks fg' );
47   is( $pen->getattr( 'fg' ), undef, '$pen fg initially undef' );
48
49   $pen->chattr( fg => 3 );
50
51   is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs after chattr' );
52   ok( $pen->hasattr( 'fg' ), '$pen now has fg' );
53   is( $pen->getattr( 'fg' ), 3, '$pen fg after chattr' );
54
55   is( "$pen", "Tickit::Pen::Mutable{fg=3}", '"$pen" after chattr' );
56
57   is_deeply( { $pen->as_mutable->getattrs }, { $pen->getattrs }, '$pen->as_mutable attrs' );
58
59   $pen->chattr( fg => "blue" );
60
61   is_deeply( { $pen->getattrs }, { fg => 4 }, '$pen attrs fg named' );
62   is( $pen->getattr( 'fg' ), 4, '$pen fg named' );
63
64   $pen->chattr( fg => "hi-blue" );
65
66   is_deeply( { $pen->getattrs }, { fg => 12 }, '$pen attrs fg named high-intensity' );
67   is( $pen->getattr( 'fg' ), 12, '$pen fg named high-intensity' );
68
69   $pen->delattr( 'fg' );
70
71   is_deeply( { $pen->getattrs }, {}, '$pen attrs after delattr' );
72   is( $pen->getattr( 'fg' ), undef, '$pen fg after delattr' );
73
74   my %attrs = ( b => 1, na => 5 );
75
76   $pen->chattrs( \%attrs );
77
78   is_deeply( { $pen->getattrs }, { b => 1 }, '$pen attrs after chattrs' );
79   is_deeply( \%attrs, { na => 5 }, '%attrs after chattrs' );
80
81   $pen->chattr( fg => "red" );
82}
83
84my $bluepen  = Tickit::Pen::Immutable->new( fg => 4 );
85my $otherpen = Tickit::Pen::Immutable->new( fg => 1, bg => 2 );
86
87{
88   my $copy = $bluepen->as_mutable;
89
90   is_deeply( { $copy->copy_from( $otherpen )->getattrs },
91              { fg => 1, bg => 2 },
92              'pen ->copy_from overwrites attributes' );
93}
94
95{
96   my $copy = $bluepen->as_mutable;
97
98   is_deeply( { $copy->default_from( $otherpen )->getattrs },
99              { fg => 4, bg => 2 },
100              'pen ->default_from does not overwrite attributes' );
101}
102
103my $norv_pen = Tickit::Pen->new( rv => 0 );
104$norv_pen->default_from( Tickit::Pen->new( rv => 1 ) );
105is_deeply( { $norv_pen->getattrs },
106           { rv => '' },
107           'pen ->default_from does not overwrite defined-but-false attributes' );
108
109# RGB8 in pens
110{
111   my $pen = Tickit::Pen->new(
112      fg => 15,
113      "fg:rgb8" => "#f0f0f0",
114   );
115
116   ok( $pen->hasattr( "fg:rgb8" ), '$pen has fg:rgb8' );
117   is( $pen->getattr( "fg:rgb8" ), "#F0F0F0", '$pen fg:rgb8 attr value' );
118
119   $pen->chattr( "fg:rgb8" => "#F1F2F3" );
120   is( $pen->getattr( "fg:rgb8" ), "#F1F2F3", '$pen fg:rgb8 attr new value' );
121
122   is_deeply( { $pen->getattrs },
123              { fg => 15, "fg:rgb8" => "#F1F2F3" },
124              '$pen->getattrs' );
125
126   $pen->chattr( "fg:rgb8" => undef );
127   ok( !$pen->hasattr( "fg:rgb8" ), '$pen has no fg:rgb8' );
128}
129
130done_testing;
131