ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/Util.pm
(Generate patch)

Comparing deliantra/gde/GCE/Util.pm (file contents):
Revision 1.4 by elmex, Sun Mar 12 23:32:58 2006 UTC vs.
Revision 1.22 by elmex, Tue Nov 28 16:26:22 2006 UTC

… …
15use Storable; 15use Storable;
16use List::Util qw(min max); 16use List::Util qw(min max);
17 17
18use Crossfire; 18use Crossfire;
19use Crossfire::MapWidget; 19use Crossfire::MapWidget;
20use File::Spec::Functions;
21use File::Basename;
22use File::Path;
23use HTTP::Request::Common;
24use Cwd 'abs_path';
20 25
21our @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); 26our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer new_arch_pb
27 fill_pb_from_arch arch_is_floor stack_find_floor stack_find_wall
28 stack_find arch_is_wall arch_is_monster add_table_widget quick_msg
29 def arch_is_exit map2abs exit_paths pseudohtml2txt arch_is_connector);
30
31sub pseudohtml2txt {
32 my ($html) = @_;
33
34 $html =~ s/<br\s*?\/?>/\n/gsi;
35 $html =~ s/<b>(.*?)<\/b>/_\1_/gsi;
36 $html =~ s/<li>/\n* /gi;
37 $html =~ s/<\/?\s*li>//gi;
38 $html =~ s/<\/?\s*ul>//gi;
39 $html =~ s/&gt;/>/g;
40 $html =~ s/&lt;/</g;
41 $html
42}
43
44sub exit_paths {
45 my ($mappath, $map1path, $map2path) = @_;
46 $mappath = abs_path $mappath;
47 $map1path = abs_path $map1path;
48 $map2path = abs_path $map2path;
49
50 if ( (substr $map1path, 0, length $mappath) eq $mappath
51 and (substr $map2path, 0, length $mappath) eq $mappath) {
52 substr $map1path, 0, length $mappath, '';
53 substr $map2path, 0, length $mappath, '';
54
55 my ($v1, $d1, $f1) = File::Spec->splitpath ($map1path);
56 my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path);
57
58 my @di1 = File::Spec->splitdir ($d1);
59 my @di2 = File::Spec->splitdir ($d2);
60
61 if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) {
62 my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2));
63 my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1));
64 return ($m1, $m2);
65 } else {
66 return ($map1path, $map2path);
67 }
68 } else {
69 return ('', '');
70 }
71}
72
73sub map2abs {
74 my ($dest, $mape) = @_;
75
76 $mappath = abs_path $mappath;
77 my $dir;
78 if (File::Spec->file_name_is_absolute($dest)) {
79 $dir = catdir ($::MAPDIR, $dest);
80 } else {
81 my ($v, $p, $f) = File::Spec->splitpath ($mape->{path});
82 $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p));
83 }
84 return $dir;
85}
86
87sub def($$) {
88 return defined ($_[0]) ? $_[0] : $_[1];
89}
90
91sub quick_msg {
92 my $wid = shift;
93 my $msg;
94 my $win = $::MAINWIN;
95 if (ref $wid) {
96 $win = $wid;
97 $msg = shift;
98 } else {
99 $msg = $wid;
100 }
101 my $dia = Gtk2::Dialog->new ('Message', $win, 'destroy-with-parent', 'gtk-ok' => 'none');
102
103 my $lbl = Gtk2::Label->new ($msg);
104 $dia->vbox->add ($lbl);
105 $dia->signal_connect (response => sub { $_[0]->destroy });
106
107 unless (defined $_[0]) {
108 Glib::Timeout->add (1000, sub { $dia->destroy; 0 });
109 }
110
111 $dia->show_all;
112}
22 113
23sub new_arch_pb { 114sub new_arch_pb {
24 # this is awful, is this really the best way? 115 # this is awful, is this really the best way?
25 my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE; 116 my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
26 return $pb; 117 return $pb;
27} 118}
28 119
29sub fill_pb_from_arch { 120sub fill_pb_from_arch {
30 my ($pb, $arch) = @_; 121 my ($pb, $a) = @_;
122
123 my $o = $Crossfire::ARCH{$a->{_name}};
124 my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"}
125 or warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n";
126
127 $face or return;
31 128
32 $pb->fill (0x00000000); 129 $pb->fill (0x00000000);
33 $TILE->composite ($pb, 130 $TILE->composite ($pb,
34 0, 0, 131 0, 0,
35 TILESIZE, TILESIZE, 132 TILESIZE, TILESIZE,
36 - ($arch->{_face} % 64) * TILESIZE, - TILESIZE * int $arch->{_face} / 64, 133 - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
37 1, 1, 'nearest', 255 134 1, 1, 'nearest', 255
38 ); 135 );
39} 136}
40 137
41sub classify_arch_layer { 138sub classify_arch_layer {
… …
53 150
54 return 'between'; 151 return 'between';
55 } 152 }
56} 153}
57 154
155sub arch_is_exit {
156 my ($a) = @_;
157 my $type = $Crossfire::ARCH{$a->{_name}}->{type};
158 return $type eq '66' || $type eq '41';
159}
160
58sub arch_is_floor { 161sub arch_is_floor {
59 my ($a) = @_; 162 my ($a) = @_;
60 return $Crossfire::ARCH{$a->{_name}}->{is_floor}; 163 my $ar = Crossfire::arch_attr $a;
164 return (
165 (substr $ar->{name}, 0, 5) eq 'Floor'
166 or (substr $ar->{name}, 0, 10) eq 'Shop Floor'
167 )
168}
169
170sub arch_is_connector {
171 my ($a) = @_;
172 my $ar = Crossfire::arch_attr $a;
173 my $has_connect_field = 0;
174
175 TOP: for (@{$ar->{section}}) {
176 my $name = shift @$_;
177 my @r = @$_;
178 if ($name eq 'general') {
179 for (@r) {
180 my ($k, $s) = ($_->[0], $_->[1]);
181 if ($k eq 'connected' && $s->{name} eq 'connection') {
182 $has_connect_field = 1;
183 last TOP;
184 }
185 }
186 last TOP;
187 }
188 }
189
190 return $has_connect_field;
61} 191}
62 192
63sub arch_is_wall { 193sub arch_is_wall {
64 my ($a) = @_; 194 my ($a) = @_;
195 my $ar = Crossfire::arch_attr $a;
196 return $ar->{name} eq 'Wall';
65 return $Crossfire::ARCH{$a->{_name}}->{no_pass}; 197#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
66} 198}
67 199
68sub arch_is_monster { 200sub arch_is_monster {
69 my ($a) = @_; 201 my ($a) = @_;
70 my $arch = $Crossfire::ARCH{$a->{_name}}; 202 my $arch = $Crossfire::ARCH{$a->{_name}};
… …
222 } 354 }
223 355
224 return \@outstack; 356 return \@outstack;
225} 357}
226 358
359sub upload {
360 my ($login, $password, $srcrep, $path, $rev, $mapdata) = @_;
361 require LWP::UserAgent;
362 my $ua = LWP::UserAgent->new (
363 agent => "gcrossedit",
364 keep_alive => 1,
365 env_proxy => 1,
366 timeout => 30,
367 );
368 require HTTP::Request::Common;
369
370 my $res = $ua->post (
371 $ENV{CFPLUS_UPLOAD},
372 Content_Type => 'multipart/form-data',
373 Content => [
374 path => $path,
375 mapdir => $srcrep,
376 map => $mapdata,
377 revision => $rev,
378 cf_login => $login, #ENV{CFPLUS_LOGIN},
379 cf_password => $password, #ENV{CFPLUS_PASSWORD},
380 comment => "",
381 ]
382 );
383
384 if ($res->is_error) {
385 # fatal condition
386 warn $res->status_line;
387 } else {
388 # script replies are marked as {{..}}
389 my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g;
390 warn map "$_\n", @msgs;
391 }
392}
393
227=head1 AUTHOR 394=head1 AUTHOR
228 395
229 Marc Lehmann <schmorp@schmorp.de> 396 Marc Lehmann <schmorp@schmorp.de>
230 http://home.schmorp.de/ 397 http://home.schmorp.de/
231 398

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines