2 ##########################################################################
4 # Copyright (c) 2003 Aymargeddon Development Team
6 # This file is part of "Last days of Aymargeddon"
8 # Aymargeddon is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by the Free
10 # Software Foundation; either version 2 of the License, or (at your option)
13 # Aymargeddon is distributed in the hope that it will be useful, but WITHOUT
14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
17 # You should have received a copy of the GNU General Public License along
18 # with this program; if not, write to the Free Software Foundation, Inc., 675
19 # Mass Ave, Cambridge, MA 02139, USA.
21 ###########################################################################
26 # creates the world to destroy
28 # usage: ./create.pl [number of eartlings]
32 # TODO: use FROGS/DataBase.pm instead of DBI.pm
40 use POSIX qw(floor ceil);
42 my $t = Term::ReadLine->new('test');
45 use FROGS::Config qw($conf);
51 my $earthlings = $ARGV[0] || 10; # number of earthlings
53 my $dont_ask = defined $ARGV[1] ? 1 : 0;
55 my $db_source = $::conf->{-DB_SOURCE};
56 my $db_user = $::conf->{-DB_USER};
57 my $db_passwd = $::conf->{-DB_PASSWD};
59 my $ascii = {-pole => '@',
67 # set to 0 to not change size of world during generation
68 # set to positive value to set the number of itterations need to pumpup
69 my $pump_up_world = 10;
71 # TODO: maybe to small?
72 my $n = ceil(sqrt($earthlings * 7)); # size of world
74 my $pole_count = floor(sqrt($n));
75 my $min_pole_distance = ceil($n/2);
76 my $water_count = floor($n*$n/2);
77 #TODO: number of islands should depend on players, not on size
78 my $island_count = floor($water_count/3);
79 my $min_home_distance = $::conf->{-MIN_DISTANCE_HOME};
80 my $min_mountain_distance = $::conf->{-MIN_DISTANCE_MOUNTAIN};
81 my $wanted_mountain_distance = $::conf->{-WANTED_DISTANCE_MOUNTAIN};
82 my $min_water_distance = $::conf->{-MIN_DISTANCE_MOUNTAIN_FROM_WATER};
83 my $city_count = $earthlings * 4;
84 my $mountain_count = floor($earthlings);
89 if ($pump_up_world and $nn > $pump_up_world) {
91 print "*** World to small! Make it bigger! New size $n.***\n";
94 my $not_enough_room = 0;
95 $map = new HexTorus($n);
96 $pole_count = floor(sqrt($n));
97 $min_pole_distance = ceil($n/2);
98 $water_count = floor($n*$n/2);
99 $island_count = floor($water_count/3);
101 # TODO: uggly structure
103 print "generate poles ...\n";
104 my @pole = distribute($pole_count,$min_pole_distance,
105 $min_pole_distance,$min_pole_distance);
106 $not_enough_room = 1 unless $pole[0];
107 my (@water,@islands,@home,@mountains,@not_cities,@cities);
108 unless ($not_enough_room){
109 print "generate water ...\n";
110 @water = flood($water_count,@pole);
112 unless ($not_enough_room){
113 print "generate islands ...\n";
114 @islands = vulcano($island_count, \@water, \@pole);
116 unless ($not_enough_room){
117 print "generate mountains ...\n";
118 @mountains = distribute($mountain_count,$min_water_distance,
119 $min_mountain_distance,$wanted_mountain_distance,[],@water);
120 $not_enough_room = 1 unless $mountains[0];
122 # print print_list(@mountains);
123 unless ($not_enough_room){
124 print "generate homecitys ...\n";
127 @home = homeland(@mountains,@pole,@water,@islands);
128 # $print = 1 unless $#home<$#mountains;
129 last unless $#home<$#mountains;
131 my $mref = Util::shuffle(\@mountains);
135 $not_enough_room = 1 if $#home<$#mountains;
138 unless ($not_enough_room){
139 print "generate citys ...\n";
140 @not_cities = (@water,@pole,@mountains,@islands,@home);
141 @cities = build($city_count,\@home,\@not_cities);
142 $not_enough_room = 1 unless $cities[0];
146 if (not $not_enough_room or $print) {
147 #print "Pole: " . print_list(@pole);
148 #print "Water: " . print_list(@water);
149 #print "Islands: " . print_list(@islands);
150 #print "Mountains: " . print_list(@mountains);
151 #print "Cities: " . print_list(@cities);
152 #print "Homes: " . print_list(@home);
154 print "Earthlings: $earthlings\n".
155 "Gods: " . ($earthlings/2) . "\n".
156 "Size of world: $n\n".
157 "Number of poles: $pole_count\n".
158 "Minimum pole distance: $min_pole_distance\n".
159 "Water: $water_count\n".
160 "Islands: $island_count\n".
161 "Citys: $city_count\n".
162 "Plain: " . ( ($n * $n * 2) - ($water_count + $pole_count +
163 $earthlings + $city_count)) . "\n";
165 print $map->write_string($ascii->{-plain},"Plain",
166 [\@pole,$ascii->{-pole},"Pole"],
167 [\@water,$ascii->{-water},"Water"],
168 [\@islands,$ascii->{-island},"Islands"],
169 [\@home,$ascii->{-home},"Home"],
170 [\@mountains,$ascii->{-mountain},"Mountains"],
171 [\@cities,$ascii->{-city},"Cities"]);
175 print "\nNot enough room! Try again ...\n";
179 my $r = $dont_ask ? 'y' :
180 $t->readline('Wrote this world to database? (n/q/[name_of_game])');
184 } elsif ($r =~ /^n$/i) {
187 my $speed = $dont_ask ? 3600 :
188 $t->readline('Speed of game in seconds per game step: ');
190 my $dbh = DBI->connect("dbi:$db_source",$db_user,$db_passwd,
192 'RaiseError' => 1,'AutoCommit' => 0});
194 # TODO: use DataBase::find_first_free("GAME","GAME")
196 my $table = $dbh->selectall_arrayref("select GAME from GAME");
197 my @game_ids = sort {$a <=> $b} (map {$_->[0]} @$table);
200 for my $try (@game_ids) {
201 last if $game < $try;
205 print "Erste Freie Game ID: $game\n";
206 my $db = DataBase->new($dbh);
207 my $aymgame = Game->new($game,-1,$db);
209 $map->write_db($dbh,$game,$r,$speed,'PLAIN',
214 [\@mountains,"MOUNTAIN"],
217 # mark home cities and holy mountains
218 for my $home (@home, @mountains) {
219 my $lo = $dbh->quote($home->to_string());
220 my $cmd = "UPDATE MAP SET HOME=-1 where GAME=$game AND LOCATION=$lo";
224 # set home cities occupied
225 # insert PRODUCE Commands for Homecitys
226 for my $home (@home) {
227 my $l = $dbh->quote($home->to_string());
228 my $c = "UPDATE MAP SET OCCUPANT=-1 where GAME=$game AND LOCATION=$l";
231 $aymgame->insert_command('PRODUCE','ROLE=-1',$home->to_string());
234 # make one of the poles startup aymargeddon
235 my $aym = $pole[rand($#pole + 1)];
236 my $ter = $dbh->quote('AYMARGEDDON');
237 my $loc = $dbh->quote($aym->to_string());
238 my $comd = "UPDATE MAP SET TERRAIN=$ter where GAME = $game AND LOCATION=$loc";
242 $::conf->{-DEBUG} = 0;
243 print "Check in the database:\n";
244 my $m_count = $db->count('MAP', "GAME=$game AND TERRAIN=MOUNTAIN");
245 my $h_count = $db->count('MAP', "GAME=$game AND TERRAIN=CITY AND HOME=-1");
246 my $o_count = $db->count('MAP', "GAME=$game AND OCCUPANT=-1");
247 print "Mountains: " . $m_count;
248 print "\nCitys: " . $db->count('MAP',
249 "GAME=$game AND TERRAIN=CITY");
250 print "\nHomes: " . $h_count;
251 print "\nIslands: " . $db->count('MAP',
252 "GAME=$game AND TERRAIN=ISLE");
253 print "\nPoles: " . $db->count('MAP',
254 "GAME=$game AND TERRAIN=POLE");
255 print "\nAymargeddon: " . $db->count('MAP',
256 "GAME=$game AND TERRAIN=AYMARGEDDON");
257 print "\nWater: " . $db->count('MAP',
258 "GAME=$game AND TERRAIN=WATER");
259 print "\nPlain: " . $db->count('MAP',
260 "GAME=$game AND TERRAIN=PLAIN");
261 print "\nOccupied: " . $o_count;
264 if($o_count != $h_count or $h_count != $m_count or $m_count != $o_count){
265 print "homes: ". print_list(@home) . "\nmountains: ".
266 print_list(@mountains) . "\ncities: " . print_list(@cities) . "\n";
267 my $boesewichter = $db->select_array('MAP',
269 "GAME=$game AND HOME=-1 AND ".
270 "OCCUPANT=0 AND TERRAIN=CITY");
271 print "boesewichter: "; print map $_->[0] . ", ", @$boesewichter;print "\n";
282 # distributes homecitys near mountains
287 for my $m (@mountains){
288 $mountains{$m->to_string()} = 1;
292 for my $m (@mountains){
293 my @neighbours = $map->neighbours($m);
296 while($#neighbours >= 0){
297 my $rand = rand($#neighbours + 1);
298 $home = $neighbours[$rand];
299 my @home_neighbours = $map->neighbours($home);
300 my ($m_count,$h_count) = (0,0);
301 for my $hn (@home_neighbours){
302 $h_count++ if exists $homes{$hn->to_string()};
303 $m_count++ if exists $mountains{$hn->to_string()};
305 if($h_count == 0 and $m_count == 1){
307 for my $h (keys %homes){
308 my $d = $map->distance(Location->from_string($h),$home);
309 if($d < $::conf->{-MIN_DISTANCE_HOME}){
314 $homes{$home->to_string()} = 1;
319 splice @neighbours,$rand,1;
321 last unless $#neighbours >= 0;
324 for my $h (keys %homes){
325 push @ret, Location->from_string($h);
331 my ($count,$homes,$exclude) = @_;
335 for my $f (@$exclude) {
336 $ex{$f->to_string()} = 1;
340 # build two cities in neihgbourhood of each home
342 for my $home (@$homes){
343 # print "build citys for " . $home->to_string() . ": ";
344 my @neighbours = $map->neighbours($home);
346 # exclude non buildable terrain
348 for my $n (@neighbours){
349 my $nstr = $n->to_string();
351 splice @neighbours,$i,1;
357 my $cities = $::conf->{-NEIGHBOUR_CITIES};
359 my $r = rand($#neighbours+1);
360 my $rstr = $neighbours[$r]->to_string();
361 # print " build city in $rstr\n";
364 splice @neighbours,$r,1;
368 # exclude all remaining neighbours
369 for my $n (@neighbours){
370 $ex{$n->to_string()} = 1;
374 # distribute the remaining cities to fields, which are not neighbours of a home
376 my $random = $map->random()->to_string();
377 unless(exists $ex{$random}){
379 $cities{$random} = 1;
384 # TODO: clustering check, no more than n in 2distance
386 return map Location->from_string($_), keys %cities;
389 # DEPRECATED, this function is no longer in use!
390 # returns all fields, which are plain and have
391 # - 4 or more neighbours ISLAND or WATER
392 # - no city as neighbour
393 # - more than 2 citys as neighbour
394 # - more than 7 citys with distance 2
396 my($water,$islands,$pole,$cities,$mountains) = @_;
398 print "look for bad home locations ...\n";
400 # my @m = @$mountains; print "mountains: $#m\n";
402 # reorganize data into hashes
404 for my $f (@$water,@$islands,@$pole){
405 $ex{$f->to_string()} = 1;
408 for my $c (@$cities){
409 $cit{$c->to_string()} = 1;
412 for my $m (@$mountains){
413 $mount{$m->to_string()} = 1;
418 for my $x (0..($n*2-1)){
419 for my $y (0..($n-1)){
420 my $lstring = "$x\_$y";
421 next if exists $ex{$lstring};
422 next if exists $cit{$lstring};
424 my $loc = new Location($x,$y);
426 # look in the neighboorhood
427 my @neighbours = $map->neighbours($loc);
428 my ($city,$water,$mount) = (0,0,0);
429 for my $n (@neighbours){
430 $city++ if exists $cit{$n->to_string()};
431 $water++ if exists $ex{$n->to_string()};
432 # $mount++ if exists $mount{$n->to_string()};
434 # $ret{$lstring} = 'no mountain in neighbourhood' if $mount == 0;
435 $ret{$lstring} = 'no city in neighbourhood' if $city == 0;
436 $ret{$lstring} = 'more than 3 cities in neighbourhood' if $city > 3;
437 $ret{$lstring} = 'to much water in neighbourhood' if $water > 3;
438 next if $ret{$lstring};
441 my @dist_neigh = $map->distant_neighbours($loc,2);
442 $city = 0; $mount = 0;
443 for my $n (@dist_neigh){
444 $city++ if exists $cit{$n->to_string()};
445 $mount++ if exists $mount{$n->to_string()};
447 # print "m: $mount, c: $city\n";
448 $ret{$lstring} = 'more than 7 cities in distance 2' if $city > 7;
449 $ret{$lstring} = 'less than 2 cities in distance 2' if $city < 2;
450 $ret{$lstring} = 'no mountain in distance 2' unless $mount;
456 for my $r (keys %ret){
458 push @ret, Location->from_string($r);
465 my ($count, $w,$p) = @_;
472 my $water_field = floor(rand($#w) + 1);
473 my $wf = $w[$water_field];
477 $to_close = 1 if($map->distance($p,$wf) < 2);
481 splice @w,$water_field,1;
489 my ($count, @w) = @_;
490 # print "flood($count,@w)\n";
495 push @new_w, $map->neighbours($pole);
497 $count -= $#new_w + 1;
498 return @new_w unless $count > 0;
501 for my $w (@w,@new_w) {
502 $w{$w->to_string()} = 1;
508 # get a random water field
509 my $water_field = floor(rand($#w) + 1);
510 my $wf = $w[$water_field];
511 # get neigbours without water
512 my @nb = $map->neighbours($wf);
515 unless (exists $w{$nb->to_string()}) {
522 # get a random neigbour
523 my $rn = floor(rand($#nb) + 1);
526 $w{$rnr->to_string()} = 1;
533 # distributes $count locations at the map in minimal distance from
534 # fields not at exclude
535 # TODO: should be in Map.pm.
536 # TODO: should incorporate build() and vulcano()
537 # TODO: make shure there is really no field left.
539 my ($count,$dist,$min_selfdist,$wanted_selfdist,$exclude,@fields) = @_;
540 my $fields_distance = 2;
541 my $selfdist = $wanted_selfdist;
543 # print "minself: $min_selfdist, wantedself: $wanted_selfdist\n";
545 # print "fields: @fields\n";
547 #print "Exclude: " . print_list(@$exclude);
553 for my $f (@$exclude) {
554 $ex{$f->to_string()} = 1;
558 my $loop = $earthlings * 10;
560 my $short_allowed = 0;
561 while ($loop and $count) {
563 my $r = $map->random();
566 for my $xy (@fields) {
567 my $d = $map->distance($r,$xy);
568 my ($x,$y) = $xy->get();
576 for my $xy (@return_fields) {
577 my $d = $map->distance($r,$xy);
578 my ($x,$y) = $xy->get();
580 if ($d < $selfdist) {
581 if($d >= $selfdist - 1 and $short_count < 1 and $short_allowed){
590 for my $x (@$exclude){
591 if($r->to_string() eq $x->to_string()){
600 push @return_fields, $r;
606 if($loop <= 0 and ($selfdist > $min_selfdist)){
616 # print "c: $count, l: $loop\n";
622 print "need still room for $count locations\n";
625 return @return_fields;
632 $string .= $l->to_string() . ', ';