lib/cf/mapscript.pm

#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
#
# Copyright (©) 2017,2018 Marc Alexander Lehmann / the Deliantra team
# Copyright (©) 2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
#
# Deliantra is free software: you can redistribute it and/or modify it under
# the terms of the Affero GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the Affero GNU General Public License
# and the GNU General Public License along with this program. If not, see
# <http://www.gnu.org/licenses/>.
#
# The authors can be reached via e-mail to <support@deliantra.net>
#

=head1 NAME

cf::mapscript

=head1 DESCRIPTION

This module implements the mapscript object.

Map scripts are perl snippets that get executed whenever any connected
element is triggered (e.g. a check inv, a lever etc.)

=head1 ENVIRONMENT

The map scripts are compiled and executed into a namespace with the
following symbols available:

=over 4

=cut

package cf::mapscript::eval;

use common::sense;

=item $self

The mapscript object itself.

=item $state

The state value (0 means release, <>0 means push/trigger/enable) that
triggered the map script.

=item $activator

The object that was triggered (the lever, check inv element, npc etc.).

=item $originator

The object that triggered the activator, usually (but not always) the
player who stepped on a check inv, pulled a lever etc. Can be C<undef>.

=cut

use vars qw($self $state $activator $originator);

=item @obs = find $id_or_object

Finds all objects with the given I<connected> C<$id>. If an object
reference is passed, it will be returned unchanged.

=cut

sub find($) {
   ref $_[0] ? $_[0]
             : $self->map->find_link ($_[0])
}

=item trigger $id_or_object[, $state]

Triggers the linked chain with the given I<connected> id, or the connected
chain associated with the given object (if an object reference is passed),
and passes the given state (or C<1>, if missing) to it.

=cut

