gde/GCE/Util.pm

package GCE::Util;
=head1 NAME

   GCE::Util - some utility functions

=over 4

=cut

use base 'Exporter';

use Crossfire;

use Carp ();
use Storable;
use List::Util qw(min max);

use Crossfire;
use Crossfire::MapWidget;
use File::Spec::Functions;
use Cwd 'abs_path';

our @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);

sub pseudohtml2txt {
   my ($html) = @_;

   $html =~ s/<br\s*?\/?>/\n/gsi;
   $html =~ s/<b>(.*?)<\/b>/_\1_/gsi;
   $html
}

sub exit_paths {
   my ($mappath, $map1path, $map2path) = @_;
   $mappath  = abs_path $mappath;
   $map1path = abs_path $map1path;
   $map2path = abs_path $map2path;

   if (    (substr $map1path, 0, length $mappath) eq $mappath
       and (substr $map2path, 0, length $mappath) eq $mappath) {
      substr $map1path, 0, length $mappath, '';
      substr $map2path, 0, length $mappath, '';

      my ($v1, $d1, $f1) = File::Spec->splitpath ($map1path);
      my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path);

      my @di1 = File::Spec->splitdir ($d1);
      my @di2 = File::Spec->splitdir ($d2);

      if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) {
         my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2));
         my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1));
         return ($m1, $m2);
      } else {
         return ($map1path, $map2path);
      }
   } else {
      return ('', '');
   }
}

sub map2abs {
   my ($dest, $mape) = @_;

   my $dir;
   if (File::Spec->file_name_is_absolute($dest)) {
      $dir = catdir ($::CFG->{MAPDIR}, $dest);
   } else {
      my ($v, $p, $f) = File::Spec->splitpath ($mape->{path});
      $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p));
   }
   return $dir;
}

sub def($$) {
   return defined ($_[0]) ? $_[0] : $_[1];
}

sub quick_msg {
   my $wid = shift;
   my $msg;
   my $win = $::MAINWIN;
   if (ref $wid) {
      $win = $wid;
      $msg = shift;
   } else {
      $msg = $wid;
   }
   my $dia = Gtk2::Dialog->new ('Message', $win, 'destroy-with-parent', 'gtk-ok' => 'none');

   my $lbl = Gtk2::Label->new ($msg);
   $dia->vbox->add ($lbl);
   $dia->signal_connect (response => sub { $_[0]->destroy });

   unless (defined $_[0]) {
      Glib::Timeout->add (1000, sub { $dia->destroy; 0 });
   }

   $dia->show_all;
}

sub new_arch_pb {
   # this is awful, is this really the best way?
   my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
   return $pb;
}

sub fill_pb_from_arch {
   my ($pb, $a) = @_;

   my $o = $Crossfire::ARCH{$a->{_name}};
   my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"}
            or warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n";

   $face or return;

   $pb->fill (0x00000000);
   $TILE->composite ($pb,
      0, 0,
      TILESIZE, TILESIZE,
      - ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
      1, 1, 'nearest', 255
   );
}

sub classify_arch_layer {
   my ($arch) = @_;

   if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals)

      return 'below';

   } elsif ($arch->{monster}) {

      return 'top';

   } else { # $arch->{is_floor} and all other arches are 'between' monsters and floor

      return 'between';
   }
}

sub arch_is_exit {
   my ($a) = @_;
   my $type = $Crossfire::ARCH{$a->{_name}}->{type};
   return $type eq '66' || $type eq '41';
}

sub arch_is_floor {
   my ($a) = @_;
   my $ar = Crossfire::arch_attr $a;
   return (substr $ar->{name}, 0, 5) eq 'Floor';
#return $Crossfire::ARCH{$a->{_name}}->{is_floor};
}

sub arch_is_wall {
   my ($a) = @_;
   my $ar = Crossfire::arch_attr $a;
   return $ar->{name} eq 'Wall';
#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
}

sub arch_is_monster {
   my ($a) = @_;
   my $arch = $Crossfire::ARCH{$a->{_name}};
   return $arch->{alive} and ($arch->{monster} or $arch->{generator});
}

sub stack_find {
   my ($stack, $dir, $pred) = @_;


   if ($dir eq 'from_top') {
      my $i = scalar (@$stack) - 1;
      if ($i < 0) { $i = 0 }

      for (reverse @$stack) {
         $pred->($_)
            and return $i;

         $i--;
      }

   } else {
      my $i = 0;

      for (@$stack) {
         $pred->($_)
            and return $i;

         $i++;
      }
   }

   return 0;

}

sub stack_find_floor {
   my ($stack, $dir) = @_;
   return stack_find ($stack, $dir, \&arch_is_floor);
}

sub stack_find_wall {
   my ($stack, $dir) = @_;
   return stack_find ($stack, $dir, \&arch_is_wall);
}

