view release on metacpan or  search on metacpan

lib/Chart/GGPlot/Theme/ElementTree.pm  view on Meta::CPAN

package Chart::GGPlot::Theme::ElementTree;

# ABSTRACT: Definitions of theme elements

use Chart::GGPlot::Setup;
use Function::Parameters qw(classmethod);
use namespace::autoclean;

our $VERSION = '0.002003'; # VERSION

use parent qw(Chart::GGPlot::Params);

use Types::Standard qw(Any ArrayRef Enum HashRef InstanceOf Num Str);

use Chart::GGPlot::Theme::Defaults qw(theme_grey);
use Chart::GGPlot::Theme::Element::Functions qw(:all);
use Chart::GGPlot::Theme::ElementTree;

# Overrides Chart::GGPlot::Params behavior to support both "foo.bar" and
# "foo_bar" as element name.
classmethod transform_key ($key) {
    return ( $key =~ s/\./_/gr );
}


classmethod el_def ( $type, $inherit = [], $desc = '' ) {
    $inherit = Ref::Util::is_arrayref($inherit) ? $inherit : [ $inherit // () ];
    return {
        type        => $type,
        inherit     => $inherit,
        description => $desc,
    };
}


classmethod default_element_tree () {
    my $ElementLine = InstanceOf ["Chart::GGPlot::Theme::Element::Line"];
    my $ElementRect = InstanceOf ["Chart::GGPlot::Theme::Element::Rect"];
    my $ElementText = InstanceOf ["Chart::GGPlot::Theme::Element::Text"];

    #my $Margin      = InstanceOf ["Chart::GGPlot::Margin"];

    my $Character =
      ( ArrayRef [ ( Str | Num ) ] )->plus_coercions( Any, sub { [ $_, $_ ] } );

    my $TagPosition = (
        (
            Enum [
                qw(
                  topleft top topright
                  left right bottomleft
                  bottom bottomright
                  )
            ]
        ) | ( ArrayRef [Num] )->where( sub { @$_ == 2 } )
    )->plus_coercions(
        Str,
        sub {
            state $mapping;
            unless ($mapping) {
                $mapping = {};
                my @setup = (
                    [qw(bottom left)],  [qw(top left)],
                    [qw(bottom right)], [qw(top right)],
                );
                for my $item (@setup) {
                    my ( $a, $b ) = @$item;
                    my $just = "$a$b";
                    $mapping->{"$b$a"} =
                      $mapping->{"${a}_$b"} = $mapping->{"${b}_$a"} = $just;
                }
            }
            return ( $mapping->{$_} // $_ );
        }
    );

    # this is just to have something shorter than $class->el_def
    my $el_def = sub { $class->el_def(@_); };

    return $class->new(
        line       => &$el_def($ElementLine),
        rect       => &$el_def($ElementRect),
        text       => &$el_def($ElementText),
        title      => &$el_def( $ElementText, "text" ),
        axis_line  => &$el_def( $ElementLine, "line" ),
        axis_text  => &$el_def( $ElementText, "text" ),
        axis_title => &$el_def( $ElementText, "title" ),