1 ##########################################################################
3 # Copyright (c) 2003-2012 Aymargeddon Development Team
5 # This file is part of "Last days of Aymargeddon" - a massive multi player
6 # onine game of strategy
8 # This program is free software: you can redistribute it and/or modify
9 # it under the terms of the GNU Affero General Public License as
10 # published by the Free Software Foundation, either version 3 of the
11 # License, or (at your option) any later version.
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
17 # See the GNU Affero General Public License for more details.
19 # You should have received a copy of the GNU Affero General Public License
20 # along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ###########################################################################
26 use POSIX qw(ceil floor);
31 # We define two classes, which gives an implementation of Maps as a
34 # TODO: selects to DataBase.pm
37 # Location. This is a class with two coordinates.
42 my ($class,$x,$y) = @_;
44 my $self = { -x => $x, -y => $y };
51 return ($self->{-x},$self->{-y});
55 my ($self, $loc) = @_;
56 my ($x,$y) = $loc->get();
57 return ($x == $self->{-x} and $y == $self->{-y});
62 return $self->{-x} . '_' . $self->{-y};
66 my ($class, $string) = @_;
68 # print "CLASS: $class, STRING: $string\n";
70 $string =~ /^(\d+)_(\d+)$/;
71 my ($x, $y) = ($1,$2);
72 # print "x: $x, y: $y\n";
73 my $self = { -x => $1,
81 $loc =~ s/^(\d+)_(\d+)$/\($1, $2\)/;
87 return 1 if $string =~ /^(\d+)\_(\d+)$/;
95 @HexTorus::ISA = qw(Map);
105 bless($self, $class);
109 # returns a list of neighbours of field x,y in
110 # an hex-torus with size 2n * n
111 # this function is more effective than the generalised
112 # distant_neighbours from Map.pm
113 # TODO BUG: dont return doubbles in turn-around
118 my $n = $self->{-size};
119 my ($x,$y) = $loc->get();
121 return (new Location($x,($y-1)%$n),
122 new Location($x,($y+1)%$n),
123 new Location(($x-1)%($n*2),$y),
124 new Location(($x+1)%($n*2),$y),
125 new Location(($x+1)%($n*2),($y-1)%$n),
126 new Location(($x-1)%($n*2),($y+1)%$n));
129 # returns the neighbour in the given direction.
130 # direction can be one of qw(NW N NE S SW SE)
132 my ($self, $loc, $dir) = @_;
133 my ($x,$y) = $loc->get();
136 my ($xx,$yy) = ($x,$y);
137 my $n = $self->{-size};
139 $yy = ($yy - 1) % $n;
141 $yy = ($yy + 1) % $n;
142 }elsif($dir eq 'SW'){
143 $xx = ($xx - 1) % ($n * 2);
144 $yy = ($yy + 1) % $n;
145 }elsif($dir eq 'SE'){
146 $xx = ($xx + 1) % ($n * 2);
147 }elsif($dir eq 'NW'){
148 $xx = ($xx - 1) % ($n * 2);
149 }elsif($dir eq 'NE'){
150 $xx = ($xx + 1) % ($n * 2);
151 $yy = ($yy - 1) % $n;
153 Util::log("HexTorus::get_neighbour(): unknown direction: $dir\n",0);
156 return Location->new($xx,$yy);
159 # returns the direction from $from to $to (assumes they are neighbours)
161 my($self,$from,$to) = @_;
163 # print "get_direction(".$from->to_string().", ".$to->to_string().")\n";
165 for my $dir (qw(NW N NE S SW SE)){
166 my $neighbour = $self->get_neighbour($from,$dir);
167 # print "test $dir from ".$from->to_string().": ".$neighbour->to_string()."\n";
168 return $dir if $to->equal($neighbour);
173 # returns the distance between two fields in
174 # an hex-torus with size 2n * n
177 my ($loc1,$loc2) = @_;
179 my $n = $self->{-size};
180 my ($xx,$yy) = $loc1->get();
181 my ($x,$y) = $loc2->get();
183 if($xx > $n * 2 or $x > $n * 2 or $yy > $n or $y > $n){
184 print "range error in distance ($n,$xx,$x,$yy,$y) !\n";
188 return 0 if($xx == $x and $yy == $y);
190 my $xd = abs($x-$xx);
191 $xd = 2 * $n - $xd if $xd > $n;
192 my $sd = abs($x-$xx+$y -$yy) % $n;
193 $sd = $n - $sd if 2* $sd > $n;
194 my $yd = abs($y-$yy);
195 $yd = $n - $yd if 2 * $yd > $n;
197 if($xd+$yd+$sd == $n){
199 if(2*$xd == $n) # this occures only for even n
201 # there must be some easier way to distinguish
202 # fields in se/nw direction from those in sw/ne
204 my $xp = abs($x-$xx+1);
205 $xp = 2 * $n - $xp if $xp > $n;
206 my $sp = abs($x -$xx +$y -$yy +1) % $n;
207 $sp = $n - $sp if 2* $sp > $n;
208 return $xd if $xp+$sp != $xd+$sd;
210 $yd = $sd if $sd > $yd;
213 return $xd if 2 * $xd > $n;
214 return ($xd+$yd+$sd)/2;
217 # returns a random location
220 my $n = $self->{-size};
222 my $x = POSIX::floor(rand($n*2));
223 my $y = POSIX::floor(rand($n));
225 my $loc = new Location($x,$y);
229 # iterator for all locations
233 my $n = $self->{-size};
235 my ($x, $y) = $loc->get();
239 $y = 0 if(++$y > $n);
241 return new Location($x, $y);
244 # returns all locations for which $code evals to true
249 my $n = $self->{-size};
252 for my $x (0..($n*2-1)){
253 for my $y (0..($n-1)){
254 my $loc = new Location($x,$y);
255 # print $loc->to_string() . "\n";
270 for my $terrain (@mapping){
271 for my $xy (@{$terrain->[0]}){
272 my ($x,$y) = $xy->get();
273 $array[$x][$y] = $terrain->[1],
279 # TODO: use FROGS::DataBase.pm
281 my ($self, $dbh, $game_id, $game_name, $game_speed, $default, @mapping) = @_;
282 $default = $dbh->quote($default);
283 $game_name = $dbh->quote($game_name);
285 my $n = $self->{-size};
288 my $insert_game = "INSERT INTO GAME (GAME,NAME,SIZE,SPEED,FORTUNE,START_MANA) VALUES".
289 " ($game_id,$game_name,$n,$game_speed,".
290 "$::conf->{-START_FORTUNE},$::conf->{-START_MANA})";
291 print $insert_game ."\n";
292 my $h = $dbh->prepare($insert_game);
296 my @db_map = @{$self->fill_array(@mapping)};
299 for my $y (0..($n - 1)){
300 for my $x ( 0 .. ($n*2-1)){
302 my $loc = new Location($x,$y);
303 my $loc_string = $dbh->quote($loc->to_string());
304 if(defined $db_map[$x][$y]){
306 $insert_map = "INSERT INTO MAP (GAME,LOCATION,TERRAIN)".
307 "VALUES ($game_id,$loc_string,".
308 $dbh->quote($db_map[$x][$y]).")";
311 $insert_map = "INSERT INTO MAP (GAME,LOCATION,TERRAIN)".
312 "VALUES ($game_id,$loc_string,$default)";
314 # print "$insert_map\n";
316 $dbh->do($insert_map);
324 my $default_string = shift;
327 my @ascii_map = @{$self->fill_array(@mapping)};
329 my $n = $self->{-size};
331 for my $y (0..($n - 1)){
332 for my $x ( 0 .. ($n*2-1)){
333 if(defined $ascii_map[$x][$y]){
334 $out .= $ascii_map[$x][$y] ;
340 $out .= "\n" . (' ' x ($y +1));
345 $out .= "$default_string: \t$default\n";
346 for my $terrain (@mapping){
347 $out .= $terrain->[2] . ": \t" .
348 $terrain->[1] . "\n";