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.3 by elmex, Sun Mar 12 12:18:55 2006 UTC vs.
Revision 1.21 by elmex, Sat Oct 14 15:18:46 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); 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}};
… …
162 } 294 }
163 295
164 return \@outstack; 296 return \@outstack;
165} 297}
166 298
299sub add_table_widget {
300 my ($table, $row, $data, $type, $cb) = @_;
301 my $edwid;
302
303 if ($type eq 'string') {
304 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
305 $edwid = Gtk2::Entry->new;
306 $edwid->set_text ($data->[1]);
307 $edwid->signal_connect (changed => sub {
308 $data->[1] = $_[0]->get_text;
309 $cb->($data->[1]) if $cb;
310 });
311 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
312
313 } elsif ($type eq 'button') {
314 $table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1);
315 $b->signal_connect (clicked => ($cb || sub {}));
316
317 } elsif ($type eq 'label') {
318 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
319 $edwid = Gtk2::Label->new ($data->[1]);
320 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
321
322 } else {
323 $edwid = Gtk2::Label->new ("FOO");
324 }
325}
326
167sub replace_arch_stack_layer { 327sub replace_arch_stack_layer {
168 my ($stack, $arch) = @_; 328 my ($stack, $arch) = @_;
169 329
170 my @outstack; 330 my @outstack;
171 331
… …
194 } 354 }
195 355
196 return \@outstack; 356 return \@outstack;
197} 357}
198 358
359sub upload {
360 my ($login, $password, $path, $rev, $mapdata) = @_;
361 require HTTP::Request::Common;
362
363 my $res = $ua->post (
364 $ENV{CFPLUS_UPLOAD},
365 Content_Type => 'multipart/form-data',
366 Content => [
367 path => $path,
368 mapdir => $::MAPDIR,
369 map => $mapdata,
370 revision => $rev,
371 cf_login => $login, #ENV{CFPLUS_LOGIN},
372 cf_password => $password, #ENV{CFPLUS_PASSWORD},
373 comment => "",
374 ]
375 );
376
377 if ($res->is_error) {
378 # fatal condition
379 warn $res->status_line;
380 } else {
381 # script replies are marked as {{..}}
382 my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g;
383 warn map "$_\n", @msgs;
384 }
385}
386
199=head1 AUTHOR 387=head1 AUTHOR
200 388
201 Marc Lehmann <schmorp@schmorp.de> 389 Marc Lehmann <schmorp@schmorp.de>
202 http://home.schmorp.de/ 390 http://home.schmorp.de/
203 391

Diff Legend

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