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.14 by elmex, Sun Apr 2 09:54:18 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 Cwd 'abs_path';
20 22
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); 23our @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);
24
25sub pseudohtml2txt {
26 my ($html) = @_;
27
28 $html =~ s/<br\s*?\/?>/\n/gsi;
29 $html =~ s/<b>(.*?)<\/b>/_\1_/gsi;
30 $html
31}
32
33sub exit_paths {
34 my ($mappath, $map1path, $map2path) = @_;
35 $mappath = abs_path $mappath;
36 $map1path = abs_path $map1path;
37 $map2path = abs_path $map2path;
38
39 if ( (substr $map1path, 0, length $mappath) eq $mappath
40 and (substr $map2path, 0, length $mappath) eq $mappath) {
41 substr $map1path, 0, length $mappath, '';
42 substr $map2path, 0, length $mappath, '';
43
44 my ($v1, $d1, $f1) = File::Spec->splitpath ($map1path);
45 my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path);
46
47 my @di1 = File::Spec->splitdir ($d1);
48 my @di2 = File::Spec->splitdir ($d2);
49
50 if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) {
51 my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2));
52 my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1));
53 return ($m1, $m2);
54 } else {
55 return ($map1path, $map2path);
56 }
57 } else {
58 return ('', '');
59 }
60}
61
62sub map2abs {
63 my ($dest, $mape) = @_;
64
65 my $dir;
66 if (File::Spec->file_name_is_absolute($dest)) {
67 $dir = catdir ($::CFG->{MAPDIR}, $dest);
68 } else {
69 my ($v, $p, $f) = File::Spec->splitpath ($mape->{path});
70 $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p));
71 }
72 return $dir;
73}
74
75sub def($$) {
76 return defined ($_[0]) ? $_[0] : $_[1];
77}
78
79sub quick_msg {
80 my $wid = shift;
81 my $msg;
82 my $win = $::MAINWIN;
83 if (ref $wid) {
84 $win = $wid;
85 $msg = shift;
86 } else {
87 $msg = $wid;
88 }
89 my $dia = Gtk2::Dialog->new ('Message', $win, 'destroy-with-parent', 'gtk-ok' => 'none');
90
91 my $lbl = Gtk2::Label->new ($msg);
92 $dia->vbox->add ($lbl);
93 $dia->signal_connect (response => sub { $_[0]->destroy });
94
95 unless (defined $_[0]) {
96 Glib::Timeout->add (1000, sub { $dia->destroy; 0 });
97 }
98
99 $dia->show_all;
100}
22 101
23sub new_arch_pb { 102sub new_arch_pb {
24 # this is awful, is this really the best way? 103 # this is awful, is this really the best way?
25 my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE; 104 my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
26 return $pb; 105 return $pb;
27} 106}
28 107
29sub fill_pb_from_arch { 108sub fill_pb_from_arch {
30 my ($pb, $arch) = @_; 109 my ($pb, $a) = @_;
110
111 my $o = $Crossfire::ARCH{$a->{_name}};
112 my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"}
113 or warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n";
114
115 $face or return;
31 116
32 $pb->fill (0x00000000); 117 $pb->fill (0x00000000);
33 $TILE->composite ($pb, 118 $TILE->composite ($pb,
34 0, 0, 119 0, 0,
35 TILESIZE, TILESIZE, 120 TILESIZE, TILESIZE,
36 - ($arch->{_face} % 64) * TILESIZE, - TILESIZE * int $arch->{_face} / 64, 121 - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
37 1, 1, 'nearest', 255 122 1, 1, 'nearest', 255
38 ); 123 );
39} 124}
40 125
41sub classify_arch_layer { 126sub classify_arch_layer {
… …
53 138
54 return 'between'; 139 return 'between';
55 } 140 }
56} 141}
57 142
143sub arch_is_exit {
144 my ($a) = @_;
145 my $type = $Crossfire::ARCH{$a->{_name}}->{type};
146 return $type eq '66' || $type eq '41';
147}
148
58sub arch_is_floor { 149sub arch_is_floor {
59 my ($a) = @_; 150 my ($a) = @_;
151 my $ar = Crossfire::arch_attr $a;
152 return (substr $ar->{name}, 0, 5) eq 'Floor';
60 return $Crossfire::ARCH{$a->{_name}}->{is_floor}; 153#return $Crossfire::ARCH{$a->{_name}}->{is_floor};
61} 154}
62 155
63sub arch_is_wall { 156sub arch_is_wall {
64 my ($a) = @_; 157 my ($a) = @_;
158 my $ar = Crossfire::arch_attr $a;
159 return $ar->{name} eq 'Wall';
65 return $Crossfire::ARCH{$a->{_name}}->{no_pass}; 160#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
66} 161}
67 162
68sub arch_is_monster { 163sub arch_is_monster {
69 my ($a) = @_; 164 my ($a) = @_;
70 my $arch = $Crossfire::ARCH{$a->{_name}}; 165 my $arch = $Crossfire::ARCH{$a->{_name}};
… …
162 } 257 }
163 258
164 return \@outstack; 259 return \@outstack;
165} 260}
166 261
262sub add_table_widget {
263 my ($table, $row, $data, $type, $cb) = @_;
264 my $edwid;
265
266 if ($type eq 'string') {
267 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
268 $edwid = Gtk2::Entry->new;
269 $edwid->set_text ($data->[1]);
270 $edwid->signal_connect (changed => sub {
271 $data->[1] = $_[0]->get_text;
272 $cb->($data->[1]) if $cb;
273 });
274 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
275
276 } elsif ($type eq 'button') {
277 $table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1);
278 $b->signal_connect (clicked => ($cb || sub {}));
279
280 } elsif ($type eq 'label') {
281 $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
282 $edwid = Gtk2::Label->new ($data->[1]);
283 $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
284
285 } else {
286 $edwid = Gtk2::Label->new ("FOO");
287 }
288}
289
167sub replace_arch_stack_layer { 290sub replace_arch_stack_layer {
168 my ($stack, $arch) = @_; 291 my ($stack, $arch) = @_;
169 292
170 my @outstack; 293 my @outstack;
171 294

Diff Legend

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