#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
#
# Copyright (©) 2005,2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
#
# Deliantra is free software: you can redistribute it and/or modify it under
# the terms of the Affero GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the Affero GNU General Public License
# and the GNU General Public License along with this program. If not, see
# .
#
# The authors can be reached via e-mail to
#
package cf::pod;
use common::sense;
use Pod::POM;
our $indent;
our $level;
our @result;
package cf::pod::AsParagraphs;
use common::sense;
use base "Pod::POM::View";
my %E = (
"<" => "E",
">" => "E",
);
sub aspod($) {
local $_ = $_[0];
s/[<>]/$E{$1}/g;
$_
}
sub flatten($) {
local $_ = $_[0];
s/^\s+//;
s/\s+$//;
s/\s+/ /g;
$_
}
*view_seq_file = sub { "C<$_[1]>" };
*view_seq_code = sub { "C<$_[1]>" };
*view_seq_bold = sub { "B<$_[1]>" };
*view_seq_italic = sub { "I<$_[1]>" };
*view_seq_T = sub { "T<$_[1]>" };
*view_seq_G = sub { "G<$_[1]>" };
*view_seq_zero = sub { "Z<>" };
*view_seq_space = sub { my $text = $_[1]; $text =~ s/ /\xa0/g; $text };
*view_seq_index = sub { push @{ $result[-1]{index} }, $_[1]; "" };
#view_seq_entity
sub view_seq_text {
my $text = $_[1];
$text =~ s/\s+/ /g;
aspod $text
}
sub view_seq_link {
my (undef, $link) = @_;
my $text = $link =~ s/^(.*)\|// ? $1 : $link;
if ($link =~ /http:/) {
"U<" . (aspod $link) . ">"
} else {
aspod $text
}
}
sub view_item {
push @result, {
type => "item",
indent => $indent * 8,
level => $level,
};
my $title = $_[1]->title->present ($_[0]);
$result[-1]{markup} = $title if length $title;
$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
local $level = $level + 1;
$_[1]->content->present ($_[0]);
()
}
sub view_verbatim {
push @result, {
type => "verbatim",
indent => $indent * 16,
level => $level,
markup => $_[1],
};
()
}
sub view_textblock {
push @result, {
indent => $indent * 16,
level => $level,
markup => flatten $_[1],
};
()
}
sub view_head1 {
push @result, {
type => "head1",
indent => $indent * 16,
level => $level,
};
my $title = $_[1]->title->present ($_[0]);
$result[-1]{markup} = $title if length $title;
$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
local $level = $level + 1;
$_[1]->content->present ($_[0]);
()
};
sub view_head2 {
push @result, {
type => "head2",
indent => $indent * 16,
level => $level,
};
my $title = $_[1]->title->present ($_[0]);
$result[-1]{markup} = $title if length $title;
$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
local $level = $level + 1;
$_[1]->content->present ($_[0]);
()
};
sub view_head3 {
push @result, {
type => "head3",
indent => $indent * 16,
level => $level,
};
my $title = $_[1]->title->present ($_[0]);
$result[-1]{markup} = $title if length $title;
$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
local $level = $level + 1;
$_[1]->content->present ($_[0]);
()
};
sub view_over {
local $indent = $indent + $_[1]->indent;
push @result, { indent => $indent };
$_[1]->content->present ($_[0]);
()
}
sub view_for {
if ($_[1]->format eq "image") {
# push @result, {
# indent => $indent * 16,
# level => $level,
# markup => (::special image => "pod/" . $_->text),
# };
}
()
}
sub view_begin {
()
}
sub view {
my ($self, $type, $item) = @_;
$item->content->present ($self);
}
#############################################################################
package cf::pod;
sub pom_as_paragraphs_ng($) {
my ($pom) = @_;
local $indent = 0;
local $level = 1;
local @result = ( { } );
$pom->present ("cf::pod::AsParagraphs");
[grep $_->{index} || exists $_->{markup}, @result]
}
sub pom_as_paragraphs($) {
my ($pom) = @_;
# we suckers use global variables, unfortunately.
my $guard = cf::lock_acquire "cf::pod::as_paragraphs";
$pom->pom_as_paragraphs_ng
}
sub load_pod($) {
my ($path) = @_;
Coro::Storable::thaw cf::cache "cf::pod::as_paragraphs/$path" => [$path],
9 => sub {
my ($src) = @_;
cf::fork_call {
Coro::Storable::blocking_nfreeze
pom_as_paragraphs_ng
+(Pod::POM->new->parse_text ($src->[0]))
}
};
}
# format as cfpod-style text
sub as_cfpod($) {
my ($pars) = @_;
my $res;
for my $par (@$pars) {
if ($par->{type} =~ /^head\d+$/) {
$res .= "B<$par->{markup}>\n\n";
} elsif ($par->{type} eq "verbatim") {
$res .= "$par->{markup}\n\n";
} elsif ($par->{type} eq "item") {
$res .= "* I<$par->{markup}>\n\n";
} else {
$res .= "$par->{markup}\n\n";
}
}
$res
}
1;