sub insert_arch_stack_layer {
   my ($stack, $arch) = @_;

   unless (@$stack) {
      return [ $arch ];
   }

   my @outstack;

   my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});

   if ($l eq 'between') {

      # loop until we reached the first 'between' arch above 'below' arches and the floor
      while (my $a = shift @$stack) {

         unless ($Crossfire::ARCH{$a->{_name}}->{is_floor}
                 or classify_arch_layer ($Crossfire::ARCH{$a->{_name}}) eq 'below') {

            unshift @$stack, $a;
            last;
         }

         push @outstack, $a;
      }

      # ignore duplicates
      # FIXME: Broken if non-floor are drawn (too tired to fix)
      return [ @outstack, @$stack ]
         if @outstack and $outstack[-1]->{_name} eq $arch->{_name};

      push @outstack, ($arch, @$stack);

   } elsif ($l eq 'top') {

      # ignore duplicates
      return [ @$stack ]
         if $stack->[-1]->{_name} eq $arch->{_name};

      @outstack = (@$stack, $arch);

   } else {

      # ignore duplicates
      return [ @$stack ]
         if $stack->[0]->{_name} eq $arch->{_name};

      @outstack = ($arch, @$stack);
   }

   return \@outstack;
}

sub add_table_widget {
   my ($table, $row, $data, $type, $cb) = @_;
   my $edwid;

   if ($type eq 'string') {
      $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
      $edwid = Gtk2::Entry->new;
         $edwid->set_text ($data->[1]);
         $edwid->signal_connect (changed => sub {
            $data->[1] = $_[0]->get_text;
            $cb->($data->[1]) if $cb;
         });
      $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);

   } elsif ($type eq 'button') {
      $table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1);
      $b->signal_connect (clicked => ($cb || sub {}));

   } elsif ($type eq 'label') {
      $table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
      $edwid = Gtk2::Label->new ($data->[1]);
      $table->attach_defaults ($edwid, 1, 2, $row, $row + 1);

   } else {
      $edwid = Gtk2::Label->new ("FOO");
   }
}

sub replace_arch_stack_layer {
   my ($stack, $arch) = @_;

   my @outstack;

   my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});

   if ($l eq 'between') {

      while (shift @$stack) {
         last unless $Crossfire::ARCH{$_->{_name}}->{is_floor};
         push @outstack, $_;
      }

      if (@outstack and $Crossfire::ARCH{$outstack[-1]->{_name}}->{is_floor}) {
         pop @outstack;
      }

      push @outstack, ($arch, @$stack);

   } elsif ($l eq 'top') {

      @outstack = (@$stack, $arch);

   } else {

      @outstack = ($arch, @$stack);
   }

   return \@outstack;
}

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 Robin Redeker <elmex@ta-sa.org>
 http://www.ta-sa.org/

