view release on metacpan or  search on metacpan

Prima/PodView.pm  view on Meta::CPAN

	$self-> {manpath} = $path;
	$self-> {source_file} = $manpage;
	$self-> open_read(%opt);
	$self-> read($_) while <$f>;
	close $f;

	$self-> pageName( $pageName);
	my $ret = $self-> close_read( $self-> {topicView});

	$self-> pointer( cr::Default);

	unless ( $ret) {
		$_ = <<ERROR;
\=head1 Warning

The file '$manpage' does not contain any POD context

ERROR
		s/^\\=/=/gm;
		$self-> message($_);
		return 2;
	}
	return 1;
}

sub load_content
{
	my ( $self, $content) = @_;
	my $path = '';
	$self-> {manpath} = '';
	undef $self-> {source_file};
	$self-> open_read;
	$self-> read($content);
	return $self-> close_read( $self-> {topicView});
}

sub open_read
{
	my ($self, @opt) = @_;
	return if $self-> {readState};
	$self-> clear_all;
	$self-> {readState} = {
		cutting       => 1,
		pod_cutting   => 1,
		begun         => '',
		bulletMode    => 0,

		indent        => DEF_INDENT,
		indentStack   => [],

		bigofs        => 0,
		wrapstate     => '',
		wrapindent    => 0,

		topicStack    => [[-1]],

		format        => 1,
		createIndex   => 1,
		encoding      => undef,
		bom           => undef,
		utf8          => undef,
		verbatim      => undef,

		@opt,
	};
}

sub load_image
{
	my ( $self, $src, $frame, $rest ) = @_;
	return Prima::Image::base64->load_icon($rest, index => $frame, iconUnmask => 1)
		if $src eq 'data:base64';

	return Prima::Icon-> load( $src, index => $frame, iconUnmask => 1)
		if -f $src;

	$src =~ s!::!/!g;
	for my $path (
		map {( "$_", "$_/pod")}
		grep { defined && length && -d }
		( length($self-> {manpath}) ? $self-> {manpath} : (), @INC)
	) {
		return Prima::Icon-> load( "$path/$src", index => $frame, iconUnmask => 1)
			if -f "$path/$src" && -r _;
	}
	return;
}

sub add_image
{
	my ( $self, $src, %opt ) = @_;

	my $w = $opt{width} // $src-> width;
	my $h = $opt{height} // $src-> height;
	my @resolution = $self-> resolution;
	my $W = $w * 72 / $resolution[0];
	my $H = $h * 72 / $resolution[1];
	$src-> {stretch} = [$w, $h];
	my $r = $self-> {readState};
	$r-> {pod_cutting} = $opt{cut} ? 0 : 1
		if defined $opt{cut};

	my @imgop = (
		tb::moveto( 2, 0, tb::X_DIMENSION_FONT_HEIGHT),
		tb::wrap(tb::WRAP_MODE_OFF),
		tb::extend( $W, $H, tb::X_DIMENSION_POINT),
		tb::code( \&_imgpaint, $src),
		tb::moveto( $W, 0, tb::X_DIMENSION_POINT),
		tb::wrap(tb::WRAP_MODE_ON)
	);

	push @{$self-> {model}},
		$opt{title} ? [div_create(
			open     => 1,
			style    => TDIVSTYLE_OUTLINE,
		)] : (),
		[model_create(
			indent    => $r-> {indent},
			offset    => $r-> {bigofs},
			lookahead => $opt{title} ? 4 : 1,
		), @imgop],