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;

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

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 $ar->{name} 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.10
Committed:	Tue Mar 21 01:02:14 2006 UTC (18 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.9:	+6 -2 lines
Log Message:	replaced the is_floor and is_wall functions by more intelligent functions which check for the informations from the xml file.
#	Content
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	use Crossfire;
19	use Crossfire::MapWidget;
20	use File::Spec::Functions;
21
22	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);
23
24	sub map2abs {
25	my ($dest, $mape) = @_;
26
27	my $dir;
28	if (File::Spec->file_name_is_absolute($dest)) {
29	$dir = catdir ($CFG->{MAPDIR}, $dest);
30	} else {
31	my ($v, $p, $f) = File::Spec->splitpath ($mape->{path});
32	$dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p));
33	}
34	return $dir;
35	}
36
37	sub def($$) {
38	return defined ($_[0]) ? $_[0] : $_[1];
39	}
40
41	sub quick_msg {
42	my $wid = shift;
43	my $msg;
44	my $win = $::MAINWIN;
45	if (ref $wid) {
46	$win = $wid;
47	$msg = shift;
48	} else {
49	$msg = $wid;
50	}
51	my $dia = Gtk2::Dialog->new ('Message', $win, 'destroy-with-parent', 'gtk-ok' => 'none');
52
53	my $lbl = Gtk2::Label->new ($msg);
54	$dia->vbox->add ($lbl);
55	$dia->signal_connect (response => sub { $_[0]->destroy });
56
57	unless (defined $_[0]) {
58	Glib::Timeout->add (1000, sub { $dia->destroy; 0 });
59	}
60
61	$dia->show_all;
62	}
63
64	sub new_arch_pb {
65	# this is awful, is this really the best way?
66	my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
67	return $pb;
68	}
69
70	sub fill_pb_from_arch {
71	my ($pb, $a) = @_;
72
73	my $o = $Crossfire::ARCH{$a->{_name}};
74	my $face = $Crossfire::FACE{$a->{face} \|\| $o->{face} \|\| "blank.111"}
75	or warn "no gfx found for arch '$a->{_name}' at ($x\|$y)\n";
76
77	$face or return;
78
79	$pb->fill (0x00000000);
80	$TILE->composite ($pb,
81	0, 0,
82	TILESIZE, TILESIZE,
83	- ($face->{idx} % 64) * TILESIZE, - TILESIZE * int $face->{idx} / 64,
84	1, 1, 'nearest', 255
85	);
86	}
87
88	sub classify_arch_layer {
89	my ($arch) = @_;
90
91	if ($arch->{invisible}) { # just a heuristic for 'special' tiles (er. pedestals)
92
93	return 'below';
94
95	} elsif ($arch->{monster}) {
96
97	return 'top';
98
99	} else { # $arch->{is_floor} and all other arches are 'between' monsters and floor
100
101	return 'between';
102	}
103	}
104
105	sub arch_is_exit {
106	my ($a) = @_;
107	my $type = $Crossfire::ARCH{$a->{_name}}->{type};
108	return $type eq '66' \|\| $type eq '41';
109	}
110
111	sub arch_is_floor {
112	my ($a) = @_;
113	my $ar = Crossfire::arch_attr $a;
114	return $ar->{name} eq 'Floor';
115	#return $Crossfire::ARCH{$a->{_name}}->{is_floor};
116	}
117
118	sub arch_is_wall {
119	my ($a) = @_;
120	my $ar = Crossfire::arch_attr $a;
121	return $ar->{name} eq 'Wall';
122	#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
123	}
124
125	sub arch_is_monster {
126	my ($a) = @_;
127	my $arch = $Crossfire::ARCH{$a->{_name}};
128	return $arch->{alive} and ($arch->{monster} or $arch->{generator});
129	}
130
131	sub stack_find {
132	my ($stack, $dir, $pred) = @_;
133
134
135	if ($dir eq 'from_top') {
136	my $i = scalar (@$stack) - 1;
137	if ($i < 0) { $i = 0 }
138
139	for (reverse @$stack) {
140	$pred->($_)
141	and return $i;
142
143	$i--;
144	}
145
146	} else {
147	my $i = 0;
148
149	for (@$stack) {
150	$pred->($_)
151	and return $i;
152
153	$i++;
154	}
155	}
156
157	return 0;
158
159	}
160
161	sub stack_find_floor {
162	my ($stack, $dir) = @_;
163	return stack_find ($stack, $dir, \&arch_is_floor);
164	}
165
166	sub stack_find_wall {
167	my ($stack, $dir) = @_;
168	return stack_find ($stack, $dir, \&arch_is_wall);
169	}
170
171	sub insert_arch_stack_layer {
172	my ($stack, $arch) = @_;
173
174	unless (@$stack) {
175	return [ $arch ];
176	}
177
178	my @outstack;
179
180	my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});
181
182	if ($l eq 'between') {
183
184	# loop until we reached the first 'between' arch above 'below' arches and the floor
185	while (my $a = shift @$stack) {
186
187	unless ($Crossfire::ARCH{$a->{_name}}->{is_floor}
188	or classify_arch_layer ($Crossfire::ARCH{$a->{_name}}) eq 'below') {
189
190	unshift @$stack, $a;
191	last;
192	}
193
194	push @outstack, $a;
195	}
196
197	# ignore duplicates
198	# FIXME: Broken if non-floor are drawn (too tired to fix)
199	return [ @outstack, @$stack ]
200	if @outstack and $outstack[-1]->{_name} eq $arch->{_name};
201
202	push @outstack, ($arch, @$stack);
203
204	} elsif ($l eq 'top') {
205
206	# ignore duplicates
207	return [ @$stack ]
208	if $stack->[-1]->{_name} eq $arch->{_name};
209
210	@outstack = (@$stack, $arch);
211
212	} else {
213
214	# ignore duplicates
215	return [ @$stack ]
216	if $stack->[0]->{_name} eq $arch->{_name};
217
218	@outstack = ($arch, @$stack);
219	}
220
221	return \@outstack;
222	}
223
224	sub add_table_widget {
225	my ($table, $row, $data, $type, $cb) = @_;
226	my $edwid;
227
228	if ($type eq 'string') {
229	$table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
230	$edwid = Gtk2::Entry->new;
231	$edwid->set_text ($data->[1]);
232	$edwid->signal_connect (changed => sub {
233	$data->[1] = $_[0]->get_text;
234	$cb->($data->[1]) if $cb;
235	});
236	$table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
237
238	} elsif ($type eq 'button') {
239	$table->attach_defaults (my $b = Gtk2::Button->new_with_label ($data), 0, 2, $row, $row + 1);
240	$b->signal_connect (clicked => ($cb \|\| sub {}));
241
242	} elsif ($type eq 'label') {
243	$table->attach_defaults (my $lbl = Gtk2::Label->new ($data->[0]), 0, 1, $row, $row + 1);
244	$edwid = Gtk2::Label->new ($data->[1]);
245	$table->attach_defaults ($edwid, 1, 2, $row, $row + 1);
246
247	} else {
248	$edwid = Gtk2::Label->new ("FOO");
249	}
250	}
251
252	sub replace_arch_stack_layer {
253	my ($stack, $arch) = @_;
254
255	my @outstack;
256
257	my $l = classify_arch_layer ($Crossfire::ARCH{$arch->{_name}});
258
259	if ($l eq 'between') {
260
261	while (shift @$stack) {
262	last unless $Crossfire::ARCH{$_->{_name}}->{is_floor};
263	push @outstack, $_;
264	}
265
266	if (@outstack and $Crossfire::ARCH{$outstack[-1]->{_name}}->{is_floor}) {
267	pop @outstack;
268	}
269
270	push @outstack, ($arch, @$stack);
271
272	} elsif ($l eq 'top') {
273
274	@outstack = (@$stack, $arch);
275
276	} else {
277
278	@outstack = ($arch, @$stack);
279	}
280
281	return \@outstack;
282	}
283
284	=head1 AUTHOR
285
286	Marc Lehmann <schmorp@schmorp.de>
287	http://home.schmorp.de/
288
289	Robin Redeker <elmex@ta-sa.org>
290	http://www.ta-sa.org/
291
292	=cut
293	1;