view release on metacpan or  search on metacpan

lib/ChordPro/lib/SVGPDF/Element.pm  view on Meta::CPAN

	if    ( $linejoin eq "round" ) { $linejoin = 1 }
	elsif ( $linejoin eq "r"     ) { $linejoin = 1 }
	elsif ( $linejoin eq "bevel" ) { $linejoin = 2 }
	elsif ( $linejoin eq "b"     ) { $linejoin = 2 }
	else                           { $linejoin = 0 } # m miter
	$msg .= " linejoin=$linejoin";
	$xo->line_join($linejoin);
    }

    my $color = $style->{color};
    my $stroke = $style->{stroke};
    if ( lc($stroke) eq "currentcolor" ) {
	# Nothing. Use current.
	$msg .= " stroke=(current)";
	$stroke = $color;
    }
    if ( $stroke ne "none" ) {
	$stroke = SVGPDF::Colour->new( colour => $stroke )->rgb;
	$xo->stroke_color($stroke);
	$msg .= " stroke=$stroke";
    }
    else {
	$msg .= " stroke=none";
    }

    my $fill = $style->{fill};
    if ( lc($fill) eq "currentcolor" ) {
	# Nothing. Use current.
	$msg .= " fill=(current)";
	$fill = $color;
    }
    if ( lc($fill) ne "none" && $fill ne "transparent" ) {
	$fill = SVGPDF::Colour->new( colour => $fill )->rgb;
	$xo->fill_color($fill);
	$msg .= " fill=$fill";
    }
    else {
	$msg .= " fill=none";
    }

    if ( my $sda = $style->{'stroke-dasharray'}  ) {
	my @sda;
	if ( $sda && $sda ne "none" ) {
	    $sda =~ s/,/ /g;
	    @sda = split( ' ', $sda );
	}
	$msg .= " sda=@sda";
	$xo->line_dash_pattern(@sda);
    }

    $self->_dbg( "%s", $msg );
    return $style;
}

# Return a stroke/fill/paint sub depending on the fill stroke styles.
method _paintsub () {
    if ( $style->{stroke}
	 && $style->{stroke} ne 'none'
	 && $style->{stroke} ne 'transparent'
	 # Hmm. Saw a note somewhere that it defaults to 0 but other notes
	 # say that it should be 1px...
	 && $style->{'stroke-width'}//1 != 0
       ) {
	if ( $style->{fill}
	     && $style->{fill} ne 'none'
	     && $style->{fill} ne 'transparent'
	   ) {
	    return sub {
		$self->_dbg("xo paint (",
			    join(" ", $style->{stroke}, $style->{fill} ), ")");
		$xo->paint;
	    };
	}
	else {
	    return sub {
		$self->_dbg("xo stroke (", $style->{stroke}, ")");
		$xo->stroke;
	    };
	}
    }
    elsif ( $style->{fill}
	    && $style->{fill} ne 'none'
	    && $style->{fill} ne 'transparent'
	  ) {
	return sub {
	    $self->_dbg("xo fill (", $style->{stroke}, ")");
	    $xo->fill;
	};
    }
    else {
	return sub {
	    $self->_dbg("xo end");
	    $xo->end;
	}
    }
}

method process () {
    # Unless overridden in a subclass there's not much we can do.
    state $warned = { desc => 1, title => 1, metadata => 1 };
    warn("SVG: Skipping element \"$name\" (not implemented)\n")
      unless $warned->{$name}++ || !$self->root->verbose;
    $self->_dbg("skipping $name (not implemented)");
    # $self->traverse;
}

method get_children () {

    # Note: This is the only place where these objects are created.

    my @res;
    for my $e ( @{$self->content} ) {
	if ( $e->{type} eq 'e' ) {
	    my $pkg = "SVGPDF::" . ucfirst(lc $e->{name});
	    $pkg = "SVGPDF::Element" unless $pkg->can("process");
	    push( @res, $pkg->new
		  ( name    => $e->{name},
		    atts    => { map { lc($_) => $e->{attrib}->{$_} } keys %{$e->{attrib}} },
		    content => $e->{content},
		    root    => $self->root,
		  ) );