| 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 | } |