gde/GCE/ArchRef.pm

package GCE::ArchRef;
=head1 NAME

   GCE::ArchRef - a intelligent reference to an arch instance on/in the map

=head1 SYNOPSIS

   GCE::ArchRef->new (arch => <hashref>, cb => <changecb>)

=over 4

=cut

use Storable qw/dclone/;
use Crossfire;
use Carp;
use GCE::Util;

sub getarch {
   my ($ar) = @_;

   if (ref $ar eq 'GCE::ArchRef') {
      return $ar->{arch}
   } else {
      return $ar
   }
}

sub new {
   my $class = shift;
   my $self = { @_ };
   bless $self, $class;

   unless (defined $self->{arch}) {
      Carp::confess ("arch not defined when making new ArchRef")
   }
   unless (defined $Crossfire::ARCH{$self->getarch->{_name}}) {
      Carp::confess ("archetype not defined")
   }

   return $self;
}

sub type {
   my ($self) = @_;
   Crossfire::arch_attr $self->getarch;
}

sub archetype {
   my ($self) = @_;

   $Crossfire::ARCH{$self->getarch->{_name}};
}

sub longname {
   my ($self) = @_;

   my $name = $self->get ('_name');
   my $rname = $self->get ('name');
   my $t = $self->type;

   $name . ($rname ? " - $rname" : "") . " ($t->{name})"
}

sub field_value_is_default {
   my ($self, $key, $val) = @_;
   my $al_arch = $self->archetype;

   # XXX: Was '... and $val', does this fix problems?
   (defined $al_arch->{$key} and $al_arch->{$key} ne $val)
      || (not (defined $al_arch->{$key}) and $val)
}

