Deliantra-Client/DC/Pod.pm

package CFPlus::Pod;

use strict;
use utf8;

use Storable;

our $VERSION = 1;

our $on_link = sub { };
our %wiki;

my $MA_BEG = "\x{fcd0}";
my $MA_SEP = "\x{fcd1}";
my $MA_END = "\x{fcd2}";

*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst";

sub is_prefix_of($@) {
   my ($node, @path) = @_;

   return 1 unless @path;

   my $kw = pop @path;

   $node = $node->{parent}
      or return 0;

   return ! ! grep $_ eq $kw, @{ $node->{kw} };
}

sub find(@) {
   my (@path) = @_;

   return unless @path;

   my $kw = pop @path;

   # TODO: make sure results are unique

   grep { is_prefix_of $_, @path }
      map @$_,
         $kw eq "*" ? @wiki{sort keys %wiki}
                    : grep $_, $wiki{$kw}
}

sub full_path_of($) {
   my ($node) = @_;

   my $path = $node->{kw}[0];
   $path = "$node->{kw}[0]/$path" while $node = $node->{parent};
   $path
}

sub section_of($) {
   my ($node) = @_;

   my $doc = $node->{doc};
   my $par = $node->{par};
   my $lvl = $node->{level};

   my @res;

   do {
      my $p = $doc->[$par];

      if (length $p->{markup}) {
         push @res, {
            markup => $p->{markup},
            indent => $p->{indent},
         };
      }
   } while $doc->[++$par]{level} > $lvl;

   @res
}

sub section(@) {
   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_label = (
   image => sub {
      my ($par, $path) = @_;

      "<small>img</small>"
   },
   link => sub {
      my ($par, $text, $link) = @_;

      "<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (CFPlus::asxml $text) . "</span>"
   },
);

sub as_label(@) {
   thaw_section @_, %as_label;

   my $text =
      join "\n",
         map +("\xa0" x ($_->{indent} / 4)) . $_->{markup},
            @_;

   $text =~ s/^\s+//;
   $text =~ s/\s+$//;

   $text
}

my %as_paragraphs = (
   image => sub {
      my ($par, $path) = @_;

      push @{ $par->{widget} }, new CFPlus::UI::Image path => $path;

      "\x{fffc}"
   },
   link => sub {
      my ($par, $text, $link) = @_;

      push @{ $par->{widget} }, new CFPlus::UI::Label
         markup     => "<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (CFPlus::asxml $text) . "</span>",
         size       => 0.8,
         can_hover  => 1,
         can_events => 1,
         padding_x  => 0,
         padding_y  => 0,
         on_button_up => sub {
            $on_link->(split /\//, $link);
         };

      "\x{fffc}"
   },
);

sub as_paragraphs(@) {
   thaw_section @_, %as_paragraphs;

   @_
}

sub section_paragraphs(@) {
   as_paragraphs &section
}

sub section_label(@) {
   as_label &section
}

1
Revision:	1.8
Committed:	Sun Aug 13 19:47:05 2006 UTC (17 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+18 -5 lines
Log Message:	docviewer psrtial rewrite
#	Content
1	package CFPlus::Pod;
2
3	use strict;
4	use utf8;
5
6	use Storable;
7
8	our $VERSION = 1;
9
10	our $on_link = sub { };
11	our %wiki;
12
13	my $MA_BEG = "\x{fcd0}";
14	my $MA_SEP = "\x{fcd1}";
15	my $MA_END = "\x{fcd2}";
16
17	*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst";
18
19	sub is_prefix_of($@) {
20	my ($node, @path) = @_;
21
22	return 1 unless @path;
23
24	my $kw = pop @path;
25
26	$node = $node->{parent}
27	or return 0;
28
29	return ! ! grep $_ eq $kw, @{ $node->{kw} };
30	}
31
32	sub find(@) {
33	my (@path) = @_;
34
35	return unless @path;
36
37	my $kw = pop @path;
38
39	# TODO: make sure results are unique
40
41	grep { is_prefix_of $_, @path }
42	map @$_,
43	$kw eq "*" ? @wiki{sort keys %wiki}
44	: grep $_, $wiki{$kw}
45	}
46
47	sub full_path_of($) {
48	my ($node) = @_;
49
50	my $path = $node->{kw}[0];
51	$path = "$node->{kw}[0]/$path" while $node = $node->{parent};
52	$path
53	}
54
55	sub section_of($) {
56	my ($node) = @_;
57
58	my $doc = $node->{doc};
59	my $par = $node->{par};
60	my $lvl = $node->{level};
61
62	my @res;
63
64	do {
65	my $p = $doc->[$par];
66
67	if (length $p->{markup}) {
68	push @res, {
69	markup => $p->{markup},
70	indent => $p->{indent},
71	};
72	}
73	} while $doc->[++$par]{level} > $lvl;
74
75	@res
76	}
77
78	sub section(@) {
79	map section_of $_, &find
80	}
81
82	sub thaw_section(\@\%) {
83	for (@{$_[0]}) {
84	$_->{markup} =~ s{
85	$MA_BEG
86	([^$MA_END]+)
87	$MA_END
88	}{
89	my ($type, @arg) = split /$MA_SEP/o, $1;
90
91	$_[1]{$type}($_, @arg)
92	}ogex;
93	}
94	}
95
96	my %as_label = (
97	image => sub {
98	my ($par, $path) = @_;
99
100	"<small>img</small>"
101	},
102	link => sub {
103	my ($par, $text, $link) = @_;
104
105	"<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (CFPlus::asxml $text) . "</span>"
106	},
107	);
108
109	sub as_label(@) {
110	thaw_section @_, %as_label;
111
112	my $text =
113	join "\n",
114	map +("\xa0" x ($_->{indent} / 4)) . $_->{markup},
115	@_;
116
117	$text =~ s/^\s+//;
118	$text =~ s/\s+$//;
119
120	$text
121	}
122
123	my %as_paragraphs = (
124	image => sub {
125	my ($par, $path) = @_;
126
127	push @{ $par->{widget} }, new CFPlus::UI::Image path => $path;
128
129	"\x{fffc}"
130	},
131	link => sub {
132	my ($par, $text, $link) = @_;
133
134	push @{ $par->{widget} }, new CFPlus::UI::Label
135	markup => "<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (CFPlus::asxml $text) . "</span>",
136	size => 0.8,
137	can_hover => 1,
138	can_events => 1,
139	padding_x => 0,
140	padding_y => 0,
141	on_button_up => sub {
142	$on_link->(split /\//, $link);
143	};
144
145	"\x{fffc}"
146	},
147	);
148
149	sub as_paragraphs(@) {
150	thaw_section @_, %as_paragraphs;
151
152	@_
153	}
154
155	sub section_paragraphs(@) {
156	as_paragraphs &section
157	}
158
159	sub section_label(@) {
160	as_label &section
161	}
162
163	1