src/AymCommand.pm

   1
   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 #  Aymargeddon specific command clsses used by the scheduler
  26 #  generic FROGS-Command is in FROGS/Command.pm
  27 #
  28
  29 use strict;
  30 use FROGS::Util;
  31 use FROGS::HexTorus;
  32 use Data::Dumper;
  33
  34 ##########################################################
  35 #
  36 # Base Class for Aymargeddon specific commands
  37 #
  38
  39 package AymCommand;
  40 use Data::Dumper;
  41 @AymCommand::ISA = qw(Command);
  42
  43 sub end_of_the_game{
  44   my $self = shift;
  45
  46   $self->{-context}->send_message_to_all({'MFROM' => 0,
  47                                           'MSG_TAG' => 'END_OF_GAME'});
  48
  49   Util::log("*****************************\n" .
  50             "***    End of the Game!   ***\n" .
  51             "*****************************",0);
  52
  53   $self->{-db}->update_hash('GAME',
  54                             "GAME=$self->{-game}",
  55                             {'RUNNING' => 'N'});
  56
  57 }
  58
  59 # just a wrapper
  60 sub avatar_available{
  61   my ($self,$loc,$god) = @_;
  62   $god = $self->{-player} unless defined $god;
  63   return $self->{-context}->avatar_available($loc,$god,$self->{-class});
  64 }
  65
  66 # just another wrapper
  67 sub get_neighbours{
  68   my ($self,$loc) = @_;
  69   $loc = $self->{-dbhash}->{'LOCATION'} unless defined $loc;
  70
  71   my $map = HexTorus->new($self->{-context}->get_size());
  72   my $location = Location->from_string($loc);
  73   my @neighbours = $map->neighbours($location);
  74   return map {$_ = $_->to_string();} @neighbours;
  75 }
  76
  77 # FIGHT_EARTHLING and Pestilenz
  78 sub casualties{
  79   my ($self,$victim,$death_count,$no_conquer) = @_;
  80   $self->{-looser} = $victim unless defined $self->{-looser};
  81   my $other;
  82   unless(defined $no_conquer){
  83     $other = ($victim != $self->{-winner}) ? $self->{-winner} : $self->{-looser};
  84   }
  85
  86   Util::log("death_count for $victim: $death_count",1);
  87
  88   $self->{-dead}->{$victim} = {'A' => 0,
  89                                'H' => 0,
  90                                'P' => 0,
  91                                'K' => 0,
  92                                'C' => 0}; # conquered arks
  93
  94   return unless $death_count;
  95
  96   my $dying = $::conf->{-DEFAULT_DYING};
  97   unless($self->{-looser} < 0){
  98     my $earthling = $self->{-db}->single_hash_select('EARTHLING',
  99                                                      "PLAYER=$self->{-looser} AND ".
 100                                                      "GAME=$self->{-game}");
 101      $dying = $earthling->{'DYING'};
 102   }
 103   $dying .= 'A';
 104   my $big_dying = {'P' => 'PRIEST',
 105                    'K' => 'WARRIOR',
 106                    'H' => 'HERO',
 107                    'A' => 'ARK'};
 108
 109   # print Dumper $dying;
 110
 111   # rearrange mobiles in a hash
 112   # TODO PERFORMANCE,DESIGN: we should have read $self->{-mobiles}
 113   #      as a hash from database earlier, should be better in all cases.
 114   my %victims_mobiles = ();
 115   for my $mob (@{$self->{-mobiles}}){
 116     my ($id,$type,$own,$count,$stat) = @$mob;
 117     next unless $own == $victim;
 118     $victims_mobiles{$id} = $mob;
 119   }
 120
 121   # print Dumper \%victims_mobiles;
 122
 123   my ($row, $carry, $share, $conquered_arks) = (0,0,0,0);
 124   my $to_kill = $death_count;
 125   my @small_dying = split //,$dying;
 126   while(int($to_kill) > 0 and %victims_mobiles){
 127     my $small_dying = $small_dying[$row];
 128     #    for my $small_dying (split //,$dying){
 129     $carry += $death_count * $::conf->{-DEATH_SHARE_ROW}->[$row];
 130     $share = int($carry);
 131     $carry -= $share;
 132     $share = $to_kill if($share > $to_kill);
 133
 134     Util::log("type: $small_dying, share: $share, carry: $carry, to_kill: $to_kill",2);
 135
 136     while( my ($key,$value) = each %victims_mobiles){
 137       my ($id,$type,$own,$count,$stat) = @$value;
 138       # next unless $own == $victim;
 139       next unless $type eq $big_dying->{$small_dying};
 140       Util::log("id: $id, count: $count, share: $share, ".
 141                 "carry: $carry, to_kill: $to_kill",2);
 142
 143       my $dead_men = Util::min($count,$share);
 144       $self->{-dead}->{$victim}->{$small_dying} += $dead_men;
 145       if($small_dying eq 'H'){
 146         # dead heros fights for gods in last battle
 147         my ($god) = $self->{-context}->get_mobile_info($id,'ADORING');
 148         Util::log("adored god: $god",1);
 149         my ($actual) = $self->{-db}->single_select("SELECT DEATH_HERO FROM GOD WHERE ".
 150                                                    "GAME=$self->{-game} AND ".
 151                                                    "PLAYER=$god");
 152         Util::log("HERO dying: adds $dead_men heros ".
 153                   "to last-battle-strength of $god",1);
 154         $self->{-db}->update_hash('GOD',
 155                                   "GAME=$self->{-game} AND PLAYER=$god",
 156                                   {'DEATH_HERO' => $actual + $dead_men});
 157       }elsif($small_dying eq 'A' and $victim == $self->{-looser}
 158              and not defined $no_conquer){
 159         # special case ark (can change owner)
 160         my $random_value = rand($dead_men);
 161         Util::log("random value of $dead_men: $random_value",1);
 162         $conquered_arks = int($random_value+0.5);
 163         # $dead_men -= $conquered_arks;
 164         Util::log("ark in battle: $conquered_arks change owner to $other, ".
 165                   "$dead_men arks sinking or conquered.",1);
 166         $self->{-dead}->{$victim}->{'C'} += $conquered_arks;
 167       }
 168
 169       if($count > $dead_men){
 170         my $new_count = $count - $dead_men;
 171         $self->{-db}->update_hash('MOBILE',
 172                                   "ID=$id",
 173                                   {'COUNT' => $new_count});
 174         $victims_mobiles{$id}->[3] = $new_count;
 175         Util::log("Mobile $id ($small_dying) looses $dead_men people ".
 176                   "and have now $new_count.",1);
 177         $to_kill -= $dead_men;
 178         last;
 179       }else{
 180         $share -= $count;
 181         $to_kill -= $count;
 182         $self->{-db}->delete_from('MOBILE',"ID=$id");
 183         $self->{-db}->update_hash('MOBILE',
 184                                   "MOVE_WITH=$id",
 185                                   {'MOVE_WITH' => 0});
 186         Util::log("Mobile $id ($small_dying) with $dead_men people is deleted",1);
 187         delete $victims_mobiles{$id};
 188       }
 189     }
 190
 191     $carry += $share;
 192     $row = ($row + 1)%4;
 193   }
 194
 195   unless(defined $no_conquer){
 196     my $total_conquered_arks = $self->{-dead}->{$victim}->{'C'};
 197     if($total_conquered_arks){
 198       # now conquered arks are (re-)created
 199       my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
 200                  'GAME' => $self->{-game},
 201                  'LOCATION' => $self->{-location},
 202                  'TYPE' => 'ARK',
 203                  'OWNER' => $self->{-winner},
 204                  'COUNT' => $self->{-dead}->{$victim}->{'C'},
 205                  'AVAILABLE' => 'Y',
 206                  'COMMAND_ID' => $self->{-id},
 207                 };
 208       $self->{-mob} = $mob;
 209       my %mobcopy = (%$mob);
 210       $self->{-db}->insert_hash('MOBILE',\%mobcopy);
 211       $self->unify_mobiles($mob,$self->{-location},$self->{-winner});
 212       Util::log("$total_conquered_arks conquered arks for $self->{-winner}.",1);
 213       $self->{-dead}->{$victim}->{'A'} -= $total_conquered_arks;
 214     }
 215   }
 216
 217   $self->change_priest_on_temple($self->{-location});
 218 }
 219
 220 sub move_with{
 221   my ($self,$id,$target,$count) = @_;
 222
 223   # read mobile
 224   my $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
 225
 226   # split mobile
 227   $self->conditional_split_mobile($mobile,$count,
 228                                   {'MOVE_WITH' => $target},1);
 229   Util::log("$count mobiles from id $id now moves with mobile $target",1);
 230
 231   # reread mobile, because split destroys it
 232   $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
 233
 234   # all mobiles which already move with this now move with the target
 235   if($target != 0){
 236     my $mob = $self->{-context}->mobiles_available($mobile->{'LOCATION'});
 237     # my $mobcount = $#{@$mob}+1;
 238     my $mobcount = @$mob;
 239     for my $i (0..$mobcount-1){
 240       my ($oid,$otype,$oown,$oado,$ocnt,$ostat,$omove) = @{$mob->[$i]};
 241       next if($omove != $id);
 242       $self->{-db}->update_hash('MOBILE',"ID=$oid",
 243                                 {'MOVE_WITH' => $target});
 244       Util::log("therefor all mobiles from id $oid now moves with mobile $target",1);
 245     }
 246   }
 247
 248   # unify
 249   $self->unify_mobiles($mobile,$mobile->{'LOCATION'});
 250 }
 251
 252 # this function is called, if an earthling leave an field and let it possible empty
 253 sub empty_field{
 254   my ($self,$loc,$player) = @_;
 255   $player = $self->{-player} unless defined $player;
 256   my $db = $self->{-db};
 257   my $aym = $self->{-context};
 258   my $oim = $aym->own_in_mobile($loc,$player,1);
 259
 260   my ($home,$ter,$occ,$temple) =
 261     $aym->read_field('HOME,TERRAIN,OCCUPANT,TEMPLE',$loc);
 262   $home=0 if $ter eq 'MOUNTAIN';
 263
 264   unless(@$oim){
 265     my $keep_owner = 0;
 266     $keep_owner = 1 if $home==$occ and $ter eq 'CITY' and $::conf->{-HOMECITY_KEEP_OWNER};
 267     $keep_owner = 1 if exists $::conf->{-KEEP_OWNER}->{$ter};
 268     $keep_owner = 1 if $::conf->{-TEMPLE_KEEP_OWNER} and $temple eq 'Y';
 269
 270     if($keep_owner){
 271       Util::log("leaving occupant $occ in field $loc",1);
 272     }else{
 273       Util::log("reset old occupant $home in field $loc.",1);
 274       # delete all PRODUCE and PRAY-Commands if any
 275       $self->{-db}->delete_from('COMMAND',
 276                                 "(COMMAND=PRODUCE OR COMMAND=PRAY) AND ".
 277                                 "LOCATION=$loc AND GAME=$self->{-game}");
 278       # delete all PRODUCE-EVENTS
 279       $self->{-db}->delete_from('EVENT',
 280                                 "(TAG=EVENT_PRODUCE_WARRIOR OR TAG=EVENT_PRODUCE_PRIEST)".
 281                                 " AND LOCATION=$loc AND GAME=$self->{-game}");
 282       $db->update_hash('MAP',
 283                        "LOCATION=$loc AND GAME=$self->{-game}",
 284                        {'OCCUPANT' => $home});
 285     }
 286   }
 287   $self->change_priest_on_temple($loc);
 288 }
 289
 290 # this check, if there is still a priest on a temple
 291 # and if there is a new priest on temple
 292 sub change_priest_on_temple{
 293   my ($self,$loc) = @_;
 294   my $aym = $self->{-context};
 295
 296   my ($home,$temple,$occ) = $aym->read_field('HOME,TEMPLE,OCCUPANT',$loc);
 297   return unless $temple eq 'Y';
 298
 299   my $produce = $self->{-db}->count('COMMAND',
 300                                     "LOCATION=$loc AND GAME=$self->{-game} AND ".
 301                                     "COMMAND=PRODUCE");
 302
 303   my $priests = $self->{-db}->count('MOBILE',
 304                                     "LOCATION=$loc AND GAME=$self->{-game} AND ".
 305                                     "TYPE=PRIEST AND ADORING=$home AND ".
 306                                     "AVAILABLE=Y");
 307
 308   Util::log("priests: $priests, produce: $produce",1);
 309
 310   if($priests and not $produce){
 311     $aym->insert_command('PRODUCE', "ROLE=$occ", $loc);
 312   }
 313
 314   if(not $priests and $produce){
 315     Util::log("delete produce-command and event",1);
 316     # delete all PRODUCE -Commands if any
 317     $self->{-db}->delete_from('COMMAND',
 318                               "COMMAND=PRODUCE AND ".
 319                               "LOCATION=$loc AND GAME=$self->{-game}");
 320     # delete all PRODUCE-EVENTS
 321     $self->{-db}->delete_from('EVENT',
 322                               "(TAG=EVENT_PRODUCE_PRIEST)".
 323                               " AND LOCATION=$loc AND GAME=$self->{-game}");
 324   }
 325 }
 326
 327 # do we fight? do we conquer? do we join?
 328 # TODO: turn_around if no ark and terrain==water
 329 # TODO:   could happen if location is flooded during movement.
 330 sub enter_field{
 331   my ($self,$loc,$ignore_friend) = @_;
 332   $ignore_friend = 0 unless defined $ignore_friend;
 333
 334   Util::log("enter_field($loc,$ignore_friend)",2);
 335
 336   # print "LOC: $loc\n";
 337   my ($occ,$att,$temple,$home,$terrain) =
 338     $self->{-context}->read_field('OCCUPANT,ATTACKER,TEMPLE,HOME,TERRAIN',$loc);
 339   $self->{-occupant} = $occ;
 340
 341   my $relation = $self->{-context}->get_relation($occ);
 342
 343   $relation = 'FOE' if $ignore_friend;
 344
 345   # if there is allready an ongoing fight
 346   if($att){
 347     # do nothing if we are allready involved
 348     if($self->{-player} == $occ or $self->{-player} == $att){
 349
 350       Util::log("join the ongoing fight in $loc",1);
 351       delete $self->{-multimove};
 352       return;
 353     }else{
 354       # turn around otherwise
 355       Util::log("in $loc: There is allready a fight between $occ and $att ".
 356                 "... turn around.",1);
 357       $self->turn_around($loc);
 358       delete $self->{-multimove};
 359       return;
 360     }
 361   }
 362
 363   if($relation eq 'FRIEND' or $relation eq 'ALLIED'){
 364     # a friend has allready occupied this place, just turn around.
 365     Util::log("in $loc: $occ is a friend of $self->{-player} ... turn around.",1);
 366     $self->turn_around($loc);
 367     delete $self->{-multimove};
 368     return;
 369   }
 370
 371   if($self->is_new_earthling_fight($loc,$relation,$terrain)){
 372     Util::log("new fight between earthlings in $loc:".
 373               " attacker $self->{-player}, defender $occ",1);
 374
 375     # we are the attacker
 376     $self->do_earthling_fight($loc);
 377     delete $self->{-multimove};
 378     return;
 379   }
 380
 381   if($occ == $self->{-player}){
 382     # was already our field
 383     Util::log("$loc is allready field of $occ.",2);
 384     $self->unify_mobiles($self->{-mob},$loc) unless defined $self->{-multimove};
 385   }else{
 386     # we are the new occupant
 387     $self->conquer($loc,$self->{-player});
 388   }
 389
 390   $self->change_priest_on_temple($loc);
 391 }
 392
 393 # peoples without arks drown
 394 sub drowning{
 395   my ($self,$loc) = @_;
 396
 397   # dont drown on islands or land
 398   my ($terrain) = $self->{-context}->read_field('TERRAIN',$loc);
 399   return unless $terrain eq 'WATER';
 400
 401   # is there still an active ark?
 402   my $arks = $self->{-context}->read_mobile('TYPE','ARK',$loc,1);
 403   # print Dumper $arks;
 404   my @aa = @$arks;
 405   return if $#aa >= 0;
 406
 407   # get active mobiles
 408   my $mobs = $self->{-context}->read_mobile('ID,TYPE,COUNT,OWNER','',$loc,1);
 409
 410   my ($id,$type,$count,$owner);
 411   for my $mob (@$mobs){
 412     ($id,$type,$count,$owner) = @$mob;
 413
 414     next if $type eq 'ARK' or $type eq 'PROPHET';
 415
 416     # drown mobile
 417     $self->{-db}->delete_from('MOBILE',"ID=$id");
 418     Util::log("No ark: $count $type from $owner drowned in $loc.",1);
 419
 420     $self->{-context}
 421       ->send_message_to($owner,
 422                         {'MFROM' => 0,
 423                          'MSG_TAG' => 'MSG_MOBILE_DRAWN',
 424                          'ARG1' => $count,
 425                          'ARG2' => $self->{-context}->mobile_string($type,$count),
 426                          'ARG3' => $self->{-context}->charname($owner),
 427                          'ARG4' => $loc});
 428   }
 429   $self->empty_field($loc,$owner) if $owner;
 430 }
 431
 432 sub conquer{
 433   my ($self,$loc,$player) = @_;
 434
 435   Util::log("$player conquers $loc.",1);
 436   $self->{-db}->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
 437                             {'OCCUPANT' => $player});
 438
 439   # conquer existing arks
 440   $self->{-db}->update_hash('MOBILE',"LOCATION=$loc AND GAME=$self->{-game} AND TYPE=ARK",
 441                             {'OWNER' => $player});
 442
 443   # insert new PRODUCE-command and delete existent one and PRODUCE-events
 444   my ($terrain,$temple,$home) = $self->{-context}->read_field('TERRAIN,TEMPLE,HOME',$loc);
 445
 446   if ((not $home and $terrain eq 'CITY')){
 447     $self->{-db}->delete_from('COMMAND', "COMMAND=PRODUCE AND LOCATION=$loc".
 448                              " AND GAME=$self->{-game}");
 449     $self->{-db}->delete_from('EVENT',"TAG=EVENT_PRODUCE_WARRIOR AND LOCATION=$loc ".
 450                               "AND GAME=$self->{-game}");
 451     $self->{-context}->insert_command('PRODUCE', "ROLE=$player", $loc);
 452   }
 453
 454   #if ($temple eq 'Y'){
 455     # PRAY at temples
 456   #  $self->{-db}->delete_from('COMMAND', "COMMAND=PRAY AND LOCATION=$loc".
 457   #" AND GAME=$self->{-game}");
 458   #
 459   # }
 460 }
 461
 462 sub enter_field_avatar{
 463   my ($self,$loc,$mob) = @_;
 464
 465   Util::log("enter_field_avatar() in $loc",1);
 466   # print Dumper $mob;
 467
 468   # if we are in Aymargeddon, do nothing special
 469   my ($terrain) = $self->{-context}->read_field('TERRAIN',$loc);
 470   if($terrain eq 'AYMARGEDDON'){
 471     Util::log("enter_field_avatar(AYMARGEDDON): do nothing",1);
 472     delete $self->{-multimove};
 473     return;
 474   }
 475
 476   # mob can be ID or hash
 477   $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
 478   # print Dumper $mob;
 479   # get all avatars allready here from me and other owners
 480   my $avatars = $self->{-context}->read_mobile_condition('ID,OWNER,STATUS',
 481                                                          "LOCATION=$loc ".
 482                                                          "AND TYPE=AVATAR ".
 483                                                          "AND AVAILABLE=Y");
 484   # print Dumper $avatars;
 485
 486   # restructure data
 487   my $own_avatars_here = 0;
 488   my $own_avatar_status = 'IGNORE';
 489   my %other_avatar_owner = ();
 490   my %other_avatar_status = ();
 491   for my $a (@$avatars){
 492     my ($id,$own,$stat) = @$a;
 493     next if($id == $mob->{'ID'});
 494     # print "own: $own\n";
 495     if($own == $mob->{'OWNER'}){
 496       $own_avatars_here = $id;
 497       $own_avatar_status = $stat;
 498     }elsif(!defined $other_avatar_owner{$own}){
 499       $other_avatar_owner{$own} = 1;
 500       $other_avatar_status{$own} = $stat;
 501       Util::log("found other avatar-owner $own in $loc",1);
 502     }else{
 503       Util::log("other avatar-owner $own allready found in $loc",1);
 504     }
 505   }
 506
 507   # if we are there allready with other avatars:
 508   if($own_avatars_here){
 509     # set STATUS of newcomer to the STATUS in the field
 510     if ($own_avatar_status ne $mob->{'STATUS'}){
 511       $self->{-db}->update_hash('MOBILE',
 512                                 "ID=$mob->{'ID'}",
 513                                 {'STATUS' => $own_avatar_status});
 514     }
 515     Util::log("enter_field_avatar():Avatars (ID:$mob->{'ID'}) ".
 516               "have to join other avatars with status $own_avatar_status in $loc.",1);
 517     $self->unify_mobiles($mob);
 518   }else{
 519     #   for each other avatar-owner
 520     for my $other (keys %other_avatar_owner){
 521       my $oas = $other_avatar_status{$other};
 522       # read alliance to each other owner (and vice versa)
 523       my $allianceA = $self->{-context}
 524         ->simplyfied_single_relation($other,$mob->{'OWNER'});
 525       my $allianceB = $self->{-context}
 526         ->simplyfied_single_relation($mob->{'OWNER'},$other);
 527       # insert FIGHT-command, if necessary
 528       if($self->is_avatar_fight($allianceA,$allianceB,$mob->{'STATUS'},$oas)){
 529         $self->{-context}->insert_command('FIGHT_GOD',
 530                                           "A=$other, B=$mob->{'OWNER'}",
 531                                           $loc);
 532         Util::log("enter_field_avatar():Avatars from $mob->{'OWNER'} ".
 533                   "have to fight with $other in $loc.",1);
 534         delete $self->{-multimove};
 535       }
 536     }
 537   }
 538 }
 539
 540 sub is_avatar_fight{
 541   my ($self,$allA,$allB,$statA,$statB) = @_;
 542
 543   Util::log("is_avatar_fight(): ".
 544             "allA: $allA, allB: $allB, statA: $statA, statB: $statB",1);
 545
 546   return 0 unless $statA eq 'BLOCK' or $statB eq 'BLOCK';
 547   my $status = 'NEUTRAL';
 548   if(($allA eq 'FOE') or ($allB eq 'FOE')){
 549     $status = 'FOE';
 550   }elsif(($allA eq 'FRIEND') or ($allB eq 'FRIEND')){
 551     $status = 'FRIEND';
 552   }
 553
 554   return 1 if ($status eq 'FOE');
 555   return 1 if ($status eq 'NEUTRAL') and $statA eq 'BLOCK' and $statB eq 'BLOCK';
 556   return 0;
 557 }
 558
 559 # unify identical mobiles
 560 # $mob still exists after function. all other of same
 561 # TYPE, MOVE_WITH, ADORING will be deleted.
 562 sub unify_mobiles{
 563   my ($self,$mob,$location,$owner) = @_;
 564
 565   # mob can be ID or hash
 566   $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
 567
 568   $location = $mob->{'LOCATION'} unless defined $location;
 569   $owner = $self->{-player} unless defined $owner;
 570
 571   Util::log("unify_mobiles() in $location for mobile $mob->{'ID'} of $owner",1);
 572
 573   return if $self->{-db}->count('COMMAND',
 574                                 "MOBILE=$mob->{'ID'} AND ID != $self->{-dbhash}->{'ID'}");
 575
 576   my $type = $mob->{'TYPE'};
 577
 578   my $mobs = $self->{-context}->read_mobile('ID,COUNT,ADORING,OWNER,MOVE_WITH',
 579                                             $type,
 580                                             # $mob->{'LOCATION'},
 581                                             $location,
 582                                             1
 583                                            );
 584
 585   my $count = $mob->{'COUNT'};
 586   for my $m (@$mobs){
 587     my ($oid,$ocount,$oado,$oown,$omove) = @$m;
 588
 589     next if $oown ne $owner; # and $type ne 'ARK';
 590     next if $oid eq $mob->{'ID'};
 591     if(Util::is_in($type,'PRIEST','PROPHET','HERO')){
 592       next if $oado ne $mob->{'ADORING'};
 593     }
 594
 595     next if(defined $mob->{'MOVE_WITH'} and $mob->{'MOVE_WITH'} ne $omove);
 596
 597     next if $self->{-db}->count('COMMAND',"MOBILE=$oid");
 598
 599     $count += $ocount;
 600
 601     $self->{-db}->delete_from('MOBILE',"ID=$oid");
 602
 603     # set new MOVE_WITH, if deleted unit has some companions
 604     $self->{-db}->update_hash('MOBILE',
 605                               "MOVE_WITH=$oid",
 606                               {'MOVE_WITH' => $mob->{'ID'}});
 607
 608   }
 609   $self->{-db}->update_hash('MOBILE',
 610                             "ID=$mob->{'ID'}",
 611                             {'COUNT' => $count}) if $count != $mob->{'COUNT'};
 612
 613   # rekursion for every companion of $mob
 614   my $companions = $self->{-context}->read_mobile_condition('ID,OWNER',
 615                                            "LOCATION=$location ".
 616                                            "AND MOVE_WITH=$mob->{'ID'}");
 617   for my $m (@$companions){
 618     my ($mid,$mown) = @$m;
 619     # does it still exist?
 620     my $comp = $self->{-db}->read_single_mobile($mid);
 621     next unless defined $comp;
 622     $self->unify_mobiles($comp,$location,$mown);
 623   }
 624 }
 625
 626 # the move-command will be set up again in the oposite direction
 627 sub turn_around{
 628   my ($self,$loc) = @_;
 629
 630   # first we have to check, if we are here because of an MOVE-COMMAND
 631   # or out of some other reason
 632   if($self->{-dbhash}->{'COMMAND'} eq 'MOVE'){
 633     my $mob = $self->{-mob};
 634     my $dir = $self->{-args}->{'DIR'};
 635     my $rev = {'S' => 'N',
 636                'N' => 'S',
 637                'SW' => 'NE',
 638                'NE' => 'SW',
 639                'SE' => 'NW',
 640                'NW' => 'SE',};
 641     $dir = $rev->{uc($dir)};
 642     Util::log("we ($mob->{'ID'} in $loc) are friends ".
 643               "and come from $dir. we turn around...",1);
 644     $self->{-context}->insert_command('MOVE',
 645                                       "DIR=$dir, MOBILE=$mob->{'ID'}, ".
 646                                       "COUNT=$mob->{'COUNT'}, AUTO=1",$loc);
 647   }else{
 648     #
 649   }
 650 }
 651
 652 # do we start a fight here?
 653 sub is_new_earthling_fight{
 654   my ($self,$location,$relation,$terrain) = @_;
 655   my $mob = $self->{-mob};
 656   my $attacker = $self->{-player};
 657   my $occupant = $self->{-occupant};
 658
 659   # no fight on some neutral territories
 660   return 0 unless $occupant or exists $::conf->{-FIGHTS_WITHOUT_OWNER}->{$terrain};
 661
 662   # no new fight, if allready one started
 663   return 0 if $self->{-context}->earthling_fight($location);
 664
 665   return 0 if $attacker == $occupant or
 666     $relation eq 'FRIEND' or
 667       $relation eq 'ALLIED';
 668
 669   my $qloc = $self->{-db}->quote($location);
 670   $self->{-db}->update_hash('MAP',"GAME=$self->{-game} AND LOCATION=$qloc",
 671                           {'ATTACKER' => $attacker});
 672
 673 }
 674
 675 # start a fight!
 676 sub do_earthling_fight{
 677   my ($self,$loc) = @_;
 678
 679   # write the fight command
 680
 681   $self->{-context}->insert_command('FIGHT_EARTHLING',
 682                                     "ATTACKER=$self->{-player}, ".
 683                                     "DEFENDER=$self->{-occupant}",
 684                                     $loc);
 685 }
 686
 687 # enough mana available?
 688 sub test_mana{
 689   my ($self,$action,$factor,$god) = @_;
 690   $factor = 1 unless defined $factor;
 691   $god = $self->{-player} unless defined $god;
 692
 693   my $mana = $self->{-context}->get_mana($god);
 694   my $mana_needed = $::conf->{-MANA}->{"-$action"} * $factor;
 695
 696   Util::log("$god needs $mana_needed mana from his $mana mana to do $action",1);
 697
 698   # dirty workaround: we fake our identity.
 699   my $player = $self->{-player};
 700   $self->{-player} = $god;
 701   unless($self->test(sub{ $mana >= $mana_needed },
 702                      'MSG_NOT_ENOUGH_MANA',
 703                      $action,
 704                      $self->{-location} ? $self->{-location} : 'GLOBAL')){
 705     $self->{-player} = $player;
 706     return 0;
 707   }
 708   $self->{-player} = $player;
 709
 710   $self->{-mana} = $mana - $mana_needed;
 711   $self->{-mana_paid} = $mana_needed;
 712   return 1;
 713 }
 714
 715 sub use_mana{
 716   my ($self,$god) = @_;
 717   $god = $self->{-player} unless defined $god;
 718   $self->{-db}->update_hash('GOD',"PLAYER=$god AND GAME=$self->{-game}",
 719                             {'MANA' => $self->{-mana}});
 720   Util::log("$god pays $self->{-mana_paid} mana ".
 721             "and has still $self->{-mana} left.",1);
 722   #TODO?: Message
 723 }
 724
 725 # this returns the used mana and did not test before
 726 sub instant_use_mana{
 727   my ($self,$mana,$god) = @_;
 728   $god = $self->{-player} unless defined $god;
 729
 730   my $mana_available = $self->{-context}->get_mana($god);
 731
 732   if ($mana_available < $mana)
 733   {
 734         # not enough mana
 735         $mana = $mana_available;
 736   }
 737   my $newmana = $mana_available - $mana;
 738
 739   $self->{-db}->update_hash(
 740         'GOD',
 741         "PLAYER=$god AND GAME=$self->{-game}",
 742         {'MANA' => $newmana}
 743   );
 744   Util::log("$god pays $mana mana ".
 745             "and has still $newmana left.",1);
 746   return $mana;
 747 }
 748
 749 #
 750 # End of AymCommand
 751 #
 752 ####################################################
 753
 754 ##########################################################
 755 #
 756 # Use this template to generate new commands
 757 #
 758
 759 package AymCommandTemplate;
 760 @AymCommandTemplate::ISA = qw(AymCommand);
 761
 762 # ... arguments in $self->{-args}
 763 # ... player in $self->{-player}
 764 # ... game in $self->{-game}
 765 # ... context object in $self->{-context}
 766 # ... database object in $self->{-db}
 767 # ... basic duration from Config in $self->{-duration}
 768 # ... command from database in $self->{-dbhash}
 769
 770 # this is called to see if the command is executable.
 771 # it should be called from first_phase() and from second_phase().
 772 # it is not called from the scheduler
 773 sub is_valid {
 774         my $self = shift;
 775         my @required_arguments = ();
 776         return 0 unless $self->Command::is_valid(@required_arguments);
 777
 778         # ... here your code
 779
 780         return 1;
 781 }
 782
 783 # this is called from Scheduler, when he see the command the
 784 # first time, some commands execute here immidiatly.
 785 # AymCommand
 786 sub first_phase{
 787   my $self = shift;
 788
 789   return 0 unless $self->is_valid();
 790
 791   # ... here your code
 792
 793   return 1;
 794 }
 795
 796 # this is called from scheduler when the command will be executed.
 797 # AymCommand
 798 sub second_phase{
 799   my $self = shift;
 800
 801   return 0 unless $self->is_valid();
 802
 803   # ... here your code
 804
 805   return 1;
 806 }
 807
 808 #
 809 # End of template
 810 #
 811 ####################################################
 812
 813 #
 814 # CH_STATUS: Change the player alliance status
 815 #
 816
 817 package CH_STATUS;
 818 @CH_STATUS::ISA  = qw(AymCommand);
 819
 820 sub is_valid{
 821   my ($self) = @_;
 822
 823   my @required_arguments = ('OTHER','STATUS');
 824   return 0 unless $self->Command::is_valid(@required_arguments);
 825
 826   # exist OTHER still in game?
 827   if($self->{-args}->{'OTHER'} != -1){
 828     my $role = $self->{-context}->read_role($self->{-args}->{'OTHER'},'PLAYER');
 829     return 0 unless $self->test(sub{$role},
 830                                 'MSG_NO_SUCH_ROLE');
 831   }
 832
 833   # is STATUS valid?
 834   my $status = $self->{-args}->{'STATUS'};
 835   return 0 unless $self->test(sub{Util::is_in($status,
 836                                               'FRIEND',
 837                                               'FOE',
 838                                               'NEUTRAL',
 839                                               'BETRAY',
 840                                               'ALLIED')},
 841                               'MSG_STATUS_INVALID',
 842                               $status);
 843   return 1;
 844 }
 845
 846 # CH_STATUS
 847 sub first_phase{
 848   my $self = shift;
 849   return 0 unless $self->is_valid();
 850
 851   my $tag = 'MSG_CH_STATUS';
 852   my $other = $self->{-args}->{'OTHER'};
 853   my $status = $self->{-args}->{'STATUS'};
 854   # ($status,$tag) = $self->{-db}->quote_all($status,$tag);
 855   $self->{-db}->insert_or_update_hash(
 856                             'ALLIANCE',
 857                             "PLAYER=$self->{-player} ".
 858                             "AND OTHER=$other ".
 859                             "AND GAME=$self->{-game}",
 860                             {'GAME' => $self->{-game},
 861                              'PLAYER' => $self->{-player},
 862                              'OTHER' => $other,
 863                              'STATUS' => $status}
 864                            );
 865
 866   #$self->{-context}->send_message_to_me({'MFROM' => 0,
 867   #                                      'MSG_TAG' => $tag,
 868   #                                      'ARG1' => $self->{-context}->charname($other),
 869   #                                      'ARG2' => $status,
 870   #                                     });
 871
 872   $self->setDuration(0);
 873   return 0;
 874 };
 875
 876 sub second_phase{
 877   my $self = shift;
 878   Util::log("Warning: We should not reach phase 2 with command CH_STATUS",0);
 879   return 0;
 880 };
 881
 882 #
 883 # END of CH_STATUS
 884 #
 885 ################################################################
 886
 887 ################################################################
 888 #
 889 # MOVE: Move mobiles
 890 #
 891
 892 package MOVE;
 893 use Data::Dumper;
 894 # use FROGS::HexTorus;
 895 @MOVE::ISA = qw(AymCommand);
 896
 897 sub is_valid {
 898   my $self = shift;
 899
 900   my $db = $self->{-db};
 901   my $args = $self->{-args};
 902   my $aym = $self->{-context};
 903   my $phase = $self->{-phase};
 904
 905   my @required_arguments = ('MOBILE','COUNT','DIR');
 906   return 0 unless $self->Command::is_valid(@required_arguments);
 907
 908   my $mob_id = $args->{'MOBILE'};
 909   my $count = $args->{'COUNT'};
 910
 911   return 0 unless $count =~ /^\s*\d+\s*$/;
 912
 913   return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
 914   my $mob = $self->{-mob};
 915
 916   my ($owner,$loc_string,$type) = ($mob->{'OWNER'},
 917                                    $mob->{'LOCATION'},
 918                                    $mob->{'TYPE'},
 919                                   );
 920   # print "LOCATION: $loc_string\n";
 921   $self->{-loc_string} = $loc_string;
 922
 923   # enough mobiles avaiable?
 924   if ($phase == 1) {
 925     return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
 926                                        $mob->{'AVAILABLE'} eq 'Y'},
 927                                 'MSG_NOT_ENOUGH_MOBILES',
 928                                 'MOVE',
 929                                 $count,
 930                                 $loc_string);
 931   }
 932   # get target field
 933
 934   my ($size) = $db->read_game($self->{-game},'SIZE');
 935   $self->{-size} = $size;
 936   my $map = HexTorus->new($size);
 937   $self->{-map} = $map;
 938
 939   my $loc = Location->from_string($loc_string);
 940   $self->{-loc} = $loc;
 941
 942   # MULTIMOVE: extract first direction and rest of string
 943   my $direction = $args->{'DIR'};
 944   $direction =~ s/^\s*(\S*)\s*$/$1/; # removing leading/trailing whitespace
 945   $direction =~ /^(\S*)\s+(.*)$/; # split up first direction
 946   my ($first_direction,$other_directions) = ($1,$2);
 947   if($other_directions){
 948     $self->{-multimove} = $other_directions;
 949     $direction = $first_direction;
 950     Util::log("MULTIMOVE: now $first_direction, later $other_directions",1);
 951   }
 952
 953   my $target = $map->get_neighbour($loc,$direction);
 954
 955   # target correct?
 956   return 0 unless $self->test(sub{$target},
 957                               'MSG_MOVE_NO_TARGET',
 958                               $loc_string,
 959                               $args->{'DIR'});
 960   $self->{-target} = $target;
 961   my $target_string = $target->to_string();
 962
 963   # get terrain of loc and target
 964   my ($terrain,$attacker,$god_attacker,$plague) =
 965     $aym->read_field('TERRAIN,ATTACKER,GOD_ATTACKER,PLAGUE',$loc_string);
 966   $plague = '' unless defined $plague;
 967   my ($target_terrain,$target_occupant) =
 968     $aym->read_field('TERRAIN,OCCUPANT',$target_string);
 969   $self->{-target_occupant} = $target_occupant;
 970
 971   # you can only MOVE_WITH on water, except you are an ARK
 972   return 0 unless $self->test(sub{Util::is_in($target_terrain,
 973                                               'PLAIN',
 974                                               'CITY',
 975                                               'MOUNTAIN',
 976                                               'AYMARGEDDON',
 977                                               'POLE') or $type eq 'ARK'},
 978                               'MSG_CANT_SWIM',
 979                               'CMD_MOVE',
 980                               $loc_string,
 981                               "MOBILE_$type\_PL");
 982   # $self->{-context}->mobile_string($type,2));
 983
 984
 985
 986   # role specific tests
 987   my $role = $self->{-role};
 988
 989   # return 0 unless $self->validate_role('GOD','EARTHLING');
 990   #if ($mob->{'TYPE'} eq 'ARK') {
 991     # Util::log("Impossible Situation: ARK has got a MOVE-Command",1);
 992   if ($role eq 'GOD') {
 993     # gods can only move avatars
 994     return 0 unless $self->test(sub{$type eq 'AVATAR'},
 995                                 'MSG_GOD_CANT_MOVE_TYPE',
 996                                 $self->{-context}->mobile_string($type,2));
 997
 998     # dont move if $loc is Aymargeddon
 999     return 0 unless $self->test(sub{$terrain ne 'AYMARGEDDON'},
1000                                 'MSG_CANT_LEAVE_AYMARGEDDON',
1001                                 $loc_string);
1002
1003
1004     # dont move, if ongoing FIGHT_GOD
1005     if($phase == 1){
1006       return 0 unless $self->test(sub{not $god_attacker},
1007                                   'MSG_CANT_MOVE_ATTACKED',
1008                                   $mob->{'LOCATION'},
1009                                   $self->{-context}->mobile_string($type,2));
1010     }
1011
1012     # if targetfield water/isle, than dont move directly (only MOVE_WITH)
1013     #if ($phase == 1 and (Util::is_in($target_terrain,'WATER','ISLE') # or
1014                          # Util::is_in($terrain,'WATER','ISLE'))
1015    # )) {
1016
1017       # TODO: Errormessage
1018
1019      # return 0;
1020
1021     #}
1022
1023     # avatars can go on land, if ark available
1024     #if ($phase==1 and Util::is_in($terrain,'ISLE','WATER') and
1025     #   not Util::is_in($target_terrain,'ISLE','WATER')) {
1026     #     my $arks = $self->{-context}->read_mobile('ID','ARK',$loc_string,1);
1027     #    my $ark_count = $#{@$arks}+1;
1028     #   return 0 unless $self->test(sub{$ark_count},
1029     #                     'MSG_CANT_SWIM',
1030     #             'MOVE',
1031     #     $loc_string,
1032     #  $self->{-context}->mobile_string($type,2));
1033     #}
1034   } elsif ($role eq 'EARTHLING' or $owner == -1) {
1035     # read companions
1036     $self->{-companions} = $self->{-context}->
1037       read_mobile_condition('TYPE,COUNT,OWNER,ID',
1038                             "MOVE_WITH=$self->{-args}->{'MOBILE'}");
1039
1040     # do not move if field is attacked or tuberculosis
1041     if ($phase == 1) {
1042       return 0 unless $self->test(sub{not $attacker},
1043                                   'MSG_CANT_MOVE_ATTACKED',
1044                                   $mob->{'LOCATION'},
1045                                   $self->{-context}->mobile_string($type,2));
1046       return 0 unless $self->test(sub{ $plague !~ /TUBERCULOSIS/
1047                                          or exists $self->{-args}->{'AUTO'}},
1048                                   'MSG_CANT_MOVE_PLAGUE',
1049                                   $mob->{'LOCATION'},
1050                                   $self->{-context}->mobile_string($type,2),
1051                                   'Tuberculosis');
1052     }
1053     # eartlings can only move this types
1054     return 0 unless $self->test(sub{Util::is_in($type,
1055                                                 'WARRIOR',
1056                                                 'PRIEST',
1057                                                 'HERO',
1058                                                 'PROPHET',
1059                                                 'ARK')},
1060                                 'MSG_EARTHLING_CANT_MOVE_TYPE',
1061                                 $self->{-context}->mobile_string($type,2));
1062
1063     # dont move if target field is Pole
1064     return 0 unless $self->test(sub{$target_terrain ne 'AYMARGEDDON' and
1065                                       $target_terrain ne 'POLE'},
1066                                 'MSG_CANT_MOVE_TO_POLE',
1067                                 'MOVE', $target_string);
1068
1069     # dont move ark from land to land
1070     if($type eq 'ARK'){
1071       return 0 unless $self->test(sub{Util::is_in($terrain,'WATER','ISLE') or
1072                                         Util::is_in($target_terrain,'WATER','ISLE')},
1073                                   'MSG_CANT_MOVE_ARK',
1074                                   'MOVE', $target_string);
1075       $self->{-active_ark} = $self->{-args}->{'MOBILE'};
1076     }
1077
1078     # automatic ark-moving
1079     #     if ($type ne 'ARK' and $phase == 1 and
1080     #         (Util::is_in($target_terrain,'WATER','ISLE'))){
1081     #       # or Util::is_in($terrain,'WATER','ISLE'))) {
1082     #       my $arks = $aym->read_mobile('ID,COUNT','ARK',$loc_string,1);
1083     #       # print Dumper $arks;
1084     #       my ($ark,$active);
1085     #       if (defined $arks->[0]) {
1086     #   ($ark,$active) = (@{$arks->[0]});
1087     #       } else {
1088     #   ($ark,$active) = (0,0);
1089     #       }
1090     #       return 0 unless $self->test(sub {$active or $type eq 'PROPHET'},
1091     #                             'MSG_CANT_SWIM',
1092     #                             'MOVE',
1093     #                             $loc_string,
1094     #                             $self->{-context}->mobile_string($type,2));
1095     #       $self->{-active_ark} = $ark;
1096     #       Util::log("We take ark $ark with us.",1);
1097     #     }
1098
1099   } else {
1100     Util::log("impossible situation. I could not be $role",0);
1101     return 0;
1102   }
1103
1104   # dont move without mana
1105   if ($phase == 1) {
1106     if ($role eq 'GOD') {
1107       unless($self->test_mana('MOVE_AVATAR',$count)){
1108         $db->update_hash('MOBILE',
1109                          "ID=$mob_id",
1110                          {
1111                           'AVAILABLE' => 'Y'});
1112         return 0;
1113       }
1114     } else {
1115       # for all avatar-companions: pay or stay (if not on ark)!
1116       if ($type ne 'ARK'){
1117         my $deleted = 0;
1118         for my $comp (@{$self->{-companions}}) {
1119           my ($ctype,$ccount,$cown,$cid) = @$comp;
1120           next unless $ctype eq 'AVATAR';
1121           unless($self->test_mana('MOVE_AVATAR',$ccount,$cown) and not $god_attacker){
1122             $db->update_hash('MOBILE',
1123                              "ID=$cid",
1124                              {'AVAILABLE' => 'Y',
1125                               'MOVE_WITH' => 0});
1126             $self->unify_mobiles($cid,0,$cown);
1127             $deleted = 1;
1128           }
1129         }
1130         # re-read companions
1131         $self->{-companions} = $self->{-context}->
1132           read_mobile_condition('TYPE,COUNT,OWNER,ID',
1133                                 "MOVE_WITH=$self->{-args}->{'MOBILE'}")
1134             if $deleted;
1135
1136       }
1137     }
1138   }
1139
1140   return 1;
1141 }
1142
1143 # MOVE
1144 sub first_phase{
1145   my ($self) = @_;
1146
1147   return 0 unless $self->is_valid();
1148
1149   my $db = $self->{-db};
1150   my $type = $self->{-mob}->{'TYPE'};
1151   my $mob = $self->{-mob};
1152   my $aym = $self->{-context};
1153
1154   # split it, if neccessary
1155   # the moving unit get the old ID!
1156
1157   my $count = $self->{-args}->{'COUNT'};
1158   #print "conditional split with $count count and mob=\n";
1159   #print Dumper $mob;
1160   #print Dumper $self;
1161   return 0 unless
1162     $self->conditional_split_mobile($mob,$count,
1163                                     {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
1164                                      'MOVE_WITH' => 0},0);
1165
1166   # if ark needed, move it together with us
1167   #if($type ne 'ARK' and $self->{-active_ark}){
1168
1169   #  $self->move_with($self->{-active_ark},$self->{-args}->{'MOBILE'},1);
1170
1171     # set owner of ark
1172     # $self->{-db}->update_hash('MOBILE',
1173     # "ID=$self->{-active_ark}",
1174     # {'OWNER' => $self->{-player}});
1175   #}
1176
1177   # collect mobiles with MOVE_WITH in same location
1178   my $companions = $self->{-companions};
1179
1180   # calculate duration
1181   my $d = $::conf->{-DURATION};
1182   my $dur = $d->{"-MOVE_$type"};
1183
1184   # if moved with ark use -MOVE_ARK else use slowest
1185   if($self->{-active_ark}){
1186     $dur = $d->{'-MOVE_ARK'};
1187   }else{
1188     for my $m (@$companions){
1189       my ($mtype) = @$m;
1190       $dur = $d->{"-MOVE_$mtype"} if $d->{"-MOVE_$mtype"} > $dur;
1191     }
1192   }
1193   $self->setDuration($dur);
1194
1195   # set all companions inactive
1196   $self->{-db}->update_hash('MOBILE',
1197                             "LOCATION=$mob->{'LOCATION'} ".
1198                             "AND MOVE_WITH=$self->{-args}->{'MOBILE'}",
1199                            {'AVAILABLE' => 'N'});
1200
1201   # remove OCCUPANT in MAP, if we are an earthling
1202   # and there are no more own active (if it was our field)
1203   # mobiles left and if it is no homecity
1204   if($aym->is_earthling()){
1205     $self->empty_field($mob->{'LOCATION'});
1206     # avatar-companions: pay now
1207     if($type ne 'ARK'){
1208       for my $comp (@$companions){
1209         my ($ctype,$ccount,$cown,$cid) = @$comp;
1210         next unless $ctype eq 'AVATAR';
1211         $self->use_mana($cown);
1212       }
1213     }
1214   }elsif($aym->is_god()){
1215     $self->use_mana();
1216   }
1217
1218   # events
1219   if($type eq 'ARK' or $self->{-active_ark}){
1220     $self->event($self->{-target}->to_string(),
1221                  'EVENT_ARK_APPROACHING',
1222                  $mob->{'LOCATION'},
1223                  $mob->{'COUNT'});
1224   }else{ #elsif($type ne 'ARK'){
1225     my $player = $self->{-player};
1226     my $count = $self->{-args}->{'COUNT'};
1227     my $typetag = $count > 1 ? "MOBILE_$type".'_PL' : "MOBILE_$type";
1228     $self->event($self->{-target}->to_string(),
1229                  'EVENT_MOBILE_APPROACHING',
1230                  $mob->{'LOCATION'},
1231                  $count,
1232                  # $self->{-context}->mobile_string($type,$count));
1233                  $typetag);
1234
1235     # TODO Bug: if avatar moves with hero, the wrong player is in the event-message.
1236
1237       for my $m2 (@$companions){
1238         my ($mtype,$c,$mo) = @$m2;
1239         $self->{-player} = $mo;
1240         $typetag = $c > 1 ? "MOBILE_$mtype".'_PL' : "MOBILE_$mtype";
1241         $self->event($self->{-target}->to_string(),
1242                      'EVENT_MOBILE_APPROACHING',
1243                      $mob->{'LOCATION'},
1244                      $c,
1245                      # $self->{-context}->mobile_string($mtype,$c))
1246                      $typetag);
1247       }
1248     $self->{-player} = $player;
1249   }
1250
1251   return $dur;
1252 }
1253
1254 # MOVE
1255 sub second_phase{
1256   my ($self) = @_;
1257
1258   return 0 unless $self->is_valid();
1259
1260   my $db = $self->{-db};
1261   my $mob = $self->{-mob};
1262   my $count = $self->{-args}->{'COUNT'};
1263   my $target_location = $self->{-target}->to_string();
1264   my $old_location = $mob->{'LOCATION'};
1265
1266   # move mobile and all moving with it.
1267   $db->update_hash('MOBILE',"ID=$mob->{'ID'} OR MOVE_WITH=$mob->{'ID'}",
1268                    {'LOCATION' => $target_location,
1269                     'AVAILABLE' => 'Y',
1270                    });
1271
1272   # TODO: distribute plagues
1273
1274   # Bug?
1275   # $self->{-db}->update_hash('MOBILE',
1276   # "TYPE=ARK AND MOVE_WITH=$mob->{'ID'}",
1277   # {'MOVE_WITH' => 0});
1278
1279   # should we do a godfight?
1280   my $companions = $self->{-companions};
1281   if($mob->{'TYPE'} eq 'AVATAR'){
1282     $self->enter_field_avatar($target_location,$mob);
1283   }else{
1284     for my $m (@$companions){
1285       my ($mtype,$mc,$mo,$mid) = @$m;
1286       next unless $mtype eq 'AVATAR';
1287       $self->enter_field_avatar($target_location,$mid);
1288     }
1289   }
1290
1291   $self->enter_field($target_location) if $self->{-role} eq 'EARTHLING';
1292   # $self->enter_field_avatar($target_location,$mob) if $self->{-role} eq 'GOD';
1293   $self->drowning($old_location);
1294
1295   # MULTIMOVE
1296   if(defined $self->{-multimove}){
1297     $self->{-context}->insert_command('MOVE',
1298                                       "ROLE=$self->{-player}, ".
1299                                       "DIR=$self->{-multimove}, ".
1300                                       "MOBILE=$mob->{'ID'}, ".
1301                                       "COUNT=$mob->{'COUNT'}",
1302                                       $mob->{'LOCATION'});
1303   }else{
1304     $self->unify_mobiles($mob,$target_location);
1305   }
1306
1307 # TODO: maybe we should give a message only to the player of the unit
1308 # ... but its difficult, because of MOVE_WITH
1309
1310 #  $self->{-context}
1311 #    ->send_message_to_field
1312 #       ($target_location,
1313 #        {'MFROM' => 0,
1314 #         'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1315 #         'ARG1' => $count,
1316 #         'ARG2' => $self->{-context}->mobile_string($self->{-mob}->{'TYPE'},
1317 #                                                    $self->{-mob}->{'COUNT'}),
1318 #         'ARG3' => $self->{-context}->charname($self->{-player}),
1319 #         'ARG4' => $target_location});
1320
1321 #  for my $m (@$companions){
1322 #    my ($mtype,$mc,$mo,$mid) = @$m;
1323 #    $self->{-context}
1324 #      ->send_message_to_field
1325 #       ($target_location,
1326 #        {'MFROM' => 0,
1327 #         'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1328 #         'ARG1' => $mc,
1329 #         'ARG2' => $self->{-context}->mobile_string($mtype,$mc),
1330 #         'ARG3' => $self->{-context}->charname($mo),
1331 #         'ARG4' => $target_location});
1332 #  }
1333
1334
1335   return 1;
1336 }
1337
1338 #
1339 # End of MOVE
1340 #
1341 ####################################################
1342
1343 ##########################################################
1344 #
1345 # BLESS_PRIEST
1346 #
1347
1348 package BLESS_PRIEST;
1349 @BLESS_PRIEST::ISA = qw(AymCommand);
1350
1351 # this is called to see if the command is executable.
1352 # it should be called from first_phase() and from second_phase().
1353 # it is not called from the scheduler
1354 sub is_valid {
1355   my $self = shift;
1356
1357   my @required_arguments = ('MOBILE');
1358   return 0 unless $self->Command::is_valid(@required_arguments);
1359
1360   return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1361
1362   return 0 unless $self->validate_role('GOD');
1363
1364   my $mobtype = $self->{-mob}->{'TYPE'};
1365   my $mobloc = $self->{-mob}->{'LOCATION'};
1366
1367   # don't bless unassigned units
1368   return 0 unless $self->test(sub{$self->{-mob}->{'OWNER'} > 0},
1369                               'MSG_CANT_BLESS_UNASSIGNED',
1370                               $mobloc);
1371
1372   # only bless warriors
1373   return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
1374                               'MSG_WRONG_TYPE',
1375                               $self->{-context}->mobile_string($mobtype,1),
1376                               $mobloc);
1377
1378   return 0 unless $self->test_mana('BLESS_PRIEST');
1379
1380   return 1;
1381 }
1382
1383 # this is called from Scheduler, if he see the command the
1384 # first time, some commands execute here immidiatly.
1385 # BLESS_PRIEST
1386 sub first_phase{
1387   my $self = shift;
1388
1389   return 0 unless $self->is_valid();
1390
1391   my $id = $self->{-mob}->{'ID'};
1392   my $newid = $self->conditional_split_mobile($self->{-mob},
1393                                               1,
1394                                               {'ADORING' => $self->{-player},
1395                                                'TYPE' => 'PRIEST',
1396                                                'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
1397                                               'beforeafter');
1398
1399   # companions move with the remaining warriors, not with the new priest
1400   $self->{-db}->update_hash('MOBILE',
1401                             "MOVE_WITH = $id",
1402                             {'MOVE_WITH' => $newid}) if $id != $newid;
1403
1404   # reread mobile, because split destroys it
1405   $self->{-mob} = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
1406   $self->unify_mobiles($self->{-mob},
1407                        $self->{-mob}->{'LOCATION'},
1408                        $self->{-mob}->{'OWNER'});
1409
1410   $self->change_priest_on_temple($self->{-mob}->{'LOCATION'});
1411
1412 #  $self->{-context}
1413 #    ->send_message_to_field
1414 #      ($self->{-mob}->{'LOCATION'},
1415 #       {'MFROM' => 0,
1416 #       'MSG_TAG' => 'MSG_BLESS_PRIEST',
1417 #       'ARG1' => $self->{-context}->charname($self->{-player}),
1418 #       'ARG2' => $self->{-context}->charname($self->{-mob}->{'OWNER'}),
1419 #       'ARG3' => $self->{-mob}->{'LOCATION'}});
1420
1421
1422   $self->use_mana();
1423   $self->setDuration(0);
1424
1425   return 0;
1426 }
1427
1428 # this is called from scheduler when the command will be executed
1429 sub second_phase{
1430   my $self = shift;
1431   Util::log("BLESS_PRIEST should not have a second phase!",0);
1432   return 0;
1433 }
1434
1435 #
1436 # End of BLESS_PRIEST
1437 #
1438 ####################################################
1439
1440 ##########################################################
1441 #
1442 # BUILD_TEMPLE
1443 #
1444
1445 package BUILD_TEMPLE;
1446 use Data::Dumper;
1447 @BUILD_TEMPLE::ISA = qw(AymCommand);
1448
1449 # this is called to see if the command is executable.
1450 # it should be called from first_phase() and from second_phase().
1451 # it is not called from the scheduler
1452 sub is_valid {
1453   my $self = shift;
1454
1455   my @required_arguments = ('MOBILE');
1456   return 0 unless $self->Command::is_valid(@required_arguments);
1457
1458   return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1459
1460   my $mobtype = $self->{-mob}->{'TYPE'};
1461   my $mobloc = $self->{-mob}->{'LOCATION'};
1462   my $god = $self->{-mob}->{'ADORING'};
1463
1464   # only priests can build temples
1465   return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'PRIEST'},
1466                               'MSG_WRONG_TYPE',
1467                               $self->{-context}->mobile_string($mobtype,1),
1468                               $mobloc);
1469
1470   # is this a valid building place?
1471   # my($loc,$terrain,$temple) = $self->{-context}->read_map('TERRAIN,TEMPLE');
1472   my ($terrain,$temple) =
1473     $self->{-context}->read_field('TERRAIN,TEMPLE',$mobloc);
1474   return 0 unless $self->test(sub{$temple ne 'Y'
1475                                     and Util::is_in($terrain,'MOUNTAIN','ISLE')},
1476                               'MSG_CANT_BUILD_HERE',
1477                               $mobloc);
1478
1479   # is the priest adoring a fitting god?
1480   #return 0 unless $self->test(sub{($terrain eq 'MOUNTAIN' and
1481   #                                $self->{-mob}->{'ADORING'} eq $god) or
1482   #                                  $terrain eq 'ISLE'},
1483   #                       'MSG_ADORING_WRONG_GOD',
1484   #                       $mobloc,
1485   #                       $self->{-mob}->{'ADORING'},
1486   #                       $self->{-context}->charname($god));
1487
1488   # is there allready a BUILD_TEMPLE Command
1489   if($self->{-phase} == 1){
1490     return 0 unless $self->test(sub{! $self->{-context}->search_event('BUILD_TEMPLE',
1491                                                                       $mobloc)},
1492                                 'MSG_CANT_BUILD_HERE',
1493                                 $mobloc);
1494   }
1495
1496   # dont build more than MAX_MOUNTAIN temples on mountains
1497   if($terrain eq 'MOUNTAIN'){
1498     my $ret = $self->test(sub{$self->{-db}->count('MAP',
1499                                                   "GAME=$self->{-game} AND ".
1500                                                   "TEMPLE=Y AND ".
1501                                                   "HOME=$god AND ".
1502                                                   "OCCUPANT=$self->{-player} AND ".
1503                                                   "TERRAIN=MOUNTAIN")
1504                                       < $::conf->{-MAX_MOUNTAINS}},
1505                           'MSG_CANT_BUILD_HERE',
1506                           $mobloc);
1507     if(not $ret and $self->{-phase} == 2){
1508       # we have to set priest active, if we tryed to build in first phase
1509       $self->{-db}->update_hash('MOBILE',
1510                                 "ID=$self->{-mob}->{'ID'}",
1511                                 {'AVAILABLE' => 'Y'});
1512     }
1513     return 0 unless $ret;
1514   }
1515
1516   return 1;
1517 }
1518
1519 # this is called from Scheduler, if he sees the command the
1520 # first time, some commands execute here immidiatly.
1521 # BUILD_TEMPLE
1522 sub first_phase{
1523   my $self = shift;
1524
1525   return 0 unless $self->is_valid();
1526
1527   $self->conditional_split_mobile($self->{-mob},
1528                                   1,
1529                                   {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
1530                                    'MOVE_WITH' => 0},
1531                                   0);
1532
1533   # delete all MOVE_WITH the priest
1534   # BUG?: uninitialized value in this line??? maybe split is wrong in a way?
1535   $self->{-db}->update_hash('MOBILE',
1536                             "MOVE_WITH = $self->{-mob}->{'ID'}",
1537                             {'MOVE_WITH' => 0});
1538
1539   $self->empty_field($self->{-mob}->{'LOCATION'});
1540
1541   my ($size) = $self->{-db}->read_game($self->{-game},'TEMPLE_SIZE');
1542
1543   # set new temple size
1544   $size++;
1545   $self->{-db}->update_hash('GAME',
1546                             "GAME=$self->{-game}",
1547                             {'TEMPLE_SIZE' => $size});
1548   Util::log("New temple size: $size",1);
1549
1550   # calculate duration
1551   $self->setDuration($size * $::conf->{-DURATION}->{-BUILD_TEMPLE});
1552
1553   $self->event($self->{-mob}->{'LOCATION'},
1554                'EVENT_BUILD_TEMPLE',
1555                $self->{-context}->charname($self->{-mob}->{'ADORING'}),
1556                $size);
1557
1558   return $self->{-duration};
1559 }
1560
1561 # this is called from scheduler when the command will be executed.
1562 # BUILD_TEMPLE
1563 sub second_phase{
1564   my $self = shift;
1565
1566   return 0 unless $self->is_valid();
1567
1568   my $loc = $self->{-mob}->{'LOCATION'};
1569   $self->{-db}->update_hash('MAP',
1570                             "GAME=$self->{-game} AND LOCATION=$loc",
1571                             {'TEMPLE' => 'Y',
1572                              'HOME' => $self->{-mob}->{'ADORING'}});
1573
1574   $self->{-db}->update_hash('MOBILE',
1575                             "ID=$self->{-mob}->{'ID'}",
1576                             {'AVAILABLE' => 'Y'});
1577
1578   # insert new PRODUCE-command
1579   $self->{-context}->insert_command('PRODUCE', "ROLE=$self->{-player}",
1580                                     $self->{-mob}->{'LOCATION'});
1581
1582   # insert new PRAY-command
1583   $self->{-context}->insert_command('PRAY','',$loc);
1584
1585   # this deletes and reinsert commands, if we conquer with building
1586   $self->enter_field($loc,1);
1587
1588   #change aymargeddon to nearest pole
1589   my $poles = $self->{-db}->select_array('MAP',
1590                                          'LOCATION,TERRAIN',
1591                                          "GAME=$self->{-game} AND ".
1592                                          "(TERRAIN=POLE OR TERRAIN=AYMARGEDDON)");
1593   my $min_distance = $::conf->{-MANY};
1594   my $Loc = Location->from_string($loc);
1595   my ($new_aym,$old_aym) = ('','');
1596   for my $pol (@$poles){
1597     my ($loc2,$ter) = @$pol;
1598     $old_aym = $loc2 if $ter eq 'AYMARGEDDON';
1599     my $map = HexTorus->new($self->{-context}->get_size());
1600     my $Loc2 = Location->from_string($loc2);
1601     my $dist = $map->distance($Loc,$Loc2);
1602     Util::log("distance from $loc to $loc2: $dist",1);
1603     $new_aym = $loc2 if $dist < $min_distance and $ter eq 'POLE';
1604   }
1605   if($new_aym){
1606     Util::log("change aymargeddon from $old_aym to $new_aym",1);
1607     $self->{-db}->update_hash('MAP',
1608                               "GAME=$self->{-game} AND LOCATION=$new_aym",
1609                               {'TERRAIN' => 'AYMARGEDDON'});
1610     $self->{-db}->update_hash('MAP',
1611                               "GAME=$self->{-game} AND LOCATION=$old_aym",
1612                               {'TERRAIN' => 'POLE'});
1613   $self->{-context}
1614     ->send_message_to_all
1615       ({'MFROM' => 0,
1616         'MSG_TAG' => 'MSG_CHANGE_AYMARGEDDON',
1617         'ARG1' => $self->{-context}->charname($self->{-player})});
1618         #'ARG2' => $old_aym,
1619         #'ARG3' => $new_aym});
1620   }
1621
1622   # is this the end of the game?
1623   my $unbuild = $self->{-context}->unbuild();
1624
1625   $self->end_of_the_game() unless $unbuild;
1626
1627   return 0;
1628 }
1629
1630 #
1631 # End of BUILD_TEMPLE
1632 #
1633 ####################################################
1634
1635 ##########################################################
1636 #
1637 # PRODUCE
1638 #
1639
1640 package PRODUCE;
1641 use Data::Dumper;
1642 @PRODUCE::ISA = qw(AymCommand);
1643
1644 sub is_valid {
1645         my $self = shift;
1646
1647         my @required_arguments = ('ROLE');
1648         # TODO: Open question: is this redundant information? allready
1649         # in PLAYER of COMMAND?
1650         return 0 unless $self->Command::is_valid(@required_arguments);
1651
1652         return 1;
1653 }
1654
1655 # PRODUCE
1656 sub first_phase{
1657   my $self = shift;
1658
1659   return 0 unless $self->is_valid();
1660
1661   my ($ter,$home,$occ,$temple) =
1662     $self->{-context}->read_field('TERRAIN,HOME,OCCUPANT,TEMPLE',
1663                                   $self->{-dbhash}->{'LOCATION'});
1664
1665   my ($type, $duration);
1666   $type = $temple eq 'Y' ? 'PRIEST' : 'WARRIOR';
1667
1668   my $d = $::conf->{-DURATION};
1669   my $peace = $self->{-args}->{'PEACE'};
1670   $peace = 0 unless defined $peace;
1671   if($type eq 'PRIEST'){
1672     Util::log("Produce a priest at ",-1);
1673     if ($ter eq 'MOUNTAIN'){
1674       Util::log("mountain.",1);
1675       $duration = $d->{-PRODUCE_PRIEST_HOME};
1676     }else{
1677       Util::log("isle.",1);
1678       $duration = $d->{-PRODUCE_PRIEST};
1679     }
1680     $self->setDuration($duration);
1681     $self->event($self->{-location},
1682                  'EVENT_PRODUCE_PRIEST');
1683   }else{
1684     Util::log("Produce a warrior at ",-1);
1685     if ($occ == $home){
1686       Util::log("homecity.",1);
1687       $duration = $d->{-PRODUCE_WARRIOR_HOME};
1688     }else{
1689       Util::log("normal city.",1);
1690       $duration = $d->{-PRODUCE_WARRIOR} + $d->{-PRODUCE_WARRIOR_CHANGE} * $peace;
1691     }
1692     $self->setDuration($duration);
1693     $self->event($self->{-location},
1694                  'EVENT_PRODUCE_WARRIOR');
1695   }
1696
1697   return $duration;
1698 }
1699
1700 # this is called from scheduler when the command will be executed.
1701 # PRODUCE
1702 sub second_phase{
1703   my $self = shift;
1704
1705   return 0 unless $self->is_valid();
1706
1707   my $loc = $self->{-dbhash}->{'LOCATION'};
1708   my ($temple,$home,$occ,$plague) =
1709     $self->{-context}->read_field('TEMPLE,HOME,OCCUPANT,PLAGUE',$loc);
1710   my $type = $temple eq 'Y' ? 'PRIEST' : 'WARRIOR';
1711
1712   # fields with influenza do not produce
1713   if(not defined $plague or not $plague =~ 'INFLUENZA'){
1714
1715     # dont produce priests at temples, if no other priests are there
1716     if ($type eq 'PRIEST'){
1717       my $mobiles = $self->{-context}
1718         ->read_mobile_condition('ID',
1719                                 "TYPE=PRIEST AND AVAILABLE=Y AND ADORING=$home",$loc);
1720       if(!@$mobiles){
1721         Util::log("No priests, no new priests!",1);
1722         $self->do_it_again();
1723         return 0;
1724       }
1725     }
1726
1727     my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1728                'TYPE' => $type,
1729                'LOCATION' => $loc,
1730                'COUNT' => 1,
1731                'AVAILABLE' => 'Y',
1732                'OWNER' => $self->{-args}->{'ROLE'},
1733                'GAME' => $self->{-game},
1734                'MOVE_WITH' => 0,
1735               };
1736
1737     # print Dumper $mob;
1738
1739     $mob->{'ADORING'} = $home if $type eq 'PRIEST';
1740
1741     my %mobcopy = (%$mob);
1742     $self->{-mob} = \%mobcopy;
1743     $self->{-db}->insert_hash('MOBILE',
1744                               $mob);
1745
1746     $self->enter_field($loc,1);
1747   } # endif no influenza
1748   else{
1749     Util::log("No production in $loc due to INFLUENZA!",1);
1750   }
1751
1752   # re-insert command
1753   my $new_peace = $self->{-args}->{'PEACE'};
1754   $new_peace = 0 unless defined $new_peace;
1755   $new_peace++;
1756   $self->do_it_again({'PEACE' => $new_peace});
1757
1758   return 1;
1759 }
1760
1761 #
1762 # End of PRODUCE
1763 #
1764 ####################################################
1765
1766 ##########################################################
1767 #
1768 # PRAY
1769 #
1770
1771 package PRAY;
1772 use Data::Dumper;
1773 @PRAY::ISA = qw(AymCommand);
1774
1775 sub is_valid {
1776   my $self = shift;
1777
1778   my @required_arguments = ();
1779   return 0 unless $self->Command::is_valid(@required_arguments);
1780
1781   $self->{-loc} = $self->{-dbhash}->{'LOCATION'};
1782   my ($temple,$home) = $self->{-context}->read_field('TEMPLE,HOME',
1783                                                      $self->{-loc});
1784   # TODO: use test() instead
1785   return 0 unless $temple eq 'Y';
1786
1787   $self->{-god} = $home;
1788
1789   return 1;
1790 }
1791
1792 # PRAY
1793 sub first_phase{
1794   my $self = shift;
1795
1796   return 0 unless $self->is_valid();
1797
1798   return $self->{-duration};
1799 }
1800
1801 # PRAY
1802 sub second_phase{
1803   my $self = shift;
1804
1805   return 0 unless $self->is_valid();
1806
1807   # count number of active orthodox priests
1808   my $priests = 0;
1809   my $oim = $self->{-context}->own_in_mobile($self->{-loc},
1810                                              $self->{-god},
1811                                              'available');
1812
1813   for my $om (@$oim){
1814     my ($id) = @$om;
1815     my $mob = $self->{-db}->read_single_mobile($id);
1816     $priests += $mob->{'COUNT'} if($mob->{'TYPE'} eq 'PRIEST');
1817   }
1818
1819   # reduce effective priests if necessary
1820   my $fortune = $self->{-context}->read_fortune();
1821   my $oldpriests = $priests;
1822
1823   my ($terrain) = $self->{-context}->read_field('TERRAIN',$self->{-loc});
1824   if($terrain eq 'MOUNTAIN'){
1825     if($priests > $::conf->{-FORTUNE_FAKTOR_MOUNTAIN} * $fortune){
1826       $priests = $::conf->{-FORTUNE_FAKTOR_MOUNTAIN} * $fortune;
1827     }
1828   }elsif($terrain eq 'ISLE'){
1829     if($priests > $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune){
1830       $priests = $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune;
1831     }
1832   }else{
1833     Util::log("ERROR: PRAY in terrain $terrain",0);
1834   }
1835
1836   Util::log("reduce praying priests from $oldpriests to".
1837             " $priests in $self->{-loc} ($terrain, fortune: $fortune)",1)
1838       if $oldpriests > $priests;
1839
1840   # add priests + 1 mana to $self->{-god}
1841   my $mana = $self->{-context}->get_mana($self->{-god});
1842   my $newmana = $mana + $priests + $::conf->{-MANA_FOR_TEMPLE};
1843
1844   $self->{-db}->update_hash('GOD',
1845                             "PLAYER=$self->{-god} AND GAME=$self->{-game}",
1846                             {'MANA' => $newmana});
1847   Util::log("$priests priests pray for $self->{-god} ".
1848             "in $self->{-loc} and he got ". ($newmana - $mana) ." mana",1);
1849
1850   # TODO: Message?
1851
1852   # re-insert command
1853   $self->do_it_again();
1854
1855   return 1;
1856 }
1857
1858 #
1859 # End of PRAY
1860 #
1861 ####################################################
1862
1863 ##########################################################
1864 #
1865 # BUILD_ARK
1866 #
1867
1868 package BUILD_ARK;
1869 use Data::Dumper;
1870 @BUILD_ARK::ISA = qw(AymCommand);
1871
1872 # this is called to see if the command is executable.
1873 # it should be called from first_phase() and from second_phase().
1874 # it is not called from the scheduler
1875 sub is_valid {
1876   my $self = shift;
1877
1878   #  my @required_arguments = ('');
1879   return 0 unless $self->Command::is_valid();
1880
1881   return 0 unless $self->validate_role('GOD');
1882
1883   return 1;
1884 }
1885
1886 # this is called from Scheduler, if he sees the command the
1887 # first time, some commands execute here immidiatly.
1888 # BUILD_ARK
1889 sub first_phase{
1890   my $self = shift;
1891
1892   return 0 unless $self->is_valid();
1893   return 0 unless $self->test_mana('BUILD_ARK');
1894
1895   # calculate duration
1896   $self->setDuration($::conf->{-DURATION}->{-BUILD_ARK});
1897
1898   $self->event($self->{-location},
1899                'EVENT_BUILD_ARK');
1900
1901   $self->use_mana();
1902
1903   return $self->{-duration};
1904 }
1905
1906 # this is called from scheduler when the command will be executed.
1907 # BUILD_ARK
1908 sub second_phase{
1909   my $self = shift;
1910
1911   return 0 unless $self->is_valid();
1912
1913   # owner should be occupant
1914   my ($occ) = $self->{-context}->read_field('OCCUPANT',$self->{-location});
1915   $occ = -1 unless $occ;
1916
1917   my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1918              'TYPE' => 'ARK',
1919              'LOCATION' => $self->{-location},
1920              'COUNT' => 1,
1921              'AVAILABLE' => 'Y',
1922              'OWNER' => $occ,
1923              'GAME' => $self->{-game},
1924             };
1925   my %mobcopy = (%$mob);
1926   $self->{-db}->insert_hash('MOBILE',$mob);
1927
1928   # merge multiple ARKs in one mobile, if same owner
1929   $self->unify_mobiles(\%mobcopy,$self->{-location},$occ);
1930
1931   # $self->{-db}->commit();
1932
1933 #  $self->{-context}
1934 #    ->send_message_to_field
1935 #      ($self->{-location},
1936 #       {'MFROM' => 0,
1937 #       'MSG_TAG' => 'MSG_BUILD_ARK',
1938 #       'ARG1' => $self->{-context}->charname($self->{-player}),
1939 #       'ARG2' => $self->{-location}});
1940
1941   return 0;
1942 }
1943
1944 #
1945 # End of BUILD_ARK
1946 #
1947 ####################################################
1948
1949 ####################################################
1950 #
1951 # INCARNATE: Create an Avatar
1952 #
1953
1954 package INCARNATE;
1955 @INCARNATE::ISA  = qw(AymCommand);
1956
1957 sub is_valid{
1958   my ($self) = @_;
1959
1960   my @required_arguments = ('COUNT');
1961   return 0 unless $self->Command::is_valid(@required_arguments);
1962
1963   # you need a temple to create an avatar
1964   $self->{-arrival} = $self->{-context}->incarnation_place();
1965   return 0 unless $self->test(sub{$self->{-arrival};},
1966                               'MSG_ERROR_NO_ARRIVAL');
1967
1968   # TODO: maybe with variing cost (distance to Aymargeddon)
1969   return 0 unless $self->test_mana('INCARNATE', $self->{-args}->{'COUNT'});
1970
1971   return 1;
1972 }
1973
1974 # INCARNATE
1975 sub first_phase{
1976   my $self = shift;
1977   return 0 unless $self->is_valid();
1978
1979   # create mobile (or join)
1980   my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1981              'GAME' => $self->{-game},
1982              'LOCATION' => $self->{-location},
1983              'TYPE' => 'AVATAR',
1984              'OWNER' => $self->{-player},
1985              'COUNT' => $self->{-args}->{'COUNT'},
1986              'AVAILABLE' => 'Y',
1987              'STATUS' => 'IGNORE',
1988              'COMMAND_ID' => $self->{-id},
1989             };
1990   $self->{-mob} = $mob;
1991   my %mobcopy = (%$mob);
1992   $self->{-db}->insert_hash('MOBILE',\%mobcopy);
1993
1994   $self->enter_field_avatar($self->{-location},$mob);
1995   $self->unify_mobiles($mob,$self->{-location});
1996
1997   $self->use_mana();
1998
1999   # TODO: count count
2000 #  $self->{-context}
2001 #    ->send_message_to_field
2002 #      ($self->{-location},
2003 #       {'MFROM' => 0,
2004 #       'MSG_TAG' => 'MSG_INCARNATE',
2005 #       'ARG1' => $self->{-context}->charname($self->{-player}),
2006 #       'ARG2' => $self->{-location}});
2007
2008   $self->setDuration(0);
2009   return 1;
2010 };
2011
2012 sub second_phase{
2013   my $self = shift;
2014   Util::log("Warning: We should not reach phase 2 with command INCARNATE",0);
2015   return 0;
2016 };
2017
2018 #
2019 # END of INCARNATE
2020 #
2021 ################################################################
2022
2023 ##########################################################
2024 #
2025 # FIGHT_EARTHLING
2026 #
2027
2028 package FIGHT_EARTHLING;
2029 use Data::Dumper;
2030 use Date::Parse qw(str2time);
2031 use Date::Calc qw(Time_to_Date);
2032 @FIGHT_EARTHLING::ISA = qw(AymCommand);
2033
2034 # this is called to see if the command is executable.
2035 # it should be called from first_phase() and from second_phase().
2036 # it is not called from the scheduler
2037 sub is_valid {
2038   my $self = shift;
2039
2040   my @required_arguments = ('ATTACKER','DEFENDER');
2041   return 0 unless $self->Command::is_valid(@required_arguments);
2042
2043   return 0 unless $self->validate_role('EARTHLING');
2044   return 0 unless $self->validate_this_role($self->{-args}->{'ATTACKER'},'EARTHLING');
2045   my $def = $self->{-args}->{'DEFENDER'};
2046   if($def > 0){
2047     return 0 unless $self->validate_this_role($self->{-args}->{'DEFENDER'},'EARTHLING');
2048   }
2049
2050   return 1;
2051 }
2052
2053 # this is called from Scheduler, if he sees the command the
2054 # first time, some commands execute here immidiatly.
2055 # FIGHT_EARTHLING
2056 sub first_phase{
2057   my $self = shift;
2058
2059   return 0 unless $self->is_valid();
2060
2061   # calculate duration
2062   $self->setDuration($::conf->{-DURATION}->{-FIGHT_EARTHLING});
2063
2064   $self->event($self->{-location},
2065                'FIGHT_EARTHLING');
2066
2067   return $self->{-duration};
2068 }
2069
2070 # this is called from scheduler when the command will be executed.
2071 # FIGHT_EARTHLING
2072 sub second_phase{
2073   my $self = shift;
2074
2075   return 0 unless $self->is_valid();
2076
2077   # read map info
2078   my ($terrain,$home,$occupant) = $self->{-context}->
2079     read_field('TERRAIN,HOME,OCCUPANT',$self->{-location});
2080
2081   my $attacker = $self->{-args}->{'ATTACKER'};
2082   my $defender = $self->{-args}->{'DEFENDER'};
2083
2084   # get all mobiles
2085   my $mobiles = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2086                                                0, $self->{-location}, 1);
2087   $self->{-mobiles} = $mobiles;
2088   # print Dumper $mobiles;
2089
2090   #my $efoa = {"$attacker" => 0}; # earthling friends of attacker
2091   #my $efod = {"$defender" => 0}; # earthling friends of defender
2092   #$self->{-efoa} = $efoa;
2093   #$self->{-efod} = $efod;
2094
2095   my ($gfoa, $gfod); # god friends ...
2096
2097   # calculate strength of both sides
2098   my ($attack_strength, $defend_strength,$attack_avatar,$defend_avatar) = (0,0,0,0);
2099   my ($people_attacker, $people_defender) = (0,0);
2100   for my $mob (@$mobiles){
2101     my ($id,$type,$own,$count,$stat) = @$mob;
2102
2103     # next if $own <= 0;
2104     if(exists($gfod->{$own})){
2105       # could be reached with differen MOVE_WITH
2106       $defend_avatar += $count * $self->strength('AVATAR');
2107       $gfod->{$own} += $count;
2108       Util::log("(1)mobile $id: $count $type from $own fights for $defender in $self->{-location}",1);
2109     }elsif(exists($gfoa->{$own})){
2110       # could be reached with differen MOVE_WITH
2111       $attack_avatar += $count * $self->strength('AVATAR');
2112       $gfoa->{$own} += $count;
2113       Util::log("(2)mobile $id: $count $type from $own fights for $attacker in $self->{-location}",1);
2114     }else{
2115       # TODO Performance (in the case of earthling this is not necessary)
2116       my ($att_rel,$def_rel,$foa,$fod) = (0,0,0,0);
2117
2118       # Avatars dont fight sometimes (no mana or no help or no friend)
2119       if($type eq 'AVATAR'){
2120         # if(not $godfight){
2121           $att_rel = $self->{-context}->read_single_relation($own,$attacker);
2122           $def_rel = $self->{-context}->read_single_relation($own,$defender);
2123
2124           $foa = 1 if Util::is_in($att_rel,'FRIEND','ALLIED');
2125           $fod = 1 if Util::is_in($def_rel,'FRIEND','ALLIED');
2126
2127           # defender has support if in doubt
2128           $foa = 0 if $foa and $fod;
2129           $fod = 1 if not $foa and not $fod;
2130
2131           $gfoa->{$own} += $count if $foa;
2132           $gfod->{$own} += $count if $fod;
2133
2134           # if you dont have enough mana for all your avatars no one fights!
2135           if($stat eq 'HELP' and $self->test_mana('FIGHT_AVATAR',1,$own)){
2136             $self->use_mana($own);
2137           }else{
2138             ($foa, $fod) = (0,0);
2139             $gfod->{$own} = 0;
2140             $gfoa->{$own} = 0;
2141           }
2142         # }
2143       }else{
2144         # earthlings are simpel: no friends in field
2145         $foa = 1 if $own == $attacker;
2146         $fod = 1 if $own == $defender;
2147       }
2148
2149       if($foa){
2150         Util::log("(3)mobile $id: $count $type from $own fights for ".
2151                   "$attacker in $self->{-location}",1);
2152         if($type eq 'AVATAR'){
2153           # count maximum avatarpower
2154           $attack_avatar += $count * $self->strength('AVATAR');
2155         }else{
2156           # count earthling_strength
2157           $attack_strength += $count * $self->strength($type);
2158           $people_attacker += $count;
2159         }
2160       }elsif($fod){     # same for defender
2161         Util::log("(4)mobile $id: $count $type from $own fights for ".
2162                   "$defender in $self->{-location}",1);
2163         if($type eq 'AVATAR'){
2164           $defend_avatar += $count * $self->strength('AVATAR');
2165         }else{
2166           $defend_strength += $count * $self->strength($type);
2167           $people_defender += $count;
2168         }
2169       }else{
2170         Util::log("(5)mobile $id: $own dont fight with $count $type ".
2171                   "in $self->{-location}",1);
2172       }
2173     }
2174   }
2175
2176   # terrain-bonus
2177   if($terrain eq 'CITY'){
2178       # bonus for home city
2179     if($home == $attacker){
2180       Util::log("homecity fights for $attacker",1);
2181       $attack_strength += $::conf->{-FIGHT}->{-HOME};
2182     }elsif($home == $defender and $home){
2183       Util::log("homecity fights for $defender",1);
2184       $defend_strength += $::conf->{-FIGHT}->{-HOME};
2185     }
2186   }elsif($terrain eq 'ISLE'){
2187     # bonus for isle
2188     if($occupant == $attacker){
2189       Util::log("isle fights for $attacker",1);
2190       $attack_strength += $::conf->{-FIGHT}->{-ISLE};
2191     }elsif($occupant == $defender){
2192       Util::log("isle fights for $defender",1);
2193       $defend_strength += $::conf->{-FIGHT}->{-ISLE};
2194     }else{
2195       Util::log("impossible situation: isle fights for no one!",0);
2196     }
2197   }
2198
2199   Util::log("earthling strength attacker($attacker): ".
2200             "$attack_strength, defender($defender): $defend_strength"
2201             ,1);
2202
2203   my $pure_attack_strength = $attack_strength;
2204   my $pure_defend_strength = $defend_strength;
2205
2206   #my $attacker_death_count = $attack_strength;
2207   #my $defender_death_count = $defend_strength;
2208
2209   my $attacker_death_count = $people_attacker;
2210   my $defender_death_count = $people_defender;
2211
2212   Util::log("$people_attacker people fight for attacker $attacker",1);
2213   Util::log("$people_defender people fight for defender $defender",1);
2214
2215   my $attacker_godpower = Util::min($people_attacker,$attack_avatar);
2216   my $defender_godpower = Util::min($people_defender,$defend_avatar);
2217
2218   Util::log("Gods supports attacker($attacker) with $attacker_godpower",1);
2219   Util::log("Gods supports defender($defender) with $defender_godpower",1);
2220
2221   $attack_strength += $attacker_godpower;
2222   $defend_strength += $defender_godpower;
2223
2224   # FLANKING
2225   # if landbattle: look, for all neighbour fields,
2226   # add flanking power of allies
2227   my ($flanking_attack,$flanking_defend) = (0,0);
2228   # if(not $self->{-see_battle} and not $self->{-island_battle}){
2229   my @neighbours = $self->get_neighbours($self->{-location});
2230   # COMMENT IN FOR NEW RULE my ($att_neighbours,$def_neighbours) = (0,0);
2231   # print "neighbours: @neighbours\n";
2232   for my $n (@neighbours){
2233     # my $n_string = $n->to_string();
2234     my ($ter,$occ,$att) = $self->{-context}->
2235       read_field('TERRAIN,OCCUPANT,ATTACKER',$n);
2236     next if $ter eq 'WATER'; # dont flank from see
2237     next if $att > 0; # dont flank from war
2238     my $attacker_relation = $self->{-context}->read_single_relation($occ,$attacker);
2239     my $defender_relation = $self->{-context}->read_single_relation($occ,$defender);
2240     Util::log("flanking ($n): $attacker_relation, $defender_relation, ".
2241               "$ter, $occ, $att",1);
2242     if($occ != $defender and
2243        ($occ == $attacker or (Util::is_in($attacker_relation,'FRIEND','ALLIED') and not
2244                               Util::is_in($defender_relation,'FRIEND','ALLIED')))){
2245       # COMMENT IN FOR NEW RULE $att_neighbours++;
2246       # COMMENT IN FOR NEW RULE $flanking_attack += $::conf->{-FIGHT}->{-FLANKING} * $att_neighbours;
2247       $flanking_attack += $::conf->{-FIGHT}->{-FLANKING};
2248       Util::log("$n flanks for attacker($attacker)",1);
2249     }elsif($occ and ($occ != $attacker and
2250            ($occ == $defender or
2251             (not Util::is_in($attacker_relation,'FRIEND','ALLIED')
2252              and Util::is_in($defender_relation,'FRIEND','ALLIED'))))){
2253       # COMMENT IN FOR NEW RULE $def_neighbours++;
2254       # COMMENT IN FOR NEW RULE  $flanking_defend += $::conf->{-FIGHT}->{-FLANKING} * $def_neighbours;
2255       $flanking_defend += $::conf->{-FIGHT}->{-FLANKING};
2256       Util::log("$n flanks for defender($defender)",1);
2257     }
2258   }
2259   Util::log("sum of flanking: $flanking_attack for attacker($attacker) and ".
2260             "$flanking_defend for defender($defender) and ",1);
2261   $attack_strength += $flanking_attack;
2262   $defend_strength += $flanking_defend;
2263   #}
2264
2265   Util::log("sum strength without fortune: $attack_strength for attacker($attacker) ".
2266             "and $defend_strength for defender($defender)",1);
2267
2268   # add random value (1 to GAME.FORTUNE)
2269   my $fortune = $self->{-context}->read_fortune();
2270   my $asf = int(rand($fortune))+1;
2271   my $dsf = int(rand($fortune))+1;
2272   $attack_strength += $asf;
2273   $defend_strength += $dsf;
2274   Util::log("strength with fortune attacker($attacker): ".
2275             "$attack_strength, defender($defender): $defend_strength",1);
2276
2277   #  my @loosers;
2278
2279   if($attack_strength > $defend_strength){
2280     $self->{-winner} = $attacker;
2281     $self->{-looser} = $defender;
2282     $self->{-winner_death_count} = Util::min($people_attacker - 1,
2283                                              int(0.5 + $defender_death_count /
2284                                              $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2285     $self->{-looser_death_count} = Util::max(1,int(0.5 + $attacker_death_count /
2286                                              $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2287     Util::log("Attackers($attacker) won!",1);
2288     $self->conquer($self->{-location},$attacker);
2289   }else{
2290     $self->{-winner} = $defender;
2291     $self->{-looser} = $attacker;
2292     $self->{-winner_death_count} = Util::min($people_defender - 1,
2293                                              int(0.5 + $attacker_death_count /
2294                                              $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2295     $self->{-looser_death_count} = Util::max(1,int(0.5 + $defender_death_count /
2296                                              $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2297     # $self->{-looser} = $efoa;
2298     # $self->{-master_looser} = $attacker;
2299     Util::log("Defenders($defender) won!",1);
2300   }
2301
2302   # loosers and helpers run away or die
2303   $self->run_or_die();
2304
2305   # erase MAP.ATTACKER
2306   $self->{-db}->update_hash('MAP',
2307                             "LOCATION=$self->{-location} AND GAME=$self->{-game}",
2308                             {'ATTACKER' => 0});
2309
2310   # reread mobiles
2311   # $self->{-mobiles} = $self->{-context}->read_mobile('ID',
2312   # 0, $self->{-location}, 1);
2313
2314   # unify the mobiles, which are still here
2315   for my $mob_arr (@$mobiles){
2316     my ($id,$type,$owner,$count,$status) = @$mob_arr;
2317     next if exists $self->{-run_or_die}->{$id};
2318     my $mob = $self->{-db}->read_single_mobile($id);
2319     $self->unify_mobiles($mob,$self->{-location},$owner) if $mob;
2320   }
2321
2322   # sometimes the last ark is gone in battle
2323   if($terrain eq 'WATER'){
2324     $self->drowning($self->{-location});
2325   }
2326
2327   # send battle-report
2328   my $name_of_attacker = $self->{-context}->charname($attacker);
2329   my $name_of_defender = $self->{-context}->charname($defender);
2330   my $name_of_winner = $self->{-context}->charname($self->{-winner});
2331
2332   my $text = <<END_OF_TEXT;
2333   <strong>BATTLE_REPORT $self->{-location}</strong><br>
2334   <table><tr><th></th><th>$name_of_attacker</th><th>$name_of_defender</th></tr>
2335   <tr><td>PEOPLE</td><td>$people_attacker</td>
2336     <td>$people_defender</td></tr>
2337   <tr><td>FIGHTING_STRENGTH</td><td>$pure_attack_strength</td>
2338     <td>$pure_defend_strength</td></tr>
2339   <tr><td>FLANKING</td><td>$flanking_attack</td><td>$flanking_defend</td></tr>
2340   <tr><td>GODS_HELP</td><td>$attacker_godpower</td><td>$defender_godpower</td></tr>
2341   <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
2342   <tr><td>SUM_OF_STRENGTH</td><td>$attack_strength</td><td>$defend_strength</td></tr>
2343   <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$attacker}->{'K'}</td>
2344     <td>$self->{-dead}->{$defender}->{'K'}</td></tr>
2345   <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$attacker}->{'H'}</td>
2346     <td>$self->{-dead}->{$defender}->{'H'}</td></tr>
2347   <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$attacker}->{'P'}</td>
2348     <td>$self->{-dead}->{$defender}->{'P'}</td></tr>
2349   <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$attacker}->{'A'}</td>
2350     <td>$self->{-dead}->{$defender}->{'A'}</td></tr>
2351   <tr><td>CONQUERED_ARKS</td><td>$self->{-dead}->{$defender}->{'C'}</td>
2352     <td>$self->{-dead}->{$attacker}->{'C'}</td></tr>
2353   </table>
2354   <strong>WINNER_IS $name_of_winner</strong>.
2355 END_OF_TEXT
2356
2357   # TODO: we should make shure, that attacker and defender are receivers.
2358   # could happen, if all dying and no other unit in the neighbourhood
2359   my @gods = (keys %$gfoa, keys %$gfod);
2360   $self->{-context}
2361     ->send_message_to_field
2362       ($self->{-location},{'MFROM' => 0,
2363                            'MSG_TEXT' => $text}
2364         # 'ARG1' => $self->{-context}->charname($attacker),
2365         # 'ARG2' => $self->{-context}->charname($defender),
2366         # 'ARG3' => $self->{-context}->charname($self->{-winner}),
2367         # 'ARG4' => $self->{-location}}
2368        );
2369        #,$attacker,$defender,@gods);
2370
2371   return 0;
2372 }
2373
2374 # FIGHT_EARTHLING
2375 sub run_or_die{
2376   my($self) = @_;
2377
2378   # some people have to die
2379   $self->casualties($self->{-winner},$self->{-winner_death_count});
2380   $self->casualties($self->{-looser},$self->{-looser_death_count});
2381
2382   # print Dumper $self->{-dead};
2383
2384   # reread mobiles
2385   $self->{-mobiles} = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2386                                                      0, $self->{-location}, 1);
2387
2388   # the survivors run
2389   # TODO: no retreat if no survivors
2390   $self->retreat();
2391
2392 }
2393
2394 sub find_retreat_field{
2395   my ($self,$retreat_fields) = @_;
2396
2397   my @retreat_fields = @$retreat_fields;
2398
2399   # chose one retreat-field
2400   return $retreat_fields[rand($#retreat_fields +1)];
2401 }
2402
2403 sub retreat_unit{
2404   my ($self,$unit,$count,$retreat,$type) = @_;
2405
2406   my $looser = $self->{-looser};
2407
2408   # calculate direction
2409   my $dir = $self->{-context}->is_in_direction_from($retreat,
2410                                                         $self->{-location});
2411
2412   # retreat via MOVE_WITH if retreat with ark
2413   if($type ne 'ARK' and exists $self->{-retreat_arks}->{$retreat}){
2414     my $ark = $self->{-retreat_arks}->{$retreat};
2415     $self->{-db}->update_hash('MOBILE',
2416                               "ID=$unit",
2417                               {'MOVE_WITH' => $ark,
2418                                'AVAILABLE' => 'N'});
2419     Util::log("retreat via $ark (MOVE_WITH)",1);
2420   }else{
2421     # TODO?: insert event
2422     $self->{-context}->insert_command('MOVE',
2423                                       "DIR=$dir, MOBILE=$unit, ".
2424                                       "COUNT=$count, AUTO=1",
2425                                       $self->{-location},
2426                                       $looser);
2427     Util::log("retreat via MOVE_COMMAND",1);
2428   }
2429   Util::log("$looser retreats from $self->{-location} to $retreat ".
2430             "in direction $dir with $count people(or ark). Mobile-ID: $unit",1);
2431   $self->{-run_or_die}->{$unit} = 1;
2432
2433   $self->{-context}
2434     ->send_message_to_list
2435       ({'MFROM' => 0,
2436         'MSG_TAG' => 'MSG_FIGHT_RETREAT',
2437         'ARG1' => $self->{-context}->charname($looser),
2438         'ARG2' => 'PEOPLE_OR_ARK',
2439         'ARG3' => $self->{-location},
2440         'ARG4' => $count},$looser,$self->{-winner});
2441
2442   return $retreat;
2443 }
2444
2445 sub retreat{
2446   my ($self) = @_;
2447
2448   my $looser = $self->{-looser};
2449   Util::log("checking retreats for looser $looser ...",1);
2450
2451   # remove MOVE_WITH if any
2452   $self->{-db}->update_hash('MOBILE',
2453                             "OWNER=$looser AND LOCATION=$self->{-location} AND ".
2454                             "AVAILABLE=Y",
2455                             {'MOVE_WITH' => 0});
2456
2457   # search for retreat-possibilities
2458   my ($local_terrain) = $self->{-context}->read_field('TERRAIN',$self->{-location});
2459   my @possible_retreat = $self->{-context}->own_neighbours($self->{-location},$looser);
2460   my @retreat_fields = ();
2461   my @retreat_water_fields = ();
2462   if ($local_terrain eq 'WATER' or $local_terrain eq 'ISLE'){
2463     @retreat_water_fields = @possible_retreat;
2464     Util::log("retreat from water: @possible_retreat",1);
2465   }else{
2466     Util::log("check retreat for ...",-1);
2467     for my $field (@possible_retreat){
2468       Util::log("\n$field ",-1);
2469       my ($terrain) = $self->{-context}->read_field('TERRAIN',$field);
2470       if ($terrain eq 'WATER' or $terrain eq 'ISLE'){
2471         Util::log("... accepted water retreat to $terrain!",1);
2472         push @retreat_water_fields, $field;
2473       }else{
2474         Util::log("... accepted land retreat to $terrain!",1);
2475         push @retreat_fields, $field;
2476       }
2477     }
2478   }
2479   # $self->{-retreat_fields} = \@retreat_fields;
2480   # $self->{-retreat_water_fields} = \@retreat_fields;
2481
2482   # retreat own arks
2483
2484   my $have_ark = 0;
2485   my %arks = ();
2486   if($#retreat_water_fields >= 0){
2487     $self->{-retreat_arks} = {}; # TODO Performance: use only hashes, no arrays
2488     for my $m (@{$self->{-mobiles}}){
2489       my ($id,$type,$own,$count,$stat) = @$m;
2490       next unless $type eq 'ARK' and ($own == $self->{-looser});
2491
2492       my $retreat_field = $self->find_retreat_field(\@retreat_water_fields);
2493       Util::log("found ark $id from $own for retreat to $retreat_field",1);
2494
2495       $self->{-retreat_arks}->{$retreat_field} = $id;
2496       $arks{$id} = $retreat_field;
2497
2498       if (not Util::is_in($retreat_field,@retreat_fields)){
2499         push @retreat_fields, $retreat_field;
2500         Util::log("... accepted retreat through ark $id to $retreat_field!",1);
2501       }
2502     }
2503   }else{
2504     # all arks change owner to winner
2505     $self->{-db}->update_hash('MOBILE',
2506                               "GAME=$self->{-game} AND ".
2507                               "LOCATION=$self->{-location} AND ".
2508                               "TYPE=ARK",
2509                               {'OWNER' => $self->{-winner}});
2510     Util::log("All arks in $self->{-location} change owner to $self->{-winner}",1);
2511   }
2512
2513
2514   # for every unit of this looser
2515   for my $mob (@{$self->{-mobiles}}){
2516     my ($id,$type,$own,$count,$stat) = @$mob;
2517     next unless $own == $looser;
2518     next if $type eq 'ARK';
2519
2520     # if there is a way out
2521     if($#retreat_fields >= 0){
2522       my $field = $self->find_retreat_field(\@retreat_fields);
2523       Util::log("checking retreat for mobile $id ".
2524                 "(own: $own, type: $type, count: $count, field: $field)",1);
2525       $self->retreat_unit($id,$count,$field,$type);
2526     }else{
2527       # die!
2528       $self->{-db}->delete_from('MOBILE',"ID=$id");
2529       $self->{-run_or_die}->{$id} = 1;
2530
2531       $self->{-context}
2532         ->send_message_to_field
2533           ($self->{-location},
2534            {'MFROM' => 0,
2535             'MSG_TAG' => 'MSG_FIGHT_RETREAT_DIE',
2536             'ARG1' => $self->{-context}->charname($looser),
2537             'ARG2' => $type,
2538             'ARG3' => $self->{-location},
2539             'ARG4' => $count});#,$looser,$self->{-winner});
2540       Util::log("$looser looses $count $type in $self->{-location}".
2541                 " because there is no place to retreat.",1);
2542     }
2543   }
2544   # MOVE COMMANDS for arks came last because others move with them
2545   for my $mob (@{$self->{-mobiles}}){
2546     my ($id,$type,$own,$count,$stat) = @$mob;
2547     next unless $own == $looser;
2548     next unless $type eq 'ARK';
2549     Util::log("checking retreat for mobile $id ".
2550               "(own: $own, type: $type, count: $count, ".
2551               "via ark $id to field: $arks{$id})",1);
2552
2553     $self->retreat_unit($id,$count,$arks{$id},$type);
2554   }
2555 }
2556
2557 sub strength{
2558   my($self,$type) = @_;
2559
2560   #  return $::conf->{-SEE_FIGHT}->{"-$type"} if $self->{-naval_battle};
2561   # return $::conf->{-ISLAND_FIGHT}->{"-$type"} if $self->{-island_battle};
2562   return $::conf->{-FIGHT}->{"-$type"};
2563 }
2564
2565 #
2566 # End of FIGHT_EARTHLING
2567 #
2568 ####################################################
2569
2570 ##########################################################
2571 #
2572 # BLESS_HERO
2573 #
2574
2575 package BLESS_HERO;
2576 @BLESS_HERO::ISA = qw(AymCommand);
2577 use Data::Dumper;
2578
2579 # this is called to see if the command is executable.
2580 # it should be called from first_phase() and from second_phase().
2581 # it is not called from the scheduler
2582 sub is_valid {
2583   my $self = shift;
2584
2585   my @required_arguments = ('MOBILE','COUNT');
2586   return 0 unless $self->Command::is_valid(@required_arguments);
2587
2588   return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2589
2590   return 0 unless $self->validate_role('GOD');
2591
2592   my $mobtype = $self->{-mob}->{'TYPE'};
2593   my $mobloc = $self->{-mob}->{'LOCATION'};
2594   my $mobcount = $self->{-mob}->{'COUNT'};
2595
2596   return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
2597                               'MSG_WRONG_TYPE',
2598                               $self->{-context}->mobile_string($mobtype,1),
2599                               $mobloc);
2600
2601   $self->{-count} = $self->{-args}->{'COUNT'} > $mobcount ?
2602     $mobcount : $self->{-args}->{'COUNT'};
2603
2604   return 0 unless $self->test_mana('BLESS_HERO',$self->{-count});
2605
2606   return 1;
2607 }
2608
2609 # this is called from Scheduler, if he see the command the
2610 # first time, some commands execute here immidiatly.
2611 # BLESS_HERO
2612 sub first_phase{
2613   my $self = shift;
2614
2615   return 0 unless $self->is_valid();
2616
2617
2618   my $id = $self->{-mob}->{'ID'};
2619   $self->conditional_split_mobile($self->{-mob},
2620                                   $self->{-count},
2621                                   {'ADORING' => $self->{-player},
2622                                    'TYPE' => 'HERO',
2623                                    'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
2624                                   'beforeafter');
2625
2626   # reread mobile, because split destroys it
2627   $self->{-mob} = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
2628   $self->unify_mobiles($self->{-mob},
2629                        $self->{-mob}->{'LOCATION'},
2630                        $self->{-mob}->{'OWNER'});
2631
2632 #  $self->{-context}
2633 #    ->send_message_to_field
2634 #      ($self->{-mob}->{'LOCATION'},
2635 #       {'MFROM' => 0,
2636 #       'MSG_TAG' => 'MSG_BLESS_HERO',
2637 #       'ARG1' => $self->{-context}->charname($self->{-player}),
2638 #       'ARG2' => $self->{-context}->charname($self->{-mob}->{'OWNER'}),
2639 #       'ARG3' => $self->{-mob}->{'LOCATION'}});
2640
2641   $self->use_mana();
2642   $self->setDuration(0);
2643
2644   return 0;
2645 }
2646
2647 # this is called from scheduler when the command will be executed
2648 sub second_phase{
2649   my $self = shift;
2650   Util::log("BLESS_HERO should not have a second phase!",0);
2651   return 0;
2652 }
2653
2654 #
2655 # End of BLESS_HERO
2656 #
2657 ####################################################
2658
2659 ##########################################################
2660 #
2661 # CH_ACTION
2662 #
2663
2664 package CH_ACTION;
2665 @CH_ACTION::ISA = qw(AymCommand);
2666 use Data::Dumper;
2667
2668 # this is called to see if the command is executable.
2669 # it should be called from first_phase() and from second_phase().
2670 # it is not called from the scheduler
2671 sub is_valid {
2672   my $self = shift;
2673
2674   my @required_arguments = ('ACTION','MOBILE');
2675   return 0 unless $self->Command::is_valid(@required_arguments);
2676
2677   return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2678
2679   return 0 unless $self->validate_role('GOD');
2680
2681   my $mobtype = $self->{-mob}->{'TYPE'};
2682   my $mobloc = $self->{-mob}->{'LOCATION'};
2683
2684   return 0 unless $self->test(sub{$mobtype eq 'AVATAR'},
2685                               'MSG_WRONG_TYPE',
2686                               $self->{-context}->mobile_string($mobtype,1),
2687                               $mobloc);
2688
2689   return 1;
2690 }
2691
2692 # this is called from Scheduler, if he see the command the
2693 # first time, some commands execute here immidiatly.
2694 # CH_ACTION
2695 sub first_phase{
2696   my $self = shift;
2697
2698   return 0 unless $self->is_valid();
2699
2700   my $mob = $self->{-mob};
2701   my $loc = $mob->{'LOCATION'};
2702   my $own = $self->{-player};
2703   my $action = $self->{-args}->{'ACTION'};
2704
2705   # all avatars in the field get the new status
2706   $self->{-db}->update_hash('MOBILE',
2707                             "LOCATION=$loc AND TYPE=AVATAR AND OWNER=$own ".
2708                             "AND GAME=$self->{-game} AND AVAILABLE=Y",
2709                             {'STATUS' => $action});
2710
2711   $mob->{'STATUS'} = $action;
2712   $self->enter_field_avatar($loc,$mob) if $action eq 'BLOCK';
2713
2714 #  $self->{-context}
2715 #    ->send_message_to_field
2716 #      ($self->{-mob}->{'LOCATION'},
2717 #       {'MFROM' => 0,
2718 #       'MSG_TAG' => 'MSG_CH_ACTION',
2719 #       'ARG1' => $self->{-args}->{'ACTION'},
2720 #       'ARG2' => $self->{-mob}->{'LOCATION'}});
2721
2722   $self->setDuration(0);
2723   return 0;
2724 }
2725
2726 # this is called from scheduler when the command will be executed
2727 sub second_phase{
2728   my $self = shift;
2729   Util::log("CH_ACTION should not have a second phase!",0);
2730   return 0;
2731 }
2732
2733 #
2734 # End of CH_ACTION
2735 #
2736 ####################################################
2737
2738 ####################################################
2739 #
2740 # DIE_ORDER: Change the order of mobiletypes which dies in battle
2741 #
2742
2743 package DIE_ORDER;
2744 @DIE_ORDER::ISA  = qw(AymCommand);
2745
2746 sub is_valid{
2747   my ($self) = @_;
2748
2749   my @required_arguments = ('DYING');
2750   return 0 unless $self->Command::is_valid(@required_arguments);
2751
2752   return 0 unless $self->validate_role('EARTHLING');
2753
2754   # TODO: use test with message
2755   return 0 unless Util::is_in($self->{-args}->{'DYING'},
2756                               'PKH','PHK','KPH','KHP','HKP','HPK');
2757
2758   return 1;
2759 }
2760
2761 # DIE_ORDER
2762 sub first_phase{
2763   my $self = shift;
2764   return 0 unless $self->is_valid();
2765
2766   my $dying = $self->{-args}->{'DYING'};
2767
2768   $self->{-db}->update_hash('EARTHLING',
2769                             "GAME=$self->{-game} AND ".
2770                             "PLAYER=$self->{-player}",
2771                             {'DYING' => $dying});
2772
2773   $self->{-context}->send_message_to_me({'MFROM' => 0,
2774                                          'MSG_TAG' => 'MSG_DIE_ORDER',
2775                                          'ARG1' => $dying
2776                                         });
2777   Util::log("New die order for player $self->{-player}: $dying",1);
2778
2779   $self->setDuration(0);
2780   return 1;
2781 };
2782
2783 sub second_phase{
2784   my $self = shift;
2785   Util::log("Warning: We should not reach phase 2 with command DIE_ORDER",0);
2786   return 0;
2787 };
2788
2789 #
2790 # END of DIE_ORDER
2791 #
2792 ################################################################
2793
2794
2795 ##########################################################
2796 #
2797 # CH_LUCK
2798 #
2799
2800 package CH_LUCK;
2801 @CH_LUCK::ISA = qw(AymCommand);
2802 use Data::Dumper;
2803
2804 # this is called to see if the command is executable.
2805 # it should be called from first_phase() and from second_phase().
2806 # it is not called from the scheduler
2807 sub is_valid {
2808   my $self = shift;
2809
2810   my @required_arguments = ('BONUS');
2811   return 0 unless $self->Command::is_valid(@required_arguments);
2812
2813   return 0 unless $self->validate_role('GOD');
2814
2815   return 1 if $self->{-phase} == 2;
2816
2817   return 0 unless $self->test_mana('CH_LUCK',
2818                    abs($self->{-args}->{'BONUS'} * $::conf->{-MANA}->{-CH_LUCK}));
2819
2820   return 1;
2821 }
2822
2823 # this is called from Scheduler, if he see the command the
2824 # first time, some commands execute here immidiatly.
2825 # CH_LUCK
2826 sub first_phase{
2827   my $self = shift;
2828
2829   return 0 unless $self->is_valid();
2830
2831   $self->use_mana();
2832
2833   return $self->setDuration($::conf->{-DURATION}->{-CH_LUCK});
2834 }
2835
2836 # this is called from scheduler when the command will be executed
2837 sub second_phase{
2838   my $self = shift;
2839   return 0 unless $self->is_valid();
2840   my $oldfortune = $self->{-context}->read_fortune();
2841
2842   my $change = $self->{-args}->{'BONUS'};
2843
2844   my $newfortune = $oldfortune + $change;
2845   if($newfortune > $::conf->{-MAX_LUCK}){
2846     $newfortune =  $::conf->{-MAX_LUCK};
2847   }elsif($newfortune < $::conf->{-MIN_LUCK}){
2848     $newfortune =  $::conf->{-MIN_LUCK};
2849   }
2850
2851   $self->{-db}->update_hash('GAME',
2852                             "GAME=$self->{-game}",
2853                             {'FORTUNE' => $newfortune});
2854
2855   $self->{-context}
2856     ->send_message_to_all
2857       ({'MFROM' => 0,
2858         'MSG_TAG' => 'MSG_CHANGE_FORTUNE',
2859         'ARG1' => $self->{-context}->charname($self->{-player}),
2860         'ARG2' => $oldfortune,
2861         'ARG3' => $newfortune});
2862
2863
2864   return 0;
2865 }
2866
2867 #
2868 # End of CH_LUCK
2869 #
2870 ####################################################
2871
2872 ##########################################################
2873 #
2874 # FLOOD
2875 #
2876
2877 package FLOOD;
2878 @FLOOD::ISA = qw(AymCommand);
2879 use Data::Dumper;
2880
2881 # this is called to see if the command is executable.
2882 # it should be called from first_phase() and from second_phase().
2883 # it is not called from the scheduler
2884 sub is_valid {
2885   my $self = shift;
2886   my $db = $self->{-db};
2887   my $context = $self->{-context};
2888   my $loc = $self->{-location};
2889
2890   my @required_arguments = ();
2891   return 0 unless $self->Command::is_valid(@required_arguments);
2892
2893   return 0 unless $self->validate_role('GOD');
2894
2895   # only PLAIN and MOUNTAIN can be flooded
2896   my ($terrain) = $context->read_field('TERRAIN', $loc);
2897   return 0 unless $self->test(sub{Util::is_in($terrain,'PLAIN','MOUNTAIN');},
2898                               'MSG_CANT_FLOOD_TERRAIN',
2899                               $loc,
2900                               $terrain);
2901   $self->{-terrain} = $terrain;
2902
2903   return 1;
2904 }
2905
2906 # this is called from Scheduler, if he see the command the
2907 # first time, some commands execute here immidiatly.
2908 # FLOOD
2909 sub first_phase{
2910   my $self = shift;
2911
2912   return 0 unless $self->is_valid();
2913
2914   my $loc = $self->{-location};
2915
2916   # need own avatar to flood
2917   return 0 unless $self->avatar_available($loc);
2918   return 0 unless $self->test_mana('FLOOD');
2919   $self->use_mana();
2920
2921   $self->setDuration($::conf->{-DURATION}->{-FLOOD});
2922
2923   $self->event($self->{-location},
2924                'EVENT_FLOOD',
2925                $self->{-player});
2926
2927   return $self->{-duration};
2928 }
2929
2930 # this is called from scheduler when the command will be executed.
2931 # FLOOD
2932 sub second_phase{
2933   my $self = shift;
2934   my $loc = $self->{-location};
2935   my $db = $self->{-db};
2936
2937   return 0 unless $self->is_valid();
2938
2939   # mountain -> isle, plain -> water
2940   my $new = $self->{-terrain} eq 'MOUNTAIN' ? 'ISLE' : 'WATER';
2941   $db->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
2942                    {'TERRAIN' => $new});
2943
2944   # drowning of mobiles if necessary
2945   $self->drowning($loc);
2946
2947   # Message
2948   $self->{-context}
2949     ->send_message_to_field
2950       ($loc,{'MFROM' => 0,
2951              'MSG_TAG' => 'MSG_FLOOD',
2952              'ARG1' => $self->{-context}->charname($self->{-player}),
2953              'ARG2' => $loc,
2954              'ARG3' => $self->{-terrain},
2955              'ARG4' => $new,});
2956
2957   return 0;
2958 }
2959
2960 #
2961 # End of FLOOD
2962 #
2963 ####################################################
2964
2965 ##########################################################
2966 #
2967 # DESTROY
2968 #
2969
2970 package DESTROY;
2971 @DESTROY::ISA = qw(AymCommand);
2972 use Data::Dumper;
2973
2974 # this is called to see if the command is executable.
2975 # it should be called from first_phase() and from second_phase().
2976 # it is not called from the scheduler
2977 sub is_valid {
2978   my $self = shift;
2979   my $db = $self->{-db};
2980   my $context = $self->{-context};
2981   my $loc = $self->{-location};
2982
2983   my @required_arguments = ();
2984   return 0 unless $self->Command::is_valid(@required_arguments);
2985
2986   return 0 unless $self->validate_role('GOD');
2987
2988   return 0 unless $self->test_mana('DESTROY');
2989
2990   # we cant destroy if there is only one temple unbuild
2991   # TODO: wrong. should be cant destroy, if last temple is under construction
2992   my $unbuild = $db->count('MAP',
2993                            "(TERRAIN=ISLE OR TERRAIN=MOUNTAIN) ".
2994                            "AND TEMPLE=N AND GAME=$self->{-game}");
2995   return 0 unless $self->test(sub{$unbuild > $::conf->{-MAX_UNBUILD_DESTROY}},
2996                               'MSG_CANT_RESCUE_WORLD',
2997                               $unbuild,
2998                               $loc);
2999
3000   # need own avatar to destroy
3001   return 0 unless $self->avatar_available($loc);
3002
3003   # there sould be no foreign priests
3004   my $foreign_priests = $db->count('MOBILE',
3005                                    "GAME=$self->{-game} AND ".
3006                                    "LOCATION=$loc AND TYPE=PRIEST AND ".
3007                                    "ADORING!=$self->{-player} AND ".
3008                                    "AVAILABLE=Y");
3009   return 0 unless $self->test(sub{$foreign_priests == 0},
3010                               'MSG_CANT_DESTROY_DEFENDED',
3011                               $loc);
3012
3013   my ($terrain,$temple,$home) = $context->read_field('TERRAIN,TEMPLE,HOME',
3014                                                      $loc);
3015
3016   # only if temple exists
3017   return 0 unless $self->test(sub{$temple eq 'Y'},
3018                               'MSG_NO_TEMPLE_TO_DESTROY',
3019                               $loc);
3020
3021   # only destroy foreign temples
3022   return 0 unless $self->test(sub{$home != $self->{-player}},
3023                               'MSG_CANT_DESTROY_OWN',
3024                               $loc);
3025   $self->{-oldgod} = $home;
3026
3027   # only on islands
3028   return 0 unless $self->test(sub{$terrain eq 'ISLE'},
3029                               'MSG_CANT_DESTROY_MOUNTAINS',
3030                               $loc);
3031
3032   return 1;
3033 }
3034
3035 # this is called from Scheduler, if he see the command the
3036 # first time, some commands execute here immidiatly.
3037 # DESTROY
3038 sub first_phase{
3039   my $self = shift;
3040   my $loc = $self->{-location};
3041
3042   return 0 unless $self->is_valid();
3043
3044   $self->use_mana();
3045
3046   $self->{-db}->update_hash('MAP',
3047                             "LOCATION=$loc AND GAME=$self->{-game}",
3048                             {'TEMPLE' => 'N',
3049                              'HOME' => 0});
3050
3051   # delete PRAY- and PRODUCE-commands and PRODUCE-PRIEST event
3052   $self->{-db}->delete_from('COMMAND',
3053                             "(COMMAND=PRODUCE OR COMMAND=PRAY) ".
3054                             "AND LOCATION=$loc AND GAME=$self->{-game}");
3055   $self->{-db}->delete_from('EVENT',
3056                             "TAG=EVENT_PRODUCE_PRIEST ".
3057                             "AND LOCATION=$loc AND GAME=$self->{-game}");
3058
3059   $self->{-context}
3060     ->send_message_to_field
3061       ($loc,
3062        {'MFROM' => 0,
3063         'MSG_TAG' => 'MSG_TEMPLE_DESTROYD',
3064         'ARG1' => $loc,
3065         'ARG2' => $self->{-context}->charname($self->{-oldgod}),
3066         'ARG3' => $self->{-context}->charname($self->{-player})
3067        });
3068
3069   Util::log("Temple of $self->{-oldgod} destroyed in $self->{-location}",1);
3070
3071   $self->setDuration(0);
3072
3073   return 0;
3074 }
3075
3076 # this is called from scheduler when the command will be executed
3077 sub second_phase{
3078   my $self = shift;
3079   Util::log("DESTROY should not have a second phase!",0);
3080   return 0;
3081 }
3082
3083 #
3084 # End of DESTROY
3085 #
3086 ####################################################
3087
3088 ##########################################################
3089 #
3090 # MOVE_WITH
3091 #
3092
3093 package MOVE_WITH;
3094 @MOVE_WITH::ISA = qw(AymCommand);
3095 use Data::Dumper;
3096
3097 # this is called to see if the command is executable.
3098 # it should be called from first_phase() and from second_phase().
3099 # it is not called from the scheduler
3100 sub is_valid {
3101   my $self = shift;
3102
3103   my @required_arguments = ('MOBILE','COUNT','TARGET');
3104   return 0 unless $self->Command::is_valid(@required_arguments);
3105
3106   my $args = $self->{-args};
3107   my $count = $args->{'COUNT'};
3108
3109   # TODO: more messages
3110   # read mobile
3111   return 0 unless $self->validate_mobile($args->{'MOBILE'});
3112   my $mob = $self->{-mob};
3113
3114   # arks cant move with other units
3115   return 0 if $self->{-mob}->{'TYPE'} eq 'ARK';
3116
3117   return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
3118                                        $mob->{'AVAILABLE'} eq 'Y'},
3119                                 'MSG_NOT_ENOUGH_MOBILES',
3120                                 'MOVE',
3121                                 $count,
3122                                 $mob->{'LOCATION'});
3123
3124   return 1;
3125 }
3126
3127 # this is called from Scheduler, if he see the command the
3128 # first time, some commands execute here immidiatly.
3129 # MOVE_WITH
3130 sub first_phase{
3131   my $self = shift;
3132
3133   return 0 unless $self->is_valid();
3134
3135   my $args = $self->{-args};
3136
3137   $self->move_with($args->{'MOBILE'},$args->{'TARGET'},$args->{'COUNT'});
3138
3139   return 0;
3140 }
3141
3142 # this is called from scheduler when the command will be executed
3143 sub second_phase{
3144   my $self = shift;
3145   Util::log("MOVE_WITH should not have a second phase!",0);
3146   return 0;
3147 }
3148
3149 #
3150 # End of MOVE_WITH
3151 #
3152 ####################################################
3153
3154 ##########################################################
3155 #
3156 # SEND_MSG
3157 #
3158
3159 # TODO: should be in FROGS/Command.pm
3160
3161 package SEND_MSG;
3162 @SEND_MSG::ISA = qw(AymCommand);
3163 use Data::Dumper;
3164
3165 # this is called to see if the command is executable.
3166 # it should be called from first_phase() and from second_phase().
3167 # it is not called from the scheduler
3168 sub is_valid {
3169   my $self = shift;
3170
3171   my @required_arguments = ('OTHER','MESSAGE');
3172   return 0 unless $self->Command::is_valid(@required_arguments);
3173
3174   return 1;
3175 }
3176
3177 # this is called from Scheduler, if he see the command the
3178 # first time, some commands execute here immidiatly.
3179 # MOVE_WITH
3180 sub first_phase{
3181   my $self = shift;
3182
3183   return 0 unless $self->is_valid();
3184
3185   my $args = $self->{-args};
3186
3187   Util::log("send message from $self->{-player} to $args->{'OTHER'}.",1);
3188
3189   my $msg = $args->{'MESSAGE'};
3190
3191   # uggly workaround necessary for Command::parse_args()
3192   $msg =~ s/__COMMA__/,/g;
3193   $msg =~ s/__EQUAL__/=/g;
3194   # newline should be in html
3195   $msg =~ s/\\r\\n/<br>/g;
3196
3197   $self->{-context}->send_message_to($args->{'OTHER'},
3198                                      {'MFROM' => $self->{-player},
3199                                       'MSG_TEXT' => $msg});
3200
3201   return 0;
3202 }
3203
3204 # this is called from scheduler when the command will be executed
3205 sub second_phase{
3206   my $self = shift;
3207   Util::log("SEND_MSG should not have a second phase!",0);
3208   return 0;
3209 }
3210
3211 #
3212 # End of SEND_MSG
3213 #
3214 ####################################################
3215
3216 ##########################################################
3217 #
3218 # FIGHT_GOD
3219 #
3220
3221 package FIGHT_GOD;
3222 use Data::Dumper;
3223 @FIGHT_GOD::ISA = qw(AymCommand);
3224
3225 # this is called to see if the command is executable.
3226 # it should be called from first_phase() and from second_phase().
3227 # it is not called from the scheduler
3228 sub is_valid {
3229   my $self = shift;
3230
3231   my @required_arguments = ('A','B');
3232   return 0 unless $self->Command::is_valid(@required_arguments);
3233
3234   my $A = $self->{-args}->{'A'};
3235   my $B = $self->{-args}->{'B'};
3236   my $loc = $self->{-dbhash}->{'LOCATION'};
3237
3238   # dont accept a new FIGHT_GOD if there is allready a fight between the same gods
3239   my $fights = $self->{-db}->select_array('COMMAND','ARGUMENTS',
3240                                           "GAME=$self->{-game} AND ".
3241                                           "COMMAND=FIGHT_GOD AND ".
3242                                           "ID != $self->{-dbhash}->{'ID'} AND ".
3243                                           "LOCATION=$loc");
3244   for my $f (@$fights){
3245     my $args = $self->parse_args($f->[0]);
3246
3247     if( $args->{'A'} == $A and $args->{'B'} == $B){
3248       Util::log("there is allready such a fight between $A and $B in $loc.",1);
3249       return 0;
3250     }
3251   }
3252
3253   # could not work, command can be inserted from earthling.
3254   # return 0 unless $self->validate_role('GOD');
3255
3256   # return 0 unless $self->validate_this_role($self->{-args}->{'A'},'GOD');
3257   # return 0 unless $self->validate_this_role($self->{-args}->{'B'},'GOD');
3258
3259   return 1;
3260 }
3261
3262 # this is called from Scheduler, if he sees the command the
3263 # first time, some commands execute here immidiatly.
3264 # FIGHT_GOD
3265 sub first_phase{
3266   my $self = shift;
3267
3268   return 0 unless $self->is_valid();
3269
3270   # calculate duration
3271   $self->setDuration($::conf->{-DURATION}->{-FIGHT_GOD});
3272
3273   # set GOD_ATTACKER in MAP to COMMAND.ID
3274   $self->{-db}->update_hash('MAP',
3275                             "LOCATION=$self->{-location} AND ".
3276                             "GAME=$self->{-game}",
3277                             {'GOD_ATTACKER' => $self->{-dbhash}->{'ID'}});
3278
3279   $self->event($self->{-location},
3280                'EVENT_FIGHT_GOD',
3281                $self->{-context}->charname($self->{-args}->{'A'}),
3282                $self->{-context}->charname($self->{-args}->{'B'}),
3283               );
3284
3285   return $self->{-duration};
3286 }
3287
3288 # this is called from scheduler when the command will be executed.
3289 # FIGHT_GOD
3290 sub second_phase{
3291   my $self = shift;
3292
3293   return 0 unless $self->is_valid();
3294
3295   # read info from map
3296   my ($earthlingfight,$earthling);
3297   ($earthlingfight, $self->{-god_attacker}, $earthling) =
3298         $self->{-context}->read_field(
3299                 'ATTACKER,GOD_ATTACKER,OCCUPANT', $self->{-location}
3300         );
3301
3302   # suspend FIGHT until end of FIGHT_GOD if any
3303   # REWRITE: suspend of avatar fight have to be encapsulated
3304   if($earthlingfight){
3305         ## REWRITE: SQL: sort events up to time, limit output to ONE
3306     # read all earthling-events for this field.
3307     my @events = @{$self->{-db}->select_array('EVENT','ID,TIME',
3308                                               "GAME=$self->{-game} AND ".
3309                                               "LOCATION=$self->{-location} AND ".
3310                                               "TAG=FIGHT_EARTHLING")};
3311     # which one is the latest?
3312     my ($late_time, $late_id) = (0,0);
3313     for my $ev (@events){
3314       my ($id, $time) = @$ev;
3315       my $ev_time = &::str2time($time,'GMT');
3316       Util::log("found FIGHT_EARTHLING with time $time",1);
3317       ($late_time, $late_id) = ($ev_time, $id) if $ev_time > $late_time;
3318     }
3319
3320     # insert new godfight with one second more.
3321     # TODO: use here the new AFTER-System instead
3322     my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($late_time + 1);
3323     $late_time = sprintf ("%04u-%02u-%02u %02u:%02u:%02u",
3324                           $year,$month,$day, $hour,$min,$sec);
3325     Util::log("found earthling fight! suspend godfight until $late_time",1);
3326     $self->{-context}->insert_command('FIGHT_GOD',
3327                                       "A=$self->{-args}->{'A'}, ".
3328                                       "B=$self->{-args}->{'B'}",
3329                                       $self->{-location},
3330                                       $self->{-player},
3331                                       $late_time);
3332     $self->{-db}->update_hash('EVENT',
3333                               "COMMAND_ID=$self->{-dbhash}->{'ID'}",
3334                               {'TIME' => $late_time});
3335     $self->stop_fight();
3336     return 0;
3337   }
3338
3339   # get all mobiles here
3340   my $mobiles = $self->{-context}->read_mobile_condition(
3341         'ID,OWNER,COUNT,TYPE',
3342         "LOCATION=$self->{-location} "."AND AVAILABLE=Y"
3343   );
3344   $self->{-mobiles} = $mobiles;
3345
3346   my $A = $self->{-args}->{'A'};
3347   my $B = $self->{-args}->{'B'};
3348   my ($avatars_A, $avatars_B) = (0,0);
3349
3350   # for every avatar-unit in the field
3351   # REWRITE: this block tries to count the opposing avatars: simplify!
3352   for my $a (@$mobiles){
3353     my ($id,$own,$count,$type) = @$a;
3354     next unless $type eq 'AVATAR';
3355
3356     Util::log("found $count avatar(s) from $own with id $id",1);
3357
3358     # determine side of owner
3359     my $side = $self->which_side($own);
3360
3361     # calculate strength_of_side
3362     if($side eq 'A'){
3363       $avatars_A += $count;
3364     }elsif($side eq 'B'){
3365       $avatars_B += $count;
3366     }
3367   }
3368
3369   my $mana = $::conf->{-MANA}->{-FIGHT_AVATAR};
3370   my $mana_A = $self->instant_use_mana($mana,$A);
3371   my $mana_B = $self->instant_use_mana($mana,$B);
3372   my $strength_A = $avatars_A * $::conf->{-FIGHT}->{-AVATAR};
3373   my $strength_B = $avatars_B * $::conf->{-FIGHT}->{-AVATAR};
3374
3375   # TODO?: message in this case
3376   unless($mana_A >= $mana){
3377     Util::log("$A has not enough mana left to fight",1);
3378     $strength_A = 0;
3379   };
3380   unless($mana_B >= $mana){
3381     Util::log("$B has not enough mana left to fight",1);
3382     $strength_B = 0;
3383   };
3384
3385   # swl: Strength_Without_Luck  strenght_X: Strenght_with_luck
3386   my ($swlA,$swlB) = ($strength_A,$strength_B);
3387
3388   # add random value (1 to GAME.FORTUNE)
3389   my $fortune = $self->{-context}->read_fortune();
3390   Util::log("avatarfight in $self->{-location}: strength without fortune player $A: ".
3391             "$strength_A, player $B: $strength_B",1);
3392   $strength_A += int(rand($fortune))+1;
3393   $strength_B += int(rand($fortune))+1;
3394   Util::log("strength with fortune player $A: ".
3395             "$strength_A, player $B: $strength_B",1);
3396
3397   # how much avatars should die?
3398   my ($dead_A,$dead_B) = (0,0);
3399   my ($winner,$looser) = (0,0);
3400
3401   if( ($strength_A > $strength_B  &&  $mana_A) or
3402                 $mana_A  &&  !$mana_B )
3403   {
3404     Util::log("$A wins!",1);
3405     $winner = $A; $looser = $B;
3406         ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B);
3407   }
3408   elsif( ($strength_B > $strength_A  &&  $mana_B) or
3409                 $mana_B  &&  !$mana_A )
3410   {
3411     Util::log("$B wins!",1);
3412     $winner = $B; $looser = $A;
3413         ($dead_B, $dead_A) = _calc_dead_avatars($avatars_B, $avatars_A);
3414   }
3415   else
3416   {
3417     Util::log("Both sides looses!",1);
3418         ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B, 'drawn');
3419   }
3420
3421   my ($new_heros_A, $new_heros_B) = (0,0);
3422   $new_heros_A = $self->die($A, $dead_A, $earthling) if $dead_A;
3423
3424   # re-read mobiles
3425   $self->{-mobiles} = $self->{-context}->
3426     read_mobile_condition('ID,OWNER,COUNT,TYPE',
3427                           "LOCATION=$self->{-location} ".
3428                           "AND AVAILABLE=Y");
3429
3430   $new_heros_B = $self->die($B,$dead_B,$earthling) if $dead_B;
3431
3432   # surviving loosers go home
3433   if($looser){
3434     $self->teleport($looser);
3435   }else{
3436     # both sides are looser!
3437     $self->teleport($A);
3438     $self->teleport($B);
3439   }
3440
3441   $self->stop_fight();
3442
3443   my $earthling_name = $self->{-context}->charname($earthling);
3444   my $name_of_A = $self->{-context}->charname($A);
3445   my $name_of_B = $self->{-context}->charname($B);
3446   my $asf = $strength_A - $swlA;
3447   my $dsf = $strength_B - $swlB;
3448   $winner = $winner ? $self->{-context}->charname($winner) : 'NOBODY';
3449
3450   my $text = <<END_OF_TEXT;
3451   <strong>BATTLE_REPORT $self->{-location}</strong><br>
3452   <table><tr><th></th><th>$name_of_A</th><th>$name_of_B</th></tr>
3453   <tr><td>MOBILE_AVATAR_PL</td><td>$avatars_A</td><td>$avatars_B</td></tr>
3454   <tr><td>FIGHTING_STRENGTH</td><td>$swlA</td>
3455     <td>$swlB</td></tr>
3456   <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
3457   <tr><td>SUM_OF_STRENGTH</td><td>$strength_A</td><td>$strength_B</td></tr>
3458   <tr><td>DEAD_AVATARS</td><td>$dead_A</td>
3459     <td>$dead_B</td></tr>
3460   <tr><td>NEW_HEROS $earthling_name</td><td>$new_heros_A</td>
3461     <td>$new_heros_B</td></tr>
3462   </table>
3463   <strong>WINNER_IS $winner</strong>.
3464 END_OF_TEXT
3465
3466   $self->{-context}->send_message_to_field(
3467                 $self->{-location},
3468                 {'MFROM' => 0, 'MSG_TEXT' => $text}
3469   );
3470 }
3471
3472 # _calc_dead_avatars
3473 # Calculates number of dead avatars on winner's and looser's side.
3474 #
3475 # Parameters:
3476 #       - # winner avatars
3477 #       - # looser avatars
3478 #       - drawn                         [OPTIONAL, boolean]
3479 #
3480 # Returns:
3481 #       - # dead winner avatars
3482 #       - # dead looser avatars
3483 #
3484 sub _calc_dead_avatars
3485 {
3486         my ($winner, $looser, $drawn) = @_;
3487         my ($dead_winner, $dead_looser) = (0,0);
3488
3489         # the winner counts as looser if the fight is drawn!
3490         if (defined $drawn  &&  $drawn)
3491         {
3492                 $dead_winner = Util::max(
3493                         1,
3494                         int(0.5 + $looser / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3495                 );
3496         }
3497         else
3498         {
3499                 $dead_winner = Util::min(
3500                         $winner - 1,
3501                         int(0.5 + $looser / $::conf->{-WINNER_AVATARS_DYING_FRACTION})
3502                 );
3503         }
3504
3505         $dead_looser = Util::max(
3506                 1,
3507                 int(0.5 + $winner / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3508         );
3509
3510         # ensure that there not dying more avatars than existing
3511         $dead_looser = $dead_looser > $looser ? $looser : $dead_looser;
3512         $dead_winner = $dead_winner > $winner ? $winner : $dead_winner;
3513
3514         return ($dead_winner, $dead_looser);
3515 }
3516
3517
3518
3519 # set MAP.GOD_ATTACKER to 0, if there is our own command-ID
3520 sub stop_fight{
3521   my($self) = @_;
3522
3523   my $own_command = $self->{-dbhash}->{'ID'};
3524   if($own_command == $self->{-god_attacker}){
3525     $self->{-db}->update_hash('MAP',
3526                               "LOCATION=$self->{-location} AND ".
3527                               "GAME=$self->{-game}",
3528                               {'GOD_ATTACKER' => 0});
3529   }
3530 }
3531
3532
3533 # teleports all of $god from $loc to location of avatar-creation
3534 sub teleport{
3535   my($self,$god) = @_;
3536   my $loc = $self->{-location};
3537
3538   # teleport surviving avatars of looser to home
3539   my $home = $self->{-context}->incarnation_place($god);
3540   Util::log("We teleport all Avatars of $god from $loc to $home.",1);
3541
3542   $self->{-db}->update_hash('MOBILE',
3543                             "TYPE=AVATAR AND OWNER=$god AND AVAILABLE=Y AND ".
3544                             "LOCATION=$self->{-location}",
3545                             {'LOCATION' => $home});
3546
3547   # get all avatar there
3548   my $avatars = $self->{-context}->read_mobile_condition('ID',
3549                                                          "LOCATION=$home ".
3550                                                          "AND OWNER=$god ".
3551                                                          "AND TYPE=AVATAR ".
3552                                                          "AND AVAILABLE=Y");
3553   # dont call this more than one time!
3554   #for my $avat (@$avatars){
3555     my ($id) = $avatars->[0]->[0];
3556     $self->enter_field_avatar($home,$id);
3557   #}
3558 }
3559
3560
3561 # kills $to_kill avatars of owner in location and create heros for earthling,
3562 # if possible
3563 sub die{
3564   my ($self,$owner,$to_kill,$earthling) = @_;
3565   Util::log("$to_kill avatars from $owner dying.",1);
3566
3567   my $loc = $self->{-location};
3568   my $mobiles = $self->{-mobiles};
3569
3570   my $to_hero = $to_kill;
3571   my $real_to_hero = 0;
3572   for my $a (@$mobiles){
3573     my ($id,$own,$count,$type) = @$a;
3574     if($own eq $owner and $to_kill){
3575       if($count <= $to_kill){
3576         $self->{-db}->delete_from('MOBILE', "ID=$id");
3577         $to_kill -= $count;
3578         # last unless $to_kill > 0;
3579       }else{
3580         $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => ($count - $to_kill)});
3581         $to_kill = 0;
3582         # last;
3583       }
3584       # add the strength of the death avatar to gods last battle
3585       #my ($actual) = $self->{-db}->single_select("SELECT DEATH_AVATAR FROM GOD WHERE ".
3586       #"GAME=$self->{-game} AND ".
3587       #     #                                            "PLAYER=$owner");
3588       #     Util::log("AVATAR dying: adds strength to last-battle-strength of $owner",1);
3589       #       $self->{-db}->update_hash('GOD',
3590       #                                 "GAME=$self->{-game} AND PLAYER=$owner",
3591       #                                 {'DEATH_AVATAR' => $actual + 1});
3592
3593       #       $self->{-context}
3594       #         ->send_message_to
3595       #           ($loc,$owner,
3596       #            {'MFROM' => 0,
3597       #             'MSG_TAG' => 'MSG_AVATAR_DEAD',
3598       #             'ARG1' => $loc,
3599       #             'ARG2' => $self->{-context}->charname($owner)});
3600       #     Util::log("One avatar of $owner died in $loc.",1);
3601       #     last;
3602     }elsif($own eq $earthling and $type eq 'WARRIOR' and $to_hero){
3603       if($count <= $to_hero){
3604         $self->{-db}->delete_from('MOBILE', "ID=$id");
3605         $to_hero -= $count;
3606         $real_to_hero += $count;
3607         # last unless $to_hero > 0;
3608       }else{
3609         $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => $count-$to_hero});
3610         $real_to_hero += $to_hero;
3611         $to_hero = 0;
3612         # last;
3613       }
3614     }
3615     last if $to_kill <= 0 and $to_hero <= 0;
3616   }
3617
3618   if($real_to_hero){
3619     my $id = $self->{-db}->find_first_free('MOBILE','ID');
3620     my $mob = {'ID' => $id,
3621                'GAME' => $self->{-game},
3622                'LOCATION' => $self->{-location},
3623                'TYPE' => 'HERO',
3624                'OWNER' => $earthling,
3625                'COUNT' => $real_to_hero,
3626                'ADORING' => $owner,
3627                'AVAILABLE' => 'Y',
3628                'COMMAND_ID' => $self->{-dbhash}->{'ID'},
3629               };
3630     # $self->{-mob} = $mob;
3631     my %mobcopy = (%$mob);
3632     $self->{-db}->insert_hash('MOBILE',\%mobcopy);
3633     $self->unify_mobiles($id,$self->{-location},$earthling);
3634     Util::log("$real_to_hero warriors from $earthling blessed to hero",1);
3635   }
3636   return $real_to_hero;
3637 }
3638
3639 # this function decides on which side other gods fight
3640 # TODO: do we really need this complicated stuff
3641 sub which_side{
3642   my($self,$own) = @_;
3643
3644   my $A = $self->{-args}->{'A'};
3645   my $B = $self->{-args}->{'B'};
3646
3647   my $side = '0';
3648   $side = 'A' if $own == $A;
3649   $side = 'B' if $own == $B;
3650
3651   if ($side eq '0') {
3652     my $allA = $self->{-context}->simplyfied_single_relation($own,$A);
3653     my $allB = $self->{-context}->simplyfied_single_relation($own,$B);
3654     if ($allA eq $allB) {
3655       $side = '0';
3656     } elsif ($allA eq 'FRIEND') {
3657       $side = 'A';
3658     } elsif ($allB eq 'FRIEND') {
3659       $side = 'B';
3660     } elsif ($allA eq 'FOE') {
3661       $side = 'B';
3662     } elsif ($allB eq 'FOE') {
3663       $side = 'A';
3664     }
3665   }
3666   return $side;
3667 }
3668
3669 #
3670 # End of FIGHT_GOD
3671 #
3672 ####################################################
3673
3674 ##########################################################
3675 #
3676 # PLAGUE
3677 #
3678
3679 package PLAGUE;
3680 @PLAGUE::ISA = qw(AymCommand);
3681 use Data::Dumper;
3682
3683 # this is called to see if the command is executable.
3684 # it should be called from first_phase() and from second_phase().
3685 # it is not called from the scheduler
3686 sub is_valid {
3687   my $self = shift;
3688
3689   my @required_arguments = ('TYPE');
3690   return 0 unless $self->Command::is_valid(@required_arguments);
3691
3692   # test role god
3693   return 0 unless $self->validate_role('GOD');
3694
3695   # test known plagues
3696   unless(Util::is_in($self->{-args}->{'TYPE'},@{$::conf->{-PLAGUES}})){
3697     Util::log("wrong type of plague: $self->{-args}->{'TYPE'}",0);
3698     return 0;
3699   }
3700
3701   return 1;
3702 }
3703
3704 # this is called from Scheduler, if he see the command the
3705 # first time, some commands execute here immidiatly.
3706 # PLAGUE
3707 sub first_phase{
3708   my $self = shift;
3709
3710   return 0 unless $self->is_valid();
3711
3712   my $args = $self->{-args};
3713   my $loc = $self->{-dbhash}->{'LOCATION'};
3714   my $type = $args->{'TYPE'};
3715   my $spread = $args->{'SPREAD'};
3716   my $context = $self->{-context};
3717
3718   my ($plague,$terrain) = $context->read_field('PLAGUE,TERRAIN', $loc);
3719   $plague = '' unless defined $plague;
3720
3721   Util::log("old plague: $plague",1);
3722
3723   # if plagu not allready here
3724   unless($plague =~ /$type/){
3725
3726     if(not $spread){
3727       # need own avatar to plague
3728       return 0 unless $self->avatar_available($loc);
3729
3730       if($self->test_mana($type,1)){
3731         $self->use_mana();
3732       }else{
3733         return 0;
3734       }
3735     }
3736     Util::log("new plague in $loc: $type",1);
3737
3738     # set plague in MAP
3739     my $new_plague = $plague ? "$plague,$type" : $type;
3740     $self->{-db}->update_hash('MAP',
3741                               "GAME=$self->{-game} AND ".
3742                               "LOCATION=$loc",
3743                               {'PLAGUE' => $new_plague});
3744   }else{
3745     Util::log("plague $type is allready in $loc.",1);
3746     # stop if there is another plague command in location of same type.
3747     # TODO: simplify this with a LIKE-clause,
3748     # but: we have to rewrite quote_condition() first :-(
3749     my $commands = $self->{-db}->select_array('COMMAND',
3750                                               'ARGUMENTS,ID',
3751                                               "COMMAND=PLAGUE AND ".
3752                                               "GAME=$self->{-game} AND ".
3753                                               "LOCATION=$loc AND ".
3754                                               "ID != $self->{-dbhash}->{'ID'}");
3755     for my $c (@$commands){
3756       my ($args,$id) = @$c;
3757       # next if $id == $self->{-dbhash}->{'ID'};
3758       if($args =~ /$type/){
3759         Util::log("There is allready another PLAGUE-command of $type in $loc",1);
3760         return 0;
3761       }
3762     }
3763   }
3764
3765   $self->setDuration($::conf->{-DURATION}->{-PLAGUE});
3766   return $self->{-duration};
3767 }
3768
3769 # this is called from scheduler when the command will be executed
3770 # PLAGUE
3771 sub second_phase{
3772   my $self = shift;
3773   my $loc = $self->{-dbhash}->{'LOCATION'};
3774   my $type = $self->{-args}->{'TYPE'};
3775   my $context = $self->{-context};
3776
3777   # heal plague with priests
3778   my $priests = $context->count_mobile('PRIEST',$loc);
3779   my $heal_prob = $priests ? 1 - 1/$priests * $::conf->{-HEAL_PLAGUE} : 0;
3780   Util::log("Heal probability: $heal_prob",1);
3781   if($heal_prob > rand(1)){
3782     Util::log("heal plague of type $type in $loc",1);
3783     my ($plague) = $context->read_field('PLAGUE,TERRAIN', $loc);
3784     if(defined $plague){
3785       $plague =~ s/$type//;
3786       $self->{-db}->update_hash('MAP',
3787                                 "GAME=$self->{-game} AND LOCATION=$loc",
3788                                 {'PLAGUE' => $plague});
3789     }
3790   }else{
3791     # spread plague to neighbour-fields
3792     my @neighbours = $self->get_neighbours();
3793     for my $field (@neighbours){
3794       my ($terrain,$owner) = $context->read_field('TERRAIN,OCCUPANT',$field);
3795       # $self->{-occ} = $owner;
3796       if(rand(1) < $::conf->{-SPREAD_PLAGUE}->{$terrain}){
3797         Util::log("spread $type from $loc to $field",1);
3798         $context->insert_command('PLAGUE',"TYPE=$type, SPREAD=1",$field);
3799       }
3800     }
3801
3802     $self->effect();
3803     $self->do_it_again({'SPREAD' => 1});
3804   }
3805
3806   return 0;
3807 }
3808
3809 # PLAGUE
3810 sub effect{
3811   my $self = shift;
3812   my $context = $self->{-context};
3813
3814   my $type = $self->{-args}->{'TYPE'};
3815   Util::log("Do effect of type $type.",1);
3816
3817   my $loc = $self->{-dbhash}->{'LOCATION'};
3818
3819   # effect of INFLUENZA is done in PRODUCE
3820   if($type eq 'PESTILENTIA'){
3821     my ($vic) = $context->read_field('OCCUPANT',$loc);;
3822
3823     # count people of owner in field
3824     my $people = $context->count_people($loc,$vic);
3825     $people = 0 unless defined $people;
3826     Util::log("$people people from $vic counted in $loc.",1);
3827     my $victims = int($people * $::conf->{-PESTILENTIA_DEATH_SHARE});
3828     Util::log("$victims from them have to die.",1);
3829     return unless $victims;
3830
3831     $self->{-mobiles} = $context->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
3832                                                  0, $self->{-location}, 1);
3833
3834     $self->casualties($vic,$victims,1);
3835
3836     # send message
3837     my $name_of_victim = $context->charname($vic);
3838     my $text = <<END_OF_TEXT;
3839   <strong>CASUALTIES_OF_PESTILENTIA $self->{-location} $name_of_victim</strong><br>
3840   <table><tr><th></th><th></th></tr>
3841   <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$vic}->{'K'}</td></tr>
3842   <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$vic}->{'H'}</td></tr>
3843   <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$vic}->{'P'}</td></tr>
3844   <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$vic}->{'A'}</td></tr>
3845   </table>
3846 END_OF_TEXT
3847
3848   $context->send_message_to_field
3849     ($self->{-location},{'MFROM' => 0,
3850                          'MSG_TEXT' => $text}
3851      # 'ARG1' => $self->{-context}->charname($attacker),
3852      # 'ARG2' => $self->{-context}->charname($defender),
3853      # 'ARG3' => $self->{-context}->charname($self->{-winner}),
3854      # 'ARG4' => $self->{-location}}
3855     );
3856     #,$attacker,$defender,@gods);
3857   }else{
3858     Util::log("no effect",1);
3859   }
3860 }
3861
3862 #
3863 # End of PLAGUE
3864 #
3865 ####################################################
3866 # vim: set ts=4