sub trigger($;$) {
   $self->map->trigger ($_[0], $#_ ? $_[1] : 1, $self);
}

=item timer $id_or_object, $seconds

Starts the timer on the given mapscript object (usually, C<$id_or_object> is
C<$self>). When the timer expires on the mapscript object, it will trigger
the script with C<$activator == $self> and C<$originator == undef>.

=cut

sub timer($$) {
   my $ob = (&find)[0];
   $ob->speed_left (-$_[1] / cf::TICK);
   $ob->set_speed (1);
}

package cf::mapscript;

use common::sense;

*{"main::safe::cf::mapscript::eval::"} = \%{"main::cf::mapscript::eval::"};

our %CACHE;

sub activate($$$) {
   package cf::mapscript::eval;

   ($self, $state, $activator, $originator) = @_;

   (
      $CACHE{$self->msg} ||= cf::safe_eval
         "package cf::mapscript::eval; sub {\n"
         . "#line 1 '" . ($self->debug_desc) . "'\n"
         . $self->msg
         . "\n}"
      or sub { }
   )->();
}

=back

=head1 EXAMPLE

Have a look at F<scorn/anthonty/portgate.map> for a nontrivial example.

=cut

1;
Revision:	1.13
Committed:	Sat Nov 17 23:40:02 2018 UTC (7 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.12:	+1 -0 lines
Log Message:	copyright update 2018
#	User	Rev	Content
1	root	1.7	#
2			# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3	root	1.12	#
4	root	1.13	# Copyright (©) 2017,2018 Marc Alexander Lehmann / the Deliantra team
5	root	1.11	# Copyright (©) 2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
6	root	1.12	#
7	root	1.7	# Deliantra is free software: you can redistribute it and/or modify it under
8			# the terms of the Affero GNU General Public License as published by the
9			# Free Software Foundation, either version 3 of the License, or (at your
10			# option) any later version.
11	root	1.12	#
12	root	1.7	# This program is distributed in the hope that it will be useful,
13			# but WITHOUT ANY WARRANTY; without even the implied warranty of
14			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15			# GNU General Public License for more details.
16	root	1.12	#
17	root	1.7	# You should have received a copy of the Affero GNU General Public License
18			# and the GNU General Public License along with this program. If not, see
19			# <http://www.gnu.org/licenses/>.
20	root	1.12	#
21	root	1.7	# The authors can be reached via e-mail to <support@deliantra.net>
22			#
23
24	root	1.4	=head1 NAME
25
26			cf::mapscript
27
28			=head1 DESCRIPTION
29
30			This module implements the mapscript object.
31
32			Map scripts are perl snippets that get executed whenever any connected
33			element is triggered (e.g. a check inv, a lever etc.)
34
35			=head1 ENVIRONMENT
36
37			The map scripts are compiled and executed into a namespace with the
38			following symbols available:
39
40			=over 4
41
42			=cut
43	root	1.1
44	root	1.8	package cf::mapscript::eval;
45	root	1.1
46	root	1.6	use common::sense;
47	root	1.1
48	root	1.4	=item $self
49
50	root	1.6	The mapscript object itself.
51	root	1.4
52			=item $state
53
54			The state value (0 means release, <>0 means push/trigger/enable) that
55			triggered the map script.
56
57			=item $activator
58
59			The object that was triggered (the lever, check inv element, npc etc.).
60
61			=item $originator
62
63			The object that triggered the activator, usually (but not always) the
64			player who stepped on a check inv, pulled a lever etc. Can be C<undef>.
65
66			=cut
67
68	root	1.8	use vars qw($self $state $activator $originator);
69	root	1.2
70	root	1.4	=item @obs = find $id_or_object
71
72			Finds all objects with the given I<connected> C<$id>. If an object
73			reference is passed, it will be returned unchanged.
74
75			=cut
76
77	root	1.2	sub find($) {
78			ref $_[0] ? $_[0]
79			: $self->map->find_link ($_[0])
80			}
81
82	root	1.4	=item trigger $id_or_object[, $state]
83
84			Triggers the linked chain with the given I<connected> id, or the connected
85	root	1.9	chain associated with the given object (if an object reference is passed),
86	root	1.4	and passes the given state (or C<1>, if missing) to it.
87
88			=cut
89	root	1.2
90	root	1.3	sub trigger($;$) {
91	root	1.2	$self->map->trigger ($_[0], $#_ ? $_[1] : 1, $self);
92			}
93
94	root	1.4	=item timer $id_or_object, $seconds
95
96	root	1.9	Starts the timer on the given mapscript object (usually, C<$id_or_object> is
97	root	1.4	C<$self>). When the timer expires on the mapscript object, it will trigger
98			the script with C<$activator == $self> and C<$originator == undef>.
99
100			=cut
101
102	root	1.2	sub timer($$) {
103			my $ob = (&find)[0];
104	root	1.5	$ob->speed_left (-$_[1] / cf::TICK);
105	root	1.2	$ob->set_speed (1);
106			}
107	root	1.1
108			package cf::mapscript;
109
110	root	1.8	use common::sense;
111
112			*{"main::safe::cf::mapscript::eval::"} = \%{"main::cf::mapscript::eval::"};
113	root	1.1
114	root	1.3	our %CACHE;
115
116	root	1.1	sub activate($$$) {
117	root	1.8	package cf::mapscript::eval;
118
119	root	1.2	($self, $state, $activator, $originator) = @_;
120	root	1.1
121			(
122	root	1.3	$CACHE{$self->msg} \|\|= cf::safe_eval
123	root	1.8	"package cf::mapscript::eval; sub {\n"
124	root	1.1	. "#line 1 '" . ($self->debug_desc) . "'\n"
125			. $self->msg
126			. "\n}"
127			or sub { }
128			)->();
129			}
130
131	root	1.4	=back
132
133			=head1 EXAMPLE
134
135			Have a look at F<scorn/anthonty/portgate.map> for a nontrivial example.
136
137			=cut
138
139	root	1.1	1;