Deliantra-Client/DC/Pod.pm

package CFPlus::Pod;

use strict;
use utf8;

use Storable;

our $VERSION = 1;

our $goto_document = 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 goto_document($) {
   $goto_document->(split /\//, $_[0]);
}

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

   return 1 unless @path;

   my $kw = lc pop @path;

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

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

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

   return unless @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}
}

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

   my @path;

   # skip toplevel hierarchy pod/, because its not a document
   while ($node->{parent}) {
      unshift @path, $node;
      $node = $node->{parent};
   }

   @path
}

sub full_path($) {
   join "/", map $_->{kw}[0], &full_path_of
}

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