--- deliantra/gde/GCE/Util.pm 2006/03/12 23:32:58 1.4 +++ deliantra/gde/GCE/Util.pm 2007/01/05 17:04:17 1.24 @@ -17,8 +17,100 @@ use Crossfire; use Crossfire::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); + +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 }); -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); + 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? @@ -27,13 +119,22 @@ } sub fill_pb_from_arch { - my ($pb, $arch) = @_; + my ($pb, $a) = @_; + + my $o = $Crossfire::ARCH{$a->{_name}}; + my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"}; + unless ($face) { + $face = $Crossfire::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, - - ($arch->{_face} % 64) * TILESIZE, - TILESIZE * int $arch->{_face} / 64, + - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64, 1, 1, 'nearest', 255 ); } @@ -55,14 +156,49 @@ } } +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) = @_; - return $Crossfire::ARCH{$a->{_name}}->{is_floor}; + 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) = @_; - return $Crossfire::ARCH{$a->{_name}}->{no_pass}; + my $ar = Crossfire::arch_attr $a; + return $ar->{name} eq 'Wall'; +#return $Crossfire::ARCH{$a->{_name}}->{no_pass}; } sub arch_is_monster { @@ -224,6 +360,41 @@ return \@outstack; } +sub upload { + my ($login, $password, $srcrep, $path, $rev, $mapdata) = @_; + require LWP::UserAgent; + my $ua = LWP::UserAgent->new ( + agent => "gcrossedit", + 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