server/ext/map-world.ext

#! perl # mandatory

# manages the worldmap by directing to other handlers

cf::map->register (qr{^/world/world_(-?\d+)_(-?\d+)(?:_(-?\d+))?$}, 100);

# universal
our $TILE_W = 50;
our $TILE_H = 50;

# registry
our @AREAS;

sub register($$$$$$$@) {
   my $meta = {
      pkg => shift,
      x0  => shift, y0  => shift, z0  => shift,
      x1  => shift, y1  => shift, z1  => shift,
      @_
   };

   my $pkg = $meta->{pkg};

   @AREAS = sort { $b->{pri} <=> $a->{pri} }
                 $meta,
                 grep $pkg ne $_->{pkg},
                      @AREAS;

   my $isa = \@{"$pkg\::ISA"};

   @$isa = (
      __PACKAGE__,
      grep __PACKAGE__ ne $_, @$isa
   );
}

sub format_xyz($$;$) {
   sprintf "/world/world_%03d_%03d%s",
           $_[0], $_[1],
           $_[2] ? sprintf "_%03d", $_[2] : "";
}

#############################################################################

sub init {
   my ($self) = @_;

   my ($x, $y, $z) = @$self{qw(x y z)} = ($1, $2, $3+0);

   # find handler for this area
   for my $meta (@AREAS) {
      if (  $meta->{x0} <= $x && $x <= $meta->{x1}
         && $meta->{y0} <= $y && $y <= $meta->{y1}
         && $meta->{z0} <= $z && $z <= $meta->{z1}
      ) {
         $self->{ox} = $x - $meta->{x0};
         $self->{oy} = $y - $meta->{y0};
         $self->{oz} = $z - $meta->{z0};

         bless $self, $meta->{pkg};

         $self->init_worldmap ($meta);

         last;
      }
   }

   $self->SUPER::init;
}

sub init_worldmap {
   # only for handlers
}

sub load_header_orig {
   my ($self) = @_;

   my ($x, $y, $z) = @$self{qw(x y z)};

   $self->width  ($TILE_W);
   $self->height ($TILE_H);

   $self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z);
   $self->msg ("worldmap dynamically created by map-world extension");
   $self->outdoor ($self->{z} >= 0);
   $self->default_region (cf::region::find "wilderness");

   # all possible worldmap tiles also exist
   $self->tile_path (0, format_xyz $x, $y - 1, $z);
   $self->tile_path (1, format_xyz $x + 1, $y, $z);
   $self->tile_path (2, format_xyz $x, $y + 1, $z);
   $self->tile_path (3, format_xyz $x - 1, $y, $z);
   $self->tile_path (4, format_xyz $x, $y, $z + 1);
   $self->tile_path (5, format_xyz $x, $y, $z - 1);

   # an overlay always wins
   my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z;

   $self->{load_path} = $overlay
      unless Coro::AIO::aio_stat $overlay;

   $self->{need_create_treasure} = 1;

   1
}

# fill map with "default" data - first region and first archetype from palette
# used when we have no map data from elsewhere
sub fill {
   my ($self) = @_;

   if ($self->{z} > 0) {
      # hmmm... air? :)
      $self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
   } elsif ($self->{z} < 0) {
      $self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
   } else {
      $self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]);
   }
}

#sub load {
#   my ($self) = @_;
#
#   if ($self->{load_path}) {
#      warn "load $self\n";#d#
#      $self->SUPER::load;
#   } else {
#      warn "fill $self\n";#d#
#      my $guard = cf::lock_acquire "map_data:$self->{path}";
#
#      $self->alloc;
#      $self->fill;
#      $self->state (cf::MAP_ACTIVE);
#      $self->activate;
#      $self->post_load;
#   }
#}

# MUST be overwritten to call at least ->fill
sub post_load {
   my ($self) = @_;

   $self->create_region_treasure
      if delete $self->{need_create_treasure};
}

