--- deliantra/Deliantra-Client/DC/Pod.pm 2006/08/13 02:43:22 1.4 +++ deliantra/Deliantra-Client/DC/Pod.pm 2008/03/30 11:31:09 1.22 @@ -1,28 +1,54 @@ -package CFPlus::Pod; +package DC::Pod; use strict; +use utf8; use Storable; -use CFPlus::UI; +our $VERSION = 1.03; -our $VERSION = 1; +our $goto_document = sub { }; +our %wiki; + +my $MA_BEG = "\x{fcd0}"; +my $MA_SEP = "\x{fcd1}"; +my $MA_END = "\x{fcd2}"; + +# nodes (order must stay as it is) +sub N_PARENT (){ 0 } +sub N_PAR (){ 1 } +sub N_LEVEL (){ 2 } +sub N_KW (){ 3 } +sub N_DOC (){ 4 } + +# paragraphs (order must stay as it is) +sub P_INDENT (){ 0 } +sub P_LEVEL (){ 1 } +sub P_MARKUP (){ 2 } +sub P_INDEX (){ 3 } our %wiki; -*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst"; +sub load_docwiki { + *wiki = Storable::retrieve $_[0]; +} + +sub goto_document($) { + $goto_document->(split /\//, $_[0]); +} sub is_prefix_of($@) { my ($node, @path) = @_; return 1 unless @path; - my $kw = pop @path; + my $kw = lc pop @path; - $node = $node->{parent} + $node = $node->[N_PARENT] or return 0; - return ! ! grep $_ eq $kw, @{ $node->{kw} }; + #TODO: maybe get rid of lowercasing? + return scalar grep lc eq $kw, @{ $node->[N_KW] }; } sub find(@) { @@ -30,48 +56,53 @@ return unless @path; - my $kw = pop @path; + my $kw = lc pop @path; # TODO: make sure results are unique grep { is_prefix_of $_, @path } map @$_, $kw eq "*" ? @wiki{sort keys %wiki} - : grep $_, $wiki{$kw} + : $wiki{$kw} || () } sub full_path_of($) { my ($node) = @_; - my $path = $node->{kw}[0]; - $path = "$node->{kw}[0]/$path" while $node = $node->{parent}; - $path + my @path; + + # skip toplevel hierarchy pod/, because its not a document + while ($node->[N_PARENT]) { + unshift @path, $node; + $node = $node->[N_PARENT]; + } + + @path +} + +sub full_path($) { + join "/", map $_->[N_KW][0], &full_path_of } sub section_of($) { my ($node) = @_; - my $doc = $node->{doc}; - my $par = $node->{par}; - my $lvl = $node->{level}; + my $doc = $node->[N_DOC]; + my $par = $node->[N_PAR]; + my $lvl = $node->[N_LEVEL]; my @res; do { my $p = $doc->[$par]; - my %para = ( - markup => $p->{markup}, - indent => $p->{indent}, - ); - - for (@{ $p->{widget} || [] }) { - my ($class, @args) = @$_; - push @{ $para{widget} }, $class->new (@args); + if (length $p->[P_MARKUP]) { + push @res, { + markup => $p->[P_MARKUP], + indent => $p->[P_INDENT], + }; } - - push @res, \%para; - } while $doc->[++$par]{level} > $lvl; + } while $doc->[++$par][P_LEVEL] > $lvl; @res } @@ -80,10 +111,101 @@ map section_of $_, &find } +sub thaw_section(\@\%) { + for (@{$_[0]}) { + $_->{markup} =~ s{ + $MA_BEG + ([^$MA_END]+) + $MA_END + }{ + my ($type, @arg) = split /$MA_SEP/o, $1; + + $_[1]{$type}($_, @arg) + }ogex; + } +} + +my %as_common = ( + h1 => sub { + "\n\n$_[1]\n" + }, + h2 => sub { + "\n\n$_[1]\n" + }, + h3 => sub { + "\n\n$_[1]\n" + }, +); + +my %as_label = ( + %as_common, + image => sub { + my ($par, $path) = @_; + + "img" + }, + link => sub { + my ($par, $text, $link) = @_; + + "" . (DC::asxml $text) . "" + }, +); + sub as_label(@) { - join "\n", - map +("\xa0" x ($_->{indent} / 4)) . $_->{markup}, - @_ + thaw_section @_, %as_label; + + my $text = + join "\n", + map +("\xa0" x ($_->{indent} / 4)) . $_->{markup}, + @_; + + $text =~ s/^\s+//; + $text =~ s/\s+$//; + + $text +} + +my %as_paragraphs = ( + %as_common, + image => sub { + my ($par, $path, $flags) = @_; + + push @{ $par->{widget} }, new DC::UI::Image path => $path, + $flags & 1 ? (max_h => $::FONTSIZE) : (); + + "\x{fffc}" + }, + link => sub { + my ($par, $text, $link) = @_; + + push @{ $par->{widget} }, new DC::UI::Label + markup => "" . (DC::asxml $text) . "", + fontsize => 0.8, + can_hover => 1, + can_events => 1, + padding_x => 0, + padding_y => 0, + tooltip => "Go to " . (DC::asxml $link) . "", + on_button_up => sub { + goto_document $link; + }; + + "\x{fffc}" + }, +); + +sub as_paragraphs(@) { + thaw_section @_, %as_paragraphs; + + @_ +} + +sub section_paragraphs(@) { + as_paragraphs §ion +} + +sub section_label(@) { + as_label §ion } 1