server/ext/map-world.ext

#! perl # optional

# 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 (@AREAS) {
      if (  $_->{x0} <= $x && $x <= $_->{x1}
         && $_->{y0} <= $y && $y <= $_->{y1}
         && $_->{z0} <= $z && $z <= $_->{z1}
      ) {
         $self->{ox} = $x - $_->{x0};
         $self->{oy} = $y - $_->{y0};
         $self->{oz} = $z - $_->{z0};

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

         $self->init_worldmap;

         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}) {
      $self->SUPER::load;
   } else {
      $self->alloc;
      $self->fill;
      $self->in_memory (cf::MAP_ACTIVE);
      $self->activate;
   }
}

# 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.41
Committed:	Fri Apr 22 06:10:33 2011 UTC (15 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.40:	+91 -70 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.27	#! perl # optional
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			for (@AREAS) {
52			if ( $_->{x0} <= $x && $x <= $_->{x1}
53			&& $_->{y0} <= $y && $y <= $_->{y1}
54			&& $_->{z0} <= $z && $z <= $_->{z1}
55			) {
56			$self->{ox} = $x - $_->{x0};
57			$self->{oy} = $y - $_->{y0};
58			$self->{oz} = $z - $_->{z0};
59
60			bless $self, $_->{pkg};
61
62			$self->init_worldmap;
63
64			last;
65			}
66
67			}
68
69			$self->SUPER::init;
70	root	1.35	}
71	root	1.8
72	root	1.41	sub init_worldmap {
73			# only for handlers
74	root	1.1	}
75
76			sub load_header_orig {
77			my ($self) = @_;
78
79	root	1.41	my ($x, $y, $z) = @$self{qw(x y z)};
80	root	1.1
81	root	1.40	$self->width ($TILE_W);
82			$self->height ($TILE_H);
83	root	1.3
84	root	1.41	$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z);
85	root	1.1	$self->msg ("worldmap dynamically created by map-world extension");
86	root	1.41	$self->outdoor ($self->{z} >= 0);
87	root	1.20	$self->default_region (cf::region::find "wilderness");
88	root	1.1
89	root	1.41	# all possible worldmap tiles also exist
90			$self->tile_path (0, format_xyz $x, $y - 1, $z);
91			$self->tile_path (1, format_xyz $x + 1, $y, $z);
92			$self->tile_path (2, format_xyz $x, $y + 1, $z);
93			$self->tile_path (3, format_xyz $x - 1, $y, $z);
94			$self->tile_path (4, format_xyz $x, $y, $z + 1);
95			$self->tile_path (5, format_xyz $x, $y, $z - 1);
96	root	1.7
97	root	1.41	# an overlay always wins
98			my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z;
99	root	1.28
100			$self->{load_path} = $overlay
101			unless Coro::AIO::aio_stat $overlay;
102	root	1.1
103	root	1.24	$self->{need_create_treasure} = 1;
104
105	root	1.1	1
106			}
107
108	root	1.41	# fill map with "default" data - first region and first archetype from palette
109			# used when we have no map data from elsewhere
110	root	1.13	sub fill {
111			my ($self) = @_;
112
113	root	1.41	if ($self->{z} > 0) {
114			# hmmm... air? :)
115			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
116			} elsif ($self->{z} < 0) {
117			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]);
118			} else {
119			$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]);
120			}
121	root	1.13	}
122
123	root	1.1	sub load {
124			my ($self) = @_;
125
126			if ($self->{load_path}) {
127			$self->SUPER::load;
128			} else {
129	root	1.2	$self->alloc;
130	root	1.13	$self->fill;
131	root	1.33	$self->in_memory (cf::MAP_ACTIVE);
132	root	1.26	$self->activate;
133	root	1.1	}
134			}
135
136	root	1.41	# MUST be overwritten to call at least ->fill
137	root	1.3	sub post_load {
138	root	1.1	my ($self) = @_;
139
140	root	1.26	$self->create_region_treasure
141			if delete $self->{need_create_treasure};
142	root	1.1	}
143