=head1 NAME Crossfire::Map - represent a crossfire map =cut package Crossfire::Map; our $VERSION = '0.1'; use strict; use Carp (); use Crossfire; use base 'Exporter'; sub new { my ($class, $width, $height) = @_; bless { width => $width, height => $height }, $class } sub new_from_file { new_from_archlist {$_[0]} read_arch $_[1] } sub new_from_archlist { my ($class, $mapa) = @_; my %meta; my ($mapx, $mapy); my $map; for (@{ $mapa->{arch} }) { my ($x, $y) = (delete $_->{x}, delete $_->{y}); if ($_->{_name} eq "map") { $meta{info} = $_; $mapx = $_->{width} || $x; $mapy = $_->{height} || $y; } else { push @{ $map->[$x][$y] }, $_; # arch map is unreliable w.r.t. width and height $mapx = $x + 1 if $mapx <= $x; $mapy = $y + 1 if $mapy <= $y; #$mapx = $a->{x} + 1, warn "$mapname: arch '$a->{_name}' outside map width at ($a->{x}|$a->{y})\n" if $mapx <= $a->{x}; #$mapy = $a->{y} + 1, warn "$mapname: arch '$a->{_name}' outside map height at ($a->{x}|$a->{y})\n" if $mapy <= $a->{y}; } } $meta{width} = $mapx; $meta{height} = $mapy; $meta{map} = $map; bless \%meta, $class } sub new_pickmap { my ($class, $archs, $width) = @_; # sort archs alphabetically my $archs = [ sort { ${$a}->{_name} cmp ${$b}->{_name} } @$archs ]; $width ||= 10; # default width my $num = @$archs; my $map = { }; # overall placement coords my $x = 0; my $y = 0; my ($maxh, $maxw) = (0, 0); # maximum sizes, to set map width/height later my $drawn_archs = 1; # line-break counter my $max_line_height = 1; for (my $i = 0; $i < $num; $i++) { defined ${$archs->[$i]}->{face} or next; # check whether this tile was already written (see below at (b)) unless (defined $map->{map}[$x][$y]) { my ($xoffs, $yoffs, $arch_w, $arch_h) = arch_extends (${$archs->[$i]}); if ($x + $arch_w > $width) { $y += $max_line_height; $max_line_height = 1; $x = 0; } # these are special placement coords, for chained faces which # have a special placement offset my ($place_x, $place_y) = ($x, $y); $xoffs < 0 and $place_x += -$xoffs; $yoffs < 0 and $place_y += -$yoffs; # iterate over the tiles this arch takes # NOTE: Chained archs are maybe not a rectangle, but i don't care # much for that on pickmaps for (my $xi = 0; $xi < $arch_w; $xi++) { for (my $yi = 0; $yi < $arch_h; $yi++) { my ($lx, $ly) = ($x + $xi, $y + $yi); if ($lx == $place_x and $ly == $place_y) { push @{$map->{map}[$place_x][$place_y]}, my $a = ${$archs->[$i]}; } else { # (b): here we set occupied tiles, but without the arch $map->{map}[$lx][$ly] = []; } } } $drawn_archs++; $x += $arch_w; $max_line_height < $arch_h and $max_line_height = $arch_h; } else { $i--; } $maxw = List::Util::max $maxw, $x; $maxh = List::Util::max $maxh, $y; } $map->{height} = $maxh; $map->{width} = $maxw; $map } sub resize { my ($self, $width, $height) = @_; $self->{width} = $width; $self->{height} = $height; # i am sure this can be done more elegantly @{$self->{map}} = @{$self->{map}}[0 .. $width - 1]; for (@{$self->{map}}) { @$_ = @$_[0 .. $height - 1]; } } sub as_archlist { my ($self) = @_; # wing map so we have no extra-map arches $self->resize ($self->{width}, $self->{height}); my @arch; for my $x (0 .. $self->{width} - 1) { my $ass = $self->{map}[$x]; for my $y (0 .. $self->{height} - 1) { for my $a (@{ $ass->[$y] || [] }) { # note: big faces _may_ span map boundaries my %a = %$a; delete $a{x}; delete $a{y}; $a{x} = $x if $x; $a{y} = $y if $y; push @arch, \%a; } } } # now assemble meta info my %meta = %{$self->{info}}; $meta{x} = $self->{width}; $meta{y} = $self->{height}; unshift @arch, \%meta; \@arch } sub as_mapstring { my ($self) = @_; my $arch = $self->as_archlist; my $str; my $append; $append = sub { my %a = %{$_[0]}; $str .= "arch " . (delete $a{_name}) . "\n"; my $inv = delete $a{arch}; # put inventory last for my $k (sort keys %a) { if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { $a{$k} =~ s/\n$//; $str .= "$k\n$a{$k}\n$end\n"; } else { $str .= "$k $a{$k}\n"; } } if ($inv) { $append->($_) for @$inv; } $str .= "end\n"; }; for (@$arch) { $append->($_); } $str } sub write_file { my ($self, $path) = @_; open my $fh, ">", "$path~" or Carp::croak "$path~: $!"; print $fh $self->as_mapstring or Carp::croak "$path~: $!"; close $fh or Carp::croak "$path~: $!"; rename "$path~", $path; } =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ Robin Redeker http://www.ta-sa.org/ =cut 1