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; use File::Spec::Functions; use Cwd 'abs_path'; 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 arch_is_monster add_table_widget quick_msg def arch_is_exit map2abs exit_paths pseudohtml2txt); sub pseudohtml2txt { my ($html) = @_; $html =~ s//\n/gsi; $html =~ s/(.*?)<\/b>/_\1_/gsi; $html =~ s/<\/?\s*li>//gi; $html =~ s/<\/?\s*ul>//gi; $html =~ s/>/>/g; $html =~ s/</splitpath ($map1path); my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path); my @di1 = File::Spec->splitdir ($d1); my @di2 = File::Spec->splitdir ($d2); if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) { my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2)); my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1)); return ($m1, $m2); } else { return ($map1path, $map2path); } } else { return ('', ''); } } sub map2abs { my ($dest, $mape) = @_; my $dir; if (File::Spec->file_name_is_absolute($dest)) { $dir = catdir ($::CFG->{MAPDIR}, $dest); } else { my ($v, $p, $f) = File::Spec->splitpath ($mape->{path}); $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p)); } return $dir; } sub def($$) { return defined ($_[0]) ? $_[0] : $_[1]; } sub quick_msg { my $wid = shift; my $msg; my $win = $::MAINWIN; if (ref $wid) { $win = $wid; $msg = shift; } else { $msg = $wid; } my $dia = Gtk2::Dialog->new ('Message', $win, 'destroy-with-parent', 'gtk-ok' => 'none'); my $lbl = Gtk2::Label->new ($msg); $dia->vbox->add ($lbl); $dia->signal_connect (response => sub { $_[0]->destroy }); unless (defined $_[0]) { Glib::Timeout->add (1000, sub { $dia->destroy; 0 }); } $dia->show_all; } 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, $a) = @_; my $o = $Crossfire::ARCH{$a->{_name}}; my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"} or warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n"; $face or return; $pb->fill (0x00000000); $TILE->composite ($pb, 0, 0, TILESIZE, TILESIZE, - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 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_exit { my ($a) = @_; my $type = $Crossfire::ARCH{$a->{_name}}->{type}; return $type eq '66' || $type eq '41'; } sub arch_is_floor { my ($a) = @_; my $ar = Crossfire::arch_attr $a; return (substr $ar->{name}, 0, 5) eq 'Floor'; #return $Crossfire::ARCH{$a->{_name}}->{is_floor}; } sub arch_is_wall { my ($a) = @_; my $ar = Crossfire::arch_attr $a; return $ar->{name} eq 'Wall'; #return $Crossfire::ARCH{$a->{_name}}->{no_pass}; } sub arch_is_monster { my ($a) = @_; my $arch = $Crossfire::ARCH{$a->{_name}}; return $arch->{alive} and ($arch->{monster} or $arch->{generator}); } 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 add_table_widget { my ($table, $row, $data, $type, $cb) = @_; my $edwid; if ($type eq 'string') { $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1); $edwid = Gtk2::Entry->new; $edwid->set_text ($data->[1]); $edwid->signal_connect (changed => sub { $data->[1] = $_[0]->get_text; $cb->($data->[1]) if $cb; }); $table->attach_defaults ($edwid, 1, 2, $row, $row + 1); } elsif ($type eq 'button') { $table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1); $b->signal_connect (clicked => ($cb || sub {})); } elsif ($type eq 'label') { $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1); $edwid = Gtk2::Label->new ($data->[1]); $table->attach_defaults ($edwid, 1, 2, $row, $row + 1); } else { $edwid = Gtk2::Label->new ("FOO"); } } 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;