=cut
1;
Revision:	1.14
Committed:	Sun Apr 2 09:54:18 2006 UTC (18 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.13:	+9 -1 lines
Log Message:	added 'use/desc' page for types and fixed the 'setme' bug with check_inv (and other archs of course :)
#	User	Rev	Content
1	elmex	1.1	package GCE::Util;
2			=head1 NAME
3
4			GCE::Util - some utility functions
5
6			=over 4
7
8			=cut
9
10			use base 'Exporter';
11
12			use Crossfire;
13
14			use Carp ();
15			use Storable;
16			use List::Util qw(min max);
17
18	elmex	1.2	use Crossfire;
19			use Crossfire::MapWidget;
20	elmex	1.8	use File::Spec::Functions;
21	elmex	1.13	use Cwd 'abs_path';
22	elmex	1.2
23	elmex	1.14	our @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
25			sub pseudohtml2txt {
26			my ($html) = @_;
27
28			$html =~ s/<br\s*?\/?>/\n/gsi;
29			$html =~ s/<b>(.*?)<\/b>/_\1_/gsi;
30			$html
31			}
32	elmex	1.13
33			sub 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	elmex	1.8
62			sub map2abs {
63			my ($dest, $mape) = @_;
64
65			my $dir;
66			if (File::Spec->file_name_is_absolute($dest)) {
67	elmex	1.11	$dir = catdir ($::CFG->{MAPDIR}, $dest);
68	elmex	1.8	} 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	elmex	1.5
75			sub def($$) {
76			return defined ($_[0]) ? $_[0] : $_[1];
77			}
78
79			sub 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			}
101	elmex	1.2
102			sub new_arch_pb {
103			# this is awful, is this really the best way?
104			my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
105			return $pb;
106			}
107
108			sub fill_pb_from_arch {
109	elmex	1.6	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;
116	elmex	1.2
117			$pb->fill (0x00000000);
118			$TILE->composite ($pb,
119			0, 0,
120			TILESIZE, TILESIZE,
121	elmex	1.6	- ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
122	elmex	1.2	1, 1, 'nearest', 255
123			);
124			}
125	elmex	1.1
126			sub classify_arch_layer {
127			my ($arch) = @_;
128
129			if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals)
130
131			return 'below';
132
133			} elsif ($arch->{monster}) {
134
135			return 'top';
136
137			} else { # $arch->{is_floor} and all other arches are 'between' monsters and floor
138
139			return 'between';
140			}
141			}
142
143	elmex	1.7	sub arch_is_exit {
144			my ($a) = @_;
145			my $type = $Crossfire::ARCH{$a->{_name}}->{type};
146			return $type eq '66' \|\| $type eq '41';
147			}
148
149	elmex	1.2	sub arch_is_floor {
150			my ($a) = @_;
151	elmex	1.10	my $ar = Crossfire::arch_attr $a;
152	elmex	1.12	return (substr $ar->{name}, 0, 5) eq 'Floor';
153	elmex	1.10	#return $Crossfire::ARCH{$a->{_name}}->{is_floor};
154	elmex	1.2	}
155
156			sub arch_is_wall {
157			my ($a) = @_;
158	elmex	1.10	my $ar = Crossfire::arch_attr $a;
159			return $ar->{name} eq 'Wall';
160			#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
161	elmex	1.2	}
162
163	elmex	1.3	sub arch_is_monster {
164			my ($a) = @_;
165			my $arch = $Crossfire::ARCH{$a->{_name}};
166			return $arch->{alive} and ($arch->{monster} or $arch->{generator});
167			}
168
169	elmex	1.2	sub stack_find {
170			my ($stack, $dir, $pred) = @_;
171
172
173			if ($dir eq 'from_top') {
174			my $i = scalar (@$stack) - 1;
175			if ($i < 0) { $i = 0 }
176
177			for (reverse @$stack) {
178			$pred->($_)
179			and return $i;
180
181			$i--;
182			}
183
184			} else {
185			my $i = 0;
186
187			for (@$stack) {
188			$pred->($_)
189			and return $i;
190
191			$i++;
192			}
193			}
194
195			return 0;
196
197			}
198
199			sub stack_find_floor {
200			my ($stack, $dir) = @_;
201			return stack_find ($stack, $dir, \&arch_is_floor);
202			}
203
204			sub stack_find_wall {
205			my ($stack, $dir) = @_;
206			return stack_find ($stack, $dir, \&arch_is_wall);
207			}
208
209	elmex	1.1	sub insert_arch_stack_layer {
210			my ($stack, $arch) = @_;
211
212			unless (@$stack) {
213			return [ $arch ];
214			}
215
216			my @outstack;
217
218			my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});
219
220			if ($l eq 'between') {
221
222			# loop until we reached the first 'between' arch above 'below' arches and the floor
223			while (my $a = shift @$stack) {
224
225			unless ($Crossfire::ARCH{$a->{_name}}->{is_floor}
226			or classify_arch_layer ($Crossfire::ARCH{$a->{_name}}) eq 'below') {
227
228			unshift @$stack, $a;
229			last;
230			}
231
232			push @outstack, $a;
233			}
234
235			# ignore duplicates
236			# FIXME: Broken if non-floor are drawn (too tired to fix)
237			return [ @outstack, @$stack ]
238			if @outstack and $outstack[-1]->{_name} eq $arch->{_name};
239
240			push @outstack, ($arch, @$stack);
241
242			} elsif ($l eq 'top') {
243
244			# ignore duplicates
245			return [ @$stack ]
246			if $stack->[-1]->{_name} eq $arch->{_name};
247
248			@outstack = (@$stack, $arch);
249
250			} else {
251
252			# ignore duplicates
253			return [ @$stack ]
254			if $stack->[0]->{_name} eq $arch->{_name};
255
256			@outstack = ($arch, @$stack);
257			}
258
259			return \@outstack;
260			}
261
262	elmex	1.4	sub 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
290	elmex	1.1	sub replace_arch_stack_layer {
291			my ($stack, $arch) = @_;
292
293			my @outstack;
294
295			my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});
296
297			if ($l eq 'between') {
298
299			while (shift @$stack) {
300			last unless $Crossfire::ARCH{$_->{_name}}->{is_floor};
301			push @outstack, $_;
302			}
303
304			if (@outstack and $Crossfire::ARCH{$outstack[-1]->{_name}}->{is_floor}) {
305			pop @outstack;
306			}
307
308			push @outstack, ($arch, @$stack);
309
310			} elsif ($l eq 'top') {
311
312			@outstack = (@$stack, $arch);
313
314			} else {
315
316			@outstack = ($arch, @$stack);
317			}
318
319			return \@outstack;
320			}
321
322			=head1 AUTHOR
323
324			Marc Lehmann <schmorp@schmorp.de>
325			http://home.schmorp.de/
326
327			Robin Redeker <elmex@ta-sa.org>
328			http://www.ta-sa.org/
329
330			=cut
331			1;