1 ##########################################################################
3 # Copyright (c) 2003-2012 Aymargeddon Development Team
5 # This file is part of "Last days of Aymargeddon" - a massive multi player
6 # onine game of strategy
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.
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.
17 # See the GNU Affero General Public License for more details.
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/>.
22 ###########################################################################
26 # Aymargeddon specific command clsses used by the scheduler
27 # generic FROGS-Command is in FROGS/Command.pm
35 ##########################################################
37 # Base Class for Aymargeddon specific commands
42 @AymCommand::ISA = qw(Command);
47 $self->{-context}->send_message_to_all({'MFROM' => 0,
48 'MSG_TAG' => 'END_OF_GAME'});
50 Util::log("*****************************\n" .
51 "*** End of the Game! ***\n" .
52 "*****************************",0);
54 $self->{-db}->update_hash('GAME',
55 "GAME=$self->{-game}",
62 my ($self,$loc,$god) = @_;
63 $god = $self->{-player} unless defined $god;
64 return $self->{-context}->avatar_available($loc,$god,$self->{-class});
67 # just another wrapper
70 $loc = $self->{-dbhash}->{'LOCATION'} unless defined $loc;
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;
78 # FIGHT_EARTHLING and Pestilenz
80 my ($self,$victim,$death_count,$no_conquer) = @_;
81 $self->{-looser} = $victim unless defined $self->{-looser};
83 unless(defined $no_conquer){
84 $other = ($victim != $self->{-winner}) ? $self->{-winner} : $self->{-looser};
87 Util::log("death_count for $victim: $death_count",1);
89 $self->{-dead}->{$victim} = {'A' => 0,
93 'C' => 0}; # conquered arks
95 return unless $death_count;
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'};
105 my $big_dying = {'P' => 'PRIEST',
110 # print Dumper $dying;
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;
122 # print Dumper \%victims_mobiles;
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);
133 $share = $to_kill if($share > $to_kill);
135 Util::log("type: $small_dying, share: $share, carry: $carry, to_kill: $to_kill",2);
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);
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 ".
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;
170 if($count > $dead_men){
171 my $new_count = $count - $dead_men;
172 $self->{-db}->update_hash('MOBILE',
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;
183 $self->{-db}->delete_from('MOBILE',"ID=$id");
184 $self->{-db}->update_hash('MOBILE',
187 Util::log("Mobile $id ($small_dying) with $dead_men people is deleted",1);
188 delete $victims_mobiles{$id};
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},
204 'OWNER' => $self->{-winner},
205 'COUNT' => $self->{-dead}->{$victim}->{'C'},
207 'COMMAND_ID' => $self->{-id},
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;
218 $self->change_priest_on_temple($self->{-location});
222 my ($self,$id,$target,$count) = @_;
225 my $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
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);
232 # reread mobile, because split destroys it
233 $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
235 # all mobiles which already move with this now move with the target
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);
250 $self->unify_mobiles($mobile,$mobile->{'LOCATION'});
253 # this function is called, if an earthling leave an field and let it possible empty
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);
261 my ($home,$ter,$occ,$temple) =
262 $aym->read_field('HOME,TERRAIN,OCCUPANT,TEMPLE',$loc);
263 $home=0 if $ter eq 'MOUNTAIN';
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';
272 Util::log("leaving occupant $occ in field $loc",1);
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});
288 $self->change_priest_on_temple($loc);
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};
297 my ($home,$temple,$occ) = $aym->read_field('HOME,TEMPLE,OCCUPANT',$loc);
298 return unless $temple eq 'Y';
300 my $produce = $self->{-db}->count('COMMAND',
301 "LOCATION=$loc AND GAME=$self->{-game} AND ".
304 my $priests = $self->{-db}->count('MOBILE',
305 "LOCATION=$loc AND GAME=$self->{-game} AND ".
306 "TYPE=PRIEST AND ADORING=$home AND ".
309 Util::log("priests: $priests, produce: $produce",1);
311 if($priests and not $produce){
312 $aym->insert_command('PRODUCE', "ROLE=$occ", $loc);
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}");
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.
332 my ($self,$loc,$ignore_friend) = @_;
333 $ignore_friend = 0 unless defined $ignore_friend;
335 Util::log("enter_field($loc,$ignore_friend)",2);
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;
342 my $relation = $self->{-context}->get_relation($occ);
344 $relation = 'FOE' if $ignore_friend;
346 # if there is allready an ongoing fight
348 # do nothing if we are allready involved
349 if($self->{-player} == $occ or $self->{-player} == $att){
351 Util::log("join the ongoing fight in $loc",1);
352 delete $self->{-multimove};
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};
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};
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);
376 # we are the attacker
377 $self->do_earthling_fight($loc);
378 delete $self->{-multimove};
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};
387 # we are the new occupant
388 $self->conquer($loc,$self->{-player});
391 $self->change_priest_on_temple($loc);
394 # peoples without arks drown
396 my ($self,$loc) = @_;
398 # dont drown on islands or land
399 my ($terrain) = $self->{-context}->read_field('TERRAIN',$loc);
400 return unless $terrain eq 'WATER';
402 # is there still an active ark?
403 my $arks = $self->{-context}->read_mobile('TYPE','ARK',$loc,1);
404 # print Dumper $arks;
409 my $mobs = $self->{-context}->read_mobile('ID,TYPE,COUNT,OWNER','',$loc,1);
411 my ($id,$type,$count,$owner);
412 for my $mob (@$mobs){
413 ($id,$type,$count,$owner) = @$mob;
415 next if $type eq 'ARK' or $type eq 'PROPHET';
418 $self->{-db}->delete_from('MOBILE',"ID=$id");
419 Util::log("No ark: $count $type from $owner drowned in $loc.",1);
422 ->send_message_to($owner,
424 'MSG_TAG' => 'MSG_MOBILE_DRAWN',
426 'ARG2' => $self->{-context}->mobile_string($type,$count),
427 'ARG3' => $self->{-context}->charname($owner),
430 $self->empty_field($loc,$owner) if $owner;
434 my ($self,$loc,$player) = @_;
436 Util::log("$player conquers $loc.",1);
437 $self->{-db}->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
438 {'OCCUPANT' => $player});
440 # conquer existing arks
441 $self->{-db}->update_hash('MOBILE',"LOCATION=$loc AND GAME=$self->{-game} AND TYPE=ARK",
442 {'OWNER' => $player});
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);
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);
455 #if ($temple eq 'Y'){
457 # $self->{-db}->delete_from('COMMAND', "COMMAND=PRAY AND LOCATION=$loc".
458 #" AND GAME=$self->{-game}");
463 sub enter_field_avatar{
464 my ($self,$loc,$mob) = @_;
466 Util::log("enter_field_avatar() in $loc",1);
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};
477 # mob can be ID or hash
478 $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
480 # get all avatars allready here from me and other owners
481 my $avatars = $self->{-context}->read_mobile_condition('ID,OWNER,STATUS',
485 # print Dumper $avatars;
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);
504 Util::log("other avatar-owner $own allready found in $loc",1);
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',
514 {'STATUS' => $own_avatar_status});
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);
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'}",
533 Util::log("enter_field_avatar():Avatars from $mob->{'OWNER'} ".
534 "have to fight with $other in $loc.",1);
535 delete $self->{-multimove};
542 my ($self,$allA,$allB,$statA,$statB) = @_;
544 Util::log("is_avatar_fight(): ".
545 "allA: $allA, allB: $allB, statA: $statA, statB: $statB",1);
547 return 0 unless $statA eq 'BLOCK' or $statB eq 'BLOCK';
548 my $status = 'NEUTRAL';
549 if(($allA eq 'FOE') or ($allB eq 'FOE')){
551 }elsif(($allA eq 'FRIEND') or ($allB eq 'FRIEND')){
555 return 1 if ($status eq 'FOE');
556 return 1 if ($status eq 'NEUTRAL') and $statA eq 'BLOCK' and $statB eq 'BLOCK';
560 # unify identical mobiles
561 # $mob still exists after function. all other of same
562 # TYPE, MOVE_WITH, ADORING will be deleted.
564 my ($self,$mob,$location,$owner) = @_;
566 # mob can be ID or hash
567 $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
569 $location = $mob->{'LOCATION'} unless defined $location;
570 $owner = $self->{-player} unless defined $owner;
572 Util::log("unify_mobiles() in $location for mobile $mob->{'ID'} of $owner",1);
574 return if $self->{-db}->count('COMMAND',
575 "MOBILE=$mob->{'ID'} AND ID != $self->{-dbhash}->{'ID'}");
577 my $type = $mob->{'TYPE'};
579 my $mobs = $self->{-context}->read_mobile('ID,COUNT,ADORING,OWNER,MOVE_WITH',
581 # $mob->{'LOCATION'},
586 my $count = $mob->{'COUNT'};
588 my ($oid,$ocount,$oado,$oown,$omove) = @$m;
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'};
596 next if(defined $mob->{'MOVE_WITH'} and $mob->{'MOVE_WITH'} ne $omove);
598 next if $self->{-db}->count('COMMAND',"MOBILE=$oid");
602 $self->{-db}->delete_from('MOBILE',"ID=$oid");
604 # set new MOVE_WITH, if deleted unit has some companions
605 $self->{-db}->update_hash('MOBILE',
607 {'MOVE_WITH' => $mob->{'ID'}});
610 $self->{-db}->update_hash('MOBILE',
612 {'COUNT' => $count}) if $count != $mob->{'COUNT'};
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);
627 # the move-command will be set up again in the oposite direction
629 my ($self,$loc) = @_;
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',
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);
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};
660 # no fight on some neutral territories
661 return 0 unless $occupant or exists $::conf->{-FIGHTS_WITHOUT_OWNER}->{$terrain};
663 # no new fight, if allready one started
664 return 0 if $self->{-context}->earthling_fight($location);
666 return 0 if $attacker == $occupant or
667 $relation eq 'FRIEND' or
668 $relation eq 'ALLIED';
670 my $qloc = $self->{-db}->quote($location);
671 $self->{-db}->update_hash('MAP',"GAME=$self->{-game} AND LOCATION=$qloc",
672 {'ATTACKER' => $attacker});
677 sub do_earthling_fight{
678 my ($self,$loc) = @_;
680 # write the fight command
682 $self->{-context}->insert_command('FIGHT_EARTHLING',
683 "ATTACKER=$self->{-player}, ".
684 "DEFENDER=$self->{-occupant}",
688 # enough mana available?
690 my ($self,$action,$factor,$god) = @_;
691 $factor = 1 unless defined $factor;
692 $god = $self->{-player} unless defined $god;
694 my $mana = $self->{-context}->get_mana($god);
695 my $mana_needed = $::conf->{-MANA}->{"-$action"} * $factor;
697 Util::log("$god needs $mana_needed mana from his $mana mana to do $action",1);
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',
705 $self->{-location} ? $self->{-location} : 'GLOBAL')){
706 $self->{-player} = $player;
709 $self->{-player} = $player;
711 $self->{-mana} = $mana - $mana_needed;
712 $self->{-mana_paid} = $mana_needed;
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);
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;
731 my $mana_available = $self->{-context}->get_mana($god);
733 if ($mana_available < $mana)
736 $mana = $mana_available;
738 my $newmana = $mana_available - $mana;
740 $self->{-db}->update_hash(
742 "PLAYER=$god AND GAME=$self->{-game}",
745 Util::log("$god pays $mana mana ".
746 "and has still $newmana left.",1);
753 ####################################################
755 ##########################################################
757 # Use this template to generate new commands
760 package AymCommandTemplate;
761 @AymCommandTemplate::ISA = qw(AymCommand);
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}
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
776 my @required_arguments = ();
777 return 0 unless $self->Command::is_valid(@required_arguments);
784 # this is called from Scheduler, when he see the command the
785 # first time, some commands execute here immidiatly.
790 return 0 unless $self->is_valid();
797 # this is called from scheduler when the command will be executed.
802 return 0 unless $self->is_valid();
812 ####################################################
815 # CH_STATUS: Change the player alliance status
819 @CH_STATUS::ISA = qw(AymCommand);
824 my @required_arguments = ('OTHER','STATUS');
825 return 0 unless $self->Command::is_valid(@required_arguments);
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},
835 my $status = $self->{-args}->{'STATUS'};
836 return 0 unless $self->test(sub{Util::is_in($status,
842 'MSG_STATUS_INVALID',
850 return 0 unless $self->is_valid();
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(
858 "PLAYER=$self->{-player} ".
860 "AND GAME=$self->{-game}",
861 {'GAME' => $self->{-game},
862 'PLAYER' => $self->{-player},
867 #$self->{-context}->send_message_to_me({'MFROM' => 0,
869 # 'ARG1' => $self->{-context}->charname($other),
873 $self->setDuration(0);
879 Util::log("Warning: We should not reach phase 2 with command CH_STATUS",0);
886 ################################################################
888 ################################################################
895 # use FROGS::HexTorus;
896 @MOVE::ISA = qw(AymCommand);
901 my $db = $self->{-db};
902 my $args = $self->{-args};
903 my $aym = $self->{-context};
904 my $phase = $self->{-phase};
906 my @required_arguments = ('MOBILE','COUNT','DIR');
907 return 0 unless $self->Command::is_valid(@required_arguments);
909 my $mob_id = $args->{'MOBILE'};
910 my $count = $args->{'COUNT'};
912 return 0 unless $count =~ /^\s*\d+\s*$/;
914 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
915 my $mob = $self->{-mob};
917 my ($owner,$loc_string,$type) = ($mob->{'OWNER'},
921 # print "LOCATION: $loc_string\n";
922 $self->{-loc_string} = $loc_string;
924 # enough mobiles avaiable?
926 return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
927 $mob->{'AVAILABLE'} eq 'Y'},
928 'MSG_NOT_ENOUGH_MOBILES',
935 my ($size) = $db->read_game($self->{-game},'SIZE');
936 $self->{-size} = $size;
937 my $map = HexTorus->new($size);
938 $self->{-map} = $map;
940 my $loc = Location->from_string($loc_string);
941 $self->{-loc} = $loc;
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);
954 my $target = $map->get_neighbour($loc,$direction);
957 return 0 unless $self->test(sub{$target},
958 'MSG_MOVE_NO_TARGET',
961 $self->{-target} = $target;
962 my $target_string = $target->to_string();
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;
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,
978 'POLE') or $type eq 'ARK'},
983 # $self->{-context}->mobile_string($type,2));
987 # role specific tests
988 my $role = $self->{-role};
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));
999 # dont move if $loc is Aymargeddon
1000 return 0 unless $self->test(sub{$terrain ne 'AYMARGEDDON'},
1001 'MSG_CANT_LEAVE_AYMARGEDDON',
1005 # dont move, if ongoing FIGHT_GOD
1007 return 0 unless $self->test(sub{not $god_attacker},
1008 'MSG_CANT_MOVE_ATTACKED',
1010 $self->{-context}->mobile_string($type,2));
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'))
1018 # TODO: Errormessage
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},
1033 # $self->{-context}->mobile_string($type,2));
1035 } elsif ($role eq 'EARTHLING' or $owner == -1) {
1037 $self->{-companions} = $self->{-context}->
1038 read_mobile_condition('TYPE,COUNT,OWNER,ID',
1039 "MOVE_WITH=$self->{-args}->{'MOBILE'}");
1041 # do not move if field is attacked or tuberculosis
1043 return 0 unless $self->test(sub{not $attacker},
1044 'MSG_CANT_MOVE_ATTACKED',
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',
1051 $self->{-context}->mobile_string($type,2),
1054 # eartlings can only move this types
1055 return 0 unless $self->test(sub{Util::is_in($type,
1061 'MSG_EARTHLING_CANT_MOVE_TYPE',
1062 $self->{-context}->mobile_string($type,2));
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);
1070 # dont move ark from land to land
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'};
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]});
1089 # ($ark,$active) = (0,0);
1091 # return 0 unless $self->test(sub {$active or $type eq 'PROPHET'},
1095 # $self->{-context}->mobile_string($type,2));
1096 # $self->{-active_ark} = $ark;
1097 # Util::log("We take ark $ark with us.",1);
1101 Util::log("impossible situation. I could not be $role",0);
1105 # dont move without mana
1107 if ($role eq 'GOD') {
1108 unless($self->test_mana('MOVE_AVATAR',$count)){
1109 $db->update_hash('MOBILE',
1112 'AVAILABLE' => 'Y'});
1116 # for all avatar-companions: pay or stay (if not on ark)!
1117 if ($type ne 'ARK'){
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',
1125 {'AVAILABLE' => 'Y',
1127 $self->unify_mobiles($cid,0,$cown);
1131 # re-read companions
1132 $self->{-companions} = $self->{-context}->
1133 read_mobile_condition('TYPE,COUNT,OWNER,ID',
1134 "MOVE_WITH=$self->{-args}->{'MOBILE'}")
1148 return 0 unless $self->is_valid();
1150 my $db = $self->{-db};
1151 my $type = $self->{-mob}->{'TYPE'};
1152 my $mob = $self->{-mob};
1153 my $aym = $self->{-context};
1155 # split it, if neccessary
1156 # the moving unit get the old ID!
1158 my $count = $self->{-args}->{'COUNT'};
1159 #print "conditional split with $count count and mob=\n";
1161 #print Dumper $self;
1163 $self->conditional_split_mobile($mob,$count,
1164 {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
1165 'MOVE_WITH' => 0},0);
1167 # if ark needed, move it together with us
1168 #if($type ne 'ARK' and $self->{-active_ark}){
1170 # $self->move_with($self->{-active_ark},$self->{-args}->{'MOBILE'},1);
1173 # $self->{-db}->update_hash('MOBILE',
1174 # "ID=$self->{-active_ark}",
1175 # {'OWNER' => $self->{-player}});
1178 # collect mobiles with MOVE_WITH in same location
1179 my $companions = $self->{-companions};
1181 # calculate duration
1182 my $d = $::conf->{-DURATION};
1183 my $dur = $d->{"-MOVE_$type"};
1185 # if moved with ark use -MOVE_ARK else use slowest
1186 if($self->{-active_ark}){
1187 $dur = $d->{'-MOVE_ARK'};
1189 for my $m (@$companions){
1191 $dur = $d->{"-MOVE_$mtype"} if $d->{"-MOVE_$mtype"} > $dur;
1194 $self->setDuration($dur);
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'});
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
1209 for my $comp (@$companions){
1210 my ($ctype,$ccount,$cown,$cid) = @$comp;
1211 next unless $ctype eq 'AVATAR';
1212 $self->use_mana($cown);
1215 }elsif($aym->is_god()){
1220 if($type eq 'ARK' or $self->{-active_ark}){
1221 $self->event($self->{-target}->to_string(),
1222 'EVENT_ARK_APPROACHING',
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',
1233 # $self->{-context}->mobile_string($type,$count));
1236 # TODO Bug: if avatar moves with hero, the wrong player is in the event-message.
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',
1246 # $self->{-context}->mobile_string($mtype,$c))
1249 $self->{-player} = $player;
1259 return 0 unless $self->is_valid();
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'};
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,
1273 # TODO: distribute plagues
1276 # $self->{-db}->update_hash('MOBILE',
1277 # "TYPE=ARK AND MOVE_WITH=$mob->{'ID'}",
1278 # {'MOVE_WITH' => 0});
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);
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);
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);
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'});
1305 $self->unify_mobiles($mob,$target_location);
1308 # TODO: maybe we should give a message only to the player of the unit
1309 # ... but its difficult, because of MOVE_WITH
1312 # ->send_message_to_field
1313 # ($target_location,
1315 # 'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1317 # 'ARG2' => $self->{-context}->mobile_string($self->{-mob}->{'TYPE'},
1318 # $self->{-mob}->{'COUNT'}),
1319 # 'ARG3' => $self->{-context}->charname($self->{-player}),
1320 # 'ARG4' => $target_location});
1322 # for my $m (@$companions){
1323 # my ($mtype,$mc,$mo,$mid) = @$m;
1325 # ->send_message_to_field
1326 # ($target_location,
1328 # 'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1330 # 'ARG2' => $self->{-context}->mobile_string($mtype,$mc),
1331 # 'ARG3' => $self->{-context}->charname($mo),
1332 # 'ARG4' => $target_location});
1342 ####################################################
1344 ##########################################################
1349 package BLESS_PRIEST;
1350 @BLESS_PRIEST::ISA = qw(AymCommand);
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
1358 my @required_arguments = ('MOBILE');
1359 return 0 unless $self->Command::is_valid(@required_arguments);
1361 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1363 return 0 unless $self->validate_role('GOD');
1365 my $mobtype = $self->{-mob}->{'TYPE'};
1366 my $mobloc = $self->{-mob}->{'LOCATION'};
1368 # don't bless unassigned units
1369 return 0 unless $self->test(sub{$self->{-mob}->{'OWNER'} > 0},
1370 'MSG_CANT_BLESS_UNASSIGNED',
1373 # only bless warriors
1374 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
1376 $self->{-context}->mobile_string($mobtype,1),
1379 return 0 unless $self->test_mana('BLESS_PRIEST');
1384 # this is called from Scheduler, if he see the command the
1385 # first time, some commands execute here immidiatly.
1390 return 0 unless $self->is_valid();
1392 my $id = $self->{-mob}->{'ID'};
1393 my $newid = $self->conditional_split_mobile($self->{-mob},
1395 {'ADORING' => $self->{-player},
1397 'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
1400 # companions move with the remaining warriors, not with the new priest
1401 $self->{-db}->update_hash('MOBILE',
1403 {'MOVE_WITH' => $newid}) if $id != $newid;
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'});
1411 $self->change_priest_on_temple($self->{-mob}->{'LOCATION'});
1414 # ->send_message_to_field
1415 # ($self->{-mob}->{'LOCATION'},
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'}});
1424 $self->setDuration(0);
1429 # this is called from scheduler when the command will be executed
1432 Util::log("BLESS_PRIEST should not have a second phase!",0);
1437 # End of BLESS_PRIEST
1439 ####################################################
1441 ##########################################################
1446 package BUILD_TEMPLE;
1448 @BUILD_TEMPLE::ISA = qw(AymCommand);
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
1456 my @required_arguments = ('MOBILE');
1457 return 0 unless $self->Command::is_valid(@required_arguments);
1459 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1461 my $mobtype = $self->{-mob}->{'TYPE'};
1462 my $mobloc = $self->{-mob}->{'LOCATION'};
1463 my $god = $self->{-mob}->{'ADORING'};
1465 # only priests can build temples
1466 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'PRIEST'},
1468 $self->{-context}->mobile_string($mobtype,1),
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',
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',
1486 # $self->{-mob}->{'ADORING'},
1487 # $self->{-context}->charname($god));
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',
1493 'MSG_CANT_BUILD_HERE',
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 ".
1503 "OCCUPANT=$self->{-player} AND ".
1505 < $::conf->{-MAX_MOUNTAINS}},
1506 'MSG_CANT_BUILD_HERE',
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'});
1514 return 0 unless $ret;
1520 # this is called from Scheduler, if he sees the command the
1521 # first time, some commands execute here immidiatly.
1526 return 0 unless $self->is_valid();
1528 $self->conditional_split_mobile($self->{-mob},
1530 {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
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});
1540 $self->empty_field($self->{-mob}->{'LOCATION'});
1542 my ($size) = $self->{-db}->read_game($self->{-game},'TEMPLE_SIZE');
1544 # set new temple size
1546 $self->{-db}->update_hash('GAME',
1547 "GAME=$self->{-game}",
1548 {'TEMPLE_SIZE' => $size});
1549 Util::log("New temple size: $size",1);
1551 # calculate duration
1552 $self->setDuration($size * $::conf->{-DURATION}->{-BUILD_TEMPLE});
1554 $self->event($self->{-mob}->{'LOCATION'},
1555 'EVENT_BUILD_TEMPLE',
1556 $self->{-context}->charname($self->{-mob}->{'ADORING'}),
1559 return $self->{-duration};
1562 # this is called from scheduler when the command will be executed.
1567 return 0 unless $self->is_valid();
1569 my $loc = $self->{-mob}->{'LOCATION'};
1570 $self->{-db}->update_hash('MAP',
1571 "GAME=$self->{-game} AND LOCATION=$loc",
1573 'HOME' => $self->{-mob}->{'ADORING'}});
1575 $self->{-db}->update_hash('MOBILE',
1576 "ID=$self->{-mob}->{'ID'}",
1577 {'AVAILABLE' => 'Y'});
1579 # insert new PRODUCE-command
1580 $self->{-context}->insert_command('PRODUCE', "ROLE=$self->{-player}",
1581 $self->{-mob}->{'LOCATION'});
1583 # insert new PRAY-command
1584 $self->{-context}->insert_command('PRAY','',$loc);
1586 # this deletes and reinsert commands, if we conquer with building
1587 $self->enter_field($loc,1);
1589 #change aymargeddon to nearest pole
1590 my $poles = $self->{-db}->select_array('MAP',
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';
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'});
1615 ->send_message_to_all
1617 'MSG_TAG' => 'MSG_CHANGE_AYMARGEDDON',
1618 'ARG1' => $self->{-context}->charname($self->{-player})});
1619 #'ARG2' => $old_aym,
1620 #'ARG3' => $new_aym});
1623 # is this the end of the game?
1624 my $unbuild = $self->{-context}->unbuild();
1626 $self->end_of_the_game() unless $unbuild;
1632 # End of BUILD_TEMPLE
1634 ####################################################
1636 ##########################################################
1643 @PRODUCE::ISA = qw(AymCommand);
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);
1660 return 0 unless $self->is_valid();
1662 my ($ter,$home,$occ,$temple) =
1663 $self->{-context}->read_field('TERRAIN,HOME,OCCUPANT,TEMPLE',
1664 $self->{-dbhash}->{'LOCATION'});
1666 my ($type, $duration);
1667 $type = $temple eq 'Y' ? 'PRIEST' : 'WARRIOR';
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};
1678 Util::log("isle.",1);
1679 $duration = $d->{-PRODUCE_PRIEST};
1681 $self->setDuration($duration);
1682 $self->event($self->{-location},
1683 'EVENT_PRODUCE_PRIEST');
1685 Util::log("Produce a warrior at ",-1);
1687 Util::log("homecity.",1);
1688 $duration = $d->{-PRODUCE_WARRIOR_HOME};
1690 Util::log("normal city.",1);
1691 $duration = $d->{-PRODUCE_WARRIOR} + $d->{-PRODUCE_WARRIOR_CHANGE} * $peace;
1693 $self->setDuration($duration);
1694 $self->event($self->{-location},
1695 'EVENT_PRODUCE_WARRIOR');
1701 # this is called from scheduler when the command will be executed.
1706 return 0 unless $self->is_valid();
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';
1713 # fields with influenza do not produce
1714 if(not defined $plague or not $plague =~ 'INFLUENZA'){
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);
1722 Util::log("No priests, no new priests!",1);
1723 $self->do_it_again();
1728 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1733 'OWNER' => $self->{-args}->{'ROLE'},
1734 'GAME' => $self->{-game},
1738 # print Dumper $mob;
1740 $mob->{'ADORING'} = $home if $type eq 'PRIEST';
1742 my %mobcopy = (%$mob);
1743 $self->{-mob} = \%mobcopy;
1744 $self->{-db}->insert_hash('MOBILE',
1747 $self->enter_field($loc,1);
1748 } # endif no influenza
1750 Util::log("No production in $loc due to INFLUENZA!",1);
1754 my $new_peace = $self->{-args}->{'PEACE'};
1755 $new_peace = 0 unless defined $new_peace;
1757 $self->do_it_again({'PEACE' => $new_peace});
1765 ####################################################
1767 ##########################################################
1774 @PRAY::ISA = qw(AymCommand);
1779 my @required_arguments = ();
1780 return 0 unless $self->Command::is_valid(@required_arguments);
1782 $self->{-loc} = $self->{-dbhash}->{'LOCATION'};
1783 my ($temple,$home) = $self->{-context}->read_field('TEMPLE,HOME',
1785 # TODO: use test() instead
1786 return 0 unless $temple eq 'Y';
1788 $self->{-god} = $home;
1797 return 0 unless $self->is_valid();
1799 return $self->{-duration};
1806 return 0 unless $self->is_valid();
1808 # count number of active orthodox priests
1810 my $oim = $self->{-context}->own_in_mobile($self->{-loc},
1816 my $mob = $self->{-db}->read_single_mobile($id);
1817 $priests += $mob->{'COUNT'} if($mob->{'TYPE'} eq 'PRIEST');
1820 # reduce effective priests if necessary
1821 my $fortune = $self->{-context}->read_fortune();
1822 my $oldpriests = $priests;
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;
1829 }elsif($terrain eq 'ISLE'){
1830 if($priests > $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune){
1831 $priests = $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune;
1834 Util::log("ERROR: PRAY in terrain $terrain",0);
1837 Util::log("reduce praying priests from $oldpriests to".
1838 " $priests in $self->{-loc} ($terrain, fortune: $fortune)",1)
1839 if $oldpriests > $priests;
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};
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);
1854 $self->do_it_again();
1862 ####################################################
1864 ##########################################################
1871 @BUILD_ARK::ISA = qw(AymCommand);
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
1879 # my @required_arguments = ('');
1880 return 0 unless $self->Command::is_valid();
1882 return 0 unless $self->validate_role('GOD');
1887 # this is called from Scheduler, if he sees the command the
1888 # first time, some commands execute here immidiatly.
1893 return 0 unless $self->is_valid();
1894 return 0 unless $self->test_mana('BUILD_ARK');
1896 # calculate duration
1897 $self->setDuration($::conf->{-DURATION}->{-BUILD_ARK});
1899 my $loc = $self->{-location};
1901 $self->event($loc,'EVENT_BUILD_ARK');
1905 $self->{-affected} = {
1907 -mana => $self->{-player},
1910 return $self->{-duration};
1913 # this is called from scheduler when the command will be executed.
1918 return 0 unless $self->is_valid();
1920 # owner should be occupant
1921 my ($occ) = $self->{-context}->read_field('OCCUPANT',$self->{-location});
1922 $occ = -1 unless $occ;
1924 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1926 'LOCATION' => $self->{-location},
1930 'GAME' => $self->{-game},
1932 my %mobcopy = (%$mob);
1933 $self->{-db}->insert_hash('MOBILE',$mob);
1935 # merge multiple ARKs in one mobile, if same owner
1936 $self->unify_mobiles(\%mobcopy,$self->{-location},$occ);
1938 # $self->{-db}->commit();
1941 # ->send_message_to_field
1942 # ($self->{-location},
1944 # 'MSG_TAG' => 'MSG_BUILD_ARK',
1945 # 'ARG1' => $self->{-context}->charname($self->{-player}),
1946 # 'ARG2' => $self->{-location}});
1954 ####################################################
1956 ####################################################
1958 # INCARNATE: Create an Avatar
1962 @INCARNATE::ISA = qw(AymCommand);
1967 my @required_arguments = ('COUNT');
1968 return 0 unless $self->Command::is_valid(@required_arguments);
1970 # you need a temple to create an avatar
1971 $self->{-arrival} = $self->{-context}->incarnation_place();
1972 return 0 unless $self->test(sub{$self->{-arrival};},
1973 'MSG_ERROR_NO_ARRIVAL');
1975 # TODO: maybe with variing cost (distance to Aymargeddon)
1976 return 0 unless $self->test_mana('INCARNATE', $self->{-args}->{'COUNT'});
1984 return 0 unless $self->is_valid();
1986 # create mobile (or join)
1987 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1988 'GAME' => $self->{-game},
1989 'LOCATION' => $self->{-location},
1991 'OWNER' => $self->{-player},
1992 'COUNT' => $self->{-args}->{'COUNT'},
1994 'STATUS' => 'IGNORE',
1995 'COMMAND_ID' => $self->{-id},
1997 $self->{-mob} = $mob;
1998 my %mobcopy = (%$mob);
1999 $self->{-db}->insert_hash('MOBILE',\%mobcopy);
2001 $self->enter_field_avatar($self->{-location},$mob);
2002 $self->unify_mobiles($mob,$self->{-location});
2008 # ->send_message_to_field
2009 # ($self->{-location},
2011 # 'MSG_TAG' => 'MSG_INCARNATE',
2012 # 'ARG1' => $self->{-context}->charname($self->{-player}),
2013 # 'ARG2' => $self->{-location}});
2015 $self->setDuration(0);
2021 Util::log("Warning: We should not reach phase 2 with command INCARNATE",0);
2028 ################################################################
2030 ##########################################################
2035 package FIGHT_EARTHLING;
2037 use Date::Parse qw(str2time);
2038 use Date::Calc qw(Time_to_Date);
2039 @FIGHT_EARTHLING::ISA = qw(AymCommand);
2041 # this is called to see if the command is executable.
2042 # it should be called from first_phase() and from second_phase().
2043 # it is not called from the scheduler
2047 my @required_arguments = ('ATTACKER','DEFENDER');
2048 return 0 unless $self->Command::is_valid(@required_arguments);
2050 return 0 unless $self->validate_role('EARTHLING');
2051 return 0 unless $self->validate_this_role($self->{-args}->{'ATTACKER'},'EARTHLING');
2052 my $def = $self->{-args}->{'DEFENDER'};
2054 return 0 unless $self->validate_this_role($self->{-args}->{'DEFENDER'},'EARTHLING');
2060 # this is called from Scheduler, if he sees the command the
2061 # first time, some commands execute here immidiatly.
2066 return 0 unless $self->is_valid();
2068 # calculate duration
2069 $self->setDuration($::conf->{-DURATION}->{-FIGHT_EARTHLING});
2071 $self->event($self->{-location},
2074 return $self->{-duration};
2077 # this is called from scheduler when the command will be executed.
2082 return 0 unless $self->is_valid();
2085 my ($terrain,$home,$occupant) = $self->{-context}->
2086 read_field('TERRAIN,HOME,OCCUPANT',$self->{-location});
2088 my $attacker = $self->{-args}->{'ATTACKER'};
2089 my $defender = $self->{-args}->{'DEFENDER'};
2092 my $mobiles = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2093 0, $self->{-location}, 1);
2094 $self->{-mobiles} = $mobiles;
2095 # print Dumper $mobiles;
2097 #my $efoa = {"$attacker" => 0}; # earthling friends of attacker
2098 #my $efod = {"$defender" => 0}; # earthling friends of defender
2099 #$self->{-efoa} = $efoa;
2100 #$self->{-efod} = $efod;
2102 my ($gfoa, $gfod); # god friends ...
2104 # calculate strength of both sides
2105 my ($attack_strength, $defend_strength,$attack_avatar,$defend_avatar) = (0,0,0,0);
2106 my ($people_attacker, $people_defender) = (0,0);
2107 for my $mob (@$mobiles){
2108 my ($id,$type,$own,$count,$stat) = @$mob;
2110 # next if $own <= 0;
2111 if(exists($gfod->{$own})){
2112 # could be reached with differen MOVE_WITH
2113 $defend_avatar += $count * $self->strength('AVATAR');
2114 $gfod->{$own} += $count;
2115 Util::log("(1)mobile $id: $count $type from $own fights for $defender in $self->{-location}",1);
2116 }elsif(exists($gfoa->{$own})){
2117 # could be reached with differen MOVE_WITH
2118 $attack_avatar += $count * $self->strength('AVATAR');
2119 $gfoa->{$own} += $count;
2120 Util::log("(2)mobile $id: $count $type from $own fights for $attacker in $self->{-location}",1);
2122 # TODO Performance (in the case of earthling this is not necessary)
2123 my ($att_rel,$def_rel,$foa,$fod) = (0,0,0,0);
2125 # Avatars dont fight sometimes (no mana or no help or no friend)
2126 if($type eq 'AVATAR'){
2127 # if(not $godfight){
2128 $att_rel = $self->{-context}->read_single_relation($own,$attacker);
2129 $def_rel = $self->{-context}->read_single_relation($own,$defender);
2131 $foa = 1 if Util::is_in($att_rel,'FRIEND','ALLIED');
2132 $fod = 1 if Util::is_in($def_rel,'FRIEND','ALLIED');
2134 # defender has support if in doubt
2135 $foa = 0 if $foa and $fod;
2136 $fod = 1 if not $foa and not $fod;
2138 $gfoa->{$own} += $count if $foa;
2139 $gfod->{$own} += $count if $fod;
2141 # if you dont have enough mana for all your avatars no one fights!
2142 if($stat eq 'HELP' and $self->test_mana('FIGHT_AVATAR',1,$own)){
2143 $self->use_mana($own);
2145 ($foa, $fod) = (0,0);
2151 # earthlings are simpel: no friends in field
2152 $foa = 1 if $own == $attacker;
2153 $fod = 1 if $own == $defender;
2157 Util::log("(3)mobile $id: $count $type from $own fights for ".
2158 "$attacker in $self->{-location}",1);
2159 if($type eq 'AVATAR'){
2160 # count maximum avatarpower
2161 $attack_avatar += $count * $self->strength('AVATAR');
2163 # count earthling_strength
2164 $attack_strength += $count * $self->strength($type);
2165 $people_attacker += $count;
2167 }elsif($fod){ # same for defender
2168 Util::log("(4)mobile $id: $count $type from $own fights for ".
2169 "$defender in $self->{-location}",1);
2170 if($type eq 'AVATAR'){
2171 $defend_avatar += $count * $self->strength('AVATAR');
2173 $defend_strength += $count * $self->strength($type);
2174 $people_defender += $count;
2177 Util::log("(5)mobile $id: $own dont fight with $count $type ".
2178 "in $self->{-location}",1);
2184 if($terrain eq 'CITY'){
2185 # bonus for home city
2186 if($home == $attacker){
2187 Util::log("homecity fights for $attacker",1);
2188 $attack_strength += $::conf->{-FIGHT}->{-HOME};
2189 }elsif($home == $defender and $home){
2190 Util::log("homecity fights for $defender",1);
2191 $defend_strength += $::conf->{-FIGHT}->{-HOME};
2193 }elsif($terrain eq 'ISLE'){
2195 if($occupant == $attacker){
2196 Util::log("isle fights for $attacker",1);
2197 $attack_strength += $::conf->{-FIGHT}->{-ISLE};
2198 }elsif($occupant == $defender){
2199 Util::log("isle fights for $defender",1);
2200 $defend_strength += $::conf->{-FIGHT}->{-ISLE};
2202 Util::log("impossible situation: isle fights for no one!",0);
2206 Util::log("earthling strength attacker($attacker): ".
2207 "$attack_strength, defender($defender): $defend_strength"
2210 my $pure_attack_strength = $attack_strength;
2211 my $pure_defend_strength = $defend_strength;
2213 #my $attacker_death_count = $attack_strength;
2214 #my $defender_death_count = $defend_strength;
2216 my $attacker_death_count = $people_attacker;
2217 my $defender_death_count = $people_defender;
2219 Util::log("$people_attacker people fight for attacker $attacker",1);
2220 Util::log("$people_defender people fight for defender $defender",1);
2222 my $attacker_godpower = Util::min($people_attacker,$attack_avatar);
2223 my $defender_godpower = Util::min($people_defender,$defend_avatar);
2225 Util::log("Gods supports attacker($attacker) with $attacker_godpower",1);
2226 Util::log("Gods supports defender($defender) with $defender_godpower",1);
2228 $attack_strength += $attacker_godpower;
2229 $defend_strength += $defender_godpower;
2232 # if landbattle: look, for all neighbour fields,
2233 # add flanking power of allies
2234 my ($flanking_attack,$flanking_defend) = (0,0);
2235 # if(not $self->{-see_battle} and not $self->{-island_battle}){
2236 my @neighbours = $self->get_neighbours($self->{-location});
2237 # COMMENT IN FOR NEW RULE my ($att_neighbours,$def_neighbours) = (0,0);
2238 # print "neighbours: @neighbours\n";
2239 for my $n (@neighbours){
2240 # my $n_string = $n->to_string();
2241 my ($ter,$occ,$att) = $self->{-context}->
2242 read_field('TERRAIN,OCCUPANT,ATTACKER',$n);
2243 next if $ter eq 'WATER'; # dont flank from see
2244 next if $att > 0; # dont flank from war
2245 my $attacker_relation = $self->{-context}->read_single_relation($occ,$attacker);
2246 my $defender_relation = $self->{-context}->read_single_relation($occ,$defender);
2247 Util::log("flanking ($n): $attacker_relation, $defender_relation, ".
2248 "$ter, $occ, $att",1);
2249 if($occ != $defender and
2250 ($occ == $attacker or (Util::is_in($attacker_relation,'FRIEND','ALLIED') and not
2251 Util::is_in($defender_relation,'FRIEND','ALLIED')))){
2252 # COMMENT IN FOR NEW RULE $att_neighbours++;
2253 # COMMENT IN FOR NEW RULE $flanking_attack += $::conf->{-FIGHT}->{-FLANKING} * $att_neighbours;
2254 $flanking_attack += $::conf->{-FIGHT}->{-FLANKING};
2255 Util::log("$n flanks for attacker($attacker)",1);
2256 }elsif($occ and ($occ != $attacker and
2257 ($occ == $defender or
2258 (not Util::is_in($attacker_relation,'FRIEND','ALLIED')
2259 and Util::is_in($defender_relation,'FRIEND','ALLIED'))))){
2260 # COMMENT IN FOR NEW RULE $def_neighbours++;
2261 # COMMENT IN FOR NEW RULE $flanking_defend += $::conf->{-FIGHT}->{-FLANKING} * $def_neighbours;
2262 $flanking_defend += $::conf->{-FIGHT}->{-FLANKING};
2263 Util::log("$n flanks for defender($defender)",1);
2266 Util::log("sum of flanking: $flanking_attack for attacker($attacker) and ".
2267 "$flanking_defend for defender($defender) and ",1);
2268 $attack_strength += $flanking_attack;
2269 $defend_strength += $flanking_defend;
2272 Util::log("sum strength without fortune: $attack_strength for attacker($attacker) ".
2273 "and $defend_strength for defender($defender)",1);
2275 # add random value (1 to GAME.FORTUNE)
2276 my $fortune = $self->{-context}->read_fortune();
2277 my $asf = int(rand($fortune))+1;
2278 my $dsf = int(rand($fortune))+1;
2279 $attack_strength += $asf;
2280 $defend_strength += $dsf;
2281 Util::log("strength with fortune attacker($attacker): ".
2282 "$attack_strength, defender($defender): $defend_strength",1);
2286 if($attack_strength > $defend_strength){
2287 $self->{-winner} = $attacker;
2288 $self->{-looser} = $defender;
2289 $self->{-winner_death_count} = Util::min($people_attacker - 1,
2290 int(0.5 + $defender_death_count /
2291 $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2292 $self->{-looser_death_count} = Util::max(1,int(0.5 + $attacker_death_count /
2293 $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2294 Util::log("Attackers($attacker) won!",1);
2295 $self->conquer($self->{-location},$attacker);
2297 $self->{-winner} = $defender;
2298 $self->{-looser} = $attacker;
2299 $self->{-winner_death_count} = Util::min($people_defender - 1,
2300 int(0.5 + $attacker_death_count /
2301 $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2302 $self->{-looser_death_count} = Util::max(1,int(0.5 + $defender_death_count /
2303 $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2304 # $self->{-looser} = $efoa;
2305 # $self->{-master_looser} = $attacker;
2306 Util::log("Defenders($defender) won!",1);
2309 # loosers and helpers run away or die
2310 $self->run_or_die();
2312 # erase MAP.ATTACKER
2313 $self->{-db}->update_hash('MAP',
2314 "LOCATION=$self->{-location} AND GAME=$self->{-game}",
2318 # $self->{-mobiles} = $self->{-context}->read_mobile('ID',
2319 # 0, $self->{-location}, 1);
2321 # unify the mobiles, which are still here
2322 for my $mob_arr (@$mobiles){
2323 my ($id,$type,$owner,$count,$status) = @$mob_arr;
2324 next if exists $self->{-run_or_die}->{$id};
2325 my $mob = $self->{-db}->read_single_mobile($id);
2326 $self->unify_mobiles($mob,$self->{-location},$owner) if $mob;
2329 # sometimes the last ark is gone in battle
2330 if($terrain eq 'WATER'){
2331 $self->drowning($self->{-location});
2334 # send battle-report
2335 my $name_of_attacker = $self->{-context}->charname($attacker);
2336 my $name_of_defender = $self->{-context}->charname($defender);
2337 my $name_of_winner = $self->{-context}->charname($self->{-winner});
2339 my $text = <<END_OF_TEXT;
2340 <strong>BATTLE_REPORT $self->{-location}</strong><br>
2341 <table><tr><th></th><th>$name_of_attacker</th><th>$name_of_defender</th></tr>
2342 <tr><td>PEOPLE</td><td>$people_attacker</td>
2343 <td>$people_defender</td></tr>
2344 <tr><td>FIGHTING_STRENGTH</td><td>$pure_attack_strength</td>
2345 <td>$pure_defend_strength</td></tr>
2346 <tr><td>FLANKING</td><td>$flanking_attack</td><td>$flanking_defend</td></tr>
2347 <tr><td>GODS_HELP</td><td>$attacker_godpower</td><td>$defender_godpower</td></tr>
2348 <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
2349 <tr><td>SUM_OF_STRENGTH</td><td>$attack_strength</td><td>$defend_strength</td></tr>
2350 <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$attacker}->{'K'}</td>
2351 <td>$self->{-dead}->{$defender}->{'K'}</td></tr>
2352 <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$attacker}->{'H'}</td>
2353 <td>$self->{-dead}->{$defender}->{'H'}</td></tr>
2354 <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$attacker}->{'P'}</td>
2355 <td>$self->{-dead}->{$defender}->{'P'}</td></tr>
2356 <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$attacker}->{'A'}</td>
2357 <td>$self->{-dead}->{$defender}->{'A'}</td></tr>
2358 <tr><td>CONQUERED_ARKS</td><td>$self->{-dead}->{$defender}->{'C'}</td>
2359 <td>$self->{-dead}->{$attacker}->{'C'}</td></tr>
2361 <strong>WINNER_IS $name_of_winner</strong>.
2364 # TODO: we should make shure, that attacker and defender are receivers.
2365 # could happen, if all dying and no other unit in the neighbourhood
2366 my @gods = (keys %$gfoa, keys %$gfod);
2368 ->send_message_to_field
2369 ($self->{-location},{'MFROM' => 0,
2370 'MSG_TEXT' => $text}
2371 # 'ARG1' => $self->{-context}->charname($attacker),
2372 # 'ARG2' => $self->{-context}->charname($defender),
2373 # 'ARG3' => $self->{-context}->charname($self->{-winner}),
2374 # 'ARG4' => $self->{-location}}
2376 #,$attacker,$defender,@gods);
2385 # some people have to die
2386 $self->casualties($self->{-winner},$self->{-winner_death_count});
2387 $self->casualties($self->{-looser},$self->{-looser_death_count});
2389 # print Dumper $self->{-dead};
2392 $self->{-mobiles} = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2393 0, $self->{-location}, 1);
2396 # TODO: no retreat if no survivors
2401 sub find_retreat_field{
2402 my ($self,$retreat_fields) = @_;
2404 my @retreat_fields = @$retreat_fields;
2406 # chose one retreat-field
2407 return $retreat_fields[rand($#retreat_fields +1)];
2411 my ($self,$unit,$count,$retreat,$type) = @_;
2413 my $looser = $self->{-looser};
2415 # calculate direction
2416 my $dir = $self->{-context}->is_in_direction_from($retreat,
2417 $self->{-location});
2419 # retreat via MOVE_WITH if retreat with ark
2420 if($type ne 'ARK' and exists $self->{-retreat_arks}->{$retreat}){
2421 my $ark = $self->{-retreat_arks}->{$retreat};
2422 $self->{-db}->update_hash('MOBILE',
2424 {'MOVE_WITH' => $ark,
2425 'AVAILABLE' => 'N'});
2426 Util::log("retreat via $ark (MOVE_WITH)",1);
2428 # TODO?: insert event
2429 $self->{-context}->insert_command('MOVE',
2430 "DIR=$dir, MOBILE=$unit, ".
2431 "COUNT=$count, AUTO=1",
2434 Util::log("retreat via MOVE_COMMAND",1);
2436 Util::log("$looser retreats from $self->{-location} to $retreat ".
2437 "in direction $dir with $count people(or ark). Mobile-ID: $unit",1);
2438 $self->{-run_or_die}->{$unit} = 1;
2441 ->send_message_to_list
2443 'MSG_TAG' => 'MSG_FIGHT_RETREAT',
2444 'ARG1' => $self->{-context}->charname($looser),
2445 'ARG2' => 'PEOPLE_OR_ARK',
2446 'ARG3' => $self->{-location},
2447 'ARG4' => $count},$looser,$self->{-winner});
2455 my $looser = $self->{-looser};
2456 Util::log("checking retreats for looser $looser ...",1);
2458 # remove MOVE_WITH if any
2459 $self->{-db}->update_hash('MOBILE',
2460 "OWNER=$looser AND LOCATION=$self->{-location} AND ".
2462 {'MOVE_WITH' => 0});
2464 # search for retreat-possibilities
2465 my ($local_terrain) = $self->{-context}->read_field('TERRAIN',$self->{-location});
2466 my @possible_retreat = $self->{-context}->own_neighbours($self->{-location},$looser);
2467 my @retreat_fields = ();
2468 my @retreat_water_fields = ();
2469 if ($local_terrain eq 'WATER' or $local_terrain eq 'ISLE'){
2470 @retreat_water_fields = @possible_retreat;
2471 Util::log("retreat from water: @possible_retreat",1);
2473 Util::log("check retreat for ...",-1);
2474 for my $field (@possible_retreat){
2475 Util::log("\n$field ",-1);
2476 my ($terrain) = $self->{-context}->read_field('TERRAIN',$field);
2477 if ($terrain eq 'WATER' or $terrain eq 'ISLE'){
2478 Util::log("... accepted water retreat to $terrain!",1);
2479 push @retreat_water_fields, $field;
2481 Util::log("... accepted land retreat to $terrain!",1);
2482 push @retreat_fields, $field;
2486 # $self->{-retreat_fields} = \@retreat_fields;
2487 # $self->{-retreat_water_fields} = \@retreat_fields;
2493 if($#retreat_water_fields >= 0){
2494 $self->{-retreat_arks} = {}; # TODO Performance: use only hashes, no arrays
2495 for my $m (@{$self->{-mobiles}}){
2496 my ($id,$type,$own,$count,$stat) = @$m;
2497 next unless $type eq 'ARK' and ($own == $self->{-looser});
2499 my $retreat_field = $self->find_retreat_field(\@retreat_water_fields);
2500 Util::log("found ark $id from $own for retreat to $retreat_field",1);
2502 $self->{-retreat_arks}->{$retreat_field} = $id;
2503 $arks{$id} = $retreat_field;
2505 if (not Util::is_in($retreat_field,@retreat_fields)){
2506 push @retreat_fields, $retreat_field;
2507 Util::log("... accepted retreat through ark $id to $retreat_field!",1);
2511 # all arks change owner to winner
2512 $self->{-db}->update_hash('MOBILE',
2513 "GAME=$self->{-game} AND ".
2514 "LOCATION=$self->{-location} AND ".
2516 {'OWNER' => $self->{-winner}});
2517 Util::log("All arks in $self->{-location} change owner to $self->{-winner}",1);
2521 # for every unit of this looser
2522 for my $mob (@{$self->{-mobiles}}){
2523 my ($id,$type,$own,$count,$stat) = @$mob;
2524 next unless $own == $looser;
2525 next if $type eq 'ARK';
2527 # if there is a way out
2528 if($#retreat_fields >= 0){
2529 my $field = $self->find_retreat_field(\@retreat_fields);
2530 Util::log("checking retreat for mobile $id ".
2531 "(own: $own, type: $type, count: $count, field: $field)",1);
2532 $self->retreat_unit($id,$count,$field,$type);
2535 $self->{-db}->delete_from('MOBILE',"ID=$id");
2536 $self->{-run_or_die}->{$id} = 1;
2539 ->send_message_to_field
2540 ($self->{-location},
2542 'MSG_TAG' => 'MSG_FIGHT_RETREAT_DIE',
2543 'ARG1' => $self->{-context}->charname($looser),
2545 'ARG3' => $self->{-location},
2546 'ARG4' => $count});#,$looser,$self->{-winner});
2547 Util::log("$looser looses $count $type in $self->{-location}".
2548 " because there is no place to retreat.",1);
2551 # MOVE COMMANDS for arks came last because others move with them
2552 for my $mob (@{$self->{-mobiles}}){
2553 my ($id,$type,$own,$count,$stat) = @$mob;
2554 next unless $own == $looser;
2555 next unless $type eq 'ARK';
2556 Util::log("checking retreat for mobile $id ".
2557 "(own: $own, type: $type, count: $count, ".
2558 "via ark $id to field: $arks{$id})",1);
2560 $self->retreat_unit($id,$count,$arks{$id},$type);
2565 my($self,$type) = @_;
2567 # return $::conf->{-SEE_FIGHT}->{"-$type"} if $self->{-naval_battle};
2568 # return $::conf->{-ISLAND_FIGHT}->{"-$type"} if $self->{-island_battle};
2569 return $::conf->{-FIGHT}->{"-$type"};
2573 # End of FIGHT_EARTHLING
2575 ####################################################
2577 ##########################################################
2583 @BLESS_HERO::ISA = qw(AymCommand);
2586 # this is called to see if the command is executable.
2587 # it should be called from first_phase() and from second_phase().
2588 # it is not called from the scheduler
2592 my @required_arguments = ('MOBILE','COUNT');
2593 return 0 unless $self->Command::is_valid(@required_arguments);
2595 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2597 return 0 unless $self->validate_role('GOD');
2599 my $mobtype = $self->{-mob}->{'TYPE'};
2600 my $mobloc = $self->{-mob}->{'LOCATION'};
2601 my $mobcount = $self->{-mob}->{'COUNT'};
2603 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
2605 $self->{-context}->mobile_string($mobtype,1),
2608 $self->{-count} = $self->{-args}->{'COUNT'} > $mobcount ?
2609 $mobcount : $self->{-args}->{'COUNT'};
2611 return 0 unless $self->test_mana('BLESS_HERO',$self->{-count});
2616 # this is called from Scheduler, if he see the command the
2617 # first time, some commands execute here immidiatly.
2622 return 0 unless $self->is_valid();
2625 my $id = $self->{-mob}->{'ID'};
2626 $self->conditional_split_mobile($self->{-mob},
2628 {'ADORING' => $self->{-player},
2630 'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
2633 # reread mobile, because split destroys it
2634 $self->{-mob} = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
2635 $self->unify_mobiles($self->{-mob},
2636 $self->{-mob}->{'LOCATION'},
2637 $self->{-mob}->{'OWNER'});
2640 # ->send_message_to_field
2641 # ($self->{-mob}->{'LOCATION'},
2643 # 'MSG_TAG' => 'MSG_BLESS_HERO',
2644 # 'ARG1' => $self->{-context}->charname($self->{-player}),
2645 # 'ARG2' => $self->{-context}->charname($self->{-mob}->{'OWNER'}),
2646 # 'ARG3' => $self->{-mob}->{'LOCATION'}});
2649 $self->setDuration(0);
2654 # this is called from scheduler when the command will be executed
2657 Util::log("BLESS_HERO should not have a second phase!",0);
2664 ####################################################
2666 ##########################################################
2672 @CH_ACTION::ISA = qw(AymCommand);
2675 # this is called to see if the command is executable.
2676 # it should be called from first_phase() and from second_phase().
2677 # it is not called from the scheduler
2681 my @required_arguments = ('ACTION','MOBILE');
2682 return 0 unless $self->Command::is_valid(@required_arguments);
2684 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2686 return 0 unless $self->validate_role('GOD');
2688 my $mobtype = $self->{-mob}->{'TYPE'};
2689 my $mobloc = $self->{-mob}->{'LOCATION'};
2691 return 0 unless $self->test(sub{$mobtype eq 'AVATAR'},
2693 $self->{-context}->mobile_string($mobtype,1),
2699 # this is called from Scheduler, if he see the command the
2700 # first time, some commands execute here immidiatly.
2705 return 0 unless $self->is_valid();
2707 my $mob = $self->{-mob};
2708 my $loc = $mob->{'LOCATION'};
2709 my $own = $self->{-player};
2710 my $action = $self->{-args}->{'ACTION'};
2712 # all avatars in the field get the new status
2713 $self->{-db}->update_hash('MOBILE',
2714 "LOCATION=$loc AND TYPE=AVATAR AND OWNER=$own ".
2715 "AND GAME=$self->{-game} AND AVAILABLE=Y",
2716 {'STATUS' => $action});
2718 $mob->{'STATUS'} = $action;
2719 $self->enter_field_avatar($loc,$mob) if $action eq 'BLOCK';
2722 # ->send_message_to_field
2723 # ($self->{-mob}->{'LOCATION'},
2725 # 'MSG_TAG' => 'MSG_CH_ACTION',
2726 # 'ARG1' => $self->{-args}->{'ACTION'},
2727 # 'ARG2' => $self->{-mob}->{'LOCATION'}});
2729 $self->setDuration(0);
2733 # this is called from scheduler when the command will be executed
2736 Util::log("CH_ACTION should not have a second phase!",0);
2743 ####################################################
2745 ####################################################
2747 # DIE_ORDER: Change the order of mobiletypes which dies in battle
2751 @DIE_ORDER::ISA = qw(AymCommand);
2756 my @required_arguments = ('DYING');
2757 return 0 unless $self->Command::is_valid(@required_arguments);
2759 return 0 unless $self->validate_role('EARTHLING');
2761 # TODO: use test with message
2762 return 0 unless Util::is_in($self->{-args}->{'DYING'},
2763 'PKH','PHK','KPH','KHP','HKP','HPK');
2771 return 0 unless $self->is_valid();
2773 my $dying = $self->{-args}->{'DYING'};
2775 $self->{-db}->update_hash('EARTHLING',
2776 "GAME=$self->{-game} AND ".
2777 "PLAYER=$self->{-player}",
2778 {'DYING' => $dying});
2780 $self->{-context}->send_message_to_me({'MFROM' => 0,
2781 'MSG_TAG' => 'MSG_DIE_ORDER',
2784 Util::log("New die order for player $self->{-player}: $dying",1);
2786 $self->setDuration(0);
2792 Util::log("Warning: We should not reach phase 2 with command DIE_ORDER",0);
2799 ################################################################
2802 ##########################################################
2808 @CH_LUCK::ISA = qw(AymCommand);
2811 # this is called to see if the command is executable.
2812 # it should be called from first_phase() and from second_phase().
2813 # it is not called from the scheduler
2817 my @required_arguments = ('BONUS');
2818 return 0 unless $self->Command::is_valid(@required_arguments);
2820 return 0 unless $self->validate_role('GOD');
2822 return 1 if $self->{-phase} == 2;
2824 return 0 unless $self->test_mana('CH_LUCK',
2825 abs($self->{-args}->{'BONUS'} * $::conf->{-MANA}->{-CH_LUCK}));
2830 # this is called from Scheduler, if he see the command the
2831 # first time, some commands execute here immidiatly.
2836 return 0 unless $self->is_valid();
2840 return $self->setDuration($::conf->{-DURATION}->{-CH_LUCK});
2843 # this is called from scheduler when the command will be executed
2846 return 0 unless $self->is_valid();
2847 my $oldfortune = $self->{-context}->read_fortune();
2849 my $change = $self->{-args}->{'BONUS'};
2851 my $newfortune = $oldfortune + $change;
2852 if($newfortune > $::conf->{-MAX_LUCK}){
2853 $newfortune = $::conf->{-MAX_LUCK};
2854 }elsif($newfortune < $::conf->{-MIN_LUCK}){
2855 $newfortune = $::conf->{-MIN_LUCK};
2858 $self->{-db}->update_hash('GAME',
2859 "GAME=$self->{-game}",
2860 {'FORTUNE' => $newfortune});
2863 ->send_message_to_all
2865 'MSG_TAG' => 'MSG_CHANGE_FORTUNE',
2866 'ARG1' => $self->{-context}->charname($self->{-player}),
2867 'ARG2' => $oldfortune,
2868 'ARG3' => $newfortune});
2877 ####################################################
2879 ##########################################################
2885 @FLOOD::ISA = qw(AymCommand);
2888 # this is called to see if the command is executable.
2889 # it should be called from first_phase() and from second_phase().
2890 # it is not called from the scheduler
2893 my $db = $self->{-db};
2894 my $context = $self->{-context};
2895 my $loc = $self->{-location};
2897 my @required_arguments = ();
2898 return 0 unless $self->Command::is_valid(@required_arguments);
2900 return 0 unless $self->validate_role('GOD');
2902 # only PLAIN and MOUNTAIN can be flooded
2903 my ($terrain) = $context->read_field('TERRAIN', $loc);
2904 return 0 unless $self->test(sub{Util::is_in($terrain,'PLAIN','MOUNTAIN');},
2905 'MSG_CANT_FLOOD_TERRAIN',
2908 $self->{-terrain} = $terrain;
2913 # this is called from Scheduler, if he see the command the
2914 # first time, some commands execute here immidiatly.
2919 return 0 unless $self->is_valid();
2921 my $loc = $self->{-location};
2923 # need own avatar to flood
2924 return 0 unless $self->avatar_available($loc);
2925 return 0 unless $self->test_mana('FLOOD');
2928 $self->setDuration($::conf->{-DURATION}->{-FLOOD});
2930 $self->event($self->{-location},
2934 return $self->{-duration};
2937 # this is called from scheduler when the command will be executed.
2941 my $loc = $self->{-location};
2942 my $db = $self->{-db};
2944 return 0 unless $self->is_valid();
2946 # mountain -> isle, plain -> water
2947 my $new = $self->{-terrain} eq 'MOUNTAIN' ? 'ISLE' : 'WATER';
2948 $db->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
2949 {'TERRAIN' => $new});
2951 # drowning of mobiles if necessary
2952 $self->drowning($loc);
2956 ->send_message_to_field
2957 ($loc,{'MFROM' => 0,
2958 'MSG_TAG' => 'MSG_FLOOD',
2959 'ARG1' => $self->{-context}->charname($self->{-player}),
2961 'ARG3' => $self->{-terrain},
2970 ####################################################
2972 ##########################################################
2978 @DESTROY::ISA = qw(AymCommand);
2981 # this is called to see if the command is executable.
2982 # it should be called from first_phase() and from second_phase().
2983 # it is not called from the scheduler
2986 my $db = $self->{-db};
2987 my $context = $self->{-context};
2988 my $loc = $self->{-location};
2990 my @required_arguments = ();
2991 return 0 unless $self->Command::is_valid(@required_arguments);
2993 return 0 unless $self->validate_role('GOD');
2995 return 0 unless $self->test_mana('DESTROY');
2997 # we cant destroy if there is only one temple unbuild
2998 # TODO: wrong. should be cant destroy, if last temple is under construction
2999 my $unbuild = $db->count('MAP',
3000 "(TERRAIN=ISLE OR TERRAIN=MOUNTAIN) ".
3001 "AND TEMPLE=N AND GAME=$self->{-game}");
3002 return 0 unless $self->test(sub{$unbuild > $::conf->{-MAX_UNBUILD_DESTROY}},
3003 'MSG_CANT_RESCUE_WORLD',
3007 # need own avatar to destroy
3008 return 0 unless $self->avatar_available($loc);
3010 # there sould be no foreign priests
3011 my $foreign_priests = $db->count('MOBILE',
3012 "GAME=$self->{-game} AND ".
3013 "LOCATION=$loc AND TYPE=PRIEST AND ".
3014 "ADORING!=$self->{-player} AND ".
3016 return 0 unless $self->test(sub{$foreign_priests == 0},
3017 'MSG_CANT_DESTROY_DEFENDED',
3020 my ($terrain,$temple,$home) = $context->read_field('TERRAIN,TEMPLE,HOME',
3023 # only if temple exists
3024 return 0 unless $self->test(sub{$temple eq 'Y'},
3025 'MSG_NO_TEMPLE_TO_DESTROY',
3028 # only destroy foreign temples
3029 return 0 unless $self->test(sub{$home != $self->{-player}},
3030 'MSG_CANT_DESTROY_OWN',
3032 $self->{-oldgod} = $home;
3035 return 0 unless $self->test(sub{$terrain eq 'ISLE'},
3036 'MSG_CANT_DESTROY_MOUNTAINS',
3042 # this is called from Scheduler, if he see the command the
3043 # first time, some commands execute here immidiatly.
3047 my $loc = $self->{-location};
3049 return 0 unless $self->is_valid();
3053 $self->{-db}->update_hash('MAP',
3054 "LOCATION=$loc AND GAME=$self->{-game}",
3058 # delete PRAY- and PRODUCE-commands and PRODUCE-PRIEST event
3059 $self->{-db}->delete_from('COMMAND',
3060 "(COMMAND=PRODUCE OR COMMAND=PRAY) ".
3061 "AND LOCATION=$loc AND GAME=$self->{-game}");
3062 $self->{-db}->delete_from('EVENT',
3063 "TAG=EVENT_PRODUCE_PRIEST ".
3064 "AND LOCATION=$loc AND GAME=$self->{-game}");
3067 ->send_message_to_field
3070 'MSG_TAG' => 'MSG_TEMPLE_DESTROYD',
3072 'ARG2' => $self->{-context}->charname($self->{-oldgod}),
3073 'ARG3' => $self->{-context}->charname($self->{-player})
3076 Util::log("Temple of $self->{-oldgod} destroyed in $self->{-location}",1);
3078 $self->setDuration(0);
3083 # this is called from scheduler when the command will be executed
3086 Util::log("DESTROY should not have a second phase!",0);
3093 ####################################################
3095 ##########################################################
3101 @MOVE_WITH::ISA = qw(AymCommand);
3104 # this is called to see if the command is executable.
3105 # it should be called from first_phase() and from second_phase().
3106 # it is not called from the scheduler
3110 my @required_arguments = ('MOBILE','COUNT','TARGET');
3111 return 0 unless $self->Command::is_valid(@required_arguments);
3113 my $args = $self->{-args};
3114 my $count = $args->{'COUNT'};
3116 # TODO: more messages
3118 return 0 unless $self->validate_mobile($args->{'MOBILE'});
3119 my $mob = $self->{-mob};
3121 # arks cant move with other units
3122 return 0 if $self->{-mob}->{'TYPE'} eq 'ARK';
3124 return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
3125 $mob->{'AVAILABLE'} eq 'Y'},
3126 'MSG_NOT_ENOUGH_MOBILES',
3129 $mob->{'LOCATION'});
3134 # this is called from Scheduler, if he see the command the
3135 # first time, some commands execute here immidiatly.
3140 return 0 unless $self->is_valid();
3142 my $args = $self->{-args};
3144 $self->move_with($args->{'MOBILE'},$args->{'TARGET'},$args->{'COUNT'});
3149 # this is called from scheduler when the command will be executed
3152 Util::log("MOVE_WITH should not have a second phase!",0);
3159 ####################################################
3161 ##########################################################
3166 # TODO: should be in FROGS/Command.pm
3169 @SEND_MSG::ISA = qw(AymCommand);
3172 # this is called to see if the command is executable.
3173 # it should be called from first_phase() and from second_phase().
3174 # it is not called from the scheduler
3178 my @required_arguments = ('OTHER','MESSAGE');
3179 return 0 unless $self->Command::is_valid(@required_arguments);
3184 # this is called from Scheduler, if he see the command the
3185 # first time, some commands execute here immidiatly.
3190 return 0 unless $self->is_valid();
3192 my $args = $self->{-args};
3194 Util::log("send message from $self->{-player} to $args->{'OTHER'}.",1);
3196 my $msg = $args->{'MESSAGE'};
3198 # uggly workaround necessary for Command::parse_args()
3199 $msg =~ s/__COMMA__/,/g;
3200 $msg =~ s/__EQUAL__/=/g;
3201 # newline should be in html
3202 $msg =~ s/\\r\\n/<br>/g;
3204 $self->{-context}->send_message_to($args->{'OTHER'},
3205 {'MFROM' => $self->{-player},
3206 'MSG_TEXT' => $msg});
3211 # this is called from scheduler when the command will be executed
3214 Util::log("SEND_MSG should not have a second phase!",0);
3221 ####################################################
3223 ##########################################################
3230 @FIGHT_GOD::ISA = qw(AymCommand);
3232 # this is called to see if the command is executable.
3233 # it should be called from first_phase() and from second_phase().
3234 # it is not called from the scheduler
3238 my @required_arguments = ('A','B');
3239 return 0 unless $self->Command::is_valid(@required_arguments);
3241 my $A = $self->{-args}->{'A'};
3242 my $B = $self->{-args}->{'B'};
3243 my $loc = $self->{-dbhash}->{'LOCATION'};
3245 # dont accept a new FIGHT_GOD if there is allready a fight between the same gods
3246 my $fights = $self->{-db}->select_array('COMMAND','ARGUMENTS',
3247 "GAME=$self->{-game} AND ".
3248 "COMMAND=FIGHT_GOD AND ".
3249 "ID != $self->{-dbhash}->{'ID'} AND ".
3251 for my $f (@$fights){
3252 my $args = $self->parse_args($f->[0]);
3254 if( $args->{'A'} == $A and $args->{'B'} == $B){
3255 Util::log("there is allready such a fight between $A and $B in $loc.",1);
3260 # could not work, command can be inserted from earthling.
3261 # return 0 unless $self->validate_role('GOD');
3263 # return 0 unless $self->validate_this_role($self->{-args}->{'A'},'GOD');
3264 # return 0 unless $self->validate_this_role($self->{-args}->{'B'},'GOD');
3269 # this is called from Scheduler, if he sees the command the
3270 # first time, some commands execute here immidiatly.
3275 return 0 unless $self->is_valid();
3277 # calculate duration
3278 $self->setDuration($::conf->{-DURATION}->{-FIGHT_GOD});
3280 # set GOD_ATTACKER in MAP to COMMAND.ID
3281 $self->{-db}->update_hash('MAP',
3282 "LOCATION=$self->{-location} AND ".
3283 "GAME=$self->{-game}",
3284 {'GOD_ATTACKER' => $self->{-dbhash}->{'ID'}});
3286 $self->event($self->{-location},
3288 $self->{-context}->charname($self->{-args}->{'A'}),
3289 $self->{-context}->charname($self->{-args}->{'B'}),
3292 return $self->{-duration};
3295 # this is called from scheduler when the command will be executed.
3300 return 0 unless $self->is_valid();
3302 # read info from map
3303 my ($earthlingfight,$earthling);
3304 ($earthlingfight, $self->{-god_attacker}, $earthling) =
3305 $self->{-context}->read_field(
3306 'ATTACKER,GOD_ATTACKER,OCCUPANT', $self->{-location}
3309 # suspend FIGHT until end of FIGHT_GOD if any
3310 # REWRITE: suspend of avatar fight have to be encapsulated
3311 if($earthlingfight){
3312 ## REWRITE: SQL: sort events up to time, limit output to ONE
3313 # read all earthling-events for this field.
3314 my @events = @{$self->{-db}->select_array('EVENT','ID,TIME',
3315 "GAME=$self->{-game} AND ".
3316 "LOCATION=$self->{-location} AND ".
3317 "TAG=FIGHT_EARTHLING")};
3318 # which one is the latest?
3319 my ($late_time, $late_id) = (0,0);
3320 for my $ev (@events){
3321 my ($id, $time) = @$ev;
3322 my $ev_time = &::str2time($time,'GMT');
3323 Util::log("found FIGHT_EARTHLING with time $time",1);
3324 ($late_time, $late_id) = ($ev_time, $id) if $ev_time > $late_time;
3327 # insert new godfight with one second more.
3328 # TODO: use here the new AFTER-System instead
3329 my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($late_time + 1);
3330 $late_time = sprintf ("%04u-%02u-%02u %02u:%02u:%02u",
3331 $year,$month,$day, $hour,$min,$sec);
3332 Util::log("found earthling fight! suspend godfight until $late_time",1);
3333 $self->{-context}->insert_command('FIGHT_GOD',
3334 "A=$self->{-args}->{'A'}, ".
3335 "B=$self->{-args}->{'B'}",
3339 $self->{-db}->update_hash('EVENT',
3340 "COMMAND_ID=$self->{-dbhash}->{'ID'}",
3341 {'TIME' => $late_time});
3342 $self->stop_fight();
3346 # get all mobiles here
3347 my $mobiles = $self->{-context}->read_mobile_condition(
3348 'ID,OWNER,COUNT,TYPE',
3349 "LOCATION=$self->{-location} "."AND AVAILABLE=Y"
3351 $self->{-mobiles} = $mobiles;
3353 my $A = $self->{-args}->{'A'};
3354 my $B = $self->{-args}->{'B'};
3355 my ($avatars_A, $avatars_B) = (0,0);
3357 # for every avatar-unit in the field
3358 # REWRITE: this block tries to count the opposing avatars: simplify!
3359 for my $a (@$mobiles){
3360 my ($id,$own,$count,$type) = @$a;
3361 next unless $type eq 'AVATAR';
3363 Util::log("found $count avatar(s) from $own with id $id",1);
3365 # determine side of owner
3366 my $side = $self->which_side($own);
3368 # calculate strength_of_side
3370 $avatars_A += $count;
3371 }elsif($side eq 'B'){
3372 $avatars_B += $count;
3376 my $mana = $::conf->{-MANA}->{-FIGHT_AVATAR};
3377 my $mana_A = $self->instant_use_mana($mana,$A);
3378 my $mana_B = $self->instant_use_mana($mana,$B);
3379 my $strength_A = $avatars_A * $::conf->{-FIGHT}->{-AVATAR};
3380 my $strength_B = $avatars_B * $::conf->{-FIGHT}->{-AVATAR};
3382 # TODO?: message in this case
3383 unless($mana_A >= $mana){
3384 Util::log("$A has not enough mana left to fight",1);
3387 unless($mana_B >= $mana){
3388 Util::log("$B has not enough mana left to fight",1);
3392 # swl: Strength_Without_Luck strenght_X: Strenght_with_luck
3393 my ($swlA,$swlB) = ($strength_A,$strength_B);
3395 # add random value (1 to GAME.FORTUNE)
3396 my $fortune = $self->{-context}->read_fortune();
3397 Util::log("avatarfight in $self->{-location}: strength without fortune player $A: ".
3398 "$strength_A, player $B: $strength_B",1);
3399 $strength_A += int(rand($fortune))+1;
3400 $strength_B += int(rand($fortune))+1;
3401 Util::log("strength with fortune player $A: ".
3402 "$strength_A, player $B: $strength_B",1);
3404 # how much avatars should die?
3405 my ($dead_A,$dead_B) = (0,0);
3406 my ($winner,$looser) = (0,0);
3408 if( ($strength_A > $strength_B && $mana_A) or
3409 $mana_A && !$mana_B )
3411 Util::log("$A wins!",1);
3412 $winner = $A; $looser = $B;
3413 ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B);
3415 elsif( ($strength_B > $strength_A && $mana_B) or
3416 $mana_B && !$mana_A )
3418 Util::log("$B wins!",1);
3419 $winner = $B; $looser = $A;
3420 ($dead_B, $dead_A) = _calc_dead_avatars($avatars_B, $avatars_A);
3424 Util::log("Both sides looses!",1);
3425 ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B, 'drawn');
3428 my ($new_heros_A, $new_heros_B) = (0,0);
3429 $new_heros_A = $self->die($A, $dead_A, $earthling) if $dead_A;
3432 $self->{-mobiles} = $self->{-context}->
3433 read_mobile_condition('ID,OWNER,COUNT,TYPE',
3434 "LOCATION=$self->{-location} ".
3437 $new_heros_B = $self->die($B,$dead_B,$earthling) if $dead_B;
3439 # surviving loosers go home
3441 $self->teleport($looser);
3443 # both sides are looser!
3444 $self->teleport($A);
3445 $self->teleport($B);
3448 $self->stop_fight();
3450 my $earthling_name = $self->{-context}->charname($earthling);
3451 my $name_of_A = $self->{-context}->charname($A);
3452 my $name_of_B = $self->{-context}->charname($B);
3453 my $asf = $strength_A - $swlA;
3454 my $dsf = $strength_B - $swlB;
3455 $winner = $winner ? $self->{-context}->charname($winner) : 'NOBODY';
3457 my $text = <<END_OF_TEXT;
3458 <strong>BATTLE_REPORT $self->{-location}</strong><br>
3459 <table><tr><th></th><th>$name_of_A</th><th>$name_of_B</th></tr>
3460 <tr><td>MOBILE_AVATAR_PL</td><td>$avatars_A</td><td>$avatars_B</td></tr>
3461 <tr><td>FIGHTING_STRENGTH</td><td>$swlA</td>
3463 <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
3464 <tr><td>SUM_OF_STRENGTH</td><td>$strength_A</td><td>$strength_B</td></tr>
3465 <tr><td>DEAD_AVATARS</td><td>$dead_A</td>
3466 <td>$dead_B</td></tr>
3467 <tr><td>NEW_HEROS $earthling_name</td><td>$new_heros_A</td>
3468 <td>$new_heros_B</td></tr>
3470 <strong>WINNER_IS $winner</strong>.
3473 $self->{-context}->send_message_to_field(
3475 {'MFROM' => 0, 'MSG_TEXT' => $text}
3479 # _calc_dead_avatars
3480 # Calculates number of dead avatars on winner's and looser's side.
3483 # - # winner avatars
3484 # - # looser avatars
3485 # - drawn [OPTIONAL, boolean]
3488 # - # dead winner avatars
3489 # - # dead looser avatars
3491 sub _calc_dead_avatars
3493 my ($winner, $looser, $drawn) = @_;
3494 my ($dead_winner, $dead_looser) = (0,0);
3496 # the winner counts as looser if the fight is drawn!
3497 if (defined $drawn && $drawn)
3499 $dead_winner = Util::max(
3501 int(0.5 + $looser / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3506 $dead_winner = Util::min(
3508 int(0.5 + $looser / $::conf->{-WINNER_AVATARS_DYING_FRACTION})
3512 $dead_looser = Util::max(
3514 int(0.5 + $winner / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3517 # ensure that there not dying more avatars than existing
3518 $dead_looser = $dead_looser > $looser ? $looser : $dead_looser;
3519 $dead_winner = $dead_winner > $winner ? $winner : $dead_winner;
3521 return ($dead_winner, $dead_looser);
3526 # set MAP.GOD_ATTACKER to 0, if there is our own command-ID
3530 my $own_command = $self->{-dbhash}->{'ID'};
3531 if($own_command == $self->{-god_attacker}){
3532 $self->{-db}->update_hash('MAP',
3533 "LOCATION=$self->{-location} AND ".
3534 "GAME=$self->{-game}",
3535 {'GOD_ATTACKER' => 0});
3540 # teleports all of $god from $loc to location of avatar-creation
3542 my($self,$god) = @_;
3543 my $loc = $self->{-location};
3545 # teleport surviving avatars of looser to home
3546 my $home = $self->{-context}->incarnation_place($god);
3547 Util::log("We teleport all Avatars of $god from $loc to $home.",1);
3549 $self->{-db}->update_hash('MOBILE',
3550 "TYPE=AVATAR AND OWNER=$god AND AVAILABLE=Y AND ".
3551 "LOCATION=$self->{-location}",
3552 {'LOCATION' => $home});
3554 # get all avatar there
3555 my $avatars = $self->{-context}->read_mobile_condition('ID',
3560 # dont call this more than one time!
3561 #for my $avat (@$avatars){
3562 my ($id) = $avatars->[0]->[0];
3563 $self->enter_field_avatar($home,$id);
3568 # kills $to_kill avatars of owner in location and create heros for earthling,
3571 my ($self,$owner,$to_kill,$earthling) = @_;
3572 Util::log("$to_kill avatars from $owner dying.",1);
3574 my $loc = $self->{-location};
3575 my $mobiles = $self->{-mobiles};
3577 my $to_hero = $to_kill;
3578 my $real_to_hero = 0;
3579 for my $a (@$mobiles){
3580 my ($id,$own,$count,$type) = @$a;
3581 if($own eq $owner and $to_kill){
3582 if($count <= $to_kill){
3583 $self->{-db}->delete_from('MOBILE', "ID=$id");
3585 # last unless $to_kill > 0;
3587 $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => ($count - $to_kill)});
3591 # add the strength of the death avatar to gods last battle
3592 #my ($actual) = $self->{-db}->single_select("SELECT DEATH_AVATAR FROM GOD WHERE ".
3593 #"GAME=$self->{-game} AND ".
3594 # # "PLAYER=$owner");
3595 # Util::log("AVATAR dying: adds strength to last-battle-strength of $owner",1);
3596 # $self->{-db}->update_hash('GOD',
3597 # "GAME=$self->{-game} AND PLAYER=$owner",
3598 # {'DEATH_AVATAR' => $actual + 1});
3604 # 'MSG_TAG' => 'MSG_AVATAR_DEAD',
3606 # 'ARG2' => $self->{-context}->charname($owner)});
3607 # Util::log("One avatar of $owner died in $loc.",1);
3609 }elsif($own eq $earthling and $type eq 'WARRIOR' and $to_hero){
3610 if($count <= $to_hero){
3611 $self->{-db}->delete_from('MOBILE', "ID=$id");
3613 $real_to_hero += $count;
3614 # last unless $to_hero > 0;
3616 $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => $count-$to_hero});
3617 $real_to_hero += $to_hero;
3622 last if $to_kill <= 0 and $to_hero <= 0;
3626 my $id = $self->{-db}->find_first_free('MOBILE','ID');
3627 my $mob = {'ID' => $id,
3628 'GAME' => $self->{-game},
3629 'LOCATION' => $self->{-location},
3631 'OWNER' => $earthling,
3632 'COUNT' => $real_to_hero,
3633 'ADORING' => $owner,
3635 'COMMAND_ID' => $self->{-dbhash}->{'ID'},
3637 # $self->{-mob} = $mob;
3638 my %mobcopy = (%$mob);
3639 $self->{-db}->insert_hash('MOBILE',\%mobcopy);
3640 $self->unify_mobiles($id,$self->{-location},$earthling);
3641 Util::log("$real_to_hero warriors from $earthling blessed to hero",1);
3643 return $real_to_hero;
3646 # this function decides on which side other gods fight
3647 # TODO: do we really need this complicated stuff
3649 my($self,$own) = @_;
3651 my $A = $self->{-args}->{'A'};
3652 my $B = $self->{-args}->{'B'};
3655 $side = 'A' if $own == $A;
3656 $side = 'B' if $own == $B;
3659 my $allA = $self->{-context}->simplyfied_single_relation($own,$A);
3660 my $allB = $self->{-context}->simplyfied_single_relation($own,$B);
3661 if ($allA eq $allB) {
3663 } elsif ($allA eq 'FRIEND') {
3665 } elsif ($allB eq 'FRIEND') {
3667 } elsif ($allA eq 'FOE') {
3669 } elsif ($allB eq 'FOE') {
3679 ####################################################
3681 ##########################################################
3687 @PLAGUE::ISA = qw(AymCommand);
3690 # this is called to see if the command is executable.
3691 # it should be called from first_phase() and from second_phase().
3692 # it is not called from the scheduler
3696 my @required_arguments = ('TYPE');
3697 return 0 unless $self->Command::is_valid(@required_arguments);
3700 return 0 unless $self->validate_role('GOD');
3702 # test known plagues
3703 unless(Util::is_in($self->{-args}->{'TYPE'},@{$::conf->{-PLAGUES}})){
3704 Util::log("wrong type of plague: $self->{-args}->{'TYPE'}",0);
3711 # this is called from Scheduler, if he see the command the
3712 # first time, some commands execute here immidiatly.
3717 return 0 unless $self->is_valid();
3719 my $args = $self->{-args};
3720 my $loc = $self->{-dbhash}->{'LOCATION'};
3721 my $type = $args->{'TYPE'};
3722 my $spread = $args->{'SPREAD'};
3723 my $context = $self->{-context};
3725 my ($plague,$terrain) = $context->read_field('PLAGUE,TERRAIN', $loc);
3726 $plague = '' unless defined $plague;
3728 Util::log("old plague: $plague",1);
3730 # if plagu not allready here
3731 unless($plague =~ /$type/){
3734 # need own avatar to plague
3735 return 0 unless $self->avatar_available($loc);
3737 if($self->test_mana($type,1)){
3743 Util::log("new plague in $loc: $type",1);
3746 my $new_plague = $plague ? "$plague,$type" : $type;
3747 $self->{-db}->update_hash('MAP',
3748 "GAME=$self->{-game} AND ".
3750 {'PLAGUE' => $new_plague});
3752 Util::log("plague $type is allready in $loc.",1);
3753 # stop if there is another plague command in location of same type.
3754 # TODO: simplify this with a LIKE-clause,
3755 # but: we have to rewrite quote_condition() first :-(
3756 my $commands = $self->{-db}->select_array('COMMAND',
3758 "COMMAND=PLAGUE AND ".
3759 "GAME=$self->{-game} AND ".
3760 "LOCATION=$loc AND ".
3761 "ID != $self->{-dbhash}->{'ID'}");
3762 for my $c (@$commands){
3763 my ($args,$id) = @$c;
3764 # next if $id == $self->{-dbhash}->{'ID'};
3765 if($args =~ /$type/){
3766 Util::log("There is allready another PLAGUE-command of $type in $loc",1);
3772 $self->setDuration($::conf->{-DURATION}->{-PLAGUE});
3773 return $self->{-duration};
3776 # this is called from scheduler when the command will be executed
3780 my $loc = $self->{-dbhash}->{'LOCATION'};
3781 my $type = $self->{-args}->{'TYPE'};
3782 my $context = $self->{-context};
3784 # heal plague with priests
3785 my $priests = $context->count_mobile('PRIEST',$loc);
3786 my $heal_prob = $priests ? 1 - 1/$priests * $::conf->{-HEAL_PLAGUE} : 0;
3787 Util::log("Heal probability: $heal_prob",1);
3788 if($heal_prob > rand(1)){
3789 Util::log("heal plague of type $type in $loc",1);
3790 my ($plague) = $context->read_field('PLAGUE,TERRAIN', $loc);
3791 if(defined $plague){
3792 $plague =~ s/$type//;
3793 $self->{-db}->update_hash('MAP',
3794 "GAME=$self->{-game} AND LOCATION=$loc",
3795 {'PLAGUE' => $plague});
3798 # spread plague to neighbour-fields
3799 my @neighbours = $self->get_neighbours();
3800 for my $field (@neighbours){
3801 my ($terrain,$owner) = $context->read_field('TERRAIN,OCCUPANT',$field);
3802 # $self->{-occ} = $owner;
3803 if(rand(1) < $::conf->{-SPREAD_PLAGUE}->{$terrain}){
3804 Util::log("spread $type from $loc to $field",1);
3805 $context->insert_command('PLAGUE',"TYPE=$type, SPREAD=1",$field);
3810 $self->do_it_again({'SPREAD' => 1});
3819 my $context = $self->{-context};
3821 my $type = $self->{-args}->{'TYPE'};
3822 Util::log("Do effect of type $type.",1);
3824 my $loc = $self->{-dbhash}->{'LOCATION'};
3826 # effect of INFLUENZA is done in PRODUCE
3827 if($type eq 'PESTILENTIA'){
3828 my ($vic) = $context->read_field('OCCUPANT',$loc);;
3830 # count people of owner in field
3831 my $people = $context->count_people($loc,$vic);
3832 $people = 0 unless defined $people;
3833 Util::log("$people people from $vic counted in $loc.",1);
3834 my $victims = int($people * $::conf->{-PESTILENTIA_DEATH_SHARE});
3835 Util::log("$victims from them have to die.",1);
3836 return unless $victims;
3838 $self->{-mobiles} = $context->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
3839 0, $self->{-location}, 1);
3841 $self->casualties($vic,$victims,1);
3844 my $name_of_victim = $context->charname($vic);
3845 my $text = <<END_OF_TEXT;
3846 <strong>CASUALTIES_OF_PESTILENTIA $self->{-location} $name_of_victim</strong><br>
3847 <table><tr><th></th><th></th></tr>
3848 <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$vic}->{'K'}</td></tr>
3849 <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$vic}->{'H'}</td></tr>
3850 <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$vic}->{'P'}</td></tr>
3851 <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$vic}->{'A'}</td></tr>
3855 $context->send_message_to_field
3856 ($self->{-location},{'MFROM' => 0,
3857 'MSG_TEXT' => $text}
3858 # 'ARG1' => $self->{-context}->charname($attacker),
3859 # 'ARG2' => $self->{-context}->charname($defender),
3860 # 'ARG3' => $self->{-context}->charname($self->{-winner}),
3861 # 'ARG4' => $self->{-location}}
3863 #,$attacker,$defender,@gods);
3865 Util::log("no effect",1);
3872 ####################################################