src/AymCommand.pm

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