src/Aymargeddon.pm

   1 ##########################################################################
   2 #
   3 #   Copyright (c) 2003-2012 Aymargeddon Development Team
   4 #
   5 #   This file is part of "Last days of Aymargeddon" - a massive multi player
   6 #   onine game of strategy
   7 #
   8 #        This program is free software: you can redistribute it and/or modify
   9 #        it under the terms of the GNU Affero General Public License as
  10 #        published by the Free Software Foundation, either version 3 of the
  11 #        License, or (at your option) any later version.
  12 #
  13 #        This program is distributed in the hope that it will be useful,
  14 #        but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 #        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  16 #
  17 #    See the GNU Affero General Public License for more details.
  18 #
  19 #    You should have received a copy of the GNU Affero General Public License
  20 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21 #
  22 ###########################################################################
  23 #
  24
  25 # generell Aymargeddon-specific functions
  26 #
  27
  28
  29 # TODO: move color calculation from map.epl in this module
  30
  31
  32 use strict;
  33 use FROGS::Game;
  34 use FROGS::HexTorus;
  35
  36 package Aymargeddon;
  37 use Data::Dumper;
  38 @Aymargeddon::ISA = qw(Game);
  39
  40 sub new{
  41   my ($class,$game,$user,$db,$lang) = @_; #TODO: $lang not used here?
  42
  43   my $self = Game->new($game,$user,$db);
  44
  45   bless($self,$class);
  46 }
  47
  48 sub get_map{
  49   my $self = shift;
  50
  51   unless (exists $self->{-map}){
  52       # TODO: HOME dupplication correct?
  53     $self->{-map} = $self->read_map("TERRAIN,HOME,OCCUPANT,TEMPLE,PLAGUE,HOME");
  54   }
  55   return $self->{-map};
  56 }
  57
  58 sub get_size{
  59   my $self = shift;
  60
  61   unless ($self->{-size}){
  62     my @size = $self->{-db}->read_game($self->{-game},'SIZE');
  63     $self->{-size} = $size[0] ? $size[0] : die "could not find size";
  64   }
  65   return $self->{-size};
  66 }
  67
  68 sub get_relation{
  69   my ($self, $other) = @_;
  70
  71   unless ($self->{-rel}){
  72     # print "bindrin\n";
  73     #    $self->{-rel} = $self->read_player_relations($self->{-game}, $self->{-user});
  74     $self->{-rel} = $self->read_player_relations($self->{-user});
  75   }
  76   #  print Dumper $self->{-rel};
  77   my $stat = $self->{-rel}->{$other}->{'STATUS'};
  78   return $stat ? $stat : 'NEUTRAL';
  79 }
  80
  81 # FRIEND, ALLIED => FRIEND ; FOE, BETRAY => FOE
  82 sub simplyfied_single_relation{
  83   my ($self,$me,$you) = @_;
  84   my $rel = $self->read_single_relation($me,$you);
  85
  86   return 'FRIEND' if Util::is_in($rel,'FRIEND','ALLIED');
  87   return 'FOE' if Util::is_in($rel,'FOE','BETRAY');
  88   return 'NEUTRAL';
  89 }
  90
  91
  92 sub god_fight{
  93   my ($self,$loc_str) = @_;
  94   my @ret = $self->read_field('GOD_ATTACKER',$loc_str);
  95   return $ret[0] ? 1 : 0;
  96 }
  97
  98 sub earthling_fight{
  99   my ($self,$loc_str) = @_;
 100   my @ret = $self->read_field('ATTACKER',$loc_str);
 101   return $ret[0] ? 1 : 0;
 102 }
 103
 104 sub arc_present{
 105   my ($self,$loc_str) = @_;
 106   my $arks_ref = $self->read_mobile('ID','ARK',$loc_str,1);
 107   my @arks = @$arks_ref;
 108   return $#arks+1;
 109 }
 110
 111 sub avatar_present{
 112   my ($self,$loc_str) = @_;
 113   return $self->read_mobile('OWNER','AVATAR',$loc_str,1);
 114 }
 115
 116 sub mobiles_available{
 117   my ($self,$loc_str,$avail) = @_;
 118   $avail = 1 unless defined $avail;
 119   my $fields = 'ID, TYPE, OWNER, ADORING, COUNT, STATUS, MOVE_WITH';
 120   return $self->read_mobile($fields,'',$loc_str, $avail);
 121 }
 122
 123
 124 #
 125 # sight stuff
 126 #
 127 # TODO: maybe the generell sight-stuff could go to Game.pm
 128
 129 # ATTENTION: this function generates the whole sight-matrix, if necessary.
 130 # it could be very time-consuming
 131 sub player_see_field{
 132   my ($self,$loc) = @_;
 133
 134   my @players = $self->get_all_roles();
 135
 136   my @ret = ();
 137   for my $player (@players){
 138     # ($player) = @$player;
 139     my $players_aym = new Aymargeddon($self->{-game},$player,
 140                                       $self->{-db},$self->{-lang});
 141     if ($players_aym->sight_of_field($loc)){
 142       push @ret, $player;
 143       # print "$player sees $loc.\n";
 144     }
 145   }
 146   return @ret;
 147 }
 148
 149 # this two functions reads sight directly from database
 150 sub sight_of_field{
 151   my ($self,$loc) = @_;
 152
 153   return 1 if $self->role($self->{-user}) eq 'OBSERVER'; # admin sees all
 154
 155   my $player = $self->{-user};
 156   my $map = HexTorus->new($self->get_size());
 157   return 1 if $self->sight_of_field_of_player($loc,$player,$map);
 158
 159   # read all players, which give us informations
 160   my $rel = $self->reverse_player_relations();
 161   for my $friend (keys %$rel){
 162     my $status = $rel->{$friend}->{'STATUS'};
 163     if($status eq 'ALLIED' or $status eq 'BETRAY'){
 164       if($self->is_earthling($friend) or $::conf->{-GODS_SHOW_EARTHLINGS}){
 165         return 1 if $self->sight_of_field_of_player($loc,$friend,$map);
 166       }
 167     }
 168   }
 169   return 0;
 170 }
 171
 172 sub sight_of_field_of_player{
 173   my ($self,$loc,$player,$map) = @_;
 174
 175   my ($ter,$own,$occ,$temple) = $self->read_field('TERRAIN,HOME,OCCUPANT,TEMPLE',$loc);
 176
 177   return 1 if($own == $player or $occ == $player);
 178   return 1 if @{$self->own_in_mobile($loc,$player)};
 179
 180   my $location = Location->from_string($loc);
 181   my $dist = 2;
 182   my @neighbours = $map->distant_neighbours($location,$dist);
 183   # Util::log("neighbours: ",-2);
 184   for my $l (@neighbours){
 185     my $d = $map->distance($location,$l);
 186     my $locstring = $l->to_string();
 187     # Util::log(" $locstring ($d),",-2);
 188
 189     my ($neighbour_ter,$neighbour_home) = $self->read_field('TERRAIN,HOME',$locstring);
 190     next if ($d > 1 && $neighbour_ter ne 'MOUNTAIN');
 191     return 1 if $neighbour_home == $player;
 192     return 1 if $neighbour_ter eq 'MOUNTAIN' and
 193       $neighbour_home <= 0 and $self->is_god($player);
 194     return 1 if @{$self->own_in_mobile($locstring,$player)};
 195   }
 196   # Util::log("",2);
 197   return 0;
 198 }
 199
 200 # this function generates the whole sight if called
 201 sub sight{
 202   my ($self,$loc_str) = @_;
 203
 204   return 1 if $self->role($self->{-user}) eq 'OBSERVER'; # admin sees all
 205
 206   $self->generate_sight() unless $self->{-sight_map};
 207
 208   return 1 if $self->{-sight_map}->{$loc_str};
 209 }
 210
 211 # overloads the function from Game-Class
 212 sub seen_locations{
 213   my $self = shift;
 214
 215   # TODO-PERFORMANCE: make map a self-constructing member of class (like size)
 216   my $map = HexTorus->new($self->get_size());
 217
 218   my @ret = ();
 219   for my $loc ($map->get_all()){
 220     my $ls = $loc->to_string();
 221     push @ret, $ls if $self->sight($ls);
 222   }
 223   return @ret;
 224 }
 225
 226 sub generate_sight{
 227   my ($self) = @_;
 228
 229   delete $self->{-sight_map};
 230
 231   my $rel = $self->reverse_player_relations();
 232
 233   $self->sight_of_player($self->{-user});
 234   for my $player (keys %$rel){
 235     my $status = $rel->{$player}->{'STATUS'};
 236     if($status eq 'ALLIED' or $status eq 'BETRAY'){
 237       if($self->is_earthling($player) or $::conf->{-GODS_SHOW_EARTHLINGS}){
 238         $self->sight_of_player($player);
 239       }
 240     }
 241   }
 242
 243   # print Dumper $self->{-sight_map};
 244 }
 245
 246 sub sight_of_player{
 247   my ($self,$player) = @_;
 248
 249   my $map = HexTorus->new($self->get_size());
 250
 251   my $selfmap = $self->get_map();
 252
 253   for my $row (@$selfmap){
 254     my ($loc,$ter,$own,$occ,$temple,$plague,$home) = @$row;
 255
 256     if($own == $player or $occ == $player
 257        or @{$self->own_in_mobile($loc,$player)}
 258        or ($self->is_god($player) and $ter eq 'MOUNTAIN' and $home <= 0)){
 259       $self->{-sight_map}->{$loc} = 1;
 260       my $location = Location->from_string($loc);
 261       my $dist = 1;
 262       $dist = 2 if $ter eq 'MOUNTAIN';
 263       my @neighbours = $map->distant_neighbours($location,$dist);
 264       for my $l (@neighbours){
 265         $self->{-sight_map}->{$l->to_string()} = 1;
 266       }
 267     }
 268   }
 269 }
 270
 271 sub is_coast{
 272   my ($self,$loc_str) = @_;
 273   my ($ter) = $self->read_field('TERRAIN',$loc_str);
 274   return 0 if($ter ne 'PLAIN' and $ter ne 'CITY' and $ter ne 'MOUNTAIN');
 275
 276   my $map = HexTorus->new($self->get_size());
 277   my @neighbours = $map->neighbours(Location->from_string($loc_str));
 278   for my $loc (@neighbours){
 279     ($ter) = $self->read_field('TERRAIN',$loc->to_string());
 280     return 1 if($ter eq 'ISLE' or $ter eq 'WATER');
 281   }
 282   return 0;
 283 }
 284
 285 sub is_arrival{
 286   my ($self, $loc_str) = @_;
 287
 288   return 1 if $loc_str eq $self->incarnation_place();
 289
 290   return 0;
 291 }
 292
 293 sub is_god{
 294   my ($self,$player) = @_;
 295   $player = $self->{-user} unless defined $player;
 296   return ($self->role($player) eq 'GOD');
 297 }
 298
 299 sub is_earthling{
 300   my ($self,$player) = @_;
 301   $player = $self->{-user} unless defined $player;
 302   return ($self->role($player) eq 'EARTHLING');
 303 }
 304
 305 sub gods{
 306   my ($self) = @_;
 307   return $self->get_all_roles('GOD');
 308 }
 309
 310 sub earthlings{
 311   my ($self) = @_;
 312   return $self->get_all_roles('EARTHLING');
 313 }
 314
 315 sub get_mana{
 316   my ($self,$player) = @_;
 317   $player = $self->{-user} unless defined $player;
 318   return 0 if $player < 1;
 319
 320   my $stmt = "SELECT MANA from GOD where GAME=$self->{-game} AND PLAYER=$player";
 321   my ($mana) = $self->{-db}->single_select($stmt);
 322   return $mana ? $mana : 0;
 323 }
 324
 325 sub gender{
 326   my ($self,$player) = @_;
 327   return 0 if $player < 1;
 328   my @gen = $self->read_role($player, 'GENDER');
 329   return $gen[0];
 330 }
 331
 332
 333 sub field_string{
 334   my ($self, $type) = @_;
 335   return $self->{-db}->loc('FIELD_'.$type);
 336 }
 337
 338 sub relation_string{
 339   my ($self, $other) = @_;
 340   my $rel = $self->get_relation($other);
 341   # print Dumper $rel;
 342   $rel = 'NEUTRAL' if not $rel;
 343   return $self->{-db}->loc('STAT_'.$rel);
 344 }
 345
 346 sub mobile_string{
 347   my ($self, $type, $num) = @_;
 348   my $tag = 'MOBILE_'.$type;
 349   $tag .= '_PL' if $num != 1;
 350   return $self->{-db}->loc($tag);
 351 }
 352
 353 sub mobile_extended_string{
 354   # count + localised type + adored god if any
 355   my ($self, $type, $num, $adoring) = @_;
 356   my $out = $num.' '.$self->mobile_string($type, $num);
 357   if($type eq 'PRIEST' or $type eq 'PROPHET' or $type eq 'HERO'){
 358     $out .= ' '.$self->{-db}->loc('ADJ_ADORING').' '.$self->charname($adoring);
 359   }
 360   return $out;
 361 }
 362
 363 sub role_string{
 364   my ($self, $player) = @_;
 365   my $role = $self->role($player);
 366   $role = 'UNDEFINED' unless defined $role;
 367   my $tag = "ROLE_$role";
 368   return $self->{-db}->loc($tag);
 369 }
 370
 371
 372 sub new_role{
 373   my($self,$role,$name,$gender,$desc) = @_;
 374   $desc = 'none' unless defined $desc;
 375   my $db = $self->{-db};
 376
 377 #  my ($qname, $qgender, $qdesc, $qrole)
 378 #    = $db->quote_all($name, $gender, $desc, $role);
 379
 380   my $cond = 'GAME='.$self->{-game}." AND NICKNAME=$name";
 381   return 0 if @{$db->select_array('ROLE','GAME',$cond)}; # error: dublicate name
 382
 383   my @homes; # all possible homes for this role
 384   if($role ne 'OBSERVER'){
 385     @homes = $self->open_homes($role);
 386     return 0 if $#homes<0; # error: no home free
 387   }
 388
 389   # dont allow names only in uppercase
 390   return 0 if $name =~ /^\s*[A-Z_]{3,}\s*$/;
 391
 392   # write in ROLE
 393   $db->insert_hash('ROLE',{'GAME' => $self->{-game},
 394                            'PLAYER' => $self->{-user},
 395                            'NICKNAME' => $name,
 396                            'ROLE' => $role,
 397                            'GENDER' => $gender,
 398                            'DESCRIPTION' => $desc}
 399                             );
 400   if($role eq 'OBSERVER'){
 401     $db->commit();
 402     return 1;
 403   }
 404
 405   # choose home:
 406   my $home = $homes[rand($#homes + 1)]->[0];
 407
 408   if($role eq 'GOD'){
 409     # read actual default manapool from GAME
 410     my ($mana,$ts) = $db->read_game($self->{-game},'START_MANA,TEMPLE_SIZE');
 411     $mana += $ts * 2;
 412
 413     # write GAME, PLAYER, MANA in GOD
 414     $db->insert_hash('GOD',{'GAME' => $self->{-game},
 415                             'PLAYER' => $self->{-user},
 416                             'MANA' => $mana});
 417
 418     # choose second and third home
 419     #     my $home2 = $home;
 420     #     my $home3 = $home;
 421     #     if($#homes > 0){
 422     #       while($home2 eq $home or $home3 eq $home or $home2 eq $home3){
 423     #   $home2 = $homes[rand($#homes + 1)]->[0];
 424     #   $home3 = $homes[rand($#homes + 1)]->[0];
 425     #       }
 426     #     }
 427
 428     #     # change OWNER in MAP where LOCATION=$home or LOCATION=$home2
 429     #     #   ($home,$home2) = $db->quote_all($home,$home2);
 430     #     $db->update_hash('MAP',
 431     #                "GAME=$self->{-game} AND".
 432     #                " (LOCATION=$home OR LOCATION=$home2 OR LOCATION=$home3)",
 433     #                {'HOME' => $self->{-user}});
 434
 435   }else{ # eartling
 436     # write GAME, PLAYER in EARTHLING
 437     $db->insert_hash('EARTHLING',{'GAME' => $self->{-game},
 438                                   'PLAYER' => $self->{-user}});
 439
 440     # change OCCUPANT, OWNER in MAP where LOCATION=$home
 441     #    ($home) = $db->quote_all($home);
 442     $db->update_hash('MAP',
 443                      "GAME=$self->{-game} AND LOCATION=$home",
 444                      {'HOME' => $self->{-user},
 445                       'OCCUPANT' => $self->{-user}});
 446
 447     # change PLAYER of WARRIORS OR PRIESTs in MOBILE where LOCATION=$home
 448     $db->update_hash('MOBILE',
 449                      "GAME=$self->{-game} AND LOCATION=$home AND OWNER=-1",
 450                      {'OWNER' => $self->{-user}});
 451
 452     # give additional start-warriors
 453     my $warriors = $db->select_array('MOBILE',
 454                                      'ID,COUNT',
 455                                      "GAME=$self->{-game} AND LOCATION=$home ".
 456                                      "AND OWNER=$self->{-user} AND TYPE=WARRIOR");
 457     my @w = @$warriors;
 458     if($#w > -1){
 459       $db->update_hash('MOBILE',
 460                        "ID=$w[0]->[0]",
 461                        {'COUNT' => "COUNT + $::conf->{-START_WARRIORS}"},
 462                        'noquote');
 463     }else{
 464       $db->insert_hash('MOBILE',
 465                        {'ID' => $db->find_first_free('MOBILE','ID'),
 466                         'GAME' => $self->{-game},
 467                         'LOCATION' => $home,
 468                         'TYPE' => 'WARRIOR',
 469                         'COUNT' => $::conf->{-START_WARRIORS},
 470                         'OWNER' => $self->{-user},
 471                         'AVAILABLE' => 'Y'});
 472     }
 473
 474     # modify PRODUCE Command
 475     $db->update_hash('COMMAND',
 476                      "GAME=$self->{-game} AND COMMAND=PRODUCE ".
 477                      "AND LOCATION=$home",
 478                      # TODO: open question: is this redundant information?
 479                      {'PLAYER' => $self->{-user},
 480                       'ARGUMENTS' => "ROLE=$self->{-user}"});
 481
 482   }
 483
 484   # TODO: write MESSAGE to all members of this game: new player with role!
 485
 486
 487   $db->commit();
 488   return 1;
 489 }
 490
 491 sub startfield{
 492   my ($self) = @_;
 493
 494   my $cond = "GAME=$self->{-game} AND ";
 495   if($self->role($self->{-user}) eq 'OBSERVER'){
 496     $cond .= 'TERRAIN='.$self->{-db}->quote('AYMARGEDDON');
 497   }else{
 498     $cond .= "HOME=$self->{-user}";
 499   }
 500   # TODO: what happens if both mountains are flooded?
 501   return $self->{-db}->select_array('MAP','LOCATION',$cond)->[0]->[0];
 502 }
 503
 504
 505 sub open_homes{
 506   my ($self,$role) = @_;
 507   my $terrain = ($role eq 'GOD') ? 'MOUNTAIN' : 'CITY';
 508   # ($terrain) = $self->{-db}->quote_all($terrain);
 509   my $cond = 'GAME='.$self->{-game}." AND HOME=-1 AND TERRAIN=$terrain";
 510   return @{$self->{-db}->select_array('MAP','LOCATION',$cond)};
 511 }
 512
 513 sub is_open{
 514   my ($self,$terrain) = @_;
 515
 516   my $cond = "GAME=$self->{-game} AND HOME=-1";
 517   if($terrain){
 518     $terrain = $self->{-db}->quote($terrain);
 519     $cond .= "AND TERRAIN=$terrain";
 520   }
 521   my $unused = $self->{-db}->select_array('MAP','LOCATION','',$cond);
 522   my @arr = @$unused;
 523
 524   return $#arr+1;
 525 }
 526
 527 # TODO performance: we can do this whole function in one sophisticated SQL-statement.
 528 sub incarnation_place{
 529   my ($self,$player) = @_;
 530   $player = $self->{-user} unless defined $player;
 531
 532   my $temples = $self->{-db}->select_array('MAP','LOCATION',
 533                                            "TEMPLE='Y' AND HOME=$player");
 534
 535   my $place;
 536   my $max_priests = 0;
 537   for my $temple (@$temples){
 538     my $loc = $temple->[0];
 539     Util::log("check for $loc...",1);
 540     # my ($qloc,$type,$yes) = $self->{-db}->quote_all($loc,'PRIEST','Y');
 541     my $priests = $self->{-db}->single_hash_select('MOBILE',
 542                                                    "ADORING=$player AND ".
 543                                                    "LOCATION=$loc AND ".
 544                                                    "TYPE=PRIEST AND ".
 545                                                    "AVAILABLE=Y AND ".
 546                                                    "GAME=$self->{-game}");
 547
 548     if(defined $priests and $priests->{'COUNT'} > $max_priests){
 549       $place = $loc;
 550       $max_priests = $priests->{'COUNT'};
 551     }
 552   }
 553   return $place;
 554 }
 555
 556 sub read_fortune{
 557   my $self = shift;
 558
 559   my ($fortune) = $self->{-db}->read_game($self->{-game},
 560                                           'FORTUNE');
 561   return $fortune;
 562 }
 563
 564 # returns also empty neighbours, but no attacked neighbours
 565 sub own_neighbours{
 566   my ($self,$loc,$player) = @_;
 567   $player = $self->{player} unless defined $player;
 568
 569   # print "own_neighbours($loc,$player)\n";
 570   my $map = HexTorus->new($self->get_size());
 571   my $location = Location->from_string($loc);
 572   my @neighbours = $map->neighbours($location);
 573   my @own_neighbours;
 574   for my $n (@neighbours){
 575     my $n_string = $n->to_string();
 576     my ($occ,$att,$terrain) = $self->read_field('OCCUPANT,ATTACKER,TERRAIN',$n_string);
 577     Util::log("$n_string occupied by $occ, attacked by $att",2);
 578     next if $att;
 579     next if $::conf->{-FIGHTS_WITHOUT_OWNER}->{$terrain} and not $occ;
 580     push @own_neighbours, $n_string if $occ == $player or $occ <= 0;
 581   }
 582   # print Dumper \@own_neighbours;
 583   Util::log("own_neighbours($loc,$player): @own_neighbours",2);
 584   return @own_neighbours;
 585 }
 586
 587 sub is_in_direction_from{
 588   my($self,$to,$from) = @_;
 589
 590   my $map = HexTorus->new($self->get_size());
 591   my $to_location = Location->from_string($to);
 592   my $from_location = Location->from_string($from);
 593
 594   return $map->get_direction($from_location,$to_location);
 595 }
 596
 597 sub show_statistic{
 598   my($self) = @_;
 599   my $db = $self->{-db};
 600
 601   my @earthlings = $self->get_all_roles('EARTHLING');
 602   my @gods = $self->get_all_roles('GOD');
 603
 604   # show for god: own mana,
 605   my $out = '';
 606   if($self->is_god()){
 607     # own mana
 608     $out .= $db->loc('OWN_MANA',$self->get_mana());
 609   }
 610
 611   # show for all: #priests of god (?), #citys of earthling, #temples to build,
 612   #               speed of game, fortune, last battle, fighting strength of earthlings
 613   #               #temples of god
 614
 615   # strength of every god in last battle
 616   $out .= $db->loc('LAST_BATTLE_HEADING') . '<p>';
 617   for my $god (@gods){
 618     # my $god = $god->[0];
 619
 620     my $strength=$self->strength_in_last_battle($god);
 621     $out .= $db->loc('LAST_BATTLE_LINE',$self->charname($god),$strength) . '<br>';
 622
 623     # TODO?: count priests
 624   }
 625
 626   # count citys
 627   $out .= '<p>' . $db->loc('CITY_HEADING'). '<p>';
 628   for my $player (@earthlings){
 629     # $player = $player->[0];
 630     my $citys = $db->count('MAP',
 631                            "GAME=$self->{-game} AND OCCUPANT=$player AND TERRAIN=CITY");
 632     $out .= $db->loc('STATISTIC_EARTHLING_CITY',
 633                      $self->charname($player),
 634                      $citys).'<br>';
 635   }
 636   $out .= '<p>';
 637
 638   # count temples to build for the end of the world
 639   $out .= $db->loc('STATISTIC_UNBUILD', $self->unbuild()). " " .
 640     $db->loc('STATISTIC_NEW_TEMPLES', $self->under_construction())."<p>\n";
 641
 642   my $game = $db->single_hash_select('GAME',
 643                                      "GAME=$self->{-game}");
 644   my $fortune = $game->{'FORTUNE'};
 645   $out .= $db->loc('STATISTIC_FORTUNE',$fortune);
 646
 647   my $speed = $game->{'SPEED'};
 648   $out .= $db->loc('STATISTIC_SPEED',"$speed sec");
 649
 650   return $out;
 651 }
 652
 653 # returns number of places for temples
 654 sub building_places{
 655   my $self = shift;
 656   return $self->{-db}->count('MAP',
 657                              "(TERRAIN=ISLE OR TERRAIN=MOUNTAIN) ".
 658                              "AND GAME=$self->{-game}");
 659 }
 660
 661 # returns number of unbuild temples
 662 sub unbuild{
 663   my $self = shift;
 664   return $self->{-db}->count('MAP',
 665                              "(TERRAIN=ISLE OR TERRAIN=MOUNTAIN) ".
 666                              "AND TEMPLE=N AND GAME=$self->{-game}");
 667 }
 668
 669 # returns number of temples or arks which are currently under construction
 670 sub under_construction{
 671   my ($self,$type) = @_;
 672   $type = 'TEMPLE' unless defined $type;
 673   return $self->{-db}->count('EVENT',
 674                              "TAG=EVENT_BUILD_$type");
 675
 676 }
 677
 678 sub strength_in_last_battle{
 679   my($self,$god) = @_;
 680   $god = $self->{-player} unless defined $god;
 681   my $db = $self->{-db};
 682
 683   my $god_hash =
 684     $db->single_hash_select('GOD',
 685                             "GAME=$self->{-game} AND PLAYER=$god");
 686
 687   my $aymargeddon =
 688     $db->single_hash_select('MAP',
 689                             "GAME=$self->{-game} AND".
 690                             " TERRAIN=AYMARGEDDON")->{'LOCATION'};
 691   my $avatars = $self->count_mobile('AVATAR',$aymargeddon,$god);
 692
 693   my $strength = $::conf->{-LAST_BATTLE}->{-AVATAR} * $avatars +
 694     $::conf->{-LAST_BATTLE}->{-DEATH_AVATAR} * $god_hash->{'DEATH_AVATAR'} +
 695       $::conf->{-LAST_BATTLE}->{-DEATH_HERO} * $god_hash->{'DEATH_HERO'};
 696
 697   return $strength;
 698
 699 }
 700
 701 sub mobile_to_html{
 702   my ($self, $loc,$own,$occ,$temple,$ter,
 703       $oid,$otype,$oown,$oado,$ocnt,$ostat,$omove) = @_;
 704 # field infos:
 705 #  loc:    location of the field
 706 #  own:    the owner of the field (for cities and temples) (HOME)
 707 #  occ:    the occupant of the field
 708 #  temple: wether there is a temple or not
 709 #  ter:    terrain of field
 710 # mobile infos:
 711 #  oid:    id of the mobile
 712 #  otype:  type of the mobile
 713 #  oown:   owner of the mobile
 714 #  oado:   which god the mobile adores
 715 #  ocnt:   mobile count
 716 #  ostat:  status of the mobile (BLOCK, IGNORE or HELP)
 717 #  omove:  the id of the mobile to move with (unused here)
 718
 719   my $user = $self->{-user};
 720   my $db = $self->{-db};
 721   my $aym = $self;
 722
 723   my $out = $ocnt.' ';
 724   if($oown == $user){
 725     $out .= $db->loc('PREP_OWN_PL').' '.$aym->mobile_string($otype,2);
 726     if($otype eq 'PRIEST' or $otype eq 'PROPHET'){
 727       $out .= $db->loc('ADJ_ADORING').' '.$aym->charname($oado);
 728       if($own != $oado){
 729         $out .= ' (<a href="command.epl?cmd=CH_STATUS&other='.$oado.'">'.
 730           $aym->relation_string($oado).
 731             '</a>, <a href="command.epl?cmd=SEND_MSG&other='.$oado.'">'.
 732               $db->loc('SEND_MESSAGE').'</a>)';
 733       }
 734       if(($ter eq 'ISLE' or $ter eq 'MOUNTAIN') and $temple eq 'N'){
 735         $out .=' (<a href="command.epl?cmd=BUILD_TEMPLE&mob='.$oid.'&loc='.$loc.'">';
 736         $out .= $db->loc('CMD_BUILD_TEMPLE').'</a>)';
 737       }
 738     }elsif($otype eq 'HERO'){
 739       $out .= $db->loc('ADJ_ADORING');#.' <a href="command.epl?cmd=CH_ADORING&mob='.
 740         # $oid.'">';
 741       $out .= ' ' . $aym->charname($oado); #.'</a>';
 742       if($own != $oado){
 743         $out .= ' (<a href="command.epl?cmd=CH_STATUS&other='.$oado.'">'.
 744           $aym->relation_string($oado).
 745             '</a>, <a href="command.epl?cmd=SEND_MSG&other='.$oado.'">'.
 746               $db->loc('SEND_MESSAGE').'</a>)';
 747       }
 748     }elsif($otype eq 'AVATAR'){
 749       $out .= ' (<a href="command.epl?cmd=CH_ACTION&mob='.$oid.'">'.
 750         $aym->mobile_string($ostat,1).'</a>)';
 751       if($temple eq 'Y'){
 752         $out .= " (<a href=\"command.epl?cmd=DESTROY&loc=$loc\">".
 753           $db->loc('CMD_DESTROY').'</a>)';
 754       }
 755     }
 756     $out .= ' (<a href="command.epl?cmd=MOVE&mob='.$oid.'&loc='.$loc.'">'.
 757       $db->loc('CMD_MOVE').'</a>)';
 758
 759   }else{
 760     $out .= $aym->mobile_string($otype, $ocnt);
 761
 762     $out .= ' '.$db->loc('PREP_OWN_SG').' ';
 763     $out .= $db->loc('ART_DAT_PL').' ' if $aym->gender($oown) eq 'PLURAL';
 764     $out .= $aym->charname($oown);
 765     if($own != $oown and $occ != $oown){
 766       $out .= ' (<a href="command.epl?cmd=CH_STATUS&other='.$oown.'">'.
 767         $aym->relation_string($oown).'</a>,'.
 768             '<a href="command.epl?cmd=SEND_MSG&other='.$oown.'">'.
 769               $db->loc('SEND_MESSAGE').'</a>)';
 770     }
 771
 772     if($otype eq 'PRIEST' or $otype eq 'PROPHET'or $otype eq 'HERO'){
 773       $out .= $db->loc('ADJ_ADORING').' ';
 774       if($oado == $user){
 775         $out .= $db->loc( ($aym->gender($user) eq 'PLURAL') ?
 776                           'PPRO_DAT3_PL' : 'PPRO_DAT3_SG');
 777       }else{
 778         $out .= $aym->charname($oado);
 779         if($own != $oown and $occ != $oown){
 780           $out .= ' (<a href="command.epl?cmd=CH_STATUS&other='.$oado.'">'.
 781           $aym->relation_string($oado).
 782             '</a>, <a href="command.epl?cmd=SEND_MSG&other='.$oado.'">'.
 783               $db->loc('SEND_MESSAGE').'</a>)';
 784         }
 785       }
 786     }elsif($otype eq 'WARRIOR' and $aym->is_god($user)){
 787       $out .= ' (<a href="command.epl?cmd=BLESS_PRIEST&mob='.$oid.'">'.
 788         $db->loc('CMD_BLESS_PRIEST').'</a>)';
 789       if($own==$user and $temple eq 'Y'){
 790         $out .= ' (<a href="command.epl?cmd=BLESS_HERO&mob='.$oid.'">'.
 791           $db->loc('CMD_BLESS_HERO').'</a>)';
 792       }
 793     }
 794   }
 795   return $out;
 796 }
 797
 798 # this overloads the same function in Game.pm
 799 # we dont look on arks, that is special for Aymargeddon
 800 #sub own_in_mobile{
 801 #  my($self,$loc,$player,$active) = @_;
 802 #  my $cond = "GAME=$self->{-game} AND LOCATION=$loc".
 803 #    " AND TYPE!=ARK AND (OWNER=$player OR ADORING=$player)";
 804 #  if(defined $active){
 805 #    # my $y = $self->{-db}->quote('Y');
 806 #    $cond .= " AND AVAILABLE='Y'";
 807 #  }
 808 #  return $self->{-db}->select_array('MOBILE','ID',$cond);
 809 #}
 810
 811
 812 # returns true if foreign eartlings approach to field
 813 sub foreign_earthling_approaching{
 814   my ($self,$loc,$earthling) = @_;
 815
 816   # TODO BUG: if $earthling < 1 => different names in different languages...
 817   my $name = $self->charname($earthling);
 818   my $ret = $self->{-db}->count('EVENT',
 819                                 "LOCATION=$loc AND ".
 820                                 "(TAG=EVENT_MOBILE_APPROACHING OR ".
 821                                 "TAG=EVENT_ARK_APPROACHING) AND ".
 822                                 "ARG1 != $name AND ".
 823                                 "ARG4 != MOBILE_AVATAR AND ".
 824                                 "ARG4 != MOBILE_AVATAR_PL");
 825
 826   return $ret;
 827 }
 828
 829 # returns true if own avatar is there and if no god-fight is running
 830 sub avatar_available{
 831   my ($self,$loc,$god,$command) = @_;
 832
 833   my $avatars = $self->own_in_mobile($loc,$god,1);
 834   my @avatars = @$avatars;
 835
 836   my ($godfight) = $self->read_field('GOD_ATTACKER',$loc);
 837
 838   unless($#avatars >= 0 and not $godfight){
 839     $self->send_message_to($god,
 840                            {'MSG_TAG' => "MSG_$command\_NEED_AVATAR",
 841                             'ARG1' => $loc}) if defined $command;
 842     return 0;
 843   }
 844
 845   return 1;
 846 }
 847
 848 1;