src/Aymargeddon.pm

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