]>
Commit | Line | Data |
---|---|---|
1f72b051 MG |
1 | #!/usr/bin/perl |
2 | use 5.014000; | |
3 | use warnings; | |
4 | ||
5 | use Convert::Color::RGB8; | |
6 | use JSON::PP qw/decode_json/; | |
7 | use Test::More; | |
8 | ||
9 | use constant EPSILON => 1e-4; # 1e-11 is OK on amd64 | |
10 | ||
11 | open my $fh, '<', 't/snapshot-rev3.json'; | |
12 | my $snapshot = join '', <$fh>; | |
13 | close $fh; | |
14 | ||
15 | my %tests = %{decode_json $snapshot}; | |
16 | my @colors = sort keys %tests; | |
17 | ||
18 | plan tests => 5 * @colors; | |
19 | ||
20 | sub isf { | |
21 | my ($x, $y, $name) = @_; | |
22 | my $ok = 1; | |
23 | $ok &&= abs ($x->[$_] - $y->[$_]) < EPSILON for 0, 1, 2; | |
24 | return pass $name if $ok; | |
25 | local $" = ', '; | |
26 | fail $name; | |
27 | diag "[@$x] != [@$y]"; | |
28 | } | |
29 | ||
30 | for my $color (@colors) { | |
31 | my %color = %{$tests{$color}}; | |
32 | my $col = Convert::Color::RGB8->new(substr $color, 1); | |
33 | isf $col->convert_to('xyz'), $color{xyz}, "convert $color to XYZ"; | |
34 | isf $col->convert_to('luv'), $color{luv}, "convert $color to LUV"; | |
35 | isf $col->convert_to('lch'), $color{lch}, "convert $color to LCh"; | |
36 | isf $col->convert_to('husl'), $color{husl}, "convert $color to HUSL"; | |
37 | isf $col->convert_to('huslp'), $color{huslp}, "convert $color to HUSLp"; | |
38 | } |