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 "%+04d", $_[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);

         goto done;
      }
   }

   bless $self, ext::map_world::empty::;

done:
   $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 (cf::TILE_NORTH, format_xyz $x, $y - 1, $z);
   $self->tile_path (cf::TILE_SOUTH, format_xyz $x, $y + 1, $z);
   $self->tile_path (cf::TILE_EAST , format_xyz $x + 1, $y, $z);
   $self->tile_path (cf::TILE_WEST , format_xyz $x - 1, $y, $z);
   $self->tile_path (cf::TILE_UP   , format_xyz $x, $y, $z + 1);
   $self->tile_path (cf::TILE_DOWN , 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};
}

package ext::map_world::empty;

our @ISA = ext::map_world::;

sub post_load_original {
   $_[0]->fill;
}

Revision:	1.46
Committed:	Sun May 8 21:51:26 2011 UTC (13 years ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.45:	+20 -9 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	root	1.46	cf::map->register (qr{^/world/world_(-?\d+)_(-?\d+)(?:([+\-]\d+))?$}, 100);
6	root	1.41
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	root	1.46	$_[2] ? sprintf "%+04d", $_[2] : "";
41	root	1.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	root	1.46	goto done;
65	root	1.41	}
66			}
67
68	root	1.46	bless $self, ext::map_world::empty::;
69
70			done:
71	root	1.41	$self->SUPER::init;
72	root	1.35	}
73	root	1.8
74	root	1.41	sub init_worldmap {
75			# only for handlers
76	root	1.1	}
77
78			sub load_header_orig {
79			my ($self) = @_;
80
81	root	1.41	my ($x, $y, $z) = @$self{qw(x y z)};
82	root	1.1
83	root	1.40	$self->width ($TILE_W);
84			$self->height ($TILE_H);
85	root	1.3
86	root	1.41	$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z);
87	root	1.1	$self->msg ("worldmap dynamically created by map-world extension");
88	root	1.41	$self->outdoor ($self->{z} >= 0);
89	root	1.20	$self->default_region (cf::region::find "wilderness");
90	root	1.1
91	root	1.41	# all possible worldmap tiles also exist
92	root	1.46	$self->tile_path (cf::TILE_NORTH, format_xyz $x, $y - 1, $z);
93			$self->tile_path (cf::TILE_SOUTH, format_xyz $x, $y + 1, $z);
94			$self->tile_path (cf::TILE_EAST , format_xyz $x + 1, $y, $z);
95			$self->tile_path (cf::TILE_WEST , format_xyz $x - 1, $y, $z);
96			$self->tile_path (cf::TILE_UP , format_xyz $x, $y, $z + 1);
97			$self->tile_path (cf::TILE_DOWN , format_xyz $x, $y, $z - 1);
98	root	1.7
99	root	1.41	# an overlay always wins
100			my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z;
101	root	1.28
102			$self->{load_path} = $overlay
103			unless Coro::AIO::aio_stat $overlay;
104	root	1.1
105	root	1.24	$self->{need_create_treasure} = 1;
106
107	root	1.1	1
108			}
109
110	root	1.41	# fill map with "default" data - first region and first archetype from palette
111			# used when we have no map data from elsewhere
112	root	1.13	sub fill {
113			my ($self) = @_;
114
115	root	1.41	if ($self->{z} > 0) {
116			# hmmm... air? :)
117			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
118			} elsif ($self->{z} < 0) {
119			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
120			} else {
121			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]);
122			}
123	root	1.13	}
124
125	root	1.43	#sub load {
126			# my ($self) = @_;
127			#
128			# if ($self->{load_path}) {
129			# warn "load $self\n";#d#
130			# $self->SUPER::load;
131			# } else {
132			# warn "fill $self\n";#d#
133			# my $guard = cf::lock_acquire "map_data:$self->{path}";
134			#
135			# $self->alloc;
136			# $self->fill;
137	root	1.44	# $self->state (cf::MAP_ACTIVE);
138	root	1.43	# $self->activate;
139			# $self->post_load;
140			# }
141			#}
142	root	1.1
143	root	1.41	# MUST be overwritten to call at least ->fill
144	root	1.3	sub post_load {
145	root	1.1	my ($self) = @_;
146
147	root	1.26	$self->create_region_treasure
148			if delete $self->{need_create_treasure};
149	root	1.1	}
150
151	root	1.46	package ext::map_world::empty;
152
153			our @ISA = ext::map_world::;
154
155			sub post_load_original {
156			$_[0]->fill;
157			}
158