gde/GCE/ArchRef.pm

package GCE::ArchRef;
use strict;
=head1 NAME

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

=head1 SYNOPSIS

   GCE::ArchRef->new (...);

=over 4

=cut

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

sub getarch {
   my ($self, $rw) = @_;

   my $arch;

   if ($self->{map}) {
      $arch =
         $rw
            ? $self->{map}->{map}->get    ($self->{x}, $self->{y})
            : $self->{map}->{map}->get_ro ($self->{x}, $self->{y});

      $self->{last_got_mapspace} = $rw ? $arch : undef;

      $self->{z} = -1 unless defined $self->{z};

      $arch = $arch->[$self->{z}];

      for (@{$self->{inv} || []}) {
         $arch = $arch->{inventory}->[$_];
      }

      unless (defined $arch) {
         die "bad arch cursor: $self->{x}, $self->{y}, $self->{z}, "
             . join (@{$self->{inv} || []})
             . " \n";
      }

   } else {
      $arch = $self->{arch};
   }

   unless (defined $Deliantra::ARCH{$arch->{_name}}) {
      quick_msg (
         $::MAINWIN,
         "ERROR: No such archetype '" . ($arch->{_name})
         ."' replacing it's type with 'empty_archetype'.",
         0
      );
   }

   $arch
}

sub commit_last_got_arch {
   my ($self, $change) = @_;
   return unless defined $self->{last_got_mapspace};

   my $map = $self->{map};

   return unless defined $map;

   $map = $map->{map};

   $map->change_begin (($change || 'unknown_edit') . ' on ' . $self);

   $map->change_stack ($self->{x}, $self->{y}, $self->{last_got_mapspace});

   if (my $changeset = $map->change_end) {
      my $undo_stack = ($map->{undo_stack} ||= []);

      my $str_self = "$self";

      if ($undo_stack->[$map->{undo_stack_pos} - 1]->{title}
             =~ /^attribute_edit:.*? on \Q$str_self\E$/) {
         $map->{undo_stack_pos}--;

         warn "merged change ($changeset->{title})\n";
      } else {
         warn "added change ($changeset->{title})\n";
      }

      splice @{ $map->{undo_stack} ||= [] },
             $map->{undo_stack_pos}++, 1e6,
             $changeset;
   }

   $::MAINWIN->broadcast_cursor_changes ($self->{map}, $self->{x}, $self->{y});
}

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

   unless (defined ($self->{arch}) || defined ($self->{map})) {
      Carp::confess ("arch not defined when making new ArchRef")
   }

   $self->getarch;

   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) = @_;

   my $arch = $self->getarch (1);

   push @{$self->{arch}->{inventory}}, dclone (getarch $arch);

   $self->commit_last_got_arch ('add_inventory');
}

