view release on metacpan or  search on metacpan

Prima/Drawable/Path.pm  view on Meta::CPAN

	my $self = shift;
	my $p = $#_ ? [@_] : $_[0];
	@$p % 2 and Carp::croak('bad parameters to rline');
	$self->rcmd( line => $p);
}

sub spline
{
	my ($self, $p, %opt) = @_;
	(@$p % 2 || @$p < 6) and Carp::croak('bad parameters to spline');
	$self-> cmd( spline => $p, \%opt );
}

sub rspline
{
	my ($self, $p, %opt) = @_;
	(@$p % 2 || @$p < 6) and Carp::croak('bad parameters to spline');
	$self-> rcmd( spline => $p, \%opt );
}

sub glyph
{
	my ($self, $ix, %opt) = @_;
	return unless $self->{canvas};
	my $outline = $self->{canvas}->render_glyph( $ix, %opt );
	return unless $outline;
	my $size = scalar(@$outline);
	my @p;
	my $fill = delete $opt{fill};
	for ( my $i = 0; $i < $size; ) {
		my $cmd = $outline->[$i++];
		my $pts = $outline->[$i++] * 2;
		my @pts = map { $outline->[$i++] / 64.0 } 0 .. $pts - 1;
		if ( $cmd == ggo::Move ) {
			$self->close unless $fill;
			$self->moveto(@pts);
		} elsif ( $cmd == ggo::Line ) {
			$self->line([ @p, @pts ]);
		} elsif ( $cmd == ggo::Conic ) {
			$self->spline([ @p, @pts ]);
		} elsif ( $cmd == ggo::Cubic ) {
			$self->spline([ @p, @pts ], degree => 3 );
		}
		@p = @pts[-2,-1];
	}
	$self->close;
}

sub text
{
	my ($self, $text, %opt) = @_;
	return unless my $c = $self->{canvas};
	my $state = $c->get_paint_state;
	unless ($state) {
		return unless $c->begin_paint_info;
	}

	$self->translate( 0, $c->font->descent )
		unless $opt{baseline} // $c->textOutBaseline;
	my $cache   = $opt{cache} || {};
	my $unicode = utf8::is_utf8($text);
	for my $char ( split //, $text ) {
		my $ix = ord($char);
		$self->glyph($ix, %opt, unicode => $unicode);
		my $r = $cache->{$char} //= do {
			my $p = $c->get_font_abc($ix,$ix,$unicode);
			$p->[0] + $p->[1] + $p->[2]
		};
		$self->translate($r,0);
	}

	$c->end_paint_info unless $state;
}

sub circular_arc
{
	my $self = shift;
	2 == @_ or Carp::croak('bad parameters to circular_arc');
	$self-> cmd( arc => @_, 0 );
}

sub arc
{
	my $self = shift;
	@_ > 5 or Carp::croak('bad parameters to arc');
	my ( $cx, $cy, $dx, $dy, $from, $to, $tilt) = @_;
	return $self if $from == $to;
	if ( $tilt // 0.0 ) {
		return $self-> save->
			scale( $dx / 2, $dy / 2)->
			rotate( $tilt)->
			translate( $cx, $cy )->
			circular_arc( $from, $to )->
			restore;
	} else {
		return $self-> save->
			matrix( $dx / 2, 0, 0, $dy / 2, $cx, $cy )->
			circular_arc( $from, $to )->
			restore;
	}
}

sub rarc
{
	my $self = shift;
	@_ > 3 or Carp::croak('bad parameters to arcto');
	my ( $dx, $dy, $from, $to, $tilt) = @_;
	return $self if $from == $to;
	$self->save;
	$self->scale( $dx / 2, $dy / 2);
	$self->rotate( $tilt // 0.0);
	$self->cmd( arc => $from, $to, 1 );
	$self->restore;
}

sub ellipse
{
	my $self = shift;
	@_ > 2 or Carp::croak('bad parameters to ellipse');
	my ( $cx, $cy, $dx, $dy, $tilt) = @_;
	$dy //= $dx;