Revision:	1.45
Committed:	Wed May 4 16:12:15 2011 UTC (13 years ago) by root
Branch:	MAIN
Changes since 1.44:	+0 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.43	#! perl # mandatory
2	root	1.1
3	root	1.41	# manages the worldmap by directing to other handlers
4
5			cf::map->register (qr{^/world/world_(-?\d+)_(-?\d+)(?:_(-?\d+))?$}, 100);
6
7			# universal
8			our $TILE_W = 50;
9			our $TILE_H = 50;
10
11			# registry
12			our @AREAS;
13
14			sub register($$$$$$$@) {
15			my $meta = {
16			pkg => shift,
17			x0 => shift, y0 => shift, z0 => shift,
18			x1 => shift, y1 => shift, z1 => shift,
19			@_
20	root	1.23	};
21	root	1.41
22			my $pkg = $meta->{pkg};
23
24			@AREAS = sort { $b->{pri} <=> $a->{pri} }
25			$meta,
26			grep $pkg ne $_->{pkg},
27			@AREAS;
28
29			my $isa = \@{"$pkg\::ISA"};
30
31			@$isa = (
32			__PACKAGE__,
33			grep __PACKAGE__ ne $_, @$isa
34			);
35			}
36
37			sub format_xyz($$;$) {
38			sprintf "/world/world_%03d_%03d%s",
39			$_[0], $_[1],
40			$_[2] ? sprintf "_%03d", $_[2] : "";
41			}
42
43			#############################################################################
44
45			sub init {
46			my ($self) = @_;
47
48			my ($x, $y, $z) = @$self{qw(x y z)} = ($1, $2, $3+0);
49
50			# find handler for this area
51	root	1.42	for my $meta (@AREAS) {
52			if ( $meta->{x0} <= $x && $x <= $meta->{x1}
53			&& $meta->{y0} <= $y && $y <= $meta->{y1}
54			&& $meta->{z0} <= $z && $z <= $meta->{z1}
55	root	1.41	) {
56	root	1.42	$self->{ox} = $x - $meta->{x0};
57			$self->{oy} = $y - $meta->{y0};
58			$self->{oz} = $z - $meta->{z0};
59	root	1.41
60	root	1.42	bless $self, $meta->{pkg};
61	root	1.41
62	root	1.42	$self->init_worldmap ($meta);
63	root	1.41
64			last;
65			}
66			}
67
68			$self->SUPER::init;
69	root	1.35	}
70	root	1.8
71	root	1.41	sub init_worldmap {
72			# only for handlers
73	root	1.1	}
74
75			sub load_header_orig {
76			my ($self) = @_;
77
78	root	1.41	my ($x, $y, $z) = @$self{qw(x y z)};
79	root	1.1
80	root	1.40	$self->width ($TILE_W);
81			$self->height ($TILE_H);
82	root	1.3
83	root	1.41	$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z);
84	root	1.1	$self->msg ("worldmap dynamically created by map-world extension");
85	root	1.41	$self->outdoor ($self->{z} >= 0);
86	root	1.20	$self->default_region (cf::region::find "wilderness");
87	root	1.1
88	root	1.41	# all possible worldmap tiles also exist
89			$self->tile_path (0, format_xyz $x, $y - 1, $z);
90			$self->tile_path (1, format_xyz $x + 1, $y, $z);
91			$self->tile_path (2, format_xyz $x, $y + 1, $z);
92			$self->tile_path (3, format_xyz $x - 1, $y, $z);
93			$self->tile_path (4, format_xyz $x, $y, $z + 1);
94			$self->tile_path (5, format_xyz $x, $y, $z - 1);
95	root	1.7
96	root	1.41	# an overlay always wins
97			my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z;
98	root	1.28
99			$self->{load_path} = $overlay
100			unless Coro::AIO::aio_stat $overlay;
101	root	1.1
102	root	1.24	$self->{need_create_treasure} = 1;
103
104	root	1.1	1
105			}
106
107	root	1.41	# fill map with "default" data - first region and first archetype from palette
108			# used when we have no map data from elsewhere
109	root	1.13	sub fill {
110			my ($self) = @_;
111
112	root	1.41	if ($self->{z} > 0) {
113			# hmmm... air? :)
114			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
115			} elsif ($self->{z} < 0) {
116			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
117			} else {
118			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]);
119			}
120	root	1.13	}
121
122	root	1.43	#sub load {
123			# my ($self) = @_;
124			#
125			# if ($self->{load_path}) {
126			# warn "load $self\n";#d#
127			# $self->SUPER::load;
128			# } else {
129			# warn "fill $self\n";#d#
130			# my $guard = cf::lock_acquire "map_data:$self->{path}";
131			#
132			# $self->alloc;
133			# $self->fill;
134	root	1.44	# $self->state (cf::MAP_ACTIVE);
135	root	1.43	# $self->activate;
136			# $self->post_load;
137			# }
138			#}
139	root	1.1
140	root	1.41	# MUST be overwritten to call at least ->fill
141	root	1.3	sub post_load {
142	root	1.1	my ($self) = @_;
143
144	root	1.26	$self->create_region_treasure
145			if delete $self->{need_create_treasure};
146	root	1.1	}
147