server/ext/map-random.ext

#! perl # mandatory

use Coro::AIO;

cf::map->register (qr{^\?random/([0-9a-f]{32})});

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

   $self->{random_id} = $1;

   if (0 < Coro::AIO::aio_load "$cf::RANDOMDIR/$self->{random_id}.meta", my $data) {
      $self->{random} = cf::decode_json $data;
      $self->{random}{custom} ||= "$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}";
   } else {
      warn "unable to read meta file for $self->{random_id}\n";
      return 0;
   }

   1
}

sub thawer_merge {
   # we have to keep some variables in memory intact
   local $_[0]{random_id};
   local $_[0]{random};

   $_[0]->SUPER::thawer_merge ($_[1]);
}

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

   my $rmp = $self->{random};
   "random map at $rmp->{custom}, level $rmp->{dungeon_level}"
}

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

   sprintf "%s/%s.map", $cf::RANDOMDIR, $self->{random_id}
}

sub uniq_path {
   undef
}

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

   return unless $self->{random};

   $self->generate_random_map ($self->{random});
   $self->activate;

   1
}

sub clean_random_maps {
   return;#d#
   my $files = Coro::AIO::aio_readdirx $cf::RANDOMDIR, IO::AIO::READDIR_STAT_ORDER
      or return;

   my $META_TIMEOUT = $cf::CFG{map_random_meta_timeout} || 86400 * 7;

   for my $file (@$files) {
      next unless $file =~ /\.meta$/;

      Coro::AIO::aio_stat "$cf::RANDOMDIR/$file"
         and next;

      my $age = $cf::NOW - (stat _)[8];

      if ($age > $META_TIMEOUT) {
         warn "resetting random meta data for $file";
         IO::AIO::aio_unlink "$cf::RANDOMDIR/$file";
      }
   }
}

# called by the random map generator
sub find_style_;
sub find_style_($$) {
   my ($path, $difficulty) = @_;

   my $map;

   $map = cf::map::find $path
      unless aio_stat "$cf::MAPDIR/$path.map";

   unless ($map) {
      # search files and/or dirs
      if (my ($dirs, $nondirs) = aio_scandir "$cf::MAPDIR/$path/", 1) {
         my @entries = sort grep s/\.map$//, @$nondirs;

         if ($difficulty < 0) {
            # pick a fully random map, but only a map, do not recurse
            $map = cf::map::find "$path/$entries[cf::rmg_rndm scalar @entries]"
               if @entries;
         } else {
            # pick a map with nearest difficulty value ("mapname_<difficulty>.map")
            @entries = sort @$dirs
               unless @entries;

            my $min_diff = 1e99;

            for my $name (@entries) {
               if ($name =~ /_(\d+)$/) {
                  my $diff = abs $difficulty - $1 + 0.5; # prefer the more difficult version
                  ($map, $min_diff) = ($name, $diff) if $diff < $min_diff;
               }
            }

            unless ($map) {
               # no map with given pattern found, choose a random map
               $map = $entries[cf::rmg_rndm scalar @entries];
            }

            $map = find_style_ "$path/$map", $difficulty
               if $map;
         }
      }
   }

   $map
}

sub find_style($$$) {
   my ($dir, $name, $difficulty) = @_;
   
   cf::cede_to_tick;

   my $map = find_style_ $name ? "$dir/$name" : $dir, $difficulty;

   if ($map) {
      $map->load;
      $map->deactivate;
   }

   #warn "return $dir,$name,$difficulty => $map\n" if $difficulty >= 0;#d#
   $map
}

# clean up old temp maps regularly
our $CLEAN_RANDOM_MAPS = cf::periodic 3600, Coro::unblock_sub {
   clean_random_maps;
};

# map generator stresstest, NEVER enable under normal circumstances
if ($ENV{STRESSTEST}) {
   cf::async {
      my $seed = 0;
      while () {
         my $map = cf::map::new;
         $map->generate_random_map ({
            region => "scorn",
            random_seed => $seed++,
            xsize => (int rand 100) + 1,
            ysize => (int rand 100) + 1,
         });
         warn sprintf "%d: %dx%d o# %d\n", $seed, $map->width, $map->height, &cf::object::objects_size;#d#
         $map->destroy;
      }
   };
}

# prefetch test, load some ocean-maps
if (0) {
   cf::async {
      # 0.58
      Coro::Timer::sleep 2;
      for my $x (200..219) {
         for my $y (200..219) {
            (cf::map::find "/world/world_$x\_$y")->load;
         }
      }
   };
}

1

