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

Diff Legend

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