2 ##########################################################################
4 # Copyright (c) 2003 Aymargeddon Development Team
6 # This file is part of "Last days of Aymargeddon"
8 # Aymargeddon is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by the Free
10 # Software Foundation; either version 2 of the License, or (at your option)
13 # Aymargeddon is distributed in the hope that it will be useful, but WITHOUT
14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
17 # You should have received a copy of the GNU General Public License along
18 # with this program; if not, write to the Free Software Foundation, Inc., 675
19 # Mass Ave, Cambridge, MA 02139, USA.
21 ###########################################################################
25 # Aymargeddon specific command clsses used by the scheduler
26 # generic FROGS-Command is in FROGS/Command.pm
34 ##########################################################
36 # Base Class for Aymargeddon specific commands
41 @AymCommand::ISA = qw(Command);
46 $self->{-context}->send_message_to_all({'MFROM' => 0,
47 'MSG_TAG' => 'END_OF_GAME'});
49 Util::log("*****************************\n" .
50 "*** End of the Game! ***\n" .
51 "*****************************",0);
53 $self->{-db}->update_hash('GAME',
54 "GAME=$self->{-game}",
61 my ($self,$loc,$god) = @_;
62 $god = $self->{-player} unless defined $god;
63 return $self->{-context}->avatar_available($loc,$god,$self->{-class});
66 # just another wrapper
69 $loc = $self->{-dbhash}->{'LOCATION'} unless defined $loc;
71 my $map = HexTorus->new($self->{-context}->get_size());
72 my $location = Location->from_string($loc);
73 my @neighbours = $map->neighbours($location);
74 return map {$_ = $_->to_string();} @neighbours;
77 # FIGHT_EARTHLING and Pestilenz
79 my ($self,$victim,$death_count,$no_conquer) = @_;
80 $self->{-looser} = $victim unless defined $self->{-looser};
82 unless(defined $no_conquer){
83 $other = ($victim != $self->{-winner}) ? $self->{-winner} : $self->{-looser};
86 Util::log("death_count for $victim: $death_count",1);
88 $self->{-dead}->{$victim} = {'A' => 0,
92 'C' => 0}; # conquered arks
94 return unless $death_count;
96 my $dying = $::conf->{-DEFAULT_DYING};
97 unless($self->{-looser} < 0){
98 my $earthling = $self->{-db}->single_hash_select('EARTHLING',
99 "PLAYER=$self->{-looser} AND ".
100 "GAME=$self->{-game}");
101 $dying = $earthling->{'DYING'};
104 my $big_dying = {'P' => 'PRIEST',
109 # print Dumper $dying;
111 # rearrange mobiles in a hash
112 # TODO PERFORMANCE,DESIGN: we should have read $self->{-mobiles}
113 # as a hash from database earlier, should be better in all cases.
114 my %victims_mobiles = ();
115 for my $mob (@{$self->{-mobiles}}){
116 my ($id,$type,$own,$count,$stat) = @$mob;
117 next unless $own == $victim;
118 $victims_mobiles{$id} = $mob;
121 # print Dumper \%victims_mobiles;
123 my ($row, $carry, $share, $conquered_arks) = (0,0,0,0);
124 my $to_kill = $death_count;
125 my @small_dying = split //,$dying;
126 while(int($to_kill) > 0 and %victims_mobiles){
127 my $small_dying = $small_dying[$row];
128 # for my $small_dying (split //,$dying){
129 $carry += $death_count * $::conf->{-DEATH_SHARE_ROW}->[$row];
130 $share = int($carry);
132 $share = $to_kill if($share > $to_kill);
134 Util::log("type: $small_dying, share: $share, carry: $carry, to_kill: $to_kill",2);
136 while( my ($key,$value) = each %victims_mobiles){
137 my ($id,$type,$own,$count,$stat) = @$value;
138 # next unless $own == $victim;
139 next unless $type eq $big_dying->{$small_dying};
140 Util::log("id: $id, count: $count, share: $share, ".
141 "carry: $carry, to_kill: $to_kill",2);
143 my $dead_men = Util::min($count,$share);
144 $self->{-dead}->{$victim}->{$small_dying} += $dead_men;
145 if($small_dying eq 'H'){
146 # dead heros fights for gods in last battle
147 my ($god) = $self->{-context}->get_mobile_info($id,'ADORING');
148 Util::log("adored god: $god",1);
149 my ($actual) = $self->{-db}->single_select("SELECT DEATH_HERO FROM GOD WHERE ".
150 "GAME=$self->{-game} AND ".
152 Util::log("HERO dying: adds $dead_men heros ".
153 "to last-battle-strength of $god",1);
154 $self->{-db}->update_hash('GOD',
155 "GAME=$self->{-game} AND PLAYER=$god",
156 {'DEATH_HERO' => $actual + $dead_men});
157 }elsif($small_dying eq 'A' and $victim == $self->{-looser}
158 and not defined $no_conquer){
159 # special case ark (can change owner)
160 my $random_value = rand($dead_men);
161 Util::log("random value of $dead_men: $random_value",1);
162 $conquered_arks = int($random_value+0.5);
163 # $dead_men -= $conquered_arks;
164 Util::log("ark in battle: $conquered_arks change owner to $other, ".
165 "$dead_men arks sinking or conquered.",1);
166 $self->{-dead}->{$victim}->{'C'} += $conquered_arks;
169 if($count > $dead_men){
170 my $new_count = $count - $dead_men;
171 $self->{-db}->update_hash('MOBILE',
173 {'COUNT' => $new_count});
174 $victims_mobiles{$id}->[3] = $new_count;
175 Util::log("Mobile $id ($small_dying) looses $dead_men people ".
176 "and have now $new_count.",1);
177 $to_kill -= $dead_men;
182 $self->{-db}->delete_from('MOBILE',"ID=$id");
183 $self->{-db}->update_hash('MOBILE',
186 Util::log("Mobile $id ($small_dying) with $dead_men people is deleted",1);
187 delete $victims_mobiles{$id};
195 unless(defined $no_conquer){
196 my $total_conquered_arks = $self->{-dead}->{$victim}->{'C'};
197 if($total_conquered_arks){
198 # now conquered arks are (re-)created
199 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
200 'GAME' => $self->{-game},
201 'LOCATION' => $self->{-location},
203 'OWNER' => $self->{-winner},
204 'COUNT' => $self->{-dead}->{$victim}->{'C'},
206 'COMMAND_ID' => $self->{-id},
208 $self->{-mob} = $mob;
209 my %mobcopy = (%$mob);
210 $self->{-db}->insert_hash('MOBILE',\%mobcopy);
211 $self->unify_mobiles($mob,$self->{-location},$self->{-winner});
212 Util::log("$total_conquered_arks conquered arks for $self->{-winner}.",1);
213 $self->{-dead}->{$victim}->{'A'} -= $total_conquered_arks;
217 $self->change_priest_on_temple($self->{-location});
221 my ($self,$id,$target,$count) = @_;
224 my $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
227 $self->conditional_split_mobile($mobile,$count,
228 {'MOVE_WITH' => $target},1);
229 Util::log("$count mobiles from id $id now moves with mobile $target",1);
231 # reread mobile, because split destroys it
232 $mobile = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
234 # all mobiles which already move with this now move with the target
236 my $mob = $self->{-context}->mobiles_available($mobile->{'LOCATION'});
237 # my $mobcount = $#{@$mob}+1;
238 my $mobcount = @$mob;
239 for my $i (0..$mobcount-1){
240 my ($oid,$otype,$oown,$oado,$ocnt,$ostat,$omove) = @{$mob->[$i]};
241 next if($omove != $id);
242 $self->{-db}->update_hash('MOBILE',"ID=$oid",
243 {'MOVE_WITH' => $target});
244 Util::log("therefor all mobiles from id $oid now moves with mobile $target",1);
249 $self->unify_mobiles($mobile,$mobile->{'LOCATION'});
252 # this function is called, if an earthling leave an field and let it possible empty
254 my ($self,$loc,$player) = @_;
255 $player = $self->{-player} unless defined $player;
256 my $db = $self->{-db};
257 my $aym = $self->{-context};
258 my $oim = $aym->own_in_mobile($loc,$player,1);
260 my ($home,$ter,$occ,$temple) =
261 $aym->read_field('HOME,TERRAIN,OCCUPANT,TEMPLE',$loc);
262 $home=0 if $ter eq 'MOUNTAIN';
266 $keep_owner = 1 if $home==$occ and $ter eq 'CITY' and $::conf->{-HOMECITY_KEEP_OWNER};
267 $keep_owner = 1 if exists $::conf->{-KEEP_OWNER}->{$ter};
268 $keep_owner = 1 if $::conf->{-TEMPLE_KEEP_OWNER} and $temple eq 'Y';
271 Util::log("leaving occupant $occ in field $loc",1);
273 Util::log("reset old occupant $home in field $loc.",1);
274 # delete all PRODUCE and PRAY-Commands if any
275 $self->{-db}->delete_from('COMMAND',
276 "(COMMAND=PRODUCE OR COMMAND=PRAY) AND ".
277 "LOCATION=$loc AND GAME=$self->{-game}");
278 # delete all PRODUCE-EVENTS
279 $self->{-db}->delete_from('EVENT',
280 "(TAG=EVENT_PRODUCE_WARRIOR OR TAG=EVENT_PRODUCE_PRIEST)".
281 " AND LOCATION=$loc AND GAME=$self->{-game}");
282 $db->update_hash('MAP',
283 "LOCATION=$loc AND GAME=$self->{-game}",
284 {'OCCUPANT' => $home});
287 $self->change_priest_on_temple($loc);
290 # this check, if there is still a priest on a temple
291 # and if there is a new priest on temple
292 sub change_priest_on_temple{
293 my ($self,$loc) = @_;
294 my $aym = $self->{-context};
296 my ($home,$temple,$occ) = $aym->read_field('HOME,TEMPLE,OCCUPANT',$loc);
297 return unless $temple eq 'Y';
299 my $produce = $self->{-db}->count('COMMAND',
300 "LOCATION=$loc AND GAME=$self->{-game} AND ".
303 my $priests = $self->{-db}->count('MOBILE',
304 "LOCATION=$loc AND GAME=$self->{-game} AND ".
305 "TYPE=PRIEST AND ADORING=$home AND ".
308 Util::log("priests: $priests, produce: $produce",1);
310 if($priests and not $produce){
311 $aym->insert_command('PRODUCE', "ROLE=$occ", $loc);
314 if(not $priests and $produce){
315 Util::log("delete produce-command and event",1);
316 # delete all PRODUCE -Commands if any
317 $self->{-db}->delete_from('COMMAND',
318 "COMMAND=PRODUCE AND ".
319 "LOCATION=$loc AND GAME=$self->{-game}");
320 # delete all PRODUCE-EVENTS
321 $self->{-db}->delete_from('EVENT',
322 "(TAG=EVENT_PRODUCE_PRIEST)".
323 " AND LOCATION=$loc AND GAME=$self->{-game}");
327 # do we fight? do we conquer? do we join?
328 # TODO: turn_around if no ark and terrain==water
329 # TODO: could happen if location is flooded during movement.
331 my ($self,$loc,$ignore_friend) = @_;
332 $ignore_friend = 0 unless defined $ignore_friend;
334 Util::log("enter_field($loc,$ignore_friend)",2);
336 # print "LOC: $loc\n";
337 my ($occ,$att,$temple,$home,$terrain) =
338 $self->{-context}->read_field('OCCUPANT,ATTACKER,TEMPLE,HOME,TERRAIN',$loc);
339 $self->{-occupant} = $occ;
341 my $relation = $self->{-context}->get_relation($occ);
343 $relation = 'FOE' if $ignore_friend;
345 # if there is allready an ongoing fight
347 # do nothing if we are allready involved
348 if($self->{-player} == $occ or $self->{-player} == $att){
350 Util::log("join the ongoing fight in $loc",1);
351 delete $self->{-multimove};
354 # turn around otherwise
355 Util::log("in $loc: There is allready a fight between $occ and $att ".
356 "... turn around.",1);
357 $self->turn_around($loc);
358 delete $self->{-multimove};
363 if($relation eq 'FRIEND' or $relation eq 'ALLIED'){
364 # a friend has allready occupied this place, just turn around.
365 Util::log("in $loc: $occ is a friend of $self->{-player} ... turn around.",1);
366 $self->turn_around($loc);
367 delete $self->{-multimove};
371 if($self->is_new_earthling_fight($loc,$relation,$terrain)){
372 Util::log("new fight between earthlings in $loc:".
373 " attacker $self->{-player}, defender $occ",1);
375 # we are the attacker
376 $self->do_earthling_fight($loc);
377 delete $self->{-multimove};
381 if($occ == $self->{-player}){
382 # was already our field
383 Util::log("$loc is allready field of $occ.",2);
384 $self->unify_mobiles($self->{-mob},$loc) unless defined $self->{-multimove};
386 # we are the new occupant
387 $self->conquer($loc,$self->{-player});
390 $self->change_priest_on_temple($loc);
393 # peoples without arks drown
395 my ($self,$loc) = @_;
397 # dont drown on islands or land
398 my ($terrain) = $self->{-context}->read_field('TERRAIN',$loc);
399 return unless $terrain eq 'WATER';
401 # is there still an active ark?
402 my $arks = $self->{-context}->read_mobile('TYPE','ARK',$loc,1);
403 # print Dumper $arks;
408 my $mobs = $self->{-context}->read_mobile('ID,TYPE,COUNT,OWNER','',$loc,1);
410 my ($id,$type,$count,$owner);
411 for my $mob (@$mobs){
412 ($id,$type,$count,$owner) = @$mob;
414 next if $type eq 'ARK' or $type eq 'PROPHET';
417 $self->{-db}->delete_from('MOBILE',"ID=$id");
418 Util::log("No ark: $count $type from $owner drowned in $loc.",1);
421 ->send_message_to($owner,
423 'MSG_TAG' => 'MSG_MOBILE_DRAWN',
425 'ARG2' => $self->{-context}->mobile_string($type,$count),
426 'ARG3' => $self->{-context}->charname($owner),
429 $self->empty_field($loc,$owner) if $owner;
433 my ($self,$loc,$player) = @_;
435 Util::log("$player conquers $loc.",1);
436 $self->{-db}->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
437 {'OCCUPANT' => $player});
439 # conquer existing arks
440 $self->{-db}->update_hash('MOBILE',"LOCATION=$loc AND GAME=$self->{-game} AND TYPE=ARK",
441 {'OWNER' => $player});
443 # insert new PRODUCE-command and delete existent one and PRODUCE-events
444 my ($terrain,$temple,$home) = $self->{-context}->read_field('TERRAIN,TEMPLE,HOME',$loc);
446 if ((not $home and $terrain eq 'CITY')){
447 $self->{-db}->delete_from('COMMAND', "COMMAND=PRODUCE AND LOCATION=$loc".
448 " AND GAME=$self->{-game}");
449 $self->{-db}->delete_from('EVENT',"TAG=EVENT_PRODUCE_WARRIOR AND LOCATION=$loc ".
450 "AND GAME=$self->{-game}");
451 $self->{-context}->insert_command('PRODUCE', "ROLE=$player", $loc);
454 #if ($temple eq 'Y'){
456 # $self->{-db}->delete_from('COMMAND', "COMMAND=PRAY AND LOCATION=$loc".
457 #" AND GAME=$self->{-game}");
462 sub enter_field_avatar{
463 my ($self,$loc,$mob) = @_;
465 Util::log("enter_field_avatar() in $loc",1);
468 # if we are in Aymargeddon, do nothing special
469 my ($terrain) = $self->{-context}->read_field('TERRAIN',$loc);
470 if($terrain eq 'AYMARGEDDON'){
471 Util::log("enter_field_avatar(AYMARGEDDON): do nothing",1);
472 delete $self->{-multimove};
476 # mob can be ID or hash
477 $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
479 # get all avatars allready here from me and other owners
480 my $avatars = $self->{-context}->read_mobile_condition('ID,OWNER,STATUS',
484 # print Dumper $avatars;
487 my $own_avatars_here = 0;
488 my $own_avatar_status = 'IGNORE';
489 my %other_avatar_owner = ();
490 my %other_avatar_status = ();
491 for my $a (@$avatars){
492 my ($id,$own,$stat) = @$a;
493 next if($id == $mob->{'ID'});
494 # print "own: $own\n";
495 if($own == $mob->{'OWNER'}){
496 $own_avatars_here = $id;
497 $own_avatar_status = $stat;
498 }elsif(!defined $other_avatar_owner{$own}){
499 $other_avatar_owner{$own} = 1;
500 $other_avatar_status{$own} = $stat;
501 Util::log("found other avatar-owner $own in $loc",1);
503 Util::log("other avatar-owner $own allready found in $loc",1);
507 # if we are there allready with other avatars:
508 if($own_avatars_here){
509 # set STATUS of newcomer to the STATUS in the field
510 if ($own_avatar_status ne $mob->{'STATUS'}){
511 $self->{-db}->update_hash('MOBILE',
513 {'STATUS' => $own_avatar_status});
515 Util::log("enter_field_avatar():Avatars (ID:$mob->{'ID'}) ".
516 "have to join other avatars with status $own_avatar_status in $loc.",1);
517 $self->unify_mobiles($mob);
519 # for each other avatar-owner
520 for my $other (keys %other_avatar_owner){
521 my $oas = $other_avatar_status{$other};
522 # read alliance to each other owner (and vice versa)
523 my $allianceA = $self->{-context}
524 ->simplyfied_single_relation($other,$mob->{'OWNER'});
525 my $allianceB = $self->{-context}
526 ->simplyfied_single_relation($mob->{'OWNER'},$other);
527 # insert FIGHT-command, if necessary
528 if($self->is_avatar_fight($allianceA,$allianceB,$mob->{'STATUS'},$oas)){
529 $self->{-context}->insert_command('FIGHT_GOD',
530 "A=$other, B=$mob->{'OWNER'}",
532 Util::log("enter_field_avatar():Avatars from $mob->{'OWNER'} ".
533 "have to fight with $other in $loc.",1);
534 delete $self->{-multimove};
541 my ($self,$allA,$allB,$statA,$statB) = @_;
543 Util::log("is_avatar_fight(): ".
544 "allA: $allA, allB: $allB, statA: $statA, statB: $statB",1);
546 return 0 unless $statA eq 'BLOCK' or $statB eq 'BLOCK';
547 my $status = 'NEUTRAL';
548 if(($allA eq 'FOE') or ($allB eq 'FOE')){
550 }elsif(($allA eq 'FRIEND') or ($allB eq 'FRIEND')){
554 return 1 if ($status eq 'FOE');
555 return 1 if ($status eq 'NEUTRAL') and $statA eq 'BLOCK' and $statB eq 'BLOCK';
559 # unify identical mobiles
560 # $mob still exists after function. all other of same
561 # TYPE, MOVE_WITH, ADORING will be deleted.
563 my ($self,$mob,$location,$owner) = @_;
565 # mob can be ID or hash
566 $mob = $self->{-db}->read_single_mobile($mob) unless ref($mob);
568 $location = $mob->{'LOCATION'} unless defined $location;
569 $owner = $self->{-player} unless defined $owner;
571 Util::log("unify_mobiles() in $location for mobile $mob->{'ID'} of $owner",1);
573 return if $self->{-db}->count('COMMAND',
574 "MOBILE=$mob->{'ID'} AND ID != $self->{-dbhash}->{'ID'}");
576 my $type = $mob->{'TYPE'};
578 my $mobs = $self->{-context}->read_mobile('ID,COUNT,ADORING,OWNER,MOVE_WITH',
580 # $mob->{'LOCATION'},
585 my $count = $mob->{'COUNT'};
587 my ($oid,$ocount,$oado,$oown,$omove) = @$m;
589 next if $oown ne $owner; # and $type ne 'ARK';
590 next if $oid eq $mob->{'ID'};
591 if(Util::is_in($type,'PRIEST','PROPHET','HERO')){
592 next if $oado ne $mob->{'ADORING'};
595 next if(defined $mob->{'MOVE_WITH'} and $mob->{'MOVE_WITH'} ne $omove);
597 next if $self->{-db}->count('COMMAND',"MOBILE=$oid");
601 $self->{-db}->delete_from('MOBILE',"ID=$oid");
603 # set new MOVE_WITH, if deleted unit has some companions
604 $self->{-db}->update_hash('MOBILE',
606 {'MOVE_WITH' => $mob->{'ID'}});
609 $self->{-db}->update_hash('MOBILE',
611 {'COUNT' => $count}) if $count != $mob->{'COUNT'};
613 # rekursion for every companion of $mob
614 my $companions = $self->{-context}->read_mobile_condition('ID,OWNER',
615 "LOCATION=$location ".
616 "AND MOVE_WITH=$mob->{'ID'}");
617 for my $m (@$companions){
618 my ($mid,$mown) = @$m;
619 # does it still exist?
620 my $comp = $self->{-db}->read_single_mobile($mid);
621 next unless defined $comp;
622 $self->unify_mobiles($comp,$location,$mown);
626 # the move-command will be set up again in the oposite direction
628 my ($self,$loc) = @_;
630 # first we have to check, if we are here because of an MOVE-COMMAND
631 # or out of some other reason
632 if($self->{-dbhash}->{'COMMAND'} eq 'MOVE'){
633 my $mob = $self->{-mob};
634 my $dir = $self->{-args}->{'DIR'};
635 my $rev = {'S' => 'N',
641 $dir = $rev->{uc($dir)};
642 Util::log("we ($mob->{'ID'} in $loc) are friends ".
643 "and come from $dir. we turn around...",1);
644 $self->{-context}->insert_command('MOVE',
645 "DIR=$dir, MOBILE=$mob->{'ID'}, ".
646 "COUNT=$mob->{'COUNT'}, AUTO=1",$loc);
652 # do we start a fight here?
653 sub is_new_earthling_fight{
654 my ($self,$location,$relation,$terrain) = @_;
655 my $mob = $self->{-mob};
656 my $attacker = $self->{-player};
657 my $occupant = $self->{-occupant};
659 # no fight on some neutral territories
660 return 0 unless $occupant or exists $::conf->{-FIGHTS_WITHOUT_OWNER}->{$terrain};
662 # no new fight, if allready one started
663 return 0 if $self->{-context}->earthling_fight($location);
665 return 0 if $attacker == $occupant or
666 $relation eq 'FRIEND' or
667 $relation eq 'ALLIED';
669 my $qloc = $self->{-db}->quote($location);
670 $self->{-db}->update_hash('MAP',"GAME=$self->{-game} AND LOCATION=$qloc",
671 {'ATTACKER' => $attacker});
676 sub do_earthling_fight{
677 my ($self,$loc) = @_;
679 # write the fight command
681 $self->{-context}->insert_command('FIGHT_EARTHLING',
682 "ATTACKER=$self->{-player}, ".
683 "DEFENDER=$self->{-occupant}",
687 # enough mana available?
689 my ($self,$action,$factor,$god) = @_;
690 $factor = 1 unless defined $factor;
691 $god = $self->{-player} unless defined $god;
693 my $mana = $self->{-context}->get_mana($god);
694 my $mana_needed = $::conf->{-MANA}->{"-$action"} * $factor;
696 Util::log("$god needs $mana_needed mana from his $mana mana to do $action",1);
698 # dirty workaround: we fake our identity.
699 my $player = $self->{-player};
700 $self->{-player} = $god;
701 unless($self->test(sub{ $mana >= $mana_needed },
702 'MSG_NOT_ENOUGH_MANA',
704 $self->{-location} ? $self->{-location} : 'GLOBAL')){
705 $self->{-player} = $player;
708 $self->{-player} = $player;
710 $self->{-mana} = $mana - $mana_needed;
711 $self->{-mana_paid} = $mana_needed;
716 my ($self,$god) = @_;
717 $god = $self->{-player} unless defined $god;
718 $self->{-db}->update_hash('GOD',"PLAYER=$god AND GAME=$self->{-game}",
719 {'MANA' => $self->{-mana}});
720 Util::log("$god pays $self->{-mana_paid} mana ".
721 "and has still $self->{-mana} left.",1);
725 # this returns the used mana and did not test before
726 sub instant_use_mana{
727 my ($self,$mana,$god) = @_;
728 $god = $self->{-player} unless defined $god;
730 my $mana_available = $self->{-context}->get_mana($god);
732 if ($mana_available < $mana)
735 $mana = $mana_available;
737 my $newmana = $mana_available - $mana;
739 $self->{-db}->update_hash(
741 "PLAYER=$god AND GAME=$self->{-game}",
744 Util::log("$god pays $mana mana ".
745 "and has still $newmana left.",1);
752 ####################################################
754 ##########################################################
756 # Use this template to generate new commands
759 package AymCommandTemplate;
760 @AymCommandTemplate::ISA = qw(AymCommand);
762 # ... arguments in $self->{-args}
763 # ... player in $self->{-player}
764 # ... game in $self->{-game}
765 # ... context object in $self->{-context}
766 # ... database object in $self->{-db}
767 # ... basic duration from Config in $self->{-duration}
768 # ... command from database in $self->{-dbhash}
770 # this is called to see if the command is executable.
771 # it should be called from first_phase() and from second_phase().
772 # it is not called from the scheduler
775 my @required_arguments = ();
776 return 0 unless $self->Command::is_valid(@required_arguments);
783 # this is called from Scheduler, when he see the command the
784 # first time, some commands execute here immidiatly.
789 return 0 unless $self->is_valid();
796 # this is called from scheduler when the command will be executed.
801 return 0 unless $self->is_valid();
811 ####################################################
814 # CH_STATUS: Change the player alliance status
818 @CH_STATUS::ISA = qw(AymCommand);
823 my @required_arguments = ('OTHER','STATUS');
824 return 0 unless $self->Command::is_valid(@required_arguments);
826 # exist OTHER still in game?
827 if($self->{-args}->{'OTHER'} != -1){
828 my $role = $self->{-context}->read_role($self->{-args}->{'OTHER'},'PLAYER');
829 return 0 unless $self->test(sub{$role},
834 my $status = $self->{-args}->{'STATUS'};
835 return 0 unless $self->test(sub{Util::is_in($status,
841 'MSG_STATUS_INVALID',
849 return 0 unless $self->is_valid();
851 my $tag = 'MSG_CH_STATUS';
852 my $other = $self->{-args}->{'OTHER'};
853 my $status = $self->{-args}->{'STATUS'};
854 # ($status,$tag) = $self->{-db}->quote_all($status,$tag);
855 $self->{-db}->insert_or_update_hash(
857 "PLAYER=$self->{-player} ".
859 "AND GAME=$self->{-game}",
860 {'GAME' => $self->{-game},
861 'PLAYER' => $self->{-player},
866 #$self->{-context}->send_message_to_me({'MFROM' => 0,
868 # 'ARG1' => $self->{-context}->charname($other),
872 $self->setDuration(0);
878 Util::log("Warning: We should not reach phase 2 with command CH_STATUS",0);
885 ################################################################
887 ################################################################
894 # use FROGS::HexTorus;
895 @MOVE::ISA = qw(AymCommand);
900 my $db = $self->{-db};
901 my $args = $self->{-args};
902 my $aym = $self->{-context};
903 my $phase = $self->{-phase};
905 my @required_arguments = ('MOBILE','COUNT','DIR');
906 return 0 unless $self->Command::is_valid(@required_arguments);
908 my $mob_id = $args->{'MOBILE'};
909 my $count = $args->{'COUNT'};
911 return 0 unless $count =~ /^\s*\d+\s*$/;
913 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
914 my $mob = $self->{-mob};
916 my ($owner,$loc_string,$type) = ($mob->{'OWNER'},
920 # print "LOCATION: $loc_string\n";
921 $self->{-loc_string} = $loc_string;
923 # enough mobiles avaiable?
925 return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
926 $mob->{'AVAILABLE'} eq 'Y'},
927 'MSG_NOT_ENOUGH_MOBILES',
934 my ($size) = $db->read_game($self->{-game},'SIZE');
935 $self->{-size} = $size;
936 my $map = HexTorus->new($size);
937 $self->{-map} = $map;
939 my $loc = Location->from_string($loc_string);
940 $self->{-loc} = $loc;
942 # MULTIMOVE: extract first direction and rest of string
943 my $direction = $args->{'DIR'};
944 $direction =~ s/^\s*(\S*)\s*$/$1/; # removing leading/trailing whitespace
945 $direction =~ /^(\S*)\s+(.*)$/; # split up first direction
946 my ($first_direction,$other_directions) = ($1,$2);
947 if($other_directions){
948 $self->{-multimove} = $other_directions;
949 $direction = $first_direction;
950 Util::log("MULTIMOVE: now $first_direction, later $other_directions",1);
953 my $target = $map->get_neighbour($loc,$direction);
956 return 0 unless $self->test(sub{$target},
957 'MSG_MOVE_NO_TARGET',
960 $self->{-target} = $target;
961 my $target_string = $target->to_string();
963 # get terrain of loc and target
964 my ($terrain,$attacker,$god_attacker,$plague) =
965 $aym->read_field('TERRAIN,ATTACKER,GOD_ATTACKER,PLAGUE',$loc_string);
966 $plague = '' unless defined $plague;
967 my ($target_terrain,$target_occupant) =
968 $aym->read_field('TERRAIN,OCCUPANT',$target_string);
969 $self->{-target_occupant} = $target_occupant;
971 # you can only MOVE_WITH on water, except you are an ARK
972 return 0 unless $self->test(sub{Util::is_in($target_terrain,
977 'POLE') or $type eq 'ARK'},
982 # $self->{-context}->mobile_string($type,2));
986 # role specific tests
987 my $role = $self->{-role};
989 # return 0 unless $self->validate_role('GOD','EARTHLING');
990 #if ($mob->{'TYPE'} eq 'ARK') {
991 # Util::log("Impossible Situation: ARK has got a MOVE-Command",1);
992 if ($role eq 'GOD') {
993 # gods can only move avatars
994 return 0 unless $self->test(sub{$type eq 'AVATAR'},
995 'MSG_GOD_CANT_MOVE_TYPE',
996 $self->{-context}->mobile_string($type,2));
998 # dont move if $loc is Aymargeddon
999 return 0 unless $self->test(sub{$terrain ne 'AYMARGEDDON'},
1000 'MSG_CANT_LEAVE_AYMARGEDDON',
1004 # dont move, if ongoing FIGHT_GOD
1006 return 0 unless $self->test(sub{not $god_attacker},
1007 'MSG_CANT_MOVE_ATTACKED',
1009 $self->{-context}->mobile_string($type,2));
1012 # if targetfield water/isle, than dont move directly (only MOVE_WITH)
1013 #if ($phase == 1 and (Util::is_in($target_terrain,'WATER','ISLE') # or
1014 # Util::is_in($terrain,'WATER','ISLE'))
1017 # TODO: Errormessage
1023 # avatars can go on land, if ark available
1024 #if ($phase==1 and Util::is_in($terrain,'ISLE','WATER') and
1025 # not Util::is_in($target_terrain,'ISLE','WATER')) {
1026 # my $arks = $self->{-context}->read_mobile('ID','ARK',$loc_string,1);
1027 # my $ark_count = $#{@$arks}+1;
1028 # return 0 unless $self->test(sub{$ark_count},
1032 # $self->{-context}->mobile_string($type,2));
1034 } elsif ($role eq 'EARTHLING' or $owner == -1) {
1036 $self->{-companions} = $self->{-context}->
1037 read_mobile_condition('TYPE,COUNT,OWNER,ID',
1038 "MOVE_WITH=$self->{-args}->{'MOBILE'}");
1040 # do not move if field is attacked or tuberculosis
1042 return 0 unless $self->test(sub{not $attacker},
1043 'MSG_CANT_MOVE_ATTACKED',
1045 $self->{-context}->mobile_string($type,2));
1046 return 0 unless $self->test(sub{ $plague !~ /TUBERCULOSIS/
1047 or exists $self->{-args}->{'AUTO'}},
1048 'MSG_CANT_MOVE_PLAGUE',
1050 $self->{-context}->mobile_string($type,2),
1053 # eartlings can only move this types
1054 return 0 unless $self->test(sub{Util::is_in($type,
1060 'MSG_EARTHLING_CANT_MOVE_TYPE',
1061 $self->{-context}->mobile_string($type,2));
1063 # dont move if target field is Pole
1064 return 0 unless $self->test(sub{$target_terrain ne 'AYMARGEDDON' and
1065 $target_terrain ne 'POLE'},
1066 'MSG_CANT_MOVE_TO_POLE',
1067 'MOVE', $target_string);
1069 # dont move ark from land to land
1071 return 0 unless $self->test(sub{Util::is_in($terrain,'WATER','ISLE') or
1072 Util::is_in($target_terrain,'WATER','ISLE')},
1073 'MSG_CANT_MOVE_ARK',
1074 'MOVE', $target_string);
1075 $self->{-active_ark} = $self->{-args}->{'MOBILE'};
1078 # automatic ark-moving
1079 # if ($type ne 'ARK' and $phase == 1 and
1080 # (Util::is_in($target_terrain,'WATER','ISLE'))){
1081 # # or Util::is_in($terrain,'WATER','ISLE'))) {
1082 # my $arks = $aym->read_mobile('ID,COUNT','ARK',$loc_string,1);
1083 # # print Dumper $arks;
1084 # my ($ark,$active);
1085 # if (defined $arks->[0]) {
1086 # ($ark,$active) = (@{$arks->[0]});
1088 # ($ark,$active) = (0,0);
1090 # return 0 unless $self->test(sub {$active or $type eq 'PROPHET'},
1094 # $self->{-context}->mobile_string($type,2));
1095 # $self->{-active_ark} = $ark;
1096 # Util::log("We take ark $ark with us.",1);
1100 Util::log("impossible situation. I could not be $role",0);
1104 # dont move without mana
1106 if ($role eq 'GOD') {
1107 unless($self->test_mana('MOVE_AVATAR',$count)){
1108 $db->update_hash('MOBILE',
1111 'AVAILABLE' => 'Y'});
1115 # for all avatar-companions: pay or stay (if not on ark)!
1116 if ($type ne 'ARK'){
1118 for my $comp (@{$self->{-companions}}) {
1119 my ($ctype,$ccount,$cown,$cid) = @$comp;
1120 next unless $ctype eq 'AVATAR';
1121 unless($self->test_mana('MOVE_AVATAR',$ccount,$cown) and not $god_attacker){
1122 $db->update_hash('MOBILE',
1124 {'AVAILABLE' => 'Y',
1126 $self->unify_mobiles($cid,0,$cown);
1130 # re-read companions
1131 $self->{-companions} = $self->{-context}->
1132 read_mobile_condition('TYPE,COUNT,OWNER,ID',
1133 "MOVE_WITH=$self->{-args}->{'MOBILE'}")
1147 return 0 unless $self->is_valid();
1149 my $db = $self->{-db};
1150 my $type = $self->{-mob}->{'TYPE'};
1151 my $mob = $self->{-mob};
1152 my $aym = $self->{-context};
1154 # split it, if neccessary
1155 # the moving unit get the old ID!
1157 my $count = $self->{-args}->{'COUNT'};
1158 #print "conditional split with $count count and mob=\n";
1160 #print Dumper $self;
1162 $self->conditional_split_mobile($mob,$count,
1163 {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
1164 'MOVE_WITH' => 0},0);
1166 # if ark needed, move it together with us
1167 #if($type ne 'ARK' and $self->{-active_ark}){
1169 # $self->move_with($self->{-active_ark},$self->{-args}->{'MOBILE'},1);
1172 # $self->{-db}->update_hash('MOBILE',
1173 # "ID=$self->{-active_ark}",
1174 # {'OWNER' => $self->{-player}});
1177 # collect mobiles with MOVE_WITH in same location
1178 my $companions = $self->{-companions};
1180 # calculate duration
1181 my $d = $::conf->{-DURATION};
1182 my $dur = $d->{"-MOVE_$type"};
1184 # if moved with ark use -MOVE_ARK else use slowest
1185 if($self->{-active_ark}){
1186 $dur = $d->{'-MOVE_ARK'};
1188 for my $m (@$companions){
1190 $dur = $d->{"-MOVE_$mtype"} if $d->{"-MOVE_$mtype"} > $dur;
1193 $self->setDuration($dur);
1195 # set all companions inactive
1196 $self->{-db}->update_hash('MOBILE',
1197 "LOCATION=$mob->{'LOCATION'} ".
1198 "AND MOVE_WITH=$self->{-args}->{'MOBILE'}",
1199 {'AVAILABLE' => 'N'});
1201 # remove OCCUPANT in MAP, if we are an earthling
1202 # and there are no more own active (if it was our field)
1203 # mobiles left and if it is no homecity
1204 if($aym->is_earthling()){
1205 $self->empty_field($mob->{'LOCATION'});
1206 # avatar-companions: pay now
1208 for my $comp (@$companions){
1209 my ($ctype,$ccount,$cown,$cid) = @$comp;
1210 next unless $ctype eq 'AVATAR';
1211 $self->use_mana($cown);
1214 }elsif($aym->is_god()){
1219 if($type eq 'ARK' or $self->{-active_ark}){
1220 $self->event($self->{-target}->to_string(),
1221 'EVENT_ARK_APPROACHING',
1224 }else{ #elsif($type ne 'ARK'){
1225 my $player = $self->{-player};
1226 my $count = $self->{-args}->{'COUNT'};
1227 my $typetag = $count > 1 ? "MOBILE_$type".'_PL' : "MOBILE_$type";
1228 $self->event($self->{-target}->to_string(),
1229 'EVENT_MOBILE_APPROACHING',
1232 # $self->{-context}->mobile_string($type,$count));
1235 # TODO Bug: if avatar moves with hero, the wrong player is in the event-message.
1237 for my $m2 (@$companions){
1238 my ($mtype,$c,$mo) = @$m2;
1239 $self->{-player} = $mo;
1240 $typetag = $c > 1 ? "MOBILE_$mtype".'_PL' : "MOBILE_$mtype";
1241 $self->event($self->{-target}->to_string(),
1242 'EVENT_MOBILE_APPROACHING',
1245 # $self->{-context}->mobile_string($mtype,$c))
1248 $self->{-player} = $player;
1258 return 0 unless $self->is_valid();
1260 my $db = $self->{-db};
1261 my $mob = $self->{-mob};
1262 my $count = $self->{-args}->{'COUNT'};
1263 my $target_location = $self->{-target}->to_string();
1264 my $old_location = $mob->{'LOCATION'};
1266 # move mobile and all moving with it.
1267 $db->update_hash('MOBILE',"ID=$mob->{'ID'} OR MOVE_WITH=$mob->{'ID'}",
1268 {'LOCATION' => $target_location,
1272 # TODO: distribute plagues
1275 # $self->{-db}->update_hash('MOBILE',
1276 # "TYPE=ARK AND MOVE_WITH=$mob->{'ID'}",
1277 # {'MOVE_WITH' => 0});
1279 # should we do a godfight?
1280 my $companions = $self->{-companions};
1281 if($mob->{'TYPE'} eq 'AVATAR'){
1282 $self->enter_field_avatar($target_location,$mob);
1284 for my $m (@$companions){
1285 my ($mtype,$mc,$mo,$mid) = @$m;
1286 next unless $mtype eq 'AVATAR';
1287 $self->enter_field_avatar($target_location,$mid);
1291 $self->enter_field($target_location) if $self->{-role} eq 'EARTHLING';
1292 # $self->enter_field_avatar($target_location,$mob) if $self->{-role} eq 'GOD';
1293 $self->drowning($old_location);
1296 if(defined $self->{-multimove}){
1297 $self->{-context}->insert_command('MOVE',
1298 "ROLE=$self->{-player}, ".
1299 "DIR=$self->{-multimove}, ".
1300 "MOBILE=$mob->{'ID'}, ".
1301 "COUNT=$mob->{'COUNT'}",
1302 $mob->{'LOCATION'});
1304 $self->unify_mobiles($mob,$target_location);
1307 # TODO: maybe we should give a message only to the player of the unit
1308 # ... but its difficult, because of MOVE_WITH
1311 # ->send_message_to_field
1312 # ($target_location,
1314 # 'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1316 # 'ARG2' => $self->{-context}->mobile_string($self->{-mob}->{'TYPE'},
1317 # $self->{-mob}->{'COUNT'}),
1318 # 'ARG3' => $self->{-context}->charname($self->{-player}),
1319 # 'ARG4' => $target_location});
1321 # for my $m (@$companions){
1322 # my ($mtype,$mc,$mo,$mid) = @$m;
1324 # ->send_message_to_field
1325 # ($target_location,
1327 # 'MSG_TAG' => 'MSG_MOBILE_ARRIVES',
1329 # 'ARG2' => $self->{-context}->mobile_string($mtype,$mc),
1330 # 'ARG3' => $self->{-context}->charname($mo),
1331 # 'ARG4' => $target_location});
1341 ####################################################
1343 ##########################################################
1348 package BLESS_PRIEST;
1349 @BLESS_PRIEST::ISA = qw(AymCommand);
1351 # this is called to see if the command is executable.
1352 # it should be called from first_phase() and from second_phase().
1353 # it is not called from the scheduler
1357 my @required_arguments = ('MOBILE');
1358 return 0 unless $self->Command::is_valid(@required_arguments);
1360 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1362 return 0 unless $self->validate_role('GOD');
1364 my $mobtype = $self->{-mob}->{'TYPE'};
1365 my $mobloc = $self->{-mob}->{'LOCATION'};
1367 # don't bless unassigned units
1368 return 0 unless $self->test(sub{$self->{-mob}->{'OWNER'} > 0},
1369 'MSG_CANT_BLESS_UNASSIGNED',
1372 # only bless warriors
1373 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
1375 $self->{-context}->mobile_string($mobtype,1),
1378 return 0 unless $self->test_mana('BLESS_PRIEST');
1383 # this is called from Scheduler, if he see the command the
1384 # first time, some commands execute here immidiatly.
1389 return 0 unless $self->is_valid();
1391 my $id = $self->{-mob}->{'ID'};
1392 my $newid = $self->conditional_split_mobile($self->{-mob},
1394 {'ADORING' => $self->{-player},
1396 'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
1399 # companions move with the remaining warriors, not with the new priest
1400 $self->{-db}->update_hash('MOBILE',
1402 {'MOVE_WITH' => $newid}) if $id != $newid;
1404 # reread mobile, because split destroys it
1405 $self->{-mob} = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
1406 $self->unify_mobiles($self->{-mob},
1407 $self->{-mob}->{'LOCATION'},
1408 $self->{-mob}->{'OWNER'});
1410 $self->change_priest_on_temple($self->{-mob}->{'LOCATION'});
1413 # ->send_message_to_field
1414 # ($self->{-mob}->{'LOCATION'},
1416 # 'MSG_TAG' => 'MSG_BLESS_PRIEST',
1417 # 'ARG1' => $self->{-context}->charname($self->{-player}),
1418 # 'ARG2' => $self->{-context}->charname($self->{-mob}->{'OWNER'}),
1419 # 'ARG3' => $self->{-mob}->{'LOCATION'}});
1423 $self->setDuration(0);
1428 # this is called from scheduler when the command will be executed
1431 Util::log("BLESS_PRIEST should not have a second phase!",0);
1436 # End of BLESS_PRIEST
1438 ####################################################
1440 ##########################################################
1445 package BUILD_TEMPLE;
1447 @BUILD_TEMPLE::ISA = qw(AymCommand);
1449 # this is called to see if the command is executable.
1450 # it should be called from first_phase() and from second_phase().
1451 # it is not called from the scheduler
1455 my @required_arguments = ('MOBILE');
1456 return 0 unless $self->Command::is_valid(@required_arguments);
1458 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
1460 my $mobtype = $self->{-mob}->{'TYPE'};
1461 my $mobloc = $self->{-mob}->{'LOCATION'};
1462 my $god = $self->{-mob}->{'ADORING'};
1464 # only priests can build temples
1465 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'PRIEST'},
1467 $self->{-context}->mobile_string($mobtype,1),
1470 # is this a valid building place?
1471 # my($loc,$terrain,$temple) = $self->{-context}->read_map('TERRAIN,TEMPLE');
1472 my ($terrain,$temple) =
1473 $self->{-context}->read_field('TERRAIN,TEMPLE',$mobloc);
1474 return 0 unless $self->test(sub{$temple ne 'Y'
1475 and Util::is_in($terrain,'MOUNTAIN','ISLE')},
1476 'MSG_CANT_BUILD_HERE',
1479 # is the priest adoring a fitting god?
1480 #return 0 unless $self->test(sub{($terrain eq 'MOUNTAIN' and
1481 # $self->{-mob}->{'ADORING'} eq $god) or
1482 # $terrain eq 'ISLE'},
1483 # 'MSG_ADORING_WRONG_GOD',
1485 # $self->{-mob}->{'ADORING'},
1486 # $self->{-context}->charname($god));
1488 # is there allready a BUILD_TEMPLE Command
1489 if($self->{-phase} == 1){
1490 return 0 unless $self->test(sub{! $self->{-context}->search_event('BUILD_TEMPLE',
1492 'MSG_CANT_BUILD_HERE',
1496 # dont build more than MAX_MOUNTAIN temples on mountains
1497 if($terrain eq 'MOUNTAIN'){
1498 my $ret = $self->test(sub{$self->{-db}->count('MAP',
1499 "GAME=$self->{-game} AND ".
1502 "OCCUPANT=$self->{-player} AND ".
1504 < $::conf->{-MAX_MOUNTAINS}},
1505 'MSG_CANT_BUILD_HERE',
1507 if(not $ret and $self->{-phase} == 2){
1508 # we have to set priest active, if we tryed to build in first phase
1509 $self->{-db}->update_hash('MOBILE',
1510 "ID=$self->{-mob}->{'ID'}",
1511 {'AVAILABLE' => 'Y'});
1513 return 0 unless $ret;
1519 # this is called from Scheduler, if he sees the command the
1520 # first time, some commands execute here immidiatly.
1525 return 0 unless $self->is_valid();
1527 $self->conditional_split_mobile($self->{-mob},
1529 {'COMMAND_ID' => $self->{-dbhash}->{'ID'},
1533 # delete all MOVE_WITH the priest
1534 # BUG?: uninitialized value in this line??? maybe split is wrong in a way?
1535 $self->{-db}->update_hash('MOBILE',
1536 "MOVE_WITH = $self->{-mob}->{'ID'}",
1537 {'MOVE_WITH' => 0});
1539 $self->empty_field($self->{-mob}->{'LOCATION'});
1541 my ($size) = $self->{-db}->read_game($self->{-game},'TEMPLE_SIZE');
1543 # set new temple size
1545 $self->{-db}->update_hash('GAME',
1546 "GAME=$self->{-game}",
1547 {'TEMPLE_SIZE' => $size});
1548 Util::log("New temple size: $size",1);
1550 # calculate duration
1551 $self->setDuration($size * $::conf->{-DURATION}->{-BUILD_TEMPLE});
1553 $self->event($self->{-mob}->{'LOCATION'},
1554 'EVENT_BUILD_TEMPLE',
1555 $self->{-context}->charname($self->{-mob}->{'ADORING'}),
1558 return $self->{-duration};
1561 # this is called from scheduler when the command will be executed.
1566 return 0 unless $self->is_valid();
1568 my $loc = $self->{-mob}->{'LOCATION'};
1569 $self->{-db}->update_hash('MAP',
1570 "GAME=$self->{-game} AND LOCATION=$loc",
1572 'HOME' => $self->{-mob}->{'ADORING'}});
1574 $self->{-db}->update_hash('MOBILE',
1575 "ID=$self->{-mob}->{'ID'}",
1576 {'AVAILABLE' => 'Y'});
1578 # insert new PRODUCE-command
1579 $self->{-context}->insert_command('PRODUCE', "ROLE=$self->{-player}",
1580 $self->{-mob}->{'LOCATION'});
1582 # insert new PRAY-command
1583 $self->{-context}->insert_command('PRAY','',$loc);
1585 # this deletes and reinsert commands, if we conquer with building
1586 $self->enter_field($loc,1);
1588 #change aymargeddon to nearest pole
1589 my $poles = $self->{-db}->select_array('MAP',
1591 "GAME=$self->{-game} AND ".
1592 "(TERRAIN=POLE OR TERRAIN=AYMARGEDDON)");
1593 my $min_distance = $::conf->{-MANY};
1594 my $Loc = Location->from_string($loc);
1595 my ($new_aym,$old_aym) = ('','');
1596 for my $pol (@$poles){
1597 my ($loc2,$ter) = @$pol;
1598 $old_aym = $loc2 if $ter eq 'AYMARGEDDON';
1599 my $map = HexTorus->new($self->{-context}->get_size());
1600 my $Loc2 = Location->from_string($loc2);
1601 my $dist = $map->distance($Loc,$Loc2);
1602 Util::log("distance from $loc to $loc2: $dist",1);
1603 $new_aym = $loc2 if $dist < $min_distance and $ter eq 'POLE';
1606 Util::log("change aymargeddon from $old_aym to $new_aym",1);
1607 $self->{-db}->update_hash('MAP',
1608 "GAME=$self->{-game} AND LOCATION=$new_aym",
1609 {'TERRAIN' => 'AYMARGEDDON'});
1610 $self->{-db}->update_hash('MAP',
1611 "GAME=$self->{-game} AND LOCATION=$old_aym",
1612 {'TERRAIN' => 'POLE'});
1614 ->send_message_to_all
1616 'MSG_TAG' => 'MSG_CHANGE_AYMARGEDDON',
1617 'ARG1' => $self->{-context}->charname($self->{-player})});
1618 #'ARG2' => $old_aym,
1619 #'ARG3' => $new_aym});
1622 # is this the end of the game?
1623 my $unbuild = $self->{-context}->unbuild();
1625 $self->end_of_the_game() unless $unbuild;
1631 # End of BUILD_TEMPLE
1633 ####################################################
1635 ##########################################################
1642 @PRODUCE::ISA = qw(AymCommand);
1647 my @required_arguments = ('ROLE');
1648 # TODO: Open question: is this redundant information? allready
1649 # in PLAYER of COMMAND?
1650 return 0 unless $self->Command::is_valid(@required_arguments);
1659 return 0 unless $self->is_valid();
1661 my ($ter,$home,$occ,$temple) =
1662 $self->{-context}->read_field('TERRAIN,HOME,OCCUPANT,TEMPLE',
1663 $self->{-dbhash}->{'LOCATION'});
1665 my ($type, $duration);
1666 $type = $temple eq 'Y' ? 'PRIEST' : 'WARRIOR';
1668 my $d = $::conf->{-DURATION};
1669 my $peace = $self->{-args}->{'PEACE'};
1670 $peace = 0 unless defined $peace;
1671 if($type eq 'PRIEST'){
1672 Util::log("Produce a priest at ",-1);
1673 if ($ter eq 'MOUNTAIN'){
1674 Util::log("mountain.",1);
1675 $duration = $d->{-PRODUCE_PRIEST_HOME};
1677 Util::log("isle.",1);
1678 $duration = $d->{-PRODUCE_PRIEST};
1680 $self->setDuration($duration);
1681 $self->event($self->{-location},
1682 'EVENT_PRODUCE_PRIEST');
1684 Util::log("Produce a warrior at ",-1);
1686 Util::log("homecity.",1);
1687 $duration = $d->{-PRODUCE_WARRIOR_HOME};
1689 Util::log("normal city.",1);
1690 $duration = $d->{-PRODUCE_WARRIOR} + $d->{-PRODUCE_WARRIOR_CHANGE} * $peace;
1692 $self->setDuration($duration);
1693 $self->event($self->{-location},
1694 'EVENT_PRODUCE_WARRIOR');
1700 # this is called from scheduler when the command will be executed.
1705 return 0 unless $self->is_valid();
1707 my $loc = $self->{-dbhash}->{'LOCATION'};
1708 my ($temple,$home,$occ,$plague) =
1709 $self->{-context}->read_field('TEMPLE,HOME,OCCUPANT,PLAGUE',$loc);
1710 my $type = $temple eq 'Y' ? 'PRIEST' : 'WARRIOR';
1712 # fields with influenza do not produce
1713 if(not defined $plague or not $plague =~ 'INFLUENZA'){
1715 # dont produce priests at temples, if no other priests are there
1716 if ($type eq 'PRIEST'){
1717 my $mobiles = $self->{-context}
1718 ->read_mobile_condition('ID',
1719 "TYPE=PRIEST AND AVAILABLE=Y AND ADORING=$home",$loc);
1721 Util::log("No priests, no new priests!",1);
1722 $self->do_it_again();
1727 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1732 'OWNER' => $self->{-args}->{'ROLE'},
1733 'GAME' => $self->{-game},
1737 # print Dumper $mob;
1739 $mob->{'ADORING'} = $home if $type eq 'PRIEST';
1741 my %mobcopy = (%$mob);
1742 $self->{-mob} = \%mobcopy;
1743 $self->{-db}->insert_hash('MOBILE',
1746 $self->enter_field($loc,1);
1747 } # endif no influenza
1749 Util::log("No production in $loc due to INFLUENZA!",1);
1753 my $new_peace = $self->{-args}->{'PEACE'};
1754 $new_peace = 0 unless defined $new_peace;
1756 $self->do_it_again({'PEACE' => $new_peace});
1764 ####################################################
1766 ##########################################################
1773 @PRAY::ISA = qw(AymCommand);
1778 my @required_arguments = ();
1779 return 0 unless $self->Command::is_valid(@required_arguments);
1781 $self->{-loc} = $self->{-dbhash}->{'LOCATION'};
1782 my ($temple,$home) = $self->{-context}->read_field('TEMPLE,HOME',
1784 # TODO: use test() instead
1785 return 0 unless $temple eq 'Y';
1787 $self->{-god} = $home;
1796 return 0 unless $self->is_valid();
1798 return $self->{-duration};
1805 return 0 unless $self->is_valid();
1807 # count number of active orthodox priests
1809 my $oim = $self->{-context}->own_in_mobile($self->{-loc},
1815 my $mob = $self->{-db}->read_single_mobile($id);
1816 $priests += $mob->{'COUNT'} if($mob->{'TYPE'} eq 'PRIEST');
1819 # reduce effective priests if necessary
1820 my $fortune = $self->{-context}->read_fortune();
1821 my $oldpriests = $priests;
1823 my ($terrain) = $self->{-context}->read_field('TERRAIN',$self->{-loc});
1824 if($terrain eq 'MOUNTAIN'){
1825 if($priests > $::conf->{-FORTUNE_FAKTOR_MOUNTAIN} * $fortune){
1826 $priests = $::conf->{-FORTUNE_FAKTOR_MOUNTAIN} * $fortune;
1828 }elsif($terrain eq 'ISLE'){
1829 if($priests > $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune){
1830 $priests = $::conf->{-FORTUNE_FAKTOR_ISLAND} * $fortune;
1833 Util::log("ERROR: PRAY in terrain $terrain",0);
1836 Util::log("reduce praying priests from $oldpriests to".
1837 " $priests in $self->{-loc} ($terrain, fortune: $fortune)",1)
1838 if $oldpriests > $priests;
1840 # add priests + 1 mana to $self->{-god}
1841 my $mana = $self->{-context}->get_mana($self->{-god});
1842 my $newmana = $mana + $priests + $::conf->{-MANA_FOR_TEMPLE};
1844 $self->{-db}->update_hash('GOD',
1845 "PLAYER=$self->{-god} AND GAME=$self->{-game}",
1846 {'MANA' => $newmana});
1847 Util::log("$priests priests pray for $self->{-god} ".
1848 "in $self->{-loc} and he got ". ($newmana - $mana) ." mana",1);
1853 $self->do_it_again();
1861 ####################################################
1863 ##########################################################
1870 @BUILD_ARK::ISA = qw(AymCommand);
1872 # this is called to see if the command is executable.
1873 # it should be called from first_phase() and from second_phase().
1874 # it is not called from the scheduler
1878 # my @required_arguments = ('');
1879 return 0 unless $self->Command::is_valid();
1881 return 0 unless $self->validate_role('GOD');
1886 # this is called from Scheduler, if he sees the command the
1887 # first time, some commands execute here immidiatly.
1892 return 0 unless $self->is_valid();
1893 return 0 unless $self->test_mana('BUILD_ARK');
1895 # calculate duration
1896 $self->setDuration($::conf->{-DURATION}->{-BUILD_ARK});
1898 $self->event($self->{-location},
1903 return $self->{-duration};
1906 # this is called from scheduler when the command will be executed.
1911 return 0 unless $self->is_valid();
1913 # owner should be occupant
1914 my ($occ) = $self->{-context}->read_field('OCCUPANT',$self->{-location});
1915 $occ = -1 unless $occ;
1917 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1919 'LOCATION' => $self->{-location},
1923 'GAME' => $self->{-game},
1925 my %mobcopy = (%$mob);
1926 $self->{-db}->insert_hash('MOBILE',$mob);
1928 # merge multiple ARKs in one mobile, if same owner
1929 $self->unify_mobiles(\%mobcopy,$self->{-location},$occ);
1931 # $self->{-db}->commit();
1934 # ->send_message_to_field
1935 # ($self->{-location},
1937 # 'MSG_TAG' => 'MSG_BUILD_ARK',
1938 # 'ARG1' => $self->{-context}->charname($self->{-player}),
1939 # 'ARG2' => $self->{-location}});
1947 ####################################################
1949 ####################################################
1951 # INCARNATE: Create an Avatar
1955 @INCARNATE::ISA = qw(AymCommand);
1960 my @required_arguments = ('COUNT');
1961 return 0 unless $self->Command::is_valid(@required_arguments);
1963 # you need a temple to create an avatar
1964 $self->{-arrival} = $self->{-context}->incarnation_place();
1965 return 0 unless $self->test(sub{$self->{-arrival};},
1966 'MSG_ERROR_NO_ARRIVAL');
1968 # TODO: maybe with variing cost (distance to Aymargeddon)
1969 return 0 unless $self->test_mana('INCARNATE', $self->{-args}->{'COUNT'});
1977 return 0 unless $self->is_valid();
1979 # create mobile (or join)
1980 my $mob = {'ID' => $self->{-db}->find_first_free('MOBILE','ID'),
1981 'GAME' => $self->{-game},
1982 'LOCATION' => $self->{-location},
1984 'OWNER' => $self->{-player},
1985 'COUNT' => $self->{-args}->{'COUNT'},
1987 'STATUS' => 'IGNORE',
1988 'COMMAND_ID' => $self->{-id},
1990 $self->{-mob} = $mob;
1991 my %mobcopy = (%$mob);
1992 $self->{-db}->insert_hash('MOBILE',\%mobcopy);
1994 $self->enter_field_avatar($self->{-location},$mob);
1995 $self->unify_mobiles($mob,$self->{-location});
2001 # ->send_message_to_field
2002 # ($self->{-location},
2004 # 'MSG_TAG' => 'MSG_INCARNATE',
2005 # 'ARG1' => $self->{-context}->charname($self->{-player}),
2006 # 'ARG2' => $self->{-location}});
2008 $self->setDuration(0);
2014 Util::log("Warning: We should not reach phase 2 with command INCARNATE",0);
2021 ################################################################
2023 ##########################################################
2028 package FIGHT_EARTHLING;
2030 use Date::Parse qw(str2time);
2031 use Date::Calc qw(Time_to_Date);
2032 @FIGHT_EARTHLING::ISA = qw(AymCommand);
2034 # this is called to see if the command is executable.
2035 # it should be called from first_phase() and from second_phase().
2036 # it is not called from the scheduler
2040 my @required_arguments = ('ATTACKER','DEFENDER');
2041 return 0 unless $self->Command::is_valid(@required_arguments);
2043 return 0 unless $self->validate_role('EARTHLING');
2044 return 0 unless $self->validate_this_role($self->{-args}->{'ATTACKER'},'EARTHLING');
2045 my $def = $self->{-args}->{'DEFENDER'};
2047 return 0 unless $self->validate_this_role($self->{-args}->{'DEFENDER'},'EARTHLING');
2053 # this is called from Scheduler, if he sees the command the
2054 # first time, some commands execute here immidiatly.
2059 return 0 unless $self->is_valid();
2061 # calculate duration
2062 $self->setDuration($::conf->{-DURATION}->{-FIGHT_EARTHLING});
2064 $self->event($self->{-location},
2067 return $self->{-duration};
2070 # this is called from scheduler when the command will be executed.
2075 return 0 unless $self->is_valid();
2078 my ($terrain,$home,$occupant) = $self->{-context}->
2079 read_field('TERRAIN,HOME,OCCUPANT',$self->{-location});
2081 my $attacker = $self->{-args}->{'ATTACKER'};
2082 my $defender = $self->{-args}->{'DEFENDER'};
2085 my $mobiles = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2086 0, $self->{-location}, 1);
2087 $self->{-mobiles} = $mobiles;
2088 # print Dumper $mobiles;
2090 #my $efoa = {"$attacker" => 0}; # earthling friends of attacker
2091 #my $efod = {"$defender" => 0}; # earthling friends of defender
2092 #$self->{-efoa} = $efoa;
2093 #$self->{-efod} = $efod;
2095 my ($gfoa, $gfod); # god friends ...
2097 # calculate strength of both sides
2098 my ($attack_strength, $defend_strength,$attack_avatar,$defend_avatar) = (0,0,0,0);
2099 my ($people_attacker, $people_defender) = (0,0);
2100 for my $mob (@$mobiles){
2101 my ($id,$type,$own,$count,$stat) = @$mob;
2103 # next if $own <= 0;
2104 if(exists($gfod->{$own})){
2105 # could be reached with differen MOVE_WITH
2106 $defend_avatar += $count * $self->strength('AVATAR');
2107 $gfod->{$own} += $count;
2108 Util::log("(1)mobile $id: $count $type from $own fights for $defender in $self->{-location}",1);
2109 }elsif(exists($gfoa->{$own})){
2110 # could be reached with differen MOVE_WITH
2111 $attack_avatar += $count * $self->strength('AVATAR');
2112 $gfoa->{$own} += $count;
2113 Util::log("(2)mobile $id: $count $type from $own fights for $attacker in $self->{-location}",1);
2115 # TODO Performance (in the case of earthling this is not necessary)
2116 my ($att_rel,$def_rel,$foa,$fod) = (0,0,0,0);
2118 # Avatars dont fight sometimes (no mana or no help or no friend)
2119 if($type eq 'AVATAR'){
2120 # if(not $godfight){
2121 $att_rel = $self->{-context}->read_single_relation($own,$attacker);
2122 $def_rel = $self->{-context}->read_single_relation($own,$defender);
2124 $foa = 1 if Util::is_in($att_rel,'FRIEND','ALLIED');
2125 $fod = 1 if Util::is_in($def_rel,'FRIEND','ALLIED');
2127 # defender has support if in doubt
2128 $foa = 0 if $foa and $fod;
2129 $fod = 1 if not $foa and not $fod;
2131 $gfoa->{$own} += $count if $foa;
2132 $gfod->{$own} += $count if $fod;
2134 # if you dont have enough mana for all your avatars no one fights!
2135 if($stat eq 'HELP' and $self->test_mana('FIGHT_AVATAR',1,$own)){
2136 $self->use_mana($own);
2138 ($foa, $fod) = (0,0);
2144 # earthlings are simpel: no friends in field
2145 $foa = 1 if $own == $attacker;
2146 $fod = 1 if $own == $defender;
2150 Util::log("(3)mobile $id: $count $type from $own fights for ".
2151 "$attacker in $self->{-location}",1);
2152 if($type eq 'AVATAR'){
2153 # count maximum avatarpower
2154 $attack_avatar += $count * $self->strength('AVATAR');
2156 # count earthling_strength
2157 $attack_strength += $count * $self->strength($type);
2158 $people_attacker += $count;
2160 }elsif($fod){ # same for defender
2161 Util::log("(4)mobile $id: $count $type from $own fights for ".
2162 "$defender in $self->{-location}",1);
2163 if($type eq 'AVATAR'){
2164 $defend_avatar += $count * $self->strength('AVATAR');
2166 $defend_strength += $count * $self->strength($type);
2167 $people_defender += $count;
2170 Util::log("(5)mobile $id: $own dont fight with $count $type ".
2171 "in $self->{-location}",1);
2177 if($terrain eq 'CITY'){
2178 # bonus for home city
2179 if($home == $attacker){
2180 Util::log("homecity fights for $attacker",1);
2181 $attack_strength += $::conf->{-FIGHT}->{-HOME};
2182 }elsif($home == $defender and $home){
2183 Util::log("homecity fights for $defender",1);
2184 $defend_strength += $::conf->{-FIGHT}->{-HOME};
2186 }elsif($terrain eq 'ISLE'){
2188 if($occupant == $attacker){
2189 Util::log("isle fights for $attacker",1);
2190 $attack_strength += $::conf->{-FIGHT}->{-ISLE};
2191 }elsif($occupant == $defender){
2192 Util::log("isle fights for $defender",1);
2193 $defend_strength += $::conf->{-FIGHT}->{-ISLE};
2195 Util::log("impossible situation: isle fights for no one!",0);
2199 Util::log("earthling strength attacker($attacker): ".
2200 "$attack_strength, defender($defender): $defend_strength"
2203 my $pure_attack_strength = $attack_strength;
2204 my $pure_defend_strength = $defend_strength;
2206 #my $attacker_death_count = $attack_strength;
2207 #my $defender_death_count = $defend_strength;
2209 my $attacker_death_count = $people_attacker;
2210 my $defender_death_count = $people_defender;
2212 Util::log("$people_attacker people fight for attacker $attacker",1);
2213 Util::log("$people_defender people fight for defender $defender",1);
2215 my $attacker_godpower = Util::min($people_attacker,$attack_avatar);
2216 my $defender_godpower = Util::min($people_defender,$defend_avatar);
2218 Util::log("Gods supports attacker($attacker) with $attacker_godpower",1);
2219 Util::log("Gods supports defender($defender) with $defender_godpower",1);
2221 $attack_strength += $attacker_godpower;
2222 $defend_strength += $defender_godpower;
2225 # if landbattle: look, for all neighbour fields,
2226 # add flanking power of allies
2227 my ($flanking_attack,$flanking_defend) = (0,0);
2228 # if(not $self->{-see_battle} and not $self->{-island_battle}){
2229 my @neighbours = $self->get_neighbours($self->{-location});
2230 # COMMENT IN FOR NEW RULE my ($att_neighbours,$def_neighbours) = (0,0);
2231 # print "neighbours: @neighbours\n";
2232 for my $n (@neighbours){
2233 # my $n_string = $n->to_string();
2234 my ($ter,$occ,$att) = $self->{-context}->
2235 read_field('TERRAIN,OCCUPANT,ATTACKER',$n);
2236 next if $ter eq 'WATER'; # dont flank from see
2237 next if $att > 0; # dont flank from war
2238 my $attacker_relation = $self->{-context}->read_single_relation($occ,$attacker);
2239 my $defender_relation = $self->{-context}->read_single_relation($occ,$defender);
2240 Util::log("flanking ($n): $attacker_relation, $defender_relation, ".
2241 "$ter, $occ, $att",1);
2242 if($occ != $defender and
2243 ($occ == $attacker or (Util::is_in($attacker_relation,'FRIEND','ALLIED') and not
2244 Util::is_in($defender_relation,'FRIEND','ALLIED')))){
2245 # COMMENT IN FOR NEW RULE $att_neighbours++;
2246 # COMMENT IN FOR NEW RULE $flanking_attack += $::conf->{-FIGHT}->{-FLANKING} * $att_neighbours;
2247 $flanking_attack += $::conf->{-FIGHT}->{-FLANKING};
2248 Util::log("$n flanks for attacker($attacker)",1);
2249 }elsif($occ and ($occ != $attacker and
2250 ($occ == $defender or
2251 (not Util::is_in($attacker_relation,'FRIEND','ALLIED')
2252 and Util::is_in($defender_relation,'FRIEND','ALLIED'))))){
2253 # COMMENT IN FOR NEW RULE $def_neighbours++;
2254 # COMMENT IN FOR NEW RULE $flanking_defend += $::conf->{-FIGHT}->{-FLANKING} * $def_neighbours;
2255 $flanking_defend += $::conf->{-FIGHT}->{-FLANKING};
2256 Util::log("$n flanks for defender($defender)",1);
2259 Util::log("sum of flanking: $flanking_attack for attacker($attacker) and ".
2260 "$flanking_defend for defender($defender) and ",1);
2261 $attack_strength += $flanking_attack;
2262 $defend_strength += $flanking_defend;
2265 Util::log("sum strength without fortune: $attack_strength for attacker($attacker) ".
2266 "and $defend_strength for defender($defender)",1);
2268 # add random value (1 to GAME.FORTUNE)
2269 my $fortune = $self->{-context}->read_fortune();
2270 my $asf = int(rand($fortune))+1;
2271 my $dsf = int(rand($fortune))+1;
2272 $attack_strength += $asf;
2273 $defend_strength += $dsf;
2274 Util::log("strength with fortune attacker($attacker): ".
2275 "$attack_strength, defender($defender): $defend_strength",1);
2279 if($attack_strength > $defend_strength){
2280 $self->{-winner} = $attacker;
2281 $self->{-looser} = $defender;
2282 $self->{-winner_death_count} = Util::min($people_attacker - 1,
2283 int(0.5 + $defender_death_count /
2284 $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2285 $self->{-looser_death_count} = Util::max(1,int(0.5 + $attacker_death_count /
2286 $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2287 Util::log("Attackers($attacker) won!",1);
2288 $self->conquer($self->{-location},$attacker);
2290 $self->{-winner} = $defender;
2291 $self->{-looser} = $attacker;
2292 $self->{-winner_death_count} = Util::min($people_defender - 1,
2293 int(0.5 + $attacker_death_count /
2294 $::conf->{-WINNER_DEATH_COUNT_FRACTION}));
2295 $self->{-looser_death_count} = Util::max(1,int(0.5 + $defender_death_count /
2296 $::conf->{-LOOSER_DEATH_COUNT_FRACTION}));
2297 # $self->{-looser} = $efoa;
2298 # $self->{-master_looser} = $attacker;
2299 Util::log("Defenders($defender) won!",1);
2302 # loosers and helpers run away or die
2303 $self->run_or_die();
2305 # erase MAP.ATTACKER
2306 $self->{-db}->update_hash('MAP',
2307 "LOCATION=$self->{-location} AND GAME=$self->{-game}",
2311 # $self->{-mobiles} = $self->{-context}->read_mobile('ID',
2312 # 0, $self->{-location}, 1);
2314 # unify the mobiles, which are still here
2315 for my $mob_arr (@$mobiles){
2316 my ($id,$type,$owner,$count,$status) = @$mob_arr;
2317 next if exists $self->{-run_or_die}->{$id};
2318 my $mob = $self->{-db}->read_single_mobile($id);
2319 $self->unify_mobiles($mob,$self->{-location},$owner) if $mob;
2322 # sometimes the last ark is gone in battle
2323 if($terrain eq 'WATER'){
2324 $self->drowning($self->{-location});
2327 # send battle-report
2328 my $name_of_attacker = $self->{-context}->charname($attacker);
2329 my $name_of_defender = $self->{-context}->charname($defender);
2330 my $name_of_winner = $self->{-context}->charname($self->{-winner});
2332 my $text = <<END_OF_TEXT;
2333 <strong>BATTLE_REPORT $self->{-location}</strong><br>
2334 <table><tr><th></th><th>$name_of_attacker</th><th>$name_of_defender</th></tr>
2335 <tr><td>PEOPLE</td><td>$people_attacker</td>
2336 <td>$people_defender</td></tr>
2337 <tr><td>FIGHTING_STRENGTH</td><td>$pure_attack_strength</td>
2338 <td>$pure_defend_strength</td></tr>
2339 <tr><td>FLANKING</td><td>$flanking_attack</td><td>$flanking_defend</td></tr>
2340 <tr><td>GODS_HELP</td><td>$attacker_godpower</td><td>$defender_godpower</td></tr>
2341 <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
2342 <tr><td>SUM_OF_STRENGTH</td><td>$attack_strength</td><td>$defend_strength</td></tr>
2343 <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$attacker}->{'K'}</td>
2344 <td>$self->{-dead}->{$defender}->{'K'}</td></tr>
2345 <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$attacker}->{'H'}</td>
2346 <td>$self->{-dead}->{$defender}->{'H'}</td></tr>
2347 <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$attacker}->{'P'}</td>
2348 <td>$self->{-dead}->{$defender}->{'P'}</td></tr>
2349 <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$attacker}->{'A'}</td>
2350 <td>$self->{-dead}->{$defender}->{'A'}</td></tr>
2351 <tr><td>CONQUERED_ARKS</td><td>$self->{-dead}->{$defender}->{'C'}</td>
2352 <td>$self->{-dead}->{$attacker}->{'C'}</td></tr>
2354 <strong>WINNER_IS $name_of_winner</strong>.
2357 # TODO: we should make shure, that attacker and defender are receivers.
2358 # could happen, if all dying and no other unit in the neighbourhood
2359 my @gods = (keys %$gfoa, keys %$gfod);
2361 ->send_message_to_field
2362 ($self->{-location},{'MFROM' => 0,
2363 'MSG_TEXT' => $text}
2364 # 'ARG1' => $self->{-context}->charname($attacker),
2365 # 'ARG2' => $self->{-context}->charname($defender),
2366 # 'ARG3' => $self->{-context}->charname($self->{-winner}),
2367 # 'ARG4' => $self->{-location}}
2369 #,$attacker,$defender,@gods);
2378 # some people have to die
2379 $self->casualties($self->{-winner},$self->{-winner_death_count});
2380 $self->casualties($self->{-looser},$self->{-looser_death_count});
2382 # print Dumper $self->{-dead};
2385 $self->{-mobiles} = $self->{-context}->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
2386 0, $self->{-location}, 1);
2389 # TODO: no retreat if no survivors
2394 sub find_retreat_field{
2395 my ($self,$retreat_fields) = @_;
2397 my @retreat_fields = @$retreat_fields;
2399 # chose one retreat-field
2400 return $retreat_fields[rand($#retreat_fields +1)];
2404 my ($self,$unit,$count,$retreat,$type) = @_;
2406 my $looser = $self->{-looser};
2408 # calculate direction
2409 my $dir = $self->{-context}->is_in_direction_from($retreat,
2410 $self->{-location});
2412 # retreat via MOVE_WITH if retreat with ark
2413 if($type ne 'ARK' and exists $self->{-retreat_arks}->{$retreat}){
2414 my $ark = $self->{-retreat_arks}->{$retreat};
2415 $self->{-db}->update_hash('MOBILE',
2417 {'MOVE_WITH' => $ark,
2418 'AVAILABLE' => 'N'});
2419 Util::log("retreat via $ark (MOVE_WITH)",1);
2421 # TODO?: insert event
2422 $self->{-context}->insert_command('MOVE',
2423 "DIR=$dir, MOBILE=$unit, ".
2424 "COUNT=$count, AUTO=1",
2427 Util::log("retreat via MOVE_COMMAND",1);
2429 Util::log("$looser retreats from $self->{-location} to $retreat ".
2430 "in direction $dir with $count people(or ark). Mobile-ID: $unit",1);
2431 $self->{-run_or_die}->{$unit} = 1;
2434 ->send_message_to_list
2436 'MSG_TAG' => 'MSG_FIGHT_RETREAT',
2437 'ARG1' => $self->{-context}->charname($looser),
2438 'ARG2' => 'PEOPLE_OR_ARK',
2439 'ARG3' => $self->{-location},
2440 'ARG4' => $count},$looser,$self->{-winner});
2448 my $looser = $self->{-looser};
2449 Util::log("checking retreats for looser $looser ...",1);
2451 # remove MOVE_WITH if any
2452 $self->{-db}->update_hash('MOBILE',
2453 "OWNER=$looser AND LOCATION=$self->{-location} AND ".
2455 {'MOVE_WITH' => 0});
2457 # search for retreat-possibilities
2458 my ($local_terrain) = $self->{-context}->read_field('TERRAIN',$self->{-location});
2459 my @possible_retreat = $self->{-context}->own_neighbours($self->{-location},$looser);
2460 my @retreat_fields = ();
2461 my @retreat_water_fields = ();
2462 if ($local_terrain eq 'WATER' or $local_terrain eq 'ISLE'){
2463 @retreat_water_fields = @possible_retreat;
2464 Util::log("retreat from water: @possible_retreat",1);
2466 Util::log("check retreat for ...",-1);
2467 for my $field (@possible_retreat){
2468 Util::log("\n$field ",-1);
2469 my ($terrain) = $self->{-context}->read_field('TERRAIN',$field);
2470 if ($terrain eq 'WATER' or $terrain eq 'ISLE'){
2471 Util::log("... accepted water retreat to $terrain!",1);
2472 push @retreat_water_fields, $field;
2474 Util::log("... accepted land retreat to $terrain!",1);
2475 push @retreat_fields, $field;
2479 # $self->{-retreat_fields} = \@retreat_fields;
2480 # $self->{-retreat_water_fields} = \@retreat_fields;
2486 if($#retreat_water_fields >= 0){
2487 $self->{-retreat_arks} = {}; # TODO Performance: use only hashes, no arrays
2488 for my $m (@{$self->{-mobiles}}){
2489 my ($id,$type,$own,$count,$stat) = @$m;
2490 next unless $type eq 'ARK' and ($own == $self->{-looser});
2492 my $retreat_field = $self->find_retreat_field(\@retreat_water_fields);
2493 Util::log("found ark $id from $own for retreat to $retreat_field",1);
2495 $self->{-retreat_arks}->{$retreat_field} = $id;
2496 $arks{$id} = $retreat_field;
2498 if (not Util::is_in($retreat_field,@retreat_fields)){
2499 push @retreat_fields, $retreat_field;
2500 Util::log("... accepted retreat through ark $id to $retreat_field!",1);
2504 # all arks change owner to winner
2505 $self->{-db}->update_hash('MOBILE',
2506 "GAME=$self->{-game} AND ".
2507 "LOCATION=$self->{-location} AND ".
2509 {'OWNER' => $self->{-winner}});
2510 Util::log("All arks in $self->{-location} change owner to $self->{-winner}",1);
2514 # for every unit of this looser
2515 for my $mob (@{$self->{-mobiles}}){
2516 my ($id,$type,$own,$count,$stat) = @$mob;
2517 next unless $own == $looser;
2518 next if $type eq 'ARK';
2520 # if there is a way out
2521 if($#retreat_fields >= 0){
2522 my $field = $self->find_retreat_field(\@retreat_fields);
2523 Util::log("checking retreat for mobile $id ".
2524 "(own: $own, type: $type, count: $count, field: $field)",1);
2525 $self->retreat_unit($id,$count,$field,$type);
2528 $self->{-db}->delete_from('MOBILE',"ID=$id");
2529 $self->{-run_or_die}->{$id} = 1;
2532 ->send_message_to_field
2533 ($self->{-location},
2535 'MSG_TAG' => 'MSG_FIGHT_RETREAT_DIE',
2536 'ARG1' => $self->{-context}->charname($looser),
2538 'ARG3' => $self->{-location},
2539 'ARG4' => $count});#,$looser,$self->{-winner});
2540 Util::log("$looser looses $count $type in $self->{-location}".
2541 " because there is no place to retreat.",1);
2544 # MOVE COMMANDS for arks came last because others move with them
2545 for my $mob (@{$self->{-mobiles}}){
2546 my ($id,$type,$own,$count,$stat) = @$mob;
2547 next unless $own == $looser;
2548 next unless $type eq 'ARK';
2549 Util::log("checking retreat for mobile $id ".
2550 "(own: $own, type: $type, count: $count, ".
2551 "via ark $id to field: $arks{$id})",1);
2553 $self->retreat_unit($id,$count,$arks{$id},$type);
2558 my($self,$type) = @_;
2560 # return $::conf->{-SEE_FIGHT}->{"-$type"} if $self->{-naval_battle};
2561 # return $::conf->{-ISLAND_FIGHT}->{"-$type"} if $self->{-island_battle};
2562 return $::conf->{-FIGHT}->{"-$type"};
2566 # End of FIGHT_EARTHLING
2568 ####################################################
2570 ##########################################################
2576 @BLESS_HERO::ISA = qw(AymCommand);
2579 # this is called to see if the command is executable.
2580 # it should be called from first_phase() and from second_phase().
2581 # it is not called from the scheduler
2585 my @required_arguments = ('MOBILE','COUNT');
2586 return 0 unless $self->Command::is_valid(@required_arguments);
2588 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2590 return 0 unless $self->validate_role('GOD');
2592 my $mobtype = $self->{-mob}->{'TYPE'};
2593 my $mobloc = $self->{-mob}->{'LOCATION'};
2594 my $mobcount = $self->{-mob}->{'COUNT'};
2596 return 0 unless $self->test(sub{$self->{-mob}->{'TYPE'} eq 'WARRIOR'},
2598 $self->{-context}->mobile_string($mobtype,1),
2601 $self->{-count} = $self->{-args}->{'COUNT'} > $mobcount ?
2602 $mobcount : $self->{-args}->{'COUNT'};
2604 return 0 unless $self->test_mana('BLESS_HERO',$self->{-count});
2609 # this is called from Scheduler, if he see the command the
2610 # first time, some commands execute here immidiatly.
2615 return 0 unless $self->is_valid();
2618 my $id = $self->{-mob}->{'ID'};
2619 $self->conditional_split_mobile($self->{-mob},
2621 {'ADORING' => $self->{-player},
2623 'COMMAND_ID' => $self->{-dbhash}->{'ID'}},
2626 # reread mobile, because split destroys it
2627 $self->{-mob} = $self->{-db}->single_hash_select('MOBILE',"ID=$id");
2628 $self->unify_mobiles($self->{-mob},
2629 $self->{-mob}->{'LOCATION'},
2630 $self->{-mob}->{'OWNER'});
2633 # ->send_message_to_field
2634 # ($self->{-mob}->{'LOCATION'},
2636 # 'MSG_TAG' => 'MSG_BLESS_HERO',
2637 # 'ARG1' => $self->{-context}->charname($self->{-player}),
2638 # 'ARG2' => $self->{-context}->charname($self->{-mob}->{'OWNER'}),
2639 # 'ARG3' => $self->{-mob}->{'LOCATION'}});
2642 $self->setDuration(0);
2647 # this is called from scheduler when the command will be executed
2650 Util::log("BLESS_HERO should not have a second phase!",0);
2657 ####################################################
2659 ##########################################################
2665 @CH_ACTION::ISA = qw(AymCommand);
2668 # this is called to see if the command is executable.
2669 # it should be called from first_phase() and from second_phase().
2670 # it is not called from the scheduler
2674 my @required_arguments = ('ACTION','MOBILE');
2675 return 0 unless $self->Command::is_valid(@required_arguments);
2677 return 0 unless $self->validate_mobile($self->{-args}->{'MOBILE'});
2679 return 0 unless $self->validate_role('GOD');
2681 my $mobtype = $self->{-mob}->{'TYPE'};
2682 my $mobloc = $self->{-mob}->{'LOCATION'};
2684 return 0 unless $self->test(sub{$mobtype eq 'AVATAR'},
2686 $self->{-context}->mobile_string($mobtype,1),
2692 # this is called from Scheduler, if he see the command the
2693 # first time, some commands execute here immidiatly.
2698 return 0 unless $self->is_valid();
2700 my $mob = $self->{-mob};
2701 my $loc = $mob->{'LOCATION'};
2702 my $own = $self->{-player};
2703 my $action = $self->{-args}->{'ACTION'};
2705 # all avatars in the field get the new status
2706 $self->{-db}->update_hash('MOBILE',
2707 "LOCATION=$loc AND TYPE=AVATAR AND OWNER=$own ".
2708 "AND GAME=$self->{-game} AND AVAILABLE=Y",
2709 {'STATUS' => $action});
2711 $mob->{'STATUS'} = $action;
2712 $self->enter_field_avatar($loc,$mob) if $action eq 'BLOCK';
2715 # ->send_message_to_field
2716 # ($self->{-mob}->{'LOCATION'},
2718 # 'MSG_TAG' => 'MSG_CH_ACTION',
2719 # 'ARG1' => $self->{-args}->{'ACTION'},
2720 # 'ARG2' => $self->{-mob}->{'LOCATION'}});
2722 $self->setDuration(0);
2726 # this is called from scheduler when the command will be executed
2729 Util::log("CH_ACTION should not have a second phase!",0);
2736 ####################################################
2738 ####################################################
2740 # DIE_ORDER: Change the order of mobiletypes which dies in battle
2744 @DIE_ORDER::ISA = qw(AymCommand);
2749 my @required_arguments = ('DYING');
2750 return 0 unless $self->Command::is_valid(@required_arguments);
2752 return 0 unless $self->validate_role('EARTHLING');
2754 # TODO: use test with message
2755 return 0 unless Util::is_in($self->{-args}->{'DYING'},
2756 'PKH','PHK','KPH','KHP','HKP','HPK');
2764 return 0 unless $self->is_valid();
2766 my $dying = $self->{-args}->{'DYING'};
2768 $self->{-db}->update_hash('EARTHLING',
2769 "GAME=$self->{-game} AND ".
2770 "PLAYER=$self->{-player}",
2771 {'DYING' => $dying});
2773 $self->{-context}->send_message_to_me({'MFROM' => 0,
2774 'MSG_TAG' => 'MSG_DIE_ORDER',
2777 Util::log("New die order for player $self->{-player}: $dying",1);
2779 $self->setDuration(0);
2785 Util::log("Warning: We should not reach phase 2 with command DIE_ORDER",0);
2792 ################################################################
2795 ##########################################################
2801 @CH_LUCK::ISA = qw(AymCommand);
2804 # this is called to see if the command is executable.
2805 # it should be called from first_phase() and from second_phase().
2806 # it is not called from the scheduler
2810 my @required_arguments = ('BONUS');
2811 return 0 unless $self->Command::is_valid(@required_arguments);
2813 return 0 unless $self->validate_role('GOD');
2815 return 1 if $self->{-phase} == 2;
2817 return 0 unless $self->test_mana('CH_LUCK',
2818 abs($self->{-args}->{'BONUS'} * $::conf->{-MANA}->{-CH_LUCK}));
2823 # this is called from Scheduler, if he see the command the
2824 # first time, some commands execute here immidiatly.
2829 return 0 unless $self->is_valid();
2833 return $self->setDuration($::conf->{-DURATION}->{-CH_LUCK});
2836 # this is called from scheduler when the command will be executed
2839 return 0 unless $self->is_valid();
2840 my $oldfortune = $self->{-context}->read_fortune();
2842 my $change = $self->{-args}->{'BONUS'};
2844 my $newfortune = $oldfortune + $change;
2845 if($newfortune > $::conf->{-MAX_LUCK}){
2846 $newfortune = $::conf->{-MAX_LUCK};
2847 }elsif($newfortune < $::conf->{-MIN_LUCK}){
2848 $newfortune = $::conf->{-MIN_LUCK};
2851 $self->{-db}->update_hash('GAME',
2852 "GAME=$self->{-game}",
2853 {'FORTUNE' => $newfortune});
2856 ->send_message_to_all
2858 'MSG_TAG' => 'MSG_CHANGE_FORTUNE',
2859 'ARG1' => $self->{-context}->charname($self->{-player}),
2860 'ARG2' => $oldfortune,
2861 'ARG3' => $newfortune});
2870 ####################################################
2872 ##########################################################
2878 @FLOOD::ISA = qw(AymCommand);
2881 # this is called to see if the command is executable.
2882 # it should be called from first_phase() and from second_phase().
2883 # it is not called from the scheduler
2886 my $db = $self->{-db};
2887 my $context = $self->{-context};
2888 my $loc = $self->{-location};
2890 my @required_arguments = ();
2891 return 0 unless $self->Command::is_valid(@required_arguments);
2893 return 0 unless $self->validate_role('GOD');
2895 # only PLAIN and MOUNTAIN can be flooded
2896 my ($terrain) = $context->read_field('TERRAIN', $loc);
2897 return 0 unless $self->test(sub{Util::is_in($terrain,'PLAIN','MOUNTAIN');},
2898 'MSG_CANT_FLOOD_TERRAIN',
2901 $self->{-terrain} = $terrain;
2906 # this is called from Scheduler, if he see the command the
2907 # first time, some commands execute here immidiatly.
2912 return 0 unless $self->is_valid();
2914 my $loc = $self->{-location};
2916 # need own avatar to flood
2917 return 0 unless $self->avatar_available($loc);
2918 return 0 unless $self->test_mana('FLOOD');
2921 $self->setDuration($::conf->{-DURATION}->{-FLOOD});
2923 $self->event($self->{-location},
2927 return $self->{-duration};
2930 # this is called from scheduler when the command will be executed.
2934 my $loc = $self->{-location};
2935 my $db = $self->{-db};
2937 return 0 unless $self->is_valid();
2939 # mountain -> isle, plain -> water
2940 my $new = $self->{-terrain} eq 'MOUNTAIN' ? 'ISLE' : 'WATER';
2941 $db->update_hash('MAP',"LOCATION=$loc AND GAME=$self->{-game}",
2942 {'TERRAIN' => $new});
2944 # drowning of mobiles if necessary
2945 $self->drowning($loc);
2949 ->send_message_to_field
2950 ($loc,{'MFROM' => 0,
2951 'MSG_TAG' => 'MSG_FLOOD',
2952 'ARG1' => $self->{-context}->charname($self->{-player}),
2954 'ARG3' => $self->{-terrain},
2963 ####################################################
2965 ##########################################################
2971 @DESTROY::ISA = qw(AymCommand);
2974 # this is called to see if the command is executable.
2975 # it should be called from first_phase() and from second_phase().
2976 # it is not called from the scheduler
2979 my $db = $self->{-db};
2980 my $context = $self->{-context};
2981 my $loc = $self->{-location};
2983 my @required_arguments = ();
2984 return 0 unless $self->Command::is_valid(@required_arguments);
2986 return 0 unless $self->validate_role('GOD');
2988 return 0 unless $self->test_mana('DESTROY');
2990 # we cant destroy if there is only one temple unbuild
2991 # TODO: wrong. should be cant destroy, if last temple is under construction
2992 my $unbuild = $db->count('MAP',
2993 "(TERRAIN=ISLE OR TERRAIN=MOUNTAIN) ".
2994 "AND TEMPLE=N AND GAME=$self->{-game}");
2995 return 0 unless $self->test(sub{$unbuild > $::conf->{-MAX_UNBUILD_DESTROY}},
2996 'MSG_CANT_RESCUE_WORLD',
3000 # need own avatar to destroy
3001 return 0 unless $self->avatar_available($loc);
3003 # there sould be no foreign priests
3004 my $foreign_priests = $db->count('MOBILE',
3005 "GAME=$self->{-game} AND ".
3006 "LOCATION=$loc AND TYPE=PRIEST AND ".
3007 "ADORING!=$self->{-player} AND ".
3009 return 0 unless $self->test(sub{$foreign_priests == 0},
3010 'MSG_CANT_DESTROY_DEFENDED',
3013 my ($terrain,$temple,$home) = $context->read_field('TERRAIN,TEMPLE,HOME',
3016 # only if temple exists
3017 return 0 unless $self->test(sub{$temple eq 'Y'},
3018 'MSG_NO_TEMPLE_TO_DESTROY',
3021 # only destroy foreign temples
3022 return 0 unless $self->test(sub{$home != $self->{-player}},
3023 'MSG_CANT_DESTROY_OWN',
3025 $self->{-oldgod} = $home;
3028 return 0 unless $self->test(sub{$terrain eq 'ISLE'},
3029 'MSG_CANT_DESTROY_MOUNTAINS',
3035 # this is called from Scheduler, if he see the command the
3036 # first time, some commands execute here immidiatly.
3040 my $loc = $self->{-location};
3042 return 0 unless $self->is_valid();
3046 $self->{-db}->update_hash('MAP',
3047 "LOCATION=$loc AND GAME=$self->{-game}",
3051 # delete PRAY- and PRODUCE-commands and PRODUCE-PRIEST event
3052 $self->{-db}->delete_from('COMMAND',
3053 "(COMMAND=PRODUCE OR COMMAND=PRAY) ".
3054 "AND LOCATION=$loc AND GAME=$self->{-game}");
3055 $self->{-db}->delete_from('EVENT',
3056 "TAG=EVENT_PRODUCE_PRIEST ".
3057 "AND LOCATION=$loc AND GAME=$self->{-game}");
3060 ->send_message_to_field
3063 'MSG_TAG' => 'MSG_TEMPLE_DESTROYD',
3065 'ARG2' => $self->{-context}->charname($self->{-oldgod}),
3066 'ARG3' => $self->{-context}->charname($self->{-player})
3069 Util::log("Temple of $self->{-oldgod} destroyed in $self->{-location}",1);
3071 $self->setDuration(0);
3076 # this is called from scheduler when the command will be executed
3079 Util::log("DESTROY should not have a second phase!",0);
3086 ####################################################
3088 ##########################################################
3094 @MOVE_WITH::ISA = qw(AymCommand);
3097 # this is called to see if the command is executable.
3098 # it should be called from first_phase() and from second_phase().
3099 # it is not called from the scheduler
3103 my @required_arguments = ('MOBILE','COUNT','TARGET');
3104 return 0 unless $self->Command::is_valid(@required_arguments);
3106 my $args = $self->{-args};
3107 my $count = $args->{'COUNT'};
3109 # TODO: more messages
3111 return 0 unless $self->validate_mobile($args->{'MOBILE'});
3112 my $mob = $self->{-mob};
3114 # arks cant move with other units
3115 return 0 if $self->{-mob}->{'TYPE'} eq 'ARK';
3117 return 0 unless $self->test(sub {$count <= $mob->{'COUNT'} and
3118 $mob->{'AVAILABLE'} eq 'Y'},
3119 'MSG_NOT_ENOUGH_MOBILES',
3122 $mob->{'LOCATION'});
3127 # this is called from Scheduler, if he see the command the
3128 # first time, some commands execute here immidiatly.
3133 return 0 unless $self->is_valid();
3135 my $args = $self->{-args};
3137 $self->move_with($args->{'MOBILE'},$args->{'TARGET'},$args->{'COUNT'});
3142 # this is called from scheduler when the command will be executed
3145 Util::log("MOVE_WITH should not have a second phase!",0);
3152 ####################################################
3154 ##########################################################
3159 # TODO: should be in FROGS/Command.pm
3162 @SEND_MSG::ISA = qw(AymCommand);
3165 # this is called to see if the command is executable.
3166 # it should be called from first_phase() and from second_phase().
3167 # it is not called from the scheduler
3171 my @required_arguments = ('OTHER','MESSAGE');
3172 return 0 unless $self->Command::is_valid(@required_arguments);
3177 # this is called from Scheduler, if he see the command the
3178 # first time, some commands execute here immidiatly.
3183 return 0 unless $self->is_valid();
3185 my $args = $self->{-args};
3187 Util::log("send message from $self->{-player} to $args->{'OTHER'}.",1);
3189 my $msg = $args->{'MESSAGE'};
3191 # uggly workaround necessary for Command::parse_args()
3192 $msg =~ s/__COMMA__/,/g;
3193 $msg =~ s/__EQUAL__/=/g;
3194 # newline should be in html
3195 $msg =~ s/\\r\\n/<br>/g;
3197 $self->{-context}->send_message_to($args->{'OTHER'},
3198 {'MFROM' => $self->{-player},
3199 'MSG_TEXT' => $msg});
3204 # this is called from scheduler when the command will be executed
3207 Util::log("SEND_MSG should not have a second phase!",0);
3214 ####################################################
3216 ##########################################################
3223 @FIGHT_GOD::ISA = qw(AymCommand);
3225 # this is called to see if the command is executable.
3226 # it should be called from first_phase() and from second_phase().
3227 # it is not called from the scheduler
3231 my @required_arguments = ('A','B');
3232 return 0 unless $self->Command::is_valid(@required_arguments);
3234 my $A = $self->{-args}->{'A'};
3235 my $B = $self->{-args}->{'B'};
3236 my $loc = $self->{-dbhash}->{'LOCATION'};
3238 # dont accept a new FIGHT_GOD if there is allready a fight between the same gods
3239 my $fights = $self->{-db}->select_array('COMMAND','ARGUMENTS',
3240 "GAME=$self->{-game} AND ".
3241 "COMMAND=FIGHT_GOD AND ".
3242 "ID != $self->{-dbhash}->{'ID'} AND ".
3244 for my $f (@$fights){
3245 my $args = $self->parse_args($f->[0]);
3247 if( $args->{'A'} == $A and $args->{'B'} == $B){
3248 Util::log("there is allready such a fight between $A and $B in $loc.",1);
3253 # could not work, command can be inserted from earthling.
3254 # return 0 unless $self->validate_role('GOD');
3256 # return 0 unless $self->validate_this_role($self->{-args}->{'A'},'GOD');
3257 # return 0 unless $self->validate_this_role($self->{-args}->{'B'},'GOD');
3262 # this is called from Scheduler, if he sees the command the
3263 # first time, some commands execute here immidiatly.
3268 return 0 unless $self->is_valid();
3270 # calculate duration
3271 $self->setDuration($::conf->{-DURATION}->{-FIGHT_GOD});
3273 # set GOD_ATTACKER in MAP to COMMAND.ID
3274 $self->{-db}->update_hash('MAP',
3275 "LOCATION=$self->{-location} AND ".
3276 "GAME=$self->{-game}",
3277 {'GOD_ATTACKER' => $self->{-dbhash}->{'ID'}});
3279 $self->event($self->{-location},
3281 $self->{-context}->charname($self->{-args}->{'A'}),
3282 $self->{-context}->charname($self->{-args}->{'B'}),
3285 return $self->{-duration};
3288 # this is called from scheduler when the command will be executed.
3293 return 0 unless $self->is_valid();
3295 # read info from map
3296 my ($earthlingfight,$earthling);
3297 ($earthlingfight, $self->{-god_attacker}, $earthling) =
3298 $self->{-context}->read_field(
3299 'ATTACKER,GOD_ATTACKER,OCCUPANT', $self->{-location}
3302 # suspend FIGHT until end of FIGHT_GOD if any
3303 # REWRITE: suspend of avatar fight have to be encapsulated
3304 if($earthlingfight){
3305 ## REWRITE: SQL: sort events up to time, limit output to ONE
3306 # read all earthling-events for this field.
3307 my @events = @{$self->{-db}->select_array('EVENT','ID,TIME',
3308 "GAME=$self->{-game} AND ".
3309 "LOCATION=$self->{-location} AND ".
3310 "TAG=FIGHT_EARTHLING")};
3311 # which one is the latest?
3312 my ($late_time, $late_id) = (0,0);
3313 for my $ev (@events){
3314 my ($id, $time) = @$ev;
3315 my $ev_time = &::str2time($time,'GMT');
3316 Util::log("found FIGHT_EARTHLING with time $time",1);
3317 ($late_time, $late_id) = ($ev_time, $id) if $ev_time > $late_time;
3320 # insert new godfight with one second more.
3321 # TODO: use here the new AFTER-System instead
3322 my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($late_time + 1);
3323 $late_time = sprintf ("%04u-%02u-%02u %02u:%02u:%02u",
3324 $year,$month,$day, $hour,$min,$sec);
3325 Util::log("found earthling fight! suspend godfight until $late_time",1);
3326 $self->{-context}->insert_command('FIGHT_GOD',
3327 "A=$self->{-args}->{'A'}, ".
3328 "B=$self->{-args}->{'B'}",
3332 $self->{-db}->update_hash('EVENT',
3333 "COMMAND_ID=$self->{-dbhash}->{'ID'}",
3334 {'TIME' => $late_time});
3335 $self->stop_fight();
3339 # get all mobiles here
3340 my $mobiles = $self->{-context}->read_mobile_condition(
3341 'ID,OWNER,COUNT,TYPE',
3342 "LOCATION=$self->{-location} "."AND AVAILABLE=Y"
3344 $self->{-mobiles} = $mobiles;
3346 my $A = $self->{-args}->{'A'};
3347 my $B = $self->{-args}->{'B'};
3348 my ($avatars_A, $avatars_B) = (0,0);
3350 # for every avatar-unit in the field
3351 # REWRITE: this block tries to count the opposing avatars: simplify!
3352 for my $a (@$mobiles){
3353 my ($id,$own,$count,$type) = @$a;
3354 next unless $type eq 'AVATAR';
3356 Util::log("found $count avatar(s) from $own with id $id",1);
3358 # determine side of owner
3359 my $side = $self->which_side($own);
3361 # calculate strength_of_side
3363 $avatars_A += $count;
3364 }elsif($side eq 'B'){
3365 $avatars_B += $count;
3369 my $mana = $::conf->{-MANA}->{-FIGHT_AVATAR};
3370 my $mana_A = $self->instant_use_mana($mana,$A);
3371 my $mana_B = $self->instant_use_mana($mana,$B);
3372 my $strength_A = $avatars_A * $::conf->{-FIGHT}->{-AVATAR};
3373 my $strength_B = $avatars_B * $::conf->{-FIGHT}->{-AVATAR};
3375 # TODO?: message in this case
3376 unless($mana_A >= $mana){
3377 Util::log("$A has not enough mana left to fight",1);
3380 unless($mana_B >= $mana){
3381 Util::log("$B has not enough mana left to fight",1);
3385 # swl: Strength_Without_Luck strenght_X: Strenght_with_luck
3386 my ($swlA,$swlB) = ($strength_A,$strength_B);
3388 # add random value (1 to GAME.FORTUNE)
3389 my $fortune = $self->{-context}->read_fortune();
3390 Util::log("avatarfight in $self->{-location}: strength without fortune player $A: ".
3391 "$strength_A, player $B: $strength_B",1);
3392 $strength_A += int(rand($fortune))+1;
3393 $strength_B += int(rand($fortune))+1;
3394 Util::log("strength with fortune player $A: ".
3395 "$strength_A, player $B: $strength_B",1);
3397 # how much avatars should die?
3398 my ($dead_A,$dead_B) = (0,0);
3399 my ($winner,$looser) = (0,0);
3401 if( ($strength_A > $strength_B && $mana_A) or
3402 $mana_A && !$mana_B )
3404 Util::log("$A wins!",1);
3405 $winner = $A; $looser = $B;
3406 ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B);
3408 elsif( ($strength_B > $strength_A && $mana_B) or
3409 $mana_B && !$mana_A )
3411 Util::log("$B wins!",1);
3412 $winner = $B; $looser = $A;
3413 ($dead_B, $dead_A) = _calc_dead_avatars($avatars_B, $avatars_A);
3417 Util::log("Both sides looses!",1);
3418 ($dead_A, $dead_B) = _calc_dead_avatars($avatars_A, $avatars_B, 'drawn');
3421 my ($new_heros_A, $new_heros_B) = (0,0);
3422 $new_heros_A = $self->die($A, $dead_A, $earthling) if $dead_A;
3425 $self->{-mobiles} = $self->{-context}->
3426 read_mobile_condition('ID,OWNER,COUNT,TYPE',
3427 "LOCATION=$self->{-location} ".
3430 $new_heros_B = $self->die($B,$dead_B,$earthling) if $dead_B;
3432 # surviving loosers go home
3434 $self->teleport($looser);
3436 # both sides are looser!
3437 $self->teleport($A);
3438 $self->teleport($B);
3441 $self->stop_fight();
3443 my $earthling_name = $self->{-context}->charname($earthling);
3444 my $name_of_A = $self->{-context}->charname($A);
3445 my $name_of_B = $self->{-context}->charname($B);
3446 my $asf = $strength_A - $swlA;
3447 my $dsf = $strength_B - $swlB;
3448 $winner = $winner ? $self->{-context}->charname($winner) : 'NOBODY';
3450 my $text = <<END_OF_TEXT;
3451 <strong>BATTLE_REPORT $self->{-location}</strong><br>
3452 <table><tr><th></th><th>$name_of_A</th><th>$name_of_B</th></tr>
3453 <tr><td>MOBILE_AVATAR_PL</td><td>$avatars_A</td><td>$avatars_B</td></tr>
3454 <tr><td>FIGHTING_STRENGTH</td><td>$swlA</td>
3456 <tr><td>LUCK</td><td>$asf</td><td>$dsf</td></tr>
3457 <tr><td>SUM_OF_STRENGTH</td><td>$strength_A</td><td>$strength_B</td></tr>
3458 <tr><td>DEAD_AVATARS</td><td>$dead_A</td>
3459 <td>$dead_B</td></tr>
3460 <tr><td>NEW_HEROS $earthling_name</td><td>$new_heros_A</td>
3461 <td>$new_heros_B</td></tr>
3463 <strong>WINNER_IS $winner</strong>.
3466 $self->{-context}->send_message_to_field(
3468 {'MFROM' => 0, 'MSG_TEXT' => $text}
3472 # _calc_dead_avatars
3473 # Calculates number of dead avatars on winner's and looser's side.
3476 # - # winner avatars
3477 # - # looser avatars
3478 # - drawn [OPTIONAL, boolean]
3481 # - # dead winner avatars
3482 # - # dead looser avatars
3484 sub _calc_dead_avatars
3486 my ($winner, $looser, $drawn) = @_;
3487 my ($dead_winner, $dead_looser) = (0,0);
3489 # the winner counts as looser if the fight is drawn!
3490 if (defined $drawn && $drawn)
3492 $dead_winner = Util::max(
3494 int(0.5 + $looser / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3499 $dead_winner = Util::min(
3501 int(0.5 + $looser / $::conf->{-WINNER_AVATARS_DYING_FRACTION})
3505 $dead_looser = Util::max(
3507 int(0.5 + $winner / $::conf->{-LOOSER_AVATARS_DYING_FRACTION})
3510 # ensure that there not dying more avatars than existing
3511 $dead_looser = $dead_looser > $looser ? $looser : $dead_looser;
3512 $dead_winner = $dead_winner > $winner ? $winner : $dead_winner;
3514 return ($dead_winner, $dead_looser);
3519 # set MAP.GOD_ATTACKER to 0, if there is our own command-ID
3523 my $own_command = $self->{-dbhash}->{'ID'};
3524 if($own_command == $self->{-god_attacker}){
3525 $self->{-db}->update_hash('MAP',
3526 "LOCATION=$self->{-location} AND ".
3527 "GAME=$self->{-game}",
3528 {'GOD_ATTACKER' => 0});
3533 # teleports all of $god from $loc to location of avatar-creation
3535 my($self,$god) = @_;
3536 my $loc = $self->{-location};
3538 # teleport surviving avatars of looser to home
3539 my $home = $self->{-context}->incarnation_place($god);
3540 Util::log("We teleport all Avatars of $god from $loc to $home.",1);
3542 $self->{-db}->update_hash('MOBILE',
3543 "TYPE=AVATAR AND OWNER=$god AND AVAILABLE=Y AND ".
3544 "LOCATION=$self->{-location}",
3545 {'LOCATION' => $home});
3547 # get all avatar there
3548 my $avatars = $self->{-context}->read_mobile_condition('ID',
3553 # dont call this more than one time!
3554 #for my $avat (@$avatars){
3555 my ($id) = $avatars->[0]->[0];
3556 $self->enter_field_avatar($home,$id);
3561 # kills $to_kill avatars of owner in location and create heros for earthling,
3564 my ($self,$owner,$to_kill,$earthling) = @_;
3565 Util::log("$to_kill avatars from $owner dying.",1);
3567 my $loc = $self->{-location};
3568 my $mobiles = $self->{-mobiles};
3570 my $to_hero = $to_kill;
3571 my $real_to_hero = 0;
3572 for my $a (@$mobiles){
3573 my ($id,$own,$count,$type) = @$a;
3574 if($own eq $owner and $to_kill){
3575 if($count <= $to_kill){
3576 $self->{-db}->delete_from('MOBILE', "ID=$id");
3578 # last unless $to_kill > 0;
3580 $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => ($count - $to_kill)});
3584 # add the strength of the death avatar to gods last battle
3585 #my ($actual) = $self->{-db}->single_select("SELECT DEATH_AVATAR FROM GOD WHERE ".
3586 #"GAME=$self->{-game} AND ".
3587 # # "PLAYER=$owner");
3588 # Util::log("AVATAR dying: adds strength to last-battle-strength of $owner",1);
3589 # $self->{-db}->update_hash('GOD',
3590 # "GAME=$self->{-game} AND PLAYER=$owner",
3591 # {'DEATH_AVATAR' => $actual + 1});
3597 # 'MSG_TAG' => 'MSG_AVATAR_DEAD',
3599 # 'ARG2' => $self->{-context}->charname($owner)});
3600 # Util::log("One avatar of $owner died in $loc.",1);
3602 }elsif($own eq $earthling and $type eq 'WARRIOR' and $to_hero){
3603 if($count <= $to_hero){
3604 $self->{-db}->delete_from('MOBILE', "ID=$id");
3606 $real_to_hero += $count;
3607 # last unless $to_hero > 0;
3609 $self->{-db}->update_hash('MOBILE', "ID=$id", {'COUNT' => $count-$to_hero});
3610 $real_to_hero += $to_hero;
3615 last if $to_kill <= 0 and $to_hero <= 0;
3619 my $id = $self->{-db}->find_first_free('MOBILE','ID');
3620 my $mob = {'ID' => $id,
3621 'GAME' => $self->{-game},
3622 'LOCATION' => $self->{-location},
3624 'OWNER' => $earthling,
3625 'COUNT' => $real_to_hero,
3626 'ADORING' => $owner,
3628 'COMMAND_ID' => $self->{-dbhash}->{'ID'},
3630 # $self->{-mob} = $mob;
3631 my %mobcopy = (%$mob);
3632 $self->{-db}->insert_hash('MOBILE',\%mobcopy);
3633 $self->unify_mobiles($id,$self->{-location},$earthling);
3634 Util::log("$real_to_hero warriors from $earthling blessed to hero",1);
3636 return $real_to_hero;
3639 # this function decides on which side other gods fight
3640 # TODO: do we really need this complicated stuff
3642 my($self,$own) = @_;
3644 my $A = $self->{-args}->{'A'};
3645 my $B = $self->{-args}->{'B'};
3648 $side = 'A' if $own == $A;
3649 $side = 'B' if $own == $B;
3652 my $allA = $self->{-context}->simplyfied_single_relation($own,$A);
3653 my $allB = $self->{-context}->simplyfied_single_relation($own,$B);
3654 if ($allA eq $allB) {
3656 } elsif ($allA eq 'FRIEND') {
3658 } elsif ($allB eq 'FRIEND') {
3660 } elsif ($allA eq 'FOE') {
3662 } elsif ($allB eq 'FOE') {
3672 ####################################################
3674 ##########################################################
3680 @PLAGUE::ISA = qw(AymCommand);
3683 # this is called to see if the command is executable.
3684 # it should be called from first_phase() and from second_phase().
3685 # it is not called from the scheduler
3689 my @required_arguments = ('TYPE');
3690 return 0 unless $self->Command::is_valid(@required_arguments);
3693 return 0 unless $self->validate_role('GOD');
3695 # test known plagues
3696 unless(Util::is_in($self->{-args}->{'TYPE'},@{$::conf->{-PLAGUES}})){
3697 Util::log("wrong type of plague: $self->{-args}->{'TYPE'}",0);
3704 # this is called from Scheduler, if he see the command the
3705 # first time, some commands execute here immidiatly.
3710 return 0 unless $self->is_valid();
3712 my $args = $self->{-args};
3713 my $loc = $self->{-dbhash}->{'LOCATION'};
3714 my $type = $args->{'TYPE'};
3715 my $spread = $args->{'SPREAD'};
3716 my $context = $self->{-context};
3718 my ($plague,$terrain) = $context->read_field('PLAGUE,TERRAIN', $loc);
3719 $plague = '' unless defined $plague;
3721 Util::log("old plague: $plague",1);
3723 # if plagu not allready here
3724 unless($plague =~ /$type/){
3727 # need own avatar to plague
3728 return 0 unless $self->avatar_available($loc);
3730 if($self->test_mana($type,1)){
3736 Util::log("new plague in $loc: $type",1);
3739 my $new_plague = $plague ? "$plague,$type" : $type;
3740 $self->{-db}->update_hash('MAP',
3741 "GAME=$self->{-game} AND ".
3743 {'PLAGUE' => $new_plague});
3745 Util::log("plague $type is allready in $loc.",1);
3746 # stop if there is another plague command in location of same type.
3747 # TODO: simplify this with a LIKE-clause,
3748 # but: we have to rewrite quote_condition() first :-(
3749 my $commands = $self->{-db}->select_array('COMMAND',
3751 "COMMAND=PLAGUE AND ".
3752 "GAME=$self->{-game} AND ".
3753 "LOCATION=$loc AND ".
3754 "ID != $self->{-dbhash}->{'ID'}");
3755 for my $c (@$commands){
3756 my ($args,$id) = @$c;
3757 # next if $id == $self->{-dbhash}->{'ID'};
3758 if($args =~ /$type/){
3759 Util::log("There is allready another PLAGUE-command of $type in $loc",1);
3765 $self->setDuration($::conf->{-DURATION}->{-PLAGUE});
3766 return $self->{-duration};
3769 # this is called from scheduler when the command will be executed
3773 my $loc = $self->{-dbhash}->{'LOCATION'};
3774 my $type = $self->{-args}->{'TYPE'};
3775 my $context = $self->{-context};
3777 # heal plague with priests
3778 my $priests = $context->count_mobile('PRIEST',$loc);
3779 my $heal_prob = $priests ? 1 - 1/$priests * $::conf->{-HEAL_PLAGUE} : 0;
3780 Util::log("Heal probability: $heal_prob",1);
3781 if($heal_prob > rand(1)){
3782 Util::log("heal plague of type $type in $loc",1);
3783 my ($plague) = $context->read_field('PLAGUE,TERRAIN', $loc);
3784 if(defined $plague){
3785 $plague =~ s/$type//;
3786 $self->{-db}->update_hash('MAP',
3787 "GAME=$self->{-game} AND LOCATION=$loc",
3788 {'PLAGUE' => $plague});
3791 # spread plague to neighbour-fields
3792 my @neighbours = $self->get_neighbours();
3793 for my $field (@neighbours){
3794 my ($terrain,$owner) = $context->read_field('TERRAIN,OCCUPANT',$field);
3795 # $self->{-occ} = $owner;
3796 if(rand(1) < $::conf->{-SPREAD_PLAGUE}->{$terrain}){
3797 Util::log("spread $type from $loc to $field",1);
3798 $context->insert_command('PLAGUE',"TYPE=$type, SPREAD=1",$field);
3803 $self->do_it_again({'SPREAD' => 1});
3812 my $context = $self->{-context};
3814 my $type = $self->{-args}->{'TYPE'};
3815 Util::log("Do effect of type $type.",1);
3817 my $loc = $self->{-dbhash}->{'LOCATION'};
3819 # effect of INFLUENZA is done in PRODUCE
3820 if($type eq 'PESTILENTIA'){
3821 my ($vic) = $context->read_field('OCCUPANT',$loc);;
3823 # count people of owner in field
3824 my $people = $context->count_people($loc,$vic);
3825 $people = 0 unless defined $people;
3826 Util::log("$people people from $vic counted in $loc.",1);
3827 my $victims = int($people * $::conf->{-PESTILENTIA_DEATH_SHARE});
3828 Util::log("$victims from them have to die.",1);
3829 return unless $victims;
3831 $self->{-mobiles} = $context->read_mobile('ID,TYPE,OWNER,COUNT,STATUS',
3832 0, $self->{-location}, 1);
3834 $self->casualties($vic,$victims,1);
3837 my $name_of_victim = $context->charname($vic);
3838 my $text = <<END_OF_TEXT;
3839 <strong>CASUALTIES_OF_PESTILENTIA $self->{-location} $name_of_victim</strong><br>
3840 <table><tr><th></th><th></th></tr>
3841 <tr><td>DEAD_WARRIORS</td><td>$self->{-dead}->{$vic}->{'K'}</td></tr>
3842 <tr><td>DEAD_HEROS</td><td>$self->{-dead}->{$vic}->{'H'}</td></tr>
3843 <tr><td>DEAD_PRIESTS</td><td>$self->{-dead}->{$vic}->{'P'}</td></tr>
3844 <tr><td>SUNKEN_ARKS</td><td>$self->{-dead}->{$vic}->{'A'}</td></tr>
3848 $context->send_message_to_field
3849 ($self->{-location},{'MFROM' => 0,
3850 'MSG_TEXT' => $text}
3851 # 'ARG1' => $self->{-context}->charname($attacker),
3852 # 'ARG2' => $self->{-context}->charname($defender),
3853 # 'ARG3' => $self->{-context}->charname($self->{-winner}),
3854 # 'ARG4' => $self->{-location}}
3856 #,$attacker,$defender,@gods);
3858 Util::log("no effect",1);
3865 ####################################################