Revision:	1.33
Committed:	Sat Jun 6 21:43:13 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_82, rel-2_81, rel-2_80, rel-2_79
Changes since 1.32:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.17	#! perl # mandatory
2	root	1.1
3	root	1.26	use Coro::AIO;
4
5	root	1.5	cf::map->register (qr{^\?random/([0-9a-f]{32})});
6	root	1.1
7			sub init {
8			my ($self) = @_;
9
10	root	1.5	$self->{random_id} = $1;
11
12	root	1.14	if (0 < Coro::AIO::aio_load "$cf::RANDOMDIR/$self->{random_id}.meta", my $data) {
13	root	1.19	$self->{random} = cf::decode_json $data;
14	root	1.3	$self->{random}{custom} \|\|= "$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}";
15	root	1.7	} else {
16			warn "unable to read meta file for $self->{random_id}\n";
17			return 0;
18	root	1.3	}
19	root	1.5
20			1
21	root	1.1	}
22
23	root	1.6	sub thawer_merge {
24			# we have to keep some variables in memory intact
25			local $_[0]{random_id};
26			local $_[0]{random};
27
28			$_[0]->SUPER::thawer_merge ($_[1]);
29			}
30
31	root	1.1	sub visible_name {
32			my ($self) = @_;
33
34	root	1.2	my $rmp = $self->{random};
35	root	1.4	"random map at $rmp->{custom}, level $rmp->{dungeon_level}"
36	root	1.1	}
37
38			sub save_path {
39			my ($self) = @_;
40
41	root	1.14	sprintf "%s/%s.map", $cf::RANDOMDIR, $self->{random_id}
42	root	1.1	}
43
44			sub uniq_path {
45			undef
46			}
47
48	root	1.8	sub load_header_orig {
49	root	1.1	my ($self) = @_;
50
51	root	1.5	return unless $self->{random};
52
53			$self->generate_random_map ($self->{random});
54	root	1.15	$self->activate;
55	root	1.5
56			1
57	root	1.1	}
58
59	root	1.3	sub clean_random_maps {
60	root	1.32	return;#d#
61	root	1.33	my $files = Coro::AIO::aio_readdirx $cf::RANDOMDIR, IO::AIO::READDIR_STAT_ORDER
62	root	1.10	or return;
63
64			my $META_TIMEOUT = $cf::CFG{map_random_meta_timeout} \|\| 86400 * 7;
65
66			for my $file (@$files) {
67	root	1.16	next unless $file =~ /\.meta$/;
68	root	1.10
69	root	1.14	Coro::AIO::aio_stat "$cf::RANDOMDIR/$file"
70	root	1.10	and next;
71
72			my $age = $cf::NOW - (stat _)[8];
73
74	root	1.16	if ($age > $META_TIMEOUT) {
75			warn "resetting random meta data for $file";
76			IO::AIO::aio_unlink "$cf::RANDOMDIR/$file";
77	root	1.3	}
78	root	1.10	}
79	root	1.3	}
80
81	root	1.26	# called by the random map generator
82			sub find_style_;
83			sub find_style_($$) {
84			my ($path, $difficulty) = @_;
85
86			my $map;
87
88			$map = cf::map::find $path
89	root	1.27	unless aio_stat "$cf::MAPDIR/$path.map";
90	root	1.26
91			unless ($map) {
92			# search files and/or dirs
93	root	1.27	if (my ($dirs, $nondirs) = aio_scandir "$cf::MAPDIR/$path/", 1) {
94	root	1.26	my @entries = sort grep s/\.map$//, @$nondirs;
95
96			if ($difficulty < 0) {
97			# pick a fully random map, but only a map, do not recurse
98			$map = cf::map::find "$path/$entries[cf::rmg_rndm scalar @entries]"
99			if @entries;
100			} else {
101			# pick a map with nearest difficulty value ("mapname_<difficulty>.map")
102			@entries = sort @$dirs
103			unless @entries;
104
105			my $min_diff = 1e99;
106
107			for my $name (@entries) {
108			if ($name =~ /_(\d+)$/) {
109			my $diff = abs $difficulty - $1 + 0.5; # prefer the more difficult version
110			($map, $min_diff) = ($name, $diff) if $diff < $min_diff;
111			}
112			}
113
114			unless ($map) {
115			# no map with given pattern found, choose a random map
116			$map = $entries[cf::rmg_rndm scalar @entries];
117			}
118
119			$map = find_style_ "$path/$map", $difficulty
120			if $map;
121			}
122			}
123			}
124
125			$map
126			}
127
128			sub find_style($$$) {
129			my ($dir, $name, $difficulty) = @_;
130
131			cf::cede_to_tick;
132
133			my $map = find_style_ $name ? "$dir/$name" : $dir, $difficulty;
134
135			if ($map) {
136			$map->load;
137			$map->deactivate;
138			}
139
140	root	1.28	#warn "return $dir,$name,$difficulty => $map\n" if $difficulty >= 0;#d#
141	root	1.26	$map
142			}
143
144	root	1.3	# clean up old temp maps regularly
145	root	1.18	our $CLEAN_RANDOM_MAPS = cf::periodic 3600, Coro::unblock_sub {
146			clean_random_maps;
147			};
148	root	1.3
149	root	1.20	# map generator stresstest, NEVER enable under normal circumstances
150	root	1.29	if ($ENV{STRESSTEST}) {
151	root	1.11	cf::async {
152			my $seed = 0;
153			while () {
154			my $map = cf::map::new;
155			$map->generate_random_map ({
156			region => "scorn",
157			random_seed => $seed++,
158	root	1.31	xsize => (int rand 100) + 1,
159			ysize => (int rand 100) + 1,
160	root	1.11	});
161	root	1.29	warn sprintf "%d: %dx%d o# %d\n", $seed, $map->width, $map->height, &cf::object::objects_size;#d#
162	root	1.11	$map->destroy;
163			}
164			};
165			}
166
167	root	1.25	# prefetch test, load some ocean-maps
168			if (0) {
169			cf::async {
170			# 0.58
171			Coro::Timer::sleep 2;
172			for my $x (200..219) {
173			for my $y (200..219) {
174			(cf::map::find "/world/world_$x\_$y")->load;
175			}
176			}
177			};
178			}
179
180	root	1.1	1
181