sub add_inv {
   my ($self, $arch) = @_;
   push @{$self->{arch}->{inventory}}, dclone (getarch $arch);

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub swap_inv {
   my ($self, $swapidx, $ownidx) = @_;
   my $inv = $self->getarch->{inventory};

   ($inv->[$swapidx], $inv->[$ownidx])
      = ($inv->[$ownidx], $inv->[$swapidx]);

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub get_inv_refs {
   my ($self) = @_;

   my $cb = sub {
      $self->{cb}->($self)
         if defined $self->{cb};

      $self->exec_change_cbs;
   };

   [ map { GCE::ArchRef->new (arch => $_, cb => $cb) } @{$self->get ('inventory') || []} ]
}

sub replace_inv {
   my ($self, $idx, $new) = @_;
   splice @{$self->getarch->{'inventory'}}, $idx, 1, $new;

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub remove_inv {
   my ($self, $idx) = @_;
   splice @{$self->getarch->{'inventory'}}, $idx, 1;

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub reset_to_defaults {
   my ($self) = @_;

   my $arch = $self->getarch;
   for (keys %$arch) {
      delete $arch->{$_} if $_ ne '_name'
   }

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub get {
   my ($self, $key) = @_;
   $self->getarch->{$key}
}

sub get_or_default {
   my ($self, $key) = @_;
   def ($self->get ($key), $self->archetype->{$key})
}

sub set_silent {
   my ($self, $key, $value) = @_;

   my $arch = $self->getarch;
   my $al_arch = $self->archetype; #$Crossfire::ARCH{$arch->{_name}};

   if (ref $value) {
      $arch->{$key} = $value;

   } else {
      if (not defined $al_arch->{$key}) {
         if (not defined $value) {
            # try to normalize
            delete $arch->{$key};
         } else {
            # try to normalize
            $arch->{$key} = $value;
         }
      } else {
         if ($al_arch->{$key} ne $value) {
            $arch->{$key} = $value;
         } else {
            # try to normalize
            delete $arch->{$key};
         }
      }
   }

   $self->{cb}->($arch)
      if defined $self->{cb};
}

sub set {
   my ($self, $key, $value) = @_;
   $self->set_silent ($key, $value);

   $self->exec_change_cbs;
}

sub remove_on_change {
   my ($self, $key) = @_;
   delete $self->{change_cbs}->{$key};
}

sub add_on_change {
   my ($self, $key, $cb) = @_;
   $self->{change_cbs}->{$key} = $cb;
}

sub exec_change_cbs {
   my ($self, @a) = @_;
   $_->($self, @a) for (values %{$self->{change_cbs}});
}

=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.1
Committed:	Tue Apr 4 21:12:08 2006 UTC (18 years, 2 months ago) by elmex
Branch:	MAIN
Log Message:	Changed updating of attribute editor and inventory editor in a major manner. We have now an abstraction layer between attribute editor and arch/object that handles updating of the map and calling change_begin/set/end. Works fine after testing, please watchout for bugs in attribute editor, inventory editor and updating of these.
#	User	Rev	Content
1	elmex	1.1	package GCE::ArchRef;
2			=head1 NAME
3
4			GCE::ArchRef - a intelligent reference to an arch instance on/in the map
5
6			=head1 SYNOPSIS
7
8			GCE::ArchRef->new (arch => <hashref>, cb => <changecb>)
9
10			=over 4
11
12			=cut
13
14			use Storable qw/dclone/;
15			use Crossfire;
16			use Carp;
17			use GCE::Util;
18
19			sub getarch {
20			my ($ar) = @_;
21
22			if (ref $ar eq 'GCE::ArchRef') {
23			return $ar->{arch}
24			} else {
25			return $ar
26			}
27			}
28
29			sub new {
30			my $class = shift;
31			my $self = { @_ };
32			bless $self, $class;
33
34			unless (defined $self->{arch}) {
35			Carp::confess ("arch not defined when making new ArchRef")
36			}
37			unless (defined $Crossfire::ARCH{$self->getarch->{_name}}) {
38			Carp::confess ("archetype not defined")
39			}
40
41			return $self;
42			}
43
44			sub type {
45			my ($self) = @_;
46			Crossfire::arch_attr $self->getarch;
47			}
48
49			sub archetype {
50			my ($self) = @_;
51
52			$Crossfire::ARCH{$self->getarch->{_name}};
53			}
54
55			sub longname {
56			my ($self) = @_;
57
58			my $name = $self->get ('_name');
59			my $rname = $self->get ('name');
60			my $t = $self->type;
61
62			$name . ($rname ? " - $rname" : "") . " ($t->{name})"
63			}
64
65			sub field_value_is_default {
66			my ($self, $key, $val) = @_;
67			my $al_arch = $self->archetype;
68
69			# XXX: Was '... and $val', does this fix problems?
70			(defined $al_arch->{$key} and $al_arch->{$key} ne $val)
71			\|\| (not (defined $al_arch->{$key}) and $val)
72			}
73
74			sub add_inv {
75			my ($self, $arch) = @_;
76			push @{$self->{arch}->{inventory}}, dclone (getarch $arch);
77
78			$self->{cb}->($self)
79			if defined $self->{cb};
80
81			$self->exec_change_cbs;
82			}
83
84			sub swap_inv {
85			my ($self, $swapidx, $ownidx) = @_;
86			my $inv = $self->getarch->{inventory};
87
88			($inv->[$swapidx], $inv->[$ownidx])
89			= ($inv->[$ownidx], $inv->[$swapidx]);
90
91			$self->{cb}->($self)
92			if defined $self->{cb};
93
94			$self->exec_change_cbs;
95			}
96
97			sub get_inv_refs {
98			my ($self) = @_;
99
100			my $cb = sub {
101			$self->{cb}->($self)
102			if defined $self->{cb};
103
104			$self->exec_change_cbs;
105			};
106
107			[ map { GCE::ArchRef->new (arch => $_, cb => $cb) } @{$self->get ('inventory') \|\| []} ]
108			}
109
110			sub replace_inv {
111			my ($self, $idx, $new) = @_;
112			splice @{$self->getarch->{'inventory'}}, $idx, 1, $new;
113
114			$self->{cb}->($self)
115			if defined $self->{cb};
116
117			$self->exec_change_cbs;
118			}
119
120			sub remove_inv {
121			my ($self, $idx) = @_;
122			splice @{$self->getarch->{'inventory'}}, $idx, 1;
123
124			$self->{cb}->($self)
125			if defined $self->{cb};
126
127			$self->exec_change_cbs;
128			}
129
130			sub reset_to_defaults {
131			my ($self) = @_;
132
133			my $arch = $self->getarch;
134			for (keys %$arch) {
135			delete $arch->{$_} if $_ ne '_name'
136			}
137
138			$self->{cb}->($self)
139			if defined $self->{cb};
140
141			$self->exec_change_cbs;
142			}
143
144			sub get {
145			my ($self, $key) = @_;
146			$self->getarch->{$key}
147			}
148
149			sub get_or_default {
150			my ($self, $key) = @_;
151			def ($self->get ($key), $self->archetype->{$key})
152			}
153
154			sub set_silent {
155			my ($self, $key, $value) = @_;
156
157			my $arch = $self->getarch;
158			my $al_arch = $self->archetype; #$Crossfire::ARCH{$arch->{_name}};
159
160			if (ref $value) {
161			$arch->{$key} = $value;
162
163			} else {
164			if (not defined $al_arch->{$key}) {
165			if (not defined $value) {
166			# try to normalize
167			delete $arch->{$key};
168			} else {
169			# try to normalize
170			$arch->{$key} = $value;
171			}
172			} else {
173			if ($al_arch->{$key} ne $value) {
174			$arch->{$key} = $value;
175			} else {
176			# try to normalize
177			delete $arch->{$key};
178			}
179			}
180			}
181
182			$self->{cb}->($arch)
183			if defined $self->{cb};
184			}
185
186			sub set {
187			my ($self, $key, $value) = @_;
188			$self->set_silent ($key, $value);
189
190			$self->exec_change_cbs;
191			}
192
193			sub remove_on_change {
194			my ($self, $key) = @_;
195			delete $self->{change_cbs}->{$key};
196			}
197
198			sub add_on_change {
199			my ($self, $key, $cb) = @_;
200			$self->{change_cbs}->{$key} = $cb;
201			}
202
203			sub exec_change_cbs {
204			my ($self, @a) = @_;
205			$_->($self, @a) for (values %{$self->{change_cbs}});
206			}
207
208			=head1 AUTHOR
209
210			Marc Lehmann <schmorp@schmorp.de>
211			http://home.schmorp.de/
212
213			Robin Redeker <elmex@ta-sa.org>
214			http://www.ta-sa.org/
215
216			=cut
217			1;