server/ext/help.ext

#! perl

our $TOPIC;

sub load_topics($$) {
   my ($type, $path) = @_;

   my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
      or die "unable to load $path";

   my @topics;
   my $level = 1e9;

   for my $par (@$paragraphs) {
      Coro::cede;
      if ($par->{type} eq "head2") {
         if ($par->{markup} =~ /^(\S+)/) {
            push @topics, $1 => [$type => $par];
            $level = $par->{level};
         }
      } elsif ($par->{level} > $level) {
         push @{ $topics[-1] }, $par;
      }
   }

   @topics
}

sub reload() {
   $TOPIC = {
      (load_topics "DM Commands" => "dmcommand_help"),
      (load_topics "Emotes" => "emote_help"),
      (load_topics "Commands" => "command_help"),
      (load_topics "Generic Help Topics" => "generic_help"),
   };
}

cf::sync_job {
   my $guard = cf::lock_acquire "ext::help::loading";
   cf::async_ext {
      reload;
      undef $guard;
   };
};

# for lack of a better place: "media tags"
#  b            bold
#  i            italic
#  ul           underlined
#  fixed        font
#  arcane       font
#  hand         font
#  strange      font
#  print        font (default)
#  color=xxx

cf::register_command help => sub {
   my ($pl, $topic) = @_;

   if (cf::lock_active "ext::help::loading") {
      $pl->reply (undef, "help files are being loaded currently, try again in a few seconds.");
      return;
   }

   $topic = $1 if $topic =~ /(\S+)/;

   if (!length $topic) {
      # sort..

      my %topics;
      while (my ($k, $v) = each %$TOPIC) {
         push @{$topics{$v->[0]}}, $k;
      }

      my $res;
      while (my ($k, $v) = each %topics) {
         $res .= "[b]$k:[/b]\n" . (join " ", sort @$v) . "\n\n";
      }

      $pl->reply (undef, $res);

   } elsif (my $topic = $TOPIC->{$topic}) {
      my ($type, @pars) = @$topic;
      $pl->reply (undef, cf::pod::as_text \@pars);

   } else {
      $pl->reply (undef, "'$topic' no such help topic, try just 'help' to get a list of topics.");
   }
};

Revision:	1.6
Committed:	Sat Apr 21 16:56:31 2007 UTC (17 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.5:	+11 -0 lines
Log Message:	having a) monsters as treasures b) multipart monsters as treasures and c) multipart monsters as terasures on tiled maps... hit a big pile of bugs again. this change: - implements a per-map active flag. when items are being inserted they are activated or deactivated according to that flag. this could get rid of most or even all of the explicit activate/deactivate calls. - implement some glue to make instantiating multipart objects easier (this is used inside fix_multipart_objects and might make it possible to put multipart objects at map borders - those were winged before) - do finer-grained locking as to not lead to deadlocks when insert recurses e.g. when loading tiled maps.
#	Content
1	#! perl
2
3	our $TOPIC;
4
5	sub load_topics($$) {
6	my ($type, $path) = @_;
7
8	my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
9	or die "unable to load $path";
10
11	my @topics;
12	my $level = 1e9;
13
14	for my $par (@$paragraphs) {
15	Coro::cede;
16	if ($par->{type} eq "head2") {
17	if ($par->{markup} =~ /^(\S+)/) {
18	push @topics, $1 => [$type => $par];
19	$level = $par->{level};
20	}
21	} elsif ($par->{level} > $level) {
22	push @{ $topics[-1] }, $par;
23	}
24	}
25
26	@topics
27	}
28
29	sub reload() {
30	$TOPIC = {
31	(load_topics "DM Commands" => "dmcommand_help"),
32	(load_topics "Emotes" => "emote_help"),
33	(load_topics "Commands" => "command_help"),
34	(load_topics "Generic Help Topics" => "generic_help"),
35	};
36	}
37
38	cf::sync_job {
39	my $guard = cf::lock_acquire "ext::help::loading";
40	cf::async_ext {
41	reload;
42	undef $guard;
43	};
44	};
45
46	# for lack of a better place: "media tags"
47	# b bold
48	# i italic
49	# ul underlined
50	# fixed font
51	# arcane font
52	# hand font
53	# strange font
54	# print font (default)
55	# color=xxx
56
57	cf::register_command help => sub {
58	my ($pl, $topic) = @_;
59
60	if (cf::lock_active "ext::help::loading") {
61	$pl->reply (undef, "help files are being loaded currently, try again in a few seconds.");
62	return;
63	}
64
65	$topic = $1 if $topic =~ /(\S+)/;
66
67	if (!length $topic) {
68	# sort..
69
70	my %topics;
71	while (my ($k, $v) = each %$TOPIC) {
72	push @{$topics{$v->[0]}}, $k;
73	}
74
75	my $res;
76	while (my ($k, $v) = each %topics) {
77	$res .= "[b]$k:[/b]\n" . (join " ", sort @$v) . "\n\n";
78	}
79
80	$pl->reply (undef, $res);
81
82	} elsif (my $topic = $TOPIC->{$topic}) {
83	my ($type, @pars) = @$topic;
84	$pl->reply (undef, cf::pod::as_text \@pars);
85
86	} else {
87	$pl->reply (undef, "'$topic' no such help topic, try just 'help' to get a list of topics.");
88	}
89	};
90