?
[aymargeddon/current.git] / 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