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.1 by elmex, Mon Feb 20 18:21:04 2006 UTC vs.
Revision 1.23 by elmex, Fri Jan 5 14:17:12 2007 UTC

… …
13 13
14use Carp (); 14use Carp ();
15use Storable; 15use Storable;
16use List::Util qw(min max); 16use List::Util qw(min max);
17 17
18use Crossfire;
19use Crossfire::MapWidget;
20use File::Spec::Functions;
21use File::Basename;
22use File::Path;
23use HTTP::Request::Common;
24use Cwd 'abs_path';
25use strict;
26
18our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer); 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}
114
115sub new_arch_pb {
116 # this is awful, is this really the best way?
117 my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
118 return $pb;
119}
120
121sub fill_pb_from_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;
132
133 $pb->fill (0x00000000);
134 $TILE->composite ($pb,
135 0, 0,
136 TILESIZE, TILESIZE,
137 - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
138 1, 1, 'nearest', 255
139 );
140}
19 141
20sub classify_arch_layer { 142sub classify_arch_layer {
21 my ($arch) = @_; 143 my ($arch) = @_;
22 144
23 if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals) 145 if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals)
… …
30 152
31 } else { # $arch->{is_floor} and all other arches are 'between' monsters and floor 153 } else { # $arch->{is_floor} and all other arches are 'between' monsters and floor
32 154
33 return 'between'; 155 return 'between';
34 } 156 }
157}
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
165sub arch_is_floor {
166 my ($a) = @_;
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;
195}
196
197sub arch_is_wall {
198 my ($a) = @_;
199 my $ar = Crossfire::arch_attr $a;
200 return $ar->{name} eq 'Wall';
201#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
202}
203
204sub arch_is_monster {
205 my ($a) = @_;
206 my $arch = $Crossfire::ARCH{$a->{_name}};
207 return $arch->{alive} and ($arch->{monster} or $arch->{generator});
208}
209
210sub stack_find {
211 my ($stack, $dir, $pred) = @_;
212
213
214 if ($dir eq 'from_top') {
215 my $i = scalar (@$stack) - 1;
216 if ($i < 0) { $i = 0 }
217
218 for (reverse @$stack) {
219 $pred->($_)
220 and return $i;
221
222 $i--;
223 }
224
225 } else {
226 my $i = 0;
227
228 for (@$stack) {
229 $pred->($_)
230 and return $i;
231
232 $i++;
233 }
234 }
235
236 return 0;
237
238}
239
240sub stack_find_floor {
241 my ($stack, $dir) = @_;
242 return stack_find ($stack, $dir, \&arch_is_floor);
243}
244
245sub stack_find_wall {
246 my ($stack, $dir) = @_;
247 return stack_find ($stack, $dir, \&arch_is_wall);
35} 248}
36 249
37sub insert_arch_stack_layer { 250sub insert_arch_stack_layer {
38 my ($stack, $arch) = @_; 251 my ($stack, $arch) = @_;
39 252
… …
85 } 298 }
86 299
87 return \@outstack; 300 return \@outstack;
88} 301}
89 302
303sub add_table_widget {
304 my ($table, $row, $data, $type, $cb) = @_;
305 my $edwid;
306
307 if ($type eq 'string') {
308 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
309 $edwid = Gtk2::Entry->new;
310 $edwid->set_text ($data->[1]);
311 $edwid->signal_connect (changed => sub {
312 $data->[1] = $_[0]->get_text;
313 $cb->($data->[1]) if $cb;
314 });
315 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
316
317 } elsif ($type eq 'button') {
318 $table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1);
319 $b->signal_connect (clicked => ($cb || sub {}));
320
321 } elsif ($type eq 'label') {
322 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
323 $edwid = Gtk2::Label->new ($data->[1]);
324 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
325
326 } else {
327 $edwid = Gtk2::Label->new ("FOO");
328 }
329}
330
90sub replace_arch_stack_layer { 331sub replace_arch_stack_layer {
91 my ($stack, $arch) = @_; 332 my ($stack, $arch) = @_;
92 333
93 my @outstack; 334 my @outstack;
94 335
… …
117 } 358 }
118 359
119 return \@outstack; 360 return \@outstack;
120} 361}
121 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
122=head1 AUTHOR 398=head1 AUTHOR
123 399
124 Marc Lehmann <schmorp@schmorp.de> 400 Marc Lehmann <schmorp@schmorp.de>
125 http://home.schmorp.de/ 401 http://home.schmorp.de/
126 402

Diff Legend

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