1 ##########################################################################
3 # Copyright (c) 2003 Aymargeddon Development Team
6 # "FROGS" = Framework for Realtime Online Games of Strategy
8 # FROGS 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 # FROGS 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 use POSIX qw(ceil floor);
30 # We define two classes, which gives an implementation of Maps as a
33 # TODO: selects to DataBase.pm
36 # Location. This is a class with two coordinates.
41 my ($class,$x,$y) = @_;
43 my $self = { -x => $x, -y => $y };
50 return ($self->{-x},$self->{-y});
54 my ($self, $loc) = @_;
55 my ($x,$y) = $loc->get();
56 return ($x == $self->{-x} and $y == $self->{-y});
61 return $self->{-x} . '_' . $self->{-y};
65 my ($class, $string) = @_;
67 # print "CLASS: $class, STRING: $string\n";
69 $string =~ /^(\d+)_(\d+)$/;
70 my ($x, $y) = ($1,$2);
71 # print "x: $x, y: $y\n";
72 my $self = { -x => $1,
80 $loc =~ s/^(\d+)_(\d+)$/\($1, $2\)/;
86 return 1 if $string =~ /^(\d+)\_(\d+)$/;
94 @HexTorus::ISA = qw(Map);
104 bless($self, $class);
108 # returns a list of neighbours of field x,y in
109 # an hex-torus with size 2n * n
110 # this function is more effective than the generalised
111 # distant_neighbours from Map.pm
112 # TODO BUG: dont return doubbles in turn-around
117 my $n = $self->{-size};
118 my ($x,$y) = $loc->get();
120 return (new Location($x,($y-1)%$n),
121 new Location($x,($y+1)%$n),
122 new Location(($x-1)%($n*2),$y),
123 new Location(($x+1)%($n*2),$y),
124 new Location(($x+1)%($n*2),($y-1)%$n),
125 new Location(($x-1)%($n*2),($y+1)%$n));
128 # returns the neighbour in the given direction.
129 # direction can be one of qw(NW N NE S SW SE)
131 my ($self, $loc, $dir) = @_;
132 my ($x,$y) = $loc->get();
135 my ($xx,$yy) = ($x,$y);
136 my $n = $self->{-size};
138 $yy = ($yy - 1) % $n;
140 $yy = ($yy + 1) % $n;
141 }elsif($dir eq 'SW'){
142 $xx = ($xx - 1) % ($n * 2);
143 $yy = ($yy + 1) % $n;
144 }elsif($dir eq 'SE'){
145 $xx = ($xx + 1) % ($n * 2);
146 }elsif($dir eq 'NW'){
147 $xx = ($xx - 1) % ($n * 2);
148 }elsif($dir eq 'NE'){
149 $xx = ($xx + 1) % ($n * 2);
150 $yy = ($yy - 1) % $n;
152 Util::log("HexTorus::get_neighbour(): unknown direction: $dir\n",0);
155 return Location->new($xx,$yy);
158 # returns the direction from $from to $to (assumes they are neighbours)
160 my($self,$from,$to) = @_;
162 # print "get_direction(".$from->to_string().", ".$to->to_string().")\n";
164 for my $dir (qw(NW N NE S SW SE)){
165 my $neighbour = $self->get_neighbour($from,$dir);
166 # print "test $dir from ".$from->to_string().": ".$neighbour->to_string()."\n";
167 return $dir if $to->equal($neighbour);
172 # returns the distance between two fields in
173 # an hex-torus with size 2n * n
176 my ($loc1,$loc2) = @_;
178 my $n = $self->{-size};
179 my ($xx,$yy) = $loc1->get();
180 my ($x,$y) = $loc2->get();
182 if($xx > $n * 2 or $x > $n * 2 or $yy > $n or $y > $n){
183 print "range error in distance ($n,$xx,$x,$yy,$y) !\n";
187 return 0 if($xx == $x and $yy == $y);
189 my $xd = abs($x-$xx);
190 $xd = 2 * $n - $xd if $xd > $n;
191 my $sd = abs($x-$xx+$y -$yy) % $n;
192 $sd = $n - $sd if 2* $sd > $n;
193 my $yd = abs($y-$yy);
194 $yd = $n - $yd if 2 * $yd > $n;
196 if($xd+$yd+$sd == $n){
198 if(2*$xd == $n) # this occures only for even n
200 # there must be some easier way to distinguish
201 # fields in se/nw direction from those in sw/ne
203 my $xp = abs($x-$xx+1);
204 $xp = 2 * $n - $xp if $xp > $n;
205 my $sp = abs($x -$xx +$y -$yy +1) % $n;
206 $sp = $n - $sp if 2* $sp > $n;
207 return $xd if $xp+$sp != $xd+$sd;
209 $yd = $sd if $sd > $yd;
212 return $xd if 2 * $xd > $n;
213 return ($xd+$yd+$sd)/2;
216 # returns a random location
219 my $n = $self->{-size};
221 my $x = POSIX::floor(rand($n*2));
222 my $y = POSIX::floor(rand($n));
224 my $loc = new Location($x,$y);
228 # iterator for all locations
232 my $n = $self->{-size};
234 my ($x, $y) = $loc->get();
238 $y = 0 if(++$y > $n);
240 return new Location($x, $y);
243 # returns all locations for which $code evals to true
248 my $n = $self->{-size};
251 for my $x (0..($n*2-1)){
252 for my $y (0..($n-1)){
253 my $loc = new Location($x,$y);
254 # print $loc->to_string() . "\n";
269 for my $terrain (@mapping){
270 for my $xy (@{$terrain->[0]}){
271 my ($x,$y) = $xy->get();
272 $array[$x][$y] = $terrain->[1],
278 # TODO: use FROGS::DataBase.pm
280 my ($self, $dbh, $game_id, $game_name, $game_speed, $default, @mapping) = @_;
281 $default = $dbh->quote($default);
282 $game_name = $dbh->quote($game_name);
284 my $n = $self->{-size};
287 my $insert_game = "INSERT INTO GAME (GAME,NAME,SIZE,SPEED,FORTUNE,START_MANA) VALUES".
288 " ($game_id,$game_name,$n,$game_speed,".
289 "$::conf->{-START_FORTUNE},$::conf->{-START_MANA})";
290 print $insert_game ."\n";
291 my $h = $dbh->prepare($insert_game);
295 my @db_map = @{$self->fill_array(@mapping)};
298 for my $y (0..($n - 1)){
299 for my $x ( 0 .. ($n*2-1)){
301 my $loc = new Location($x,$y);
302 my $loc_string = $dbh->quote($loc->to_string());
303 if(defined $db_map[$x][$y]){
305 $insert_map = "INSERT INTO MAP (GAME,LOCATION,TERRAIN)".
306 "VALUES ($game_id,$loc_string,".
307 $dbh->quote($db_map[$x][$y]).")";
310 $insert_map = "INSERT INTO MAP (GAME,LOCATION,TERRAIN)".
311 "VALUES ($game_id,$loc_string,$default)";
313 # print "$insert_map\n";
315 $dbh->do($insert_map);
323 my $default_string = shift;
326 my @ascii_map = @{$self->fill_array(@mapping)};
328 my $n = $self->{-size};
330 for my $y (0..($n - 1)){
331 for my $x ( 0 .. ($n*2-1)){
332 if(defined $ascii_map[$x][$y]){
333 $out .= $ascii_map[$x][$y] ;
339 $out .= "\n" . (' ' x ($y +1));
344 $out .= "$default_string: \t$default\n";
345 for my $terrain (@mapping){
346 $out .= $terrain->[2] . ": \t" .
347 $terrain->[1] . "\n";