sub swap_inv {
   my ($self, $swapidx, $ownidx) = @_;

   my $arch = $self->getarch (1);

   my $inv = $arch->{inventory};

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

   $self->commit_last_got_arch ('swap_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) = @_;

   my $arch = $self->getarch (1);

   splice @{$arch->{'inventory'}}, $idx, 1, $new;

   $self->commit_last_got_arch ('replace_inventory');
}

sub remove_inv {
   my ($self, $idx) = @_;

   my $arch = $self->getarch (1);

   splice @{$arch->{'inventory'}}, $idx, 1;

   $self->commit_last_got_arch ('remove_inventory');
}

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

   my $arch = $self->getarch (1);

   for (keys %$arch) {
      delete $arch->{$_} if $_ ne '_name'
   }

   $self->commit_last_got_arch ('reset_to_defaults');
}

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

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

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

   my $arch = $self->getarch (1);
   my $al_arch = $self->archetype;

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

   } else {
      if (not defined $al_arch->{$key}) {
         if ((not defined $value) || $value eq ''
             || ($type eq 'bool' && $value eq '0')) {
            # 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->commit_last_got_arch ('attribute_edit:' . $key);
}

=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.9.2.1
Committed:	Tue Jul 7 15:42:18 2009 UTC (14 years, 11 months ago) by elmex
Branch:	cursor
Changes since 1.9:	+113 -74 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	elmex	1.1	package GCE::ArchRef;
2	elmex	1.9.2.1	use strict;
3	elmex	1.1	=head1 NAME
4
5			GCE::ArchRef - a intelligent reference to an arch instance on/in the map
6
7			=head1 SYNOPSIS
8
9	elmex	1.9.2.1	GCE::ArchRef->new (...);
10	elmex	1.1
11			=over 4
12
13			=cut
14
15			use Storable qw/dclone/;
16	root	1.7	use Deliantra;
17	elmex	1.1	use Carp;
18			use GCE::Util;
19
20			sub getarch {
21	elmex	1.9.2.1	my ($self, $rw) = @_;
22
23			my $arch;
24
25			if ($self->{map}) {
26			$arch =
27			$rw
28			? $self->{map}->{map}->get ($self->{x}, $self->{y})
29			: $self->{map}->{map}->get_ro ($self->{x}, $self->{y});
30
31			$self->{last_got_mapspace} = $rw ? $arch : undef;
32
33			$self->{z} = -1 unless defined $self->{z};
34
35			$arch = $arch->[$self->{z}];
36
37			for (@{$self->{inv} \|\| []}) {
38			$arch = $arch->{inventory}->[$_];
39			}
40
41			unless (defined $arch) {
42			die "bad arch cursor: $self->{x}, $self->{y}, $self->{z}, "
43			. join (@{$self->{inv} \|\| []})
44			. " \n";
45			}
46	elmex	1.1
47			} else {
48	elmex	1.9.2.1	$arch = $self->{arch};
49			}
50
51			unless (defined $Deliantra::ARCH{$arch->{_name}}) {
52			quick_msg (
53			$::MAINWIN,
54			"ERROR: No such archetype '" . ($arch->{_name})
55			."' replacing it's type with 'empty_archetype'.",
56			0
57			);
58			}
59
60			$arch
61			}
62
63			sub commit_last_got_arch {
64			my ($self, $change) = @_;
65			return unless defined $self->{last_got_mapspace};
66
67			my $map = $self->{map};
68
69			return unless defined $map;
70
71			$map = $map->{map};
72
73			$map->change_begin (($change \|\| 'unknown_edit') . ' on ' . $self);
74
75			$map->change_stack ($self->{x}, $self->{y}, $self->{last_got_mapspace});
76
77			if (my $changeset = $map->change_end) {
78			my $undo_stack = ($map->{undo_stack} \|\|= []);
79
80			my $str_self = "$self";
81
82			if ($undo_stack->[$map->{undo_stack_pos} - 1]->{title}
83			=~ /^attribute_edit:.*? on \Q$str_self\E$/) {
84			$map->{undo_stack_pos}--;
85
86			warn "merged change ($changeset->{title})\n";
87			} else {
88			warn "added change ($changeset->{title})\n";
89			}
90
91			splice @{ $map->{undo_stack} \|\|= [] },
92			$map->{undo_stack_pos}++, 1e6,
93			$changeset;
94	elmex	1.1	}
95	elmex	1.9.2.1
96			$::MAINWIN->broadcast_cursor_changes ($self->{map}, $self->{x}, $self->{y});
97	elmex	1.1	}
98
99			sub new {
100			my $class = shift;
101			my $self = { @_ };
102			bless $self, $class;
103
104	elmex	1.9.2.1	unless (defined ($self->{arch}) \|\| defined ($self->{map})) {
105	elmex	1.1	Carp::confess ("arch not defined when making new ArchRef")
106			}
107	elmex	1.9.2.1
108			$self->getarch;
109	elmex	1.1
110			return $self;
111			}
112
113			sub type {
114			my ($self) = @_;
115	root	1.7	Deliantra::arch_attr $self->getarch;
116	elmex	1.1	}
117
118			sub archetype {
119			my ($self) = @_;
120
121	root	1.7	$Deliantra::ARCH{$self->getarch->{_name}} \|\| $Deliantra::ARCH{empty_archetype};
122	elmex	1.1	}
123
124	elmex	1.4	sub picker_folder {
125			my ($self) = @_;
126			my $folder = $self->archetype->{editor_folder};
127			my @a = split /\//, $folder;
128			$a[0]
129			}
130
131	elmex	1.1	sub longname {
132			my ($self) = @_;
133
134			my $name = $self->get ('_name');
135			my $rname = $self->get ('name');
136			my $t = $self->type;
137
138			$name . ($rname ? " - $rname" : "") . " ($t->{name})"
139			}
140
141			sub field_value_is_default {
142			my ($self, $key, $val) = @_;
143			my $al_arch = $self->archetype;
144
145			# XXX: Was '... and $val', does this fix problems?
146	elmex	1.5	(defined ($al_arch->{$key}) && $al_arch->{$key} ne $val)
147	elmex	1.1	\|\| (not (defined $al_arch->{$key}) and $val)
148			}
149
150			sub add_inv {
151			my ($self, $arch) = @_;
152
153	elmex	1.9.2.1	my $arch = $self->getarch (1);
154
155			push @{$self->{arch}->{inventory}}, dclone (getarch $arch);
156	elmex	1.1
157	elmex	1.9.2.1	$self->commit_last_got_arch ('add_inventory');
158	elmex	1.1	}
159
160			sub swap_inv {
161			my ($self, $swapidx, $ownidx) = @_;
162	elmex	1.9.2.1
163			my $arch = $self->getarch (1);
164
165			my $inv = $arch->{inventory};
166	elmex	1.1
167			($inv->[$swapidx], $inv->[$ownidx])
168			= ($inv->[$ownidx], $inv->[$swapidx]);
169
170	elmex	1.9.2.1	$self->commit_last_got_arch ('swap_inventory');
171	elmex	1.1	}
172
173	elmex	1.9.2.1	#sub get_inv_refs {
174			# my ($self) = @_;
175			#
176			# my $cb = sub {
177			# $self->{cb}->($self)
178			# if defined $self->{cb};
179			#
180			# $self->exec_change_cbs (qw/inventory/);
181			# };
182			#
183			# [ map { GCE::ArchRef->new (arch => $_, source => 'inventory', cb => $cb) } @{$self->get ('inventory') \|\| []} ]
184			#}
185	elmex	1.1
186			sub replace_inv {
187			my ($self, $idx, $new) = @_;
188
189	elmex	1.9.2.1	my $arch = $self->getarch (1);
190	elmex	1.1
191	elmex	1.9.2.1	splice @{$arch->{'inventory'}}, $idx, 1, $new;
192
193			$self->commit_last_got_arch ('replace_inventory');
194	elmex	1.1	}
195
196			sub remove_inv {
197			my ($self, $idx) = @_;
198
199	elmex	1.9.2.1	my $arch = $self->getarch (1);
200
201			splice @{$arch->{'inventory'}}, $idx, 1;
202	elmex	1.1
203	elmex	1.9.2.1	$self->commit_last_got_arch ('remove_inventory');
204	elmex	1.1	}
205
206			sub reset_to_defaults {
207			my ($self) = @_;
208
209	elmex	1.9.2.1	my $arch = $self->getarch (1);
210
211	elmex	1.1	for (keys %$arch) {
212			delete $arch->{$_} if $_ ne '_name'
213			}
214
215	elmex	1.9.2.1	$self->commit_last_got_arch ('reset_to_defaults');
216	elmex	1.1	}
217
218			sub get {
219			my ($self, $key) = @_;
220			$self->getarch->{$key}
221			}
222
223			sub get_or_default {
224			my ($self, $key) = @_;
225			def ($self->get ($key), $self->archetype->{$key})
226			}
227
228	elmex	1.9.2.1	sub set {
229	elmex	1.9	my ($self, $key, $value, $type) = @_;
230	elmex	1.1
231	elmex	1.9.2.1	my $arch = $self->getarch (1);
232	elmex	1.3	my $al_arch = $self->archetype;
233	elmex	1.1
234			if (ref $value) {
235			$arch->{$key} = $value;
236
237			} else {
238			if (not defined $al_arch->{$key}) {
239	elmex	1.9	if ((not defined $value) \|\| $value eq ''
240			\|\| ($type eq 'bool' && $value eq '0')) {
241	elmex	1.1	# try to normalize
242			delete $arch->{$key};
243			} else {
244			# try to normalize
245			$arch->{$key} = $value;
246			}
247			} else {
248			if ($al_arch->{$key} ne $value) {
249			$arch->{$key} = $value;
250			} else {
251			# try to normalize
252			delete $arch->{$key};
253			}
254			}
255			}
256
257	elmex	1.9.2.1	$self->commit_last_got_arch ('attribute_edit:' . $key);
258	elmex	1.1	}
259
260			=head1 AUTHOR
261
262			Marc Lehmann <schmorp@schmorp.de>
263			http://home.schmorp.de/
264
265			Robin Redeker <elmex@ta-sa.org>
266			http://www.ta-sa.org/
267
268			=cut
269			1;