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])
}
}
return ($x, $y, $arch, $stack)
}
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));
$m1 =~ s/\.map$//;
$m2 =~ s/\.map$//;
return ($m1, $m2);
} else {
$map1path =~ s/\.map$//;
$map2path =~ s/\.map$//;
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 undef;
}
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;