Deliantra-Client/DC/Pod.pm

package DC::Pod;

use strict;
use utf8;

use Storable;

our $VERSION = 1.03;

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

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

*wiki = Storable::retrieve DC::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}
                    : $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'>" . (DC::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, $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     => "<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (DC::asxml $text) . "</span>",
         fontsize   => 0.8,
         can_hover  => 1,
         can_events => 1,
         padding_x  => 0,
         padding_y  => 0,
         tooltip    => "Go to <i>" . (DC::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.17
Committed:	Wed Dec 26 21:03:21 2007 UTC (16 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_9965, rel-0_9964, rel-0_9963, rel-0_9967, rel-0_9966
Changes since 1.16:	+7 -7 lines
Log Message:	initial module hiding
#	User	Rev	Content
1	root	1.17	package DC::Pod;
2	root	1.1
3			use strict;
4	root	1.8	use utf8;
5	root	1.1
6	root	1.4	use Storable;
7	root	1.1
8	root	1.15	our $VERSION = 1.03;
9	root	1.1
10	root	1.9	our $goto_document = sub { };
11	root	1.4	our %wiki;
12	root	1.1
13	root	1.7	my $MA_BEG = "\x{fcd0}";
14			my $MA_SEP = "\x{fcd1}";
15			my $MA_END = "\x{fcd2}";
16
17	root	1.17	*wiki = Storable::retrieve DC::find_rcfile "docwiki.pst";
18	root	1.1
19	root	1.9	sub goto_document($) {
20			$goto_document->(split /\//, $_[0]);
21			}
22
23	root	1.4	sub is_prefix_of($@) {
24			my ($node, @path) = @_;
25	root	1.1
26	root	1.4	return 1 unless @path;
27	root	1.1
28	root	1.10	my $kw = lc pop @path;
29	root	1.1
30	root	1.4	$node = $node->{parent}
31			or return 0;
32	root	1.2
33	root	1.4	return ! ! grep $_ eq $kw, @{ $node->{kw} };
34	root	1.2	}
35
36	root	1.4	sub find(@) {
37			my (@path) = @_;
38	root	1.1
39	root	1.4	return unless @path;
40	root	1.1
41	root	1.10	my $kw = lc pop @path;
42	root	1.1
43	root	1.4	# TODO: make sure results are unique
44	root	1.1
45	root	1.4	grep { is_prefix_of $_, @path }
46			map @$_,
47			$kw eq "*" ? @wiki{sort keys %wiki}
48	root	1.14	: $wiki{$kw} \|\| ()
49	root	1.1	}
50
51	root	1.4	sub full_path_of($) {
52			my ($node) = @_;
53	root	1.1
54	root	1.9	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	root	1.1	}
68
69	root	1.4	sub section_of($) {
70			my ($node) = @_;
71	root	1.1
72	root	1.4	my $doc = $node->{doc};
73			my $par = $node->{par};
74			my $lvl = $node->{level};
75	root	1.1
76	root	1.4	my @res;
77	root	1.1
78	root	1.4	do {
79			my $p = $doc->[$par];
80	root	1.1
81	root	1.7	if (length $p->{markup}) {
82			push @res, {
83	root	1.5	markup => $p->{markup},
84			indent => $p->{indent},
85	root	1.7	};
86	root	1.4	}
87			} while $doc->[++$par]{level} > $lvl;
88	root	1.1
89	root	1.4	@res
90	root	1.1	}
91
92	root	1.4	sub section(@) {
93			map section_of $_, &find
94	root	1.2	}
95
96	root	1.7	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	root	1.8	my ($par, $text, $link) = @_;
118	root	1.7
119	root	1.17	"<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (DC::asxml $text) . "</span>"
120	root	1.7	},
121			);
122
123	root	1.4	sub as_label(@) {
124	root	1.7	thaw_section @_, %as_label;
125
126	root	1.6	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	root	1.7	my %as_paragraphs = (
138			image => sub {
139	root	1.12	my ($par, $path, $flags) = @_;
140	root	1.7
141	root	1.17	push @{ $par->{widget} }, new DC::UI::Image path => $path,
142	root	1.13	$flags & 1 ? (max_h => $::FONTSIZE) : ();
143	root	1.7
144	root	1.8	"\x{fffc}"
145	root	1.7	},
146			link => sub {
147	root	1.8	my ($par, $text, $link) = @_;
148	root	1.7
149	root	1.17	push @{ $par->{widget} }, new DC::UI::Label
150			markup => "<span foreground='#ffff00'>↺</span><span foreground='#c0c0ff' underline='single'>" . (DC::asxml $text) . "</span>",
151	root	1.11	fontsize => 0.8,
152	root	1.8	can_hover => 1,
153			can_events => 1,
154			padding_x => 0,
155			padding_y => 0,
156	root	1.17	tooltip => "Go to <i>" . (DC::asxml $link) . "</i>",
157	root	1.8	on_button_up => sub {
158	root	1.9	goto_document $link;
159	root	1.8	};
160
161			"\x{fffc}"
162	root	1.7	},
163			);
164
165			sub as_paragraphs(@) {
166			thaw_section @_, %as_paragraphs;
167
168			@_
169			}
170
171			sub section_paragraphs(@) {
172			as_paragraphs &section
173			}
174
175	root	1.6	sub section_label(@) {
176			as_label &section
177	root	1.1	}
178
179	root	1.4	1