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 Deliantra;
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 $Deliantra::ARCH{$self->getarch->{_name}}) {
      quick_msg (
         $::MAINWIN,
         "ERROR: No such archetype '" . ($self->getarch->{_name})
         ."' replacing it's type with 'empty_archetype'.",
         0
      );
   }

   return $self;
}

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

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

   $Deliantra::ARCH{$self->getarch->{_name}} || $Deliantra::ARCH{empty_archetype};
}

sub picker_folder {
   my ($self) = @_;
   my $folder = $self->archetype->{editor_folder};
   my @a = split /\//, $folder;
   $a[0]
}

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}) && $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 (qw/inventory/);
}

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 (qw/inventory/);
}

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

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

      $self->exec_change_cbs (qw/inventory/);
   };

   [ map { GCE::ArchRef->new (arch => $_, source => 'inventory', 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 (qw/inventory/);
}

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

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

   $self->exec_change_cbs (qw/inventory/);
}

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;

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

   } else {
      if (not defined $al_arch->{$key}) {
         if ((not defined $value) || $value eq '') {
            # 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 ($key);
}

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.7
Committed:	Thu Dec 27 22:28:01 2007 UTC (16 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.6:	+4 -4 lines
Log Message:	upgrade Crossfire to Deliantra
#	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	root	1.7	use Deliantra;
16	elmex	1.1	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	root	1.7	unless (defined $Deliantra::ARCH{$self->getarch->{_name}}) {
38	elmex	1.3	quick_msg (
39			$::MAINWIN,
40			"ERROR: No such archetype '" . ($self->getarch->{_name})
41			."' replacing it's type with 'empty_archetype'.",
42			0
43			);
44	elmex	1.1	}
45
46			return $self;
47			}
48
49			sub type {
50			my ($self) = @_;
51	root	1.7	Deliantra::arch_attr $self->getarch;
52	elmex	1.1	}
53
54			sub archetype {
55			my ($self) = @_;
56
57	root	1.7	$Deliantra::ARCH{$self->getarch->{_name}} \|\| $Deliantra::ARCH{empty_archetype};
58	elmex	1.1	}
59
60	elmex	1.4	sub picker_folder {
61			my ($self) = @_;
62			my $folder = $self->archetype->{editor_folder};
63			my @a = split /\//, $folder;
64			$a[0]
65			}
66
67	elmex	1.1	sub longname {
68			my ($self) = @_;
69
70			my $name = $self->get ('_name');
71			my $rname = $self->get ('name');
72			my $t = $self->type;
73
74			$name . ($rname ? " - $rname" : "") . " ($t->{name})"
75			}
76
77			sub field_value_is_default {
78			my ($self, $key, $val) = @_;
79			my $al_arch = $self->archetype;
80
81			# XXX: Was '... and $val', does this fix problems?
82	elmex	1.5	(defined ($al_arch->{$key}) && $al_arch->{$key} ne $val)
83	elmex	1.1	\|\| (not (defined $al_arch->{$key}) and $val)
84			}
85
86			sub add_inv {
87			my ($self, $arch) = @_;
88			push @{$self->{arch}->{inventory}}, dclone (getarch $arch);
89
90			$self->{cb}->($self)
91			if defined $self->{cb};
92
93	elmex	1.2	$self->exec_change_cbs (qw/inventory/);
94	elmex	1.1	}
95
96			sub swap_inv {
97			my ($self, $swapidx, $ownidx) = @_;
98			my $inv = $self->getarch->{inventory};
99
100			($inv->[$swapidx], $inv->[$ownidx])
101			= ($inv->[$ownidx], $inv->[$swapidx]);
102
103			$self->{cb}->($self)
104			if defined $self->{cb};
105
106	elmex	1.2	$self->exec_change_cbs (qw/inventory/);
107	elmex	1.1	}
108
109			sub get_inv_refs {
110			my ($self) = @_;
111
112			my $cb = sub {
113			$self->{cb}->($self)
114			if defined $self->{cb};
115
116	elmex	1.2	$self->exec_change_cbs (qw/inventory/);
117	elmex	1.1	};
118
119	elmex	1.6	[ map { GCE::ArchRef->new (arch => $_, source => 'inventory', cb => $cb) } @{$self->get ('inventory') \|\| []} ]
120	elmex	1.1	}
121
122			sub replace_inv {
123			my ($self, $idx, $new) = @_;
124			splice @{$self->getarch->{'inventory'}}, $idx, 1, $new;
125
126			$self->{cb}->($self)
127			if defined $self->{cb};
128
129	elmex	1.2	$self->exec_change_cbs (qw/inventory/);
130	elmex	1.1	}
131
132			sub remove_inv {
133			my ($self, $idx) = @_;
134			splice @{$self->getarch->{'inventory'}}, $idx, 1;
135
136			$self->{cb}->($self)
137			if defined $self->{cb};
138
139	elmex	1.2	$self->exec_change_cbs (qw/inventory/);
140	elmex	1.1	}
141
142			sub reset_to_defaults {
143			my ($self) = @_;
144
145			my $arch = $self->getarch;
146			for (keys %$arch) {
147			delete $arch->{$_} if $_ ne '_name'
148			}
149
150			$self->{cb}->($self)
151			if defined $self->{cb};
152
153			$self->exec_change_cbs;
154			}
155
156			sub get {
157			my ($self, $key) = @_;
158			$self->getarch->{$key}
159			}
160
161			sub get_or_default {
162			my ($self, $key) = @_;
163			def ($self->get ($key), $self->archetype->{$key})
164			}
165
166			sub set_silent {
167			my ($self, $key, $value) = @_;
168
169			my $arch = $self->getarch;
170	elmex	1.3	my $al_arch = $self->archetype;
171	elmex	1.1
172			if (ref $value) {
173			$arch->{$key} = $value;
174
175			} else {
176			if (not defined $al_arch->{$key}) {
177	elmex	1.5	if ((not defined $value) \|\| $value eq '') {
178	elmex	1.1	# try to normalize
179			delete $arch->{$key};
180			} else {
181			# try to normalize
182			$arch->{$key} = $value;
183			}
184			} else {
185			if ($al_arch->{$key} ne $value) {
186			$arch->{$key} = $value;
187			} else {
188			# try to normalize
189			delete $arch->{$key};
190			}
191			}
192			}
193
194			$self->{cb}->($arch)
195			if defined $self->{cb};
196			}
197
198			sub set {
199			my ($self, $key, $value) = @_;
200			$self->set_silent ($key, $value);
201
202	elmex	1.2	$self->exec_change_cbs ($key);
203	elmex	1.1	}
204
205			sub remove_on_change {
206			my ($self, $key) = @_;
207			delete $self->{change_cbs}->{$key};
208			}
209
210			sub add_on_change {
211			my ($self, $key, $cb) = @_;
212			$self->{change_cbs}->{$key} = $cb;
213			}
214
215			sub exec_change_cbs {
216			my ($self, @a) = @_;
217			$_->($self, @a) for (values %{$self->{change_cbs}});
218			}
219
220			=head1 AUTHOR
221
222			Marc Lehmann <schmorp@schmorp.de>
223			http://home.schmorp.de/
224
225			Robin Redeker <elmex@ta-sa.org>
226			http://www.ta-sa.org/
227
228			=cut
229			1;