view release on metacpan or  search on metacpan

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

#! perl

use v5.26;
use Object::Pad;
use utf8;
class SVGPDF::Element;

use Carp;

field $xo       :mutator;
field $style    :accessor;
field $name     :param :accessor;
field $atts     :param :accessor;
field $css      :accessor;
field $content  :param :accessor;	# array of children
field $root     :param :accessor;	# top module

BUILD {
    $css  = $root->css;
    $xo   = $root->xoforms->[-1]->{xo};
};

method _dbg (@args) {
    $root->_dbg(@args);
}

method css_push ( $updated_atts = undef ) {
    $style = $css->push( element => $name, %{$updated_atts // $atts} );
}

method css_pop () {
    $css->pop;
}

method set_transform ( $tf ) {
    return unless $tf;

    my $nooptimize = 1;
    $tf =~ s/\s+/ /g;

    # The parts of the transform need to be executed in order.
    while ( $tf =~ /\S/ ) {
	if ( $tf =~ /^\s*translate\s*\((.*?)\)(.*)/ ) {
	    $tf = $2;
	    my ( $x, $y ) = $self->getargs($1);
	    $y ||= 0;
	    if ( $nooptimize || $x || $y ) {
		$xo->transform( translate => [ $x, $y ] );
		$self->_dbg( "transform translate(%.2f,%.2f)", $x, $y );
	    }
	}
	elsif ( $tf =~ /^\s*rotate\s*\((.*?)\)(.*)/ ) {
	    $tf = $2;
	    my ( $r, $x, $y ) = $self->getargs($1);
	    if ( $nooptimize || $r ) {
		if ( $x || $y ) {
		    $xo->transform( translate => [ $x, $y ] );
		    $self->_dbg( "transform translate(%.2f,%.2f)", $x, $y );
		}
		$self->_dbg( "transform rotate(%.2f)", $r );
		$xo->transform( rotate => $r );
		if ( $x || $y ) {
		    $xo->transform( translate => [ -$x, -$y ] );
		    $self->_dbg( "transform translate(%.2f,%.2f)", -$x, -$y );
		}
	    }
	}
	elsif ( $tf =~ /^\s*scale\s*\((.*?)\)(.*)/ ) {
	    $tf = $2;
	    my ( $x, $y ) = $self->getargs($1);
	    $y ||= $x;
	    if ( $nooptimize || $x != 1 && $y != 1 ) {
		$self->_dbg( "transform scale(%.2f,%.2f)", $x, $y );
		$xo->transform( scale => [ $x, $y ] );
	    }
	}
	elsif ( $tf =~ /^\s*matrix\s*\((.*?)\)(.*)/ ) {
	    $tf = $2;
	    my ( @m ) = $self->getargs($1);

	    #  1  0  0  1  dx dy    translate
	    #  sx 0  0  sy 0  0     scale
	    #  c  s  -s c  0  0     rotate (s = sin, c = cos)
	    #  1  a  b  1  0  0     skew (a = tan a, b = tan b)

	    $self->_dbg( "transform matrix(%.2f,%.2f %.2f,%.2f %.2f,%.2f)", @m);
	    $xo->matrix(@m);
	}

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

	my $w = $args{width} || $self->root->xoforms->[-1]->{diag};
	return $1/100 * $w * $pxpt;
    }
    # Font dependent.
    # CSS defines em to be the font size.
    if ( $2 eq "em" ) {
	return $1 * ( $args{fontsize}
		      || $style->{'font-size'}
		      || $self->root->fontsize );
    }
    # CSS defines ex to be half the font size.
    if ( $2 eq "ex" ) {
	return $1 * 0.5 * ( $args{fontsize}
			    || $style->{'font-size'}
			    || $self->root->fontsize );
    }

    confess("Unhandled units in \"$a\"");
    return $a;			# will hopefully crash somewhere...
}

method getargs ( $a ) {
    confess("Null attr?") unless defined $a;
    $a =~ s/^\s+//;
    $a =~ s/\s+$//;
    map { $self->u($_) } split( /\s*[,\s]\s*/, $a );
}

# Initial fiddling with entity attributes.
method get_params ( @desc ) {
    my $atts = shift(@desc) if ref($desc[0]) eq 'HASH';
    my @res;
    my %atts = %{ $atts // $self->atts }; # copy

    # xlink:href is obsoleted in favour of href.
    $atts{href} //= delete $atts{"xlink:href"} if exists $atts{"xlink:href"};

    my @todo;
    for my $param ( @desc ) {

	# Attribute may be followed by ':' and flags.
	# 0   undef -> 0
	# h   process units, % is viewBox height
	# s   undef -> ""
	# u   process units
	# v   process units, % is viewBox width
	# U   undef -> 0, process units
	# !   barf if undef
	my $flags = "";
	( $param, $flags ) = ( $1, $2 )
	  if $param =~ /^(.*):(.*)$/;
	$param = lc($param);

	# Get and remove the attribute.
	my $p = delete( $atts{$param} );

	# Queue.
	push( @todo, [ $param, $flags, $p ] );
    }

    # CSS push with updated attributes.
    $self->css_push( \%atts );

    # Now we can process the values.
    for ( @todo ) {
	my ( $param, $flags, $p ) = @$_;

	unless ( defined $p ) {
	    if    ( $flags =~ /s/ )    { $p = ""; }
	    elsif ( $flags =~ /[0HUV]/ ) { $p = 0;  }
	    else {
		croak("Undefined mandatory attribute: $param")
		  if $flags =~ /\!/;
		push( @res, $p );
		next;
	    }
	}

	$flags = lc($flags);
	# Convert units if 'u' flag.
	if ( $flags =~ /([huv])/ ) {
	    my $flag = $1;
	    if ( $p =~ /^([\d.]+)\%$/ ) {
		$p = $1/100;
		if ( $flags eq "w" || $param =~ /^(?:w(?:idth)|x)?$/i ) {
		    # Percentage of viewBox width.
		    $p *= $root->xoforms->[-1]->{width};
		}
		elsif ( $flag eq "h" || $param =~ /^(?:h(?:eight)?|y)$/i ) {
		    # Percentage of viewBox height.
		    $p *= $root->xoforms->[-1]->{height};
		}
		else {
		    # Percentage of viewBox diagonal.
		    $p *= $root->xoforms->[-1]->{diag};
		}
	    }
	    else {
		$p = $self->u($p);
	    }
	}

	push( @res, $p );
    }

    # Return param values.
    return @res;
}

method get_cdata () {
    my $res = "";
    for ( $self->get_children ) {
	$res .= "\n" . $_->content if ref($_) eq "SVGPDF::TextElement";
    }
    $res;
}

method nfi ( $tag ) {
    state $aw = {};
    warn("SVG: $tag - not fully implemented, expect strange results.\n")
      unless !$self->root->verbose || $aw->{$tag}++;