src/create.pl

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