2 ##########################################################################
4 # Copyright (c) 2003-2012 Aymargeddon Development Team
6 # This file is part of "Last days of Aymargeddon" - a massive multi player
7 # onine game of strategy
9 # This program is free software: you can redistribute it and/or modify
10 # it under the terms of the GNU Affero General Public License as
11 # published by the Free Software Foundation, either version 3 of the
12 # License, or (at your option) any later version.
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
18 # See the GNU Affero General Public License for more details.
20 # You should have received a copy of the GNU Affero General Public License
21 # along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ###########################################################################
28 # creates the world to destroy
30 # usage: ./create.pl [number of eartlings]
34 # TODO: use FROGS/DataBase.pm instead of DBI.pm
42 use POSIX qw(floor ceil);
44 my $t = Term::ReadLine->new('test');
47 use FROGS::Config qw($conf);
53 my $earthlings = $ARGV[0] || 10; # number of earthlings
55 my $dont_ask = defined $ARGV[1] ? 1 : 0;
57 my $db_source = $::conf->{-DB_SOURCE};
58 my $db_user = $::conf->{-DB_USER};
59 my $db_passwd = $::conf->{-DB_PASSWD};
61 my $ascii = {-pole => '@',
69 # set to 0 to not change size of world during generation
70 # set to positive value to set the number of itterations need to pumpup
71 my $pump_up_world = 10;
73 # TODO: maybe to small?
74 my $n = ceil(sqrt($earthlings * 7)); # size of world
76 my $pole_count = floor(sqrt($n));
77 my $min_pole_distance = ceil($n/2);
78 my $water_count = floor($n*$n/2);
79 #TODO: number of islands should depend on players, not on size
80 my $island_count = floor($water_count/3);
81 my $min_home_distance = $::conf->{-MIN_DISTANCE_HOME};
82 my $min_mountain_distance = $::conf->{-MIN_DISTANCE_MOUNTAIN};
83 my $wanted_mountain_distance = $::conf->{-WANTED_DISTANCE_MOUNTAIN};
84 my $min_water_distance = $::conf->{-MIN_DISTANCE_MOUNTAIN_FROM_WATER};
85 my $city_count = $earthlings * 4;
86 my $mountain_count = floor($earthlings);
91 if ($pump_up_world and $nn > $pump_up_world) {
93 print "*** World to small! Make it bigger! New size $n.***\n";
96 my $not_enough_room = 0;
97 $map = new HexTorus($n);
98 $pole_count = floor(sqrt($n));
99 $min_pole_distance = ceil($n/2);
100 $water_count = floor($n*$n/2);
101 $island_count = floor($water_count/3);
103 # TODO: uggly structure
105 print "generate poles ...\n";
106 my @pole = distribute($pole_count,$min_pole_distance,
107 $min_pole_distance,$min_pole_distance);
108 $not_enough_room = 1 unless $pole[0];
109 my (@water,@islands,@home,@mountains,@not_cities,@cities);
110 unless ($not_enough_room){
111 print "generate water ...\n";
112 @water = flood($water_count,@pole);
114 unless ($not_enough_room){
115 print "generate islands ...\n";
116 @islands = vulcano($island_count, \@water, \@pole);
118 unless ($not_enough_room){
119 print "generate mountains ...\n";
120 @mountains = distribute($mountain_count,$min_water_distance,
121 $min_mountain_distance,$wanted_mountain_distance,[],@water);
122 $not_enough_room = 1 unless $mountains[0];
124 # print print_list(@mountains);
125 unless ($not_enough_room){
126 print "generate homecitys ...\n";
129 @home = homeland(@mountains,@pole,@water,@islands);
130 # $print = 1 unless $#home<$#mountains;
131 last unless $#home<$#mountains;
133 my $mref = Util::shuffle(\@mountains);
137 $not_enough_room = 1 if $#home<$#mountains;
140 unless ($not_enough_room){
141 print "generate citys ...\n";
142 @not_cities = (@water,@pole,@mountains,@islands,@home);
143 @cities = build($city_count,\@home,\@not_cities);
144 $not_enough_room = 1 unless $cities[0];
148 if (not $not_enough_room or $print) {
149 #print "Pole: " . print_list(@pole);
150 #print "Water: " . print_list(@water);
151 #print "Islands: " . print_list(@islands);
152 #print "Mountains: " . print_list(@mountains);
153 #print "Cities: " . print_list(@cities);
154 #print "Homes: " . print_list(@home);
156 print "Earthlings: $earthlings\n".
157 "Gods: " . ($earthlings/2) . "\n".
158 "Size of world: $n\n".
159 "Number of poles: $pole_count\n".
160 "Minimum pole distance: $min_pole_distance\n".
161 "Water: $water_count\n".
162 "Islands: $island_count\n".
163 "Citys: $city_count\n".
164 "Plain: " . ( ($n * $n * 2) - ($water_count + $pole_count +
165 $earthlings + $city_count)) . "\n";
167 print $map->write_string($ascii->{-plain},"Plain",
168 [\@pole,$ascii->{-pole},"Pole"],
169 [\@water,$ascii->{-water},"Water"],
170 [\@islands,$ascii->{-island},"Islands"],
171 [\@home,$ascii->{-home},"Home"],
172 [\@mountains,$ascii->{-mountain},"Mountains"],
173 [\@cities,$ascii->{-city},"Cities"]);
177 print "\nNot enough room! Try again ...\n";
181 my $r = $dont_ask ? 'y' :
182 $t->readline('Wrote this world to database? (n/q/[name_of_game])');
186 } elsif ($r =~ /^n$/i) {
189 my $speed = $dont_ask ? 3600 :
190 $t->readline('Speed of game in seconds per game step: ');
192 my $dbh = DBI->connect("dbi:$db_source",$db_user,$db_passwd,
194 'RaiseError' => 1,'AutoCommit' => 0});
196 # TODO: use DataBase::find_first_free("GAME","GAME")
198 my $table = $dbh->selectall_arrayref("select GAME from GAME");
199 my @game_ids = sort {$a <=> $b} (map {$_->[0]} @$table);
202 for my $try (@game_ids) {
203 last if $game < $try;
207 print "Erste Freie Game ID: $game\n";
208 my $db = DataBase->new($dbh);
209 my $aymgame = Game->new($game,-1,$db);
211 $map->write_db($dbh,$game,$r,$speed,'PLAIN',
216 [\@mountains,"MOUNTAIN"],
219 # mark home cities and holy mountains
220 for my $home (@home, @mountains) {
221 my $lo = $dbh->quote($home->to_string());
222 my $cmd = "UPDATE MAP SET HOME=-1 where GAME=$game AND LOCATION=$lo";
226 # set home cities occupied
227 # insert PRODUCE Commands for Homecitys
228 for my $home (@home) {
229 my $l = $dbh->quote($home->to_string());
230 my $c = "UPDATE MAP SET OCCUPANT=-1 where GAME=$game AND LOCATION=$l";
233 $aymgame->insert_command('PRODUCE','ROLE=-1',$home->to_string());
236 # make one of the poles startup aymargeddon
237 my $aym = $pole[rand($#pole + 1)];
238 my $ter = $dbh->quote('AYMARGEDDON');
239 my $loc = $dbh->quote($aym->to_string());
240 my $comd = "UPDATE MAP SET TERRAIN=$ter where GAME = $game AND LOCATION=$loc";
244 $::conf->{-DEBUG} = 0;
245 print "Check in the database:\n";
246 my $m_count = $db->count('MAP', "GAME=$game AND TERRAIN=MOUNTAIN");
247 my $h_count = $db->count('MAP', "GAME=$game AND TERRAIN=CITY AND HOME=-1");
248 my $o_count = $db->count('MAP', "GAME=$game AND OCCUPANT=-1");
249 print "Mountains: " . $m_count;
250 print "\nCitys: " . $db->count('MAP',
251 "GAME=$game AND TERRAIN=CITY");
252 print "\nHomes: " . $h_count;
253 print "\nIslands: " . $db->count('MAP',
254 "GAME=$game AND TERRAIN=ISLE");
255 print "\nPoles: " . $db->count('MAP',
256 "GAME=$game AND TERRAIN=POLE");
257 print "\nAymargeddon: " . $db->count('MAP',
258 "GAME=$game AND TERRAIN=AYMARGEDDON");
259 print "\nWater: " . $db->count('MAP',
260 "GAME=$game AND TERRAIN=WATER");
261 print "\nPlain: " . $db->count('MAP',
262 "GAME=$game AND TERRAIN=PLAIN");
263 print "\nOccupied: " . $o_count;
266 if($o_count != $h_count or $h_count != $m_count or $m_count != $o_count){
267 print "homes: ". print_list(@home) . "\nmountains: ".
268 print_list(@mountains) . "\ncities: " . print_list(@cities) . "\n";
269 my $boesewichter = $db->select_array('MAP',
271 "GAME=$game AND HOME=-1 AND ".
272 "OCCUPANT=0 AND TERRAIN=CITY");
273 print "boesewichter: "; print map $_->[0] . ", ", @$boesewichter;print "\n";
284 # distributes homecitys near mountains
289 for my $m (@mountains){
290 $mountains{$m->to_string()} = 1;
294 for my $m (@mountains){
295 my @neighbours = $map->neighbours($m);
298 while($#neighbours >= 0){
299 my $rand = rand($#neighbours + 1);
300 $home = $neighbours[$rand];
301 my @home_neighbours = $map->neighbours($home);
302 my ($m_count,$h_count) = (0,0);
303 for my $hn (@home_neighbours){
304 $h_count++ if exists $homes{$hn->to_string()};
305 $m_count++ if exists $mountains{$hn->to_string()};
307 if($h_count == 0 and $m_count == 1){
309 for my $h (keys %homes){
310 my $d = $map->distance(Location->from_string($h),$home);
311 if($d < $::conf->{-MIN_DISTANCE_HOME}){
316 $homes{$home->to_string()} = 1;
321 splice @neighbours,$rand,1;
323 last unless $#neighbours >= 0;
326 for my $h (keys %homes){
327 push @ret, Location->from_string($h);
333 my ($count,$homes,$exclude) = @_;
337 for my $f (@$exclude) {
338 $ex{$f->to_string()} = 1;
342 # build two cities in neihgbourhood of each home
344 for my $home (@$homes){
345 # print "build citys for " . $home->to_string() . ": ";
346 my @neighbours = $map->neighbours($home);
348 # exclude non buildable terrain
350 for my $n (@neighbours){
351 my $nstr = $n->to_string();
353 splice @neighbours,$i,1;
359 my $cities = $::conf->{-NEIGHBOUR_CITIES};
361 my $r = rand($#neighbours+1);
362 my $rstr = $neighbours[$r]->to_string();
363 # print " build city in $rstr\n";
366 splice @neighbours,$r,1;
370 # exclude all remaining neighbours
371 for my $n (@neighbours){
372 $ex{$n->to_string()} = 1;
376 # distribute the remaining cities to fields, which are not neighbours of a home
378 my $random = $map->random()->to_string();
379 unless(exists $ex{$random}){
381 $cities{$random} = 1;
386 # TODO: clustering check, no more than n in 2distance
388 return map Location->from_string($_), keys %cities;
391 # DEPRECATED, this function is no longer in use!
392 # returns all fields, which are plain and have
393 # - 4 or more neighbours ISLAND or WATER
394 # - no city as neighbour
395 # - more than 2 citys as neighbour
396 # - more than 7 citys with distance 2
398 my($water,$islands,$pole,$cities,$mountains) = @_;
400 print "look for bad home locations ...\n";
402 # my @m = @$mountains; print "mountains: $#m\n";
404 # reorganize data into hashes
406 for my $f (@$water,@$islands,@$pole){
407 $ex{$f->to_string()} = 1;
410 for my $c (@$cities){
411 $cit{$c->to_string()} = 1;
414 for my $m (@$mountains){
415 $mount{$m->to_string()} = 1;
420 for my $x (0..($n*2-1)){
421 for my $y (0..($n-1)){
422 my $lstring = "$x\_$y";
423 next if exists $ex{$lstring};
424 next if exists $cit{$lstring};
426 my $loc = new Location($x,$y);
428 # look in the neighboorhood
429 my @neighbours = $map->neighbours($loc);
430 my ($city,$water,$mount) = (0,0,0);
431 for my $n (@neighbours){
432 $city++ if exists $cit{$n->to_string()};
433 $water++ if exists $ex{$n->to_string()};
434 # $mount++ if exists $mount{$n->to_string()};
436 # $ret{$lstring} = 'no mountain in neighbourhood' if $mount == 0;
437 $ret{$lstring} = 'no city in neighbourhood' if $city == 0;
438 $ret{$lstring} = 'more than 3 cities in neighbourhood' if $city > 3;
439 $ret{$lstring} = 'to much water in neighbourhood' if $water > 3;
440 next if $ret{$lstring};
443 my @dist_neigh = $map->distant_neighbours($loc,2);
444 $city = 0; $mount = 0;
445 for my $n (@dist_neigh){
446 $city++ if exists $cit{$n->to_string()};
447 $mount++ if exists $mount{$n->to_string()};
449 # print "m: $mount, c: $city\n";
450 $ret{$lstring} = 'more than 7 cities in distance 2' if $city > 7;
451 $ret{$lstring} = 'less than 2 cities in distance 2' if $city < 2;
452 $ret{$lstring} = 'no mountain in distance 2' unless $mount;
458 for my $r (keys %ret){
460 push @ret, Location->from_string($r);
467 my ($count, $w,$p) = @_;
474 my $water_field = floor(rand($#w) + 1);
475 my $wf = $w[$water_field];
479 $to_close = 1 if($map->distance($p,$wf) < 2);
483 splice @w,$water_field,1;
491 my ($count, @w) = @_;
492 # print "flood($count,@w)\n";
497 push @new_w, $map->neighbours($pole);
499 $count -= $#new_w + 1;
500 return @new_w unless $count > 0;
503 for my $w (@w,@new_w) {
504 $w{$w->to_string()} = 1;
510 # get a random water field
511 my $water_field = floor(rand($#w) + 1);
512 my $wf = $w[$water_field];
513 # get neigbours without water
514 my @nb = $map->neighbours($wf);
517 unless (exists $w{$nb->to_string()}) {
524 # get a random neigbour
525 my $rn = floor(rand($#nb) + 1);
528 $w{$rnr->to_string()} = 1;
535 # distributes $count locations at the map in minimal distance from
536 # fields not at exclude
537 # TODO: should be in Map.pm.
538 # TODO: should incorporate build() and vulcano()
539 # TODO: make shure there is really no field left.
541 my ($count,$dist,$min_selfdist,$wanted_selfdist,$exclude,@fields) = @_;
542 my $fields_distance = 2;
543 my $selfdist = $wanted_selfdist;
545 # print "minself: $min_selfdist, wantedself: $wanted_selfdist\n";
547 # print "fields: @fields\n";
549 #print "Exclude: " . print_list(@$exclude);
555 for my $f (@$exclude) {
556 $ex{$f->to_string()} = 1;
560 my $loop = $earthlings * 10;
562 my $short_allowed = 0;
563 while ($loop and $count) {
565 my $r = $map->random();
568 for my $xy (@fields) {
569 my $d = $map->distance($r,$xy);
570 my ($x,$y) = $xy->get();
578 for my $xy (@return_fields) {
579 my $d = $map->distance($r,$xy);
580 my ($x,$y) = $xy->get();
582 if ($d < $selfdist) {
583 if($d >= $selfdist - 1 and $short_count < 1 and $short_allowed){
592 for my $x (@$exclude){
593 if($r->to_string() eq $x->to_string()){
602 push @return_fields, $r;
608 if($loop <= 0 and ($selfdist > $min_selfdist)){
618 # print "c: $count, l: $loop\n";
624 print "need still room for $count locations\n";
627 return @return_fields;
634 $string .= $l->to_string() . ', ';