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 *
#	Content
1	package GCE::ArchRef;
2	use strict;
3	=head1 NAME
4
5	GCE::ArchRef - a intelligent reference to an arch instance on/in the map
6
7	=head1 SYNOPSIS
8
9	GCE::ArchRef->new (...);
10
11	=over 4
12
13	=cut
14
15	use Storable qw/dclone/;
16	use Deliantra;
17	use Carp;
18	use GCE::Util;
19
20	sub getarch {
21	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
47	} else {
48	$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	}
95
96	$::MAINWIN->broadcast_cursor_changes ($self->{map}, $self->{x}, $self->{y});
97	}
98
99	sub new {
100	my $class = shift;
101	my $self = { @_ };
102	bless $self, $class;
103
104	unless (defined ($self->{arch}) \|\| defined ($self->{map})) {
105	Carp::confess ("arch not defined when making new ArchRef")
106	}
107
108	$self->getarch;
109
110	return $self;
111	}
112
113	sub type {
114	my ($self) = @_;
115	Deliantra::arch_attr $self->getarch;
116	}
117
118	sub archetype {
119	my ($self) = @_;
120
121	$Deliantra::ARCH{$self->getarch->{_name}} \|\| $Deliantra::ARCH{empty_archetype};
122	}
123
124	sub picker_folder {
125	my ($self) = @_;
126	my $folder = $self->archetype->{editor_folder};
127	my @a = split /\//, $folder;
128	$a[0]
129	}
130
131	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	(defined ($al_arch->{$key}) && $al_arch->{$key} ne $val)
147	\|\| (not (defined $al_arch->{$key}) and $val)
148	}
149
150	sub add_inv {
151	my ($self, $arch) = @_;
152
153	my $arch = $self->getarch (1);
154
155	push @{$self->{arch}->{inventory}}, dclone (getarch $arch);
156
157	$self->commit_last_got_arch ('add_inventory');
158	}
159
160	sub swap_inv {
161	my ($self, $swapidx, $ownidx) = @_;
162
163	my $arch = $self->getarch (1);
164
165	my $inv = $arch->{inventory};
166
167	($inv->[$swapidx], $inv->[$ownidx])
168	= ($inv->[$ownidx], $inv->[$swapidx]);
169
170	$self->commit_last_got_arch ('swap_inventory');
171	}
172
173	#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
186	sub replace_inv {
187	my ($self, $idx, $new) = @_;
188
189	my $arch = $self->getarch (1);
190
191	splice @{$arch->{'inventory'}}, $idx, 1, $new;
192
193	$self->commit_last_got_arch ('replace_inventory');
194	}
195
196	sub remove_inv {
197	my ($self, $idx) = @_;
198
199	my $arch = $self->getarch (1);
200
201	splice @{$arch->{'inventory'}}, $idx, 1;
202
203	$self->commit_last_got_arch ('remove_inventory');
204	}
205
206	sub reset_to_defaults {
207	my ($self) = @_;
208
209	my $arch = $self->getarch (1);
210
211	for (keys %$arch) {
212	delete $arch->{$_} if $_ ne '_name'
213	}
214
215	$self->commit_last_got_arch ('reset_to_defaults');
216	}
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	sub set {
229	my ($self, $key, $value, $type) = @_;
230
231	my $arch = $self->getarch (1);
232	my $al_arch = $self->archetype;
233
234	if (ref $value) {
235	$arch->{$key} = $value;
236
237	} else {
238	if (not defined $al_arch->{$key}) {
239	if ((not defined $value) \|\| $value eq ''
240	\|\| ($type eq 'bool' && $value eq '0')) {
241	# 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	$self->commit_last_got_arch ('attribute_edit:' . $key);
258	}
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;