src/create.pl

   1 #!/usr/bin/perl -w
   2 ##########################################################################
   3 #
   4 #   Copyright (c) 2003-2012 Aymargeddon Development Team
   5 #
   6 #   This file is part of "Last days of Aymargeddon" - a massive multi player
   7 #   onine game of strategy
   8 #
   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.
  13 #
  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.
  17 #
  18 #    See the GNU Affero General Public License for more details.
  19 #
  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/>.
  22 #
  23 ###########################################################################
  24 #
  25
  26 #
  27 #
  28 # creates the world to destroy
  29 #
  30 # usage: ./create.pl [number of eartlings]
  31 #
  32 #
  33
  34 # TODO: use FROGS/DataBase.pm instead of DBI.pm
  35
  36 use strict;
  37
  38 $| = 1;
  39
  40 use DBI;
  41 use Data::Dumper;
  42 use POSIX qw(floor ceil);
  43 use Term::ReadLine;
  44   my $t = Term::ReadLine->new('test');
  45
  46 use FROGS::HexTorus;
  47 use FROGS::Config qw($conf);
  48 use FROGS::DataBase;
  49 use FROGS::Game;
  50
  51 Util::open_log();
  52
  53 my $earthlings = $ARGV[0] || 10; # number of earthlings
  54
  55 my $dont_ask = defined $ARGV[1] ? 1 : 0;
  56
  57 my $db_source = $::conf->{-DB_SOURCE};
  58 my $db_user = $::conf->{-DB_USER};
  59 my $db_passwd = $::conf->{-DB_PASSWD};
  60
  61 my $ascii = {-pole => '@',
  62              -city => '+',
  63              -home => '#',
  64              -water => '~',
  65              -island => 'o',
  66              -mountain => '^',
  67              -plain => '\''};
  68
  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;
  72
  73 # TODO: maybe to small?
  74 my $n = ceil(sqrt($earthlings * 7)); # size of world
  75
  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);
  87
  88 my $nn = 0;
  89 my $map;
  90 while (1) {
  91   if ($pump_up_world and $nn > $pump_up_world) {
  92     $n++;
  93     print "*** World to small! Make it bigger! New size $n.***\n";
  94     $nn = 0;
  95   }
  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);
 102
 103   # TODO: uggly structure
 104   my $print = 0;
 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);
 113   }
 114   unless ($not_enough_room){
 115     print "generate islands ...\n";
 116     @islands = vulcano($island_count, \@water, \@pole);
 117   }
 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];
 123   }
 124   # print print_list(@mountains);
 125   unless ($not_enough_room){
 126     print "generate homecitys ...\n";
 127
 128     for my $i (1..50){
 129       @home = homeland(@mountains,@pole,@water,@islands);
 130       # $print = 1 unless $#home<$#mountains;
 131       last unless $#home<$#mountains;
 132       print " RETRY...\n";
 133       my $mref = Util::shuffle(\@mountains);
 134       @mountains = @$mref;
 135     }
 136     print "\n";
 137     $not_enough_room = 1 if $#home<$#mountains;
 138   }
 139
 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];
 145   }
 146
 147
 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);
 155
 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";
 166
 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"]);
 174     die if $print;
 175   } else {
 176     $nn++;
 177     print "\nNot enough room! Try again ...\n";
 178     next;
 179   }
 180
 181   my $r = $dont_ask ? 'y' :
 182     $t->readline('Wrote this world to database? (n/q/[name_of_game])');
 183
 184   if ($r =~ /^q$/i) {
 185     exit;
 186   } elsif ($r =~ /^n$/i) {
 187     next;
 188   } else {
 189     my $speed = $dont_ask ? 3600 :
 190       $t->readline('Speed of game in seconds per game step: ');
 191
 192     my $dbh = DBI->connect("dbi:$db_source",$db_user,$db_passwd,
 193                            {
 194                             'RaiseError' => 1,'AutoCommit' => 0});
 195
 196     # TODO: use DataBase::find_first_free("GAME","GAME")
 197
 198     my $table = $dbh->selectall_arrayref("select GAME from GAME");
 199     my @game_ids = sort {$a <=> $b} (map {$_->[0]} @$table);
 200
 201     my $game = 1;
 202     for my $try (@game_ids) {
 203       last if $game < $try;
 204       $game = $try + 1;
 205     }
 206
 207     print "Erste Freie Game ID: $game\n";
 208     my $db = DataBase->new($dbh);
 209     my $aymgame = Game->new($game,-1,$db);
 210
 211     $map->write_db($dbh,$game,$r,$speed,'PLAIN',
 212                    [\@pole,"POLE"],
 213                    [\@water,"WATER"],
 214                    [\@islands,"ISLE"],
 215                    [\@home,"CITY"],
 216                    [\@mountains,"MOUNTAIN"],
 217                    [\@cities,"CITY"]);
 218
 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";
 223       $dbh->do($cmd);
 224     }
 225
 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";
 231       $dbh->do($c);
 232
 233       $aymgame->insert_command('PRODUCE','ROLE=-1',$home->to_string());
 234     }
 235
 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";
 241     $dbh->do($comd);
 242
 243     # check some values
 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;
 264     print "\n";
 265
 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',
 270                                            'LOCATION',
 271                                            "GAME=$game AND HOME=-1 AND ".
 272                                            "OCCUPANT=0 AND TERRAIN=CITY");
 273       print "boesewichter: "; print map $_->[0] . ", ", @$boesewichter;print "\n";
 274     }
 275
 276     $dbh->commit();
 277     $dbh->disconnect();
 278
 279
 280     exit;
 281   }
 282 }
 283
 284 # distributes homecitys near mountains
 285 sub homeland{
 286   my @mountains = @_;
 287
 288   my %mountains = ();
 289   for my $m (@mountains){
 290     $mountains{$m->to_string()} = 1;
 291   }
 292
 293   my %homes = ();
 294   for my $m (@mountains){
 295     my @neighbours = $map->neighbours($m);
 296
 297     my $home;
 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()};
 306       }
 307       if($h_count == 0 and $m_count == 1){
 308         my $valid = 1;
 309         for my $h (keys %homes){
 310           my $d = $map->distance(Location->from_string($h),$home);
 311           if($d < $::conf->{-MIN_DISTANCE_HOME}){
 312             $valid = 0;
 313           }
 314         }
 315         if($valid){
 316           $homes{$home->to_string()} = 1;
 317           print "#";
 318           last;
 319         }
 320       }
 321       splice @neighbours,$rand,1;
 322     }
 323     last unless $#neighbours >= 0;
 324   }
 325   my @ret = ();
 326   for my $h (keys %homes){
 327     push @ret, Location->from_string($h);
 328   }
 329   return @ret;
 330 }
 331
 332 sub build{
 333   my ($count,$homes,$exclude) = @_;
 334
 335   my %ex;
 336   if ($exclude) {
 337     for my $f (@$exclude) {
 338       $ex{$f->to_string()} = 1;
 339     }
 340   }
 341
 342   # build two cities in neihgbourhood of each home
 343   my %cities = ();
 344   for my $home (@$homes){
 345     # print "build citys for " . $home->to_string() . ": ";
 346     my @neighbours = $map->neighbours($home);
 347
 348     # exclude non buildable terrain
 349     my $i = 0;
 350     for my $n (@neighbours){
 351       my $nstr = $n->to_string();
 352       if($ex{$nstr}){
 353         splice @neighbours,$i,1;
 354       }
 355       $i++;
 356     }
 357
 358     # build citys
 359     my $cities = $::conf->{-NEIGHBOUR_CITIES};
 360     while($cities){
 361       my $r = rand($#neighbours+1);
 362       my $rstr = $neighbours[$r]->to_string();
 363       # print "  build city in $rstr\n";
 364       $cities{$rstr} = 1;
 365       $ex{$rstr} = 1;
 366       splice @neighbours,$r,1;
 367       $cities--;
 368     }
 369
 370     # exclude all remaining neighbours
 371     for my $n (@neighbours){
 372       $ex{$n->to_string()} = 1;
 373     }
 374   }
 375
 376   # distribute the remaining cities to fields, which are not neighbours of a home
 377   while($count){
 378     my $random = $map->random()->to_string();
 379     unless(exists $ex{$random}){
 380       $ex{$random} = 1;
 381       $cities{$random} = 1;
 382       $count--;
 383     }
 384   }
 385
 386   # TODO: clustering check, no more than n in 2distance
 387
 388   return map Location->from_string($_), keys %cities;
 389 }
 390
 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
 397 sub bad_home{
 398   my($water,$islands,$pole,$cities,$mountains) = @_;
 399
 400   print "look for bad home locations ...\n";
 401
 402   # my @m = @$mountains; print "mountains: $#m\n";
 403
 404   # reorganize data into hashes
 405   my %ex;
 406   for my $f (@$water,@$islands,@$pole){
 407     $ex{$f->to_string()} = 1;
 408   }
 409   my %cit;
 410   for my $c (@$cities){
 411     $cit{$c->to_string()} = 1;
 412   }
 413   my %mount;
 414   for my $m (@$mountains){
 415     $mount{$m->to_string()} = 1;
 416   }
 417
 418   # for all fields
 419   my %ret;
 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};
 425       print ".";
 426       my $loc = new Location($x,$y);
 427
 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()};
 435       }
 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};
 441
 442       # look in distance 2
 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()};
 448       }
 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;
 453     }
 454   }
 455   print "\n";
 456   my @ret;
 457   my %stat;
 458   for my $r (keys %ret){
 459     $stat{$ret{$r}}++;
 460     push @ret, Location->from_string($r);
 461   }
 462   print Dumper \%stat;
 463   return @ret;
 464 }
 465
 466 sub vulcano{
 467   my ($count, $w,$p) = @_;
 468   my @w = @$w;
 469   my @p = @$p;
 470
 471   my @islands;
 472
 473   while ($count) {
 474     my $water_field = floor(rand($#w) + 1);
 475     my $wf = $w[$water_field];
 476
 477     my $to_close = 0;
 478     for my $p (@p) {
 479       $to_close = 1 if($map->distance($p,$wf) < 2);
 480     }
 481     next if $to_close;
 482
 483     splice @w,$water_field,1;
 484     push @islands, $wf;
 485     $count--;
 486   }
 487   return @islands;
 488 }
 489
 490 sub flood{
 491   my ($count, @w) = @_;
 492   # print "flood($count,@w)\n";
 493
 494   # flood neighbours
 495   my @new_w;
 496   for my $pole (@w) {
 497     push @new_w, $map->neighbours($pole);
 498   }
 499   $count -= $#new_w + 1;
 500   return @new_w unless $count > 0;
 501
 502   my %w;
 503   for my $w (@w,@new_w) {
 504     $w{$w->to_string()} = 1;
 505   }
 506   @w = @new_w;
 507
 508   while ($count) {
 509     # print "$count ";
 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);
 515     my @nb_new;
 516     for my $nb (@nb) {
 517       unless (exists $w{$nb->to_string()}) {
 518         push @nb_new, $nb;
 519       }
 520     }
 521     @nb = @nb_new;
 522
 523     if ($#nb > 0) {
 524       # get a random neigbour
 525       my $rn = floor(rand($#nb) + 1);
 526       my $rnr = $nb[$rn];
 527       push @w,$rnr;
 528       $w{$rnr->to_string()} = 1;
 529       $count --;
 530     }
 531   }
 532   return @w;
 533 }
 534
 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.
 540 sub distribute{
 541   my ($count,$dist,$min_selfdist,$wanted_selfdist,$exclude,@fields) = @_;
 542   my $fields_distance = 2;
 543   my $selfdist = $wanted_selfdist;
 544
 545   # print "minself: $min_selfdist, wantedself: $wanted_selfdist\n";
 546
 547   # print "fields: @fields\n";
 548
 549   #print "Exclude: " . print_list(@$exclude);
 550
 551   my @return_fields;
 552
 553   my %ex;
 554   if ($exclude) {
 555     for my $f (@$exclude) {
 556       $ex{$f->to_string()} = 1;
 557     }
 558   }
 559
 560   my $loop = $earthlings * 10;
 561   my $maxloop = $loop;
 562   my $short_allowed = 0;
 563   while ($loop and $count) {
 564     #  while($count){
 565     my $r = $map->random();
 566     my $valid = 1;
 567     #    if ($valid) {
 568     for my $xy (@fields) {
 569       my $d = $map->distance($r,$xy);
 570       my ($x,$y) = $xy->get();
 571
 572       if ($d < $dist) {
 573         $valid = 0;
 574         last;
 575       }
 576     }
 577     my $short_count = 0;
 578     for my $xy (@return_fields) {
 579       my $d = $map->distance($r,$xy);
 580       my ($x,$y) = $xy->get();
 581
 582       if ($d < $selfdist) {
 583         if($d >= $selfdist - 1 and $short_count < 1 and $short_allowed){
 584           $short_count++;
 585           print $short_count;
 586         }else{
 587           $valid = 0;
 588           last;
 589         }
 590       }
 591     }
 592     for my $x (@$exclude){
 593       if($r->to_string() eq $x->to_string()){
 594         $valid = 0;
 595         last;
 596       }
 597     }
 598     # }
 599
 600     if ($valid) {
 601       # push @fields, $r;
 602       push @return_fields, $r;
 603       $count--;
 604       print "+";
 605     } else {
 606       $loop--;
 607       # print "-";
 608       if($loop <= 0 and ($selfdist > $min_selfdist)){
 609         $loop = $maxloop;
 610         # $selfdist--;
 611         # print $selfdist;
 612         $short_allowed = 1;
 613         print "S";
 614       }
 615
 616       next;
 617     }
 618     # print "c: $count, l: $loop\n";
 619     # }
 620   }
 621
 622   print "\n";
 623   unless($loop){
 624     print "need still room for $count locations\n";
 625     return 0;
 626   }
 627   return @return_fields;
 628 }
 629
 630 sub print_list{
 631   my @f = @_;
 632   my $string;
 633   for my $l (@f){
 634     $string .= $l->to_string() . ', ';
 635   }
 636   $string .= "\n";
 637   return $string;
 638 }
 639