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