--- deliantra/gde/GCE/Util.pm 2006/02/20 18:21:04 1.1 +++ deliantra/gde/GCE/Util.pm 2006/10/14 15:18:46 1.21 @@ -15,7 +15,125 @@ use Storable; use List::Util qw(min max); -our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer); +use Crossfire; +use Crossfire::MapWidget; +use File::Spec::Functions; +use File::Basename; +use File::Path; +use HTTP::Request::Common; +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 arch_is_connector); + +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) = @_; + + $mappath = abs_path $mappath; + 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; + 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) = @_; @@ -34,6 +152,97 @@ } } +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' + or (substr $ar->{name}, 0, 10) eq 'Shop Floor' + ) +} + +sub arch_is_connector { + my ($a) = @_; + my $ar = Crossfire::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 = 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) = @_; @@ -87,6 +296,34 @@ 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) = @_; @@ -119,6 +356,34 @@ return \@outstack; } +sub upload { + my ($login, $password, $path, $rev, $mapdata) = @_; + require HTTP::Request::Common; + + my $res = $ua->post ( + $ENV{CFPLUS_UPLOAD}, + Content_Type => 'multipart/form-data', + Content => [ + path => $path, + mapdir => $::MAPDIR, + 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