package GCE::Util; =head1 NAME GCE::Util - some utility functions =over 4 =cut use base 'Exporter'; use Deliantra; use Carp (); use Storable; use List::Util qw(min max); use Deliantra; use Deliantra::MapWidget; use File::Spec::Functions; use File::Basename; use File::Path; #use HTTP::Request::Common; use Cwd 'abs_path'; use strict; 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 arch_is_connector gtk2_get_color devirtualize); my %allocated_colors; sub devirtualize { my ($map, $x, $y, $arch, $stack) = @_; if ($arch->{_virtual}) { my @head = $map->get_head ($arch); if (@head) { return ($head[0], $head[1], $head[3]->[$head[2]], $head[3], $head[2]) } } my ($z) = grep $stack->[$_] == $arch, 0..$#$stack; return ($x, $y, $arch, $stack, $z) } sub gtk2_get_color { my ($widget, $name) = @_; my $colormap = $widget->{window}->get_colormap; my $ret; if ($ret = $allocated_colors{$name}) { return $ret; } my $color = Gtk2::Gdk::Color->parse($name); $colormap->alloc_color($color,1,1); $allocated_colors{$name} = $color; return $color; } sub pseudohtml2txt { my ($html) = @_; $html =~ s//\n/gsi; $html =~ s/(.*?)<\/b>/_\1_/gsi; $html =~ s/
  • /\n* /gi; $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) = @_; #$dest = abs_path $dest; my $dir; if (File::Spec->file_name_is_absolute($dest)) { $dir = catdir ($::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; fill_pb_from_arch ($pb, {}); return $pb; } sub fill_pb_from_arch { my ($pb, $a) = @_; my $o = $Deliantra::ARCH{$a->{_name}} || {}; my $face = $Deliantra::FACE{$a->{face} || $o->{face} || "blank.111"}; unless ($face) { $face = $Deliantra::FACE{"blank.x11"} or warn "no gfx found for arch '$a->{_name}'\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 = $Deliantra::ARCH{$a->{_name}}->{type}; return $type eq '66' || $type eq '41'; } sub arch_is_floor { my ($a) = @_; my $ar = Deliantra::arch_attr $a; return ( (substr $ar->{name}, 0, 5) eq 'Floor' or (substr $ar->{name}, 0, 10) eq 'Shop Floor' ) } sub arch_is_connector { my ($a) = @_; my $ar = Deliantra::arch_attr $a; my $has_connect_field = 0; TOP: for (@{$ar->{section}}) { my $name = shift @$_; my @r = @$_; if ($name eq 'general') { for (@r) { my ($k, $s) = ($_->[0], $_->[1]); if ($k eq 'connected' && $s->{name} eq 'connection') { $has_connect_field = 1; last TOP; } } last TOP; } } return $has_connect_field; } sub arch_is_wall { my ($a) = @_; my $ar = Deliantra::arch_attr $a; return $ar->{name} eq 'Wall'; #return $Deliantra::ARCH{$a->{_name}}->{no_pass}; } sub arch_is_monster { my ($a) = @_; my $arch = $Deliantra::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 ($Deliantra::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 ($Deliantra::ARCH{$a->{_name}}->{is_floor} or classify_arch_layer ($Deliantra::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 ($Deliantra::ARCH{$arch->{_name}}); if ($l eq 'between') { while (shift @$stack) { last unless $Deliantra::ARCH{$_->{_name}}->{is_floor}; push @outstack, $_; } if (@outstack and $Deliantra::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; } sub upload { my ($login, $password, $srcrep, $path, $rev, $mapdata) = @_; #require LWP::UserAgent; #my $ua = LWP::UserAgent->new ( # agent => "deliantra editor", # keep_alive => 1, # env_proxy => 1, # timeout => 30, #); #require HTTP::Request::Common; #my $res = $ua->post ( # $ENV{CFPLUS_UPLOAD}, # Content_Type => 'multipart/form-data', # Content => [ # path => $path, # mapdir => $srcrep, # map => $mapdata, # revision => $rev, # cf_login => $login, #ENV{CFPLUS_LOGIN}, # cf_password => $password, #ENV{CFPLUS_PASSWORD}, # comment => "", # ] #); #if ($res->is_error) { # # fatal condition # warn $res->status_line; #} else { # # script replies are marked as {{..}} # my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g; # warn map "$_\n", @msgs; #} } =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ Robin Redeker http://www.ta-sa.org/ =cut 1;