package GCE::Util; =head1 NAME GCE::Util - some utility functions =over 4 =cut use base 'Exporter'; use Crossfire; use Carp (); use Storable; use List::Util qw(min max); use Crossfire; use Crossfire::MapWidget; our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer new_arch_pb fill_pb_from_arch arch_is_floor stack_find_floor stack_find_wall stack_find arch_is_wall); sub new_arch_pb { # this is awful, is this really the best way? my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE; return $pb; } sub fill_pb_from_arch { my ($pb, $arch) = @_; $pb->fill (0x00000000); $TILE->composite ($pb, 0, 0, TILESIZE, TILESIZE, - ($arch->{_face} % 64) * TILESIZE, - TILESIZE * int $arch->{_face} / 64, 1, 1, 'nearest', 255 ); } sub classify_arch_layer { my ($arch) = @_; if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals) return 'below'; } elsif ($arch->{monster}) { return 'top'; } else { # $arch->{is_floor} and all other arches are 'between' monsters and floor return 'between'; } } sub arch_is_floor { my ($a) = @_; return $Crossfire::ARCH{$a->{_name}}->{is_floor}; } sub arch_is_wall { my ($a) = @_; return $Crossfire::ARCH{$a->{_name}}->{no_pass}; } sub stack_find { my ($stack, $dir, $pred) = @_; if ($dir eq 'from_top') { my $i = scalar (@$stack) - 1; if ($i < 0) { $i = 0 } for (reverse @$stack) { $pred->($_) and return $i; $i--; } } else { my $i = 0; for (@$stack) { $pred->($_) and return $i; $i++; } } return 0; } sub stack_find_floor { my ($stack, $dir) = @_; return stack_find ($stack, $dir, \&arch_is_floor); } sub stack_find_wall { my ($stack, $dir) = @_; return stack_find ($stack, $dir, \&arch_is_wall); } sub insert_arch_stack_layer { my ($stack, $arch) = @_; unless (@$stack) { return [ $arch ]; } my @outstack; my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}}); if ($l eq 'between') { # loop until we reached the first 'between' arch above 'below' arches and the floor while (my $a = shift @$stack) { unless ($Crossfire::ARCH{$a->{_name}}->{is_floor} or classify_arch_layer ($Crossfire::ARCH{$a->{_name}}) eq 'below') { unshift @$stack, $a; last; } push @outstack, $a; } # ignore duplicates # FIXME: Broken if non-floor are drawn (too tired to fix) return [ @outstack, @$stack ] if @outstack and $outstack[-1]->{_name} eq $arch->{_name}; push @outstack, ($arch, @$stack); } elsif ($l eq 'top') { # ignore duplicates return [ @$stack ] if $stack->[-1]->{_name} eq $arch->{_name}; @outstack = (@$stack, $arch); } else { # ignore duplicates return [ @$stack ] if $stack->[0]->{_name} eq $arch->{_name}; @outstack = ($arch, @$stack); } return \@outstack; } sub replace_arch_stack_layer { my ($stack, $arch) = @_; my @outstack; my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}}); if ($l eq 'between') { while (shift @$stack) { last unless $Crossfire::ARCH{$_->{_name}}->{is_floor}; push @outstack, $_; } if (@outstack and $Crossfire::ARCH{$outstack[-1]->{_name}}->{is_floor}) { pop @outstack; } push @outstack, ($arch, @$stack); } elsif ($l eq 'top') { @outstack = (@$stack, $arch); } else { @outstack = ($arch, @$stack); } return \@outstack; } =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ Robin Redeker http://www.ta-sa.org/ =cut 1;