WxPerl::TreeCtrlMapped - a more reasonably perlish wxTreeCtrl
Index
Code Index:
NAME
WxPerl::TreeCtrlMapped - a more reasonably perlish wxTreeCtrl
ABOUT
I want a better TreeCtrl
Troubles with wxTreeCtrl:
o data is ad-hoc nested in TreeCtrl using TreeItemData
o no random-access to tree without mapping id => TreeItemId
o no reverse-lookup for id without putting it in TreeItemData
So, we want get_id($item), get_item($id)
And, a way to store a single object as the data (that's not incompatible
with the id mapping.) If I'm going to store the id and an object, I
would have to say Wx::TreeItemData->new({id => $id, object => $object),
which is just too much given the $tree->GetPlData()->{object} calls that
would always be following it around.
get_data($id|$item)
set_data($id|$item, $data)
TODO
Probably some more convenient get_children() and such methods.
Maybe overriding the Wx::TreeItemId to allow it to have a data() method,
but this could get somewhat tangled WRT events.
Overrides
In each of these methods, the TreeItemData parameter in the base class
is replaced with a scalar $id, or an array [$id, $object].
$object can be whatever you want it to be. It will be returned when you
call get_data().
AddRoot
$tree->AddRoot($text, $image, $selimage, $id_or_array);
AppendItem
$tree->AppendItem($parent, $text, $image, $selimage, $id_or_array);
InsertItem
$tree->InsertItem($parent, $prev, $text, $img, $selimg, $id_or_array);
PrependItem
$tree->PrependItem($parent, $text, $image, $selImage, $id_or_array);
Cleanup
These are overridden to cleanup the mappings.
Delete
DeleteAllItems
DeleteChildren
$tree->DeleteChildren($item);
Internals
_new_data
my $data = $self->_new_data($id);
Or:
my $data = $self->_new_data([$id, $object]);
_map_new
my $item = $self->_map_new($item);
_map_item
$self->_map_item($id, $item);
_clear
Lookups
get_item
Get the item for a given $id.
my $item = $self->get_item($id);
get_id
my $id = $self->get_id($item);
Data
get_data
$self->get_data($id|$item);
set_data
$self->set_data($id|$item, $data);
AUTHOR
Eric Wilhelm <ewilhelm at cpan dot org>
http://scratchcomputing.com/
COPYRIGHT
Copyright (C) 2006 Eric L. Wilhelm and OSoft, All Rights Reserved.
NO WARRANTY
Absolutely, positively NO WARRANTY, neither express or implied, is
offered with this software. You use this software at your own risk. In
case of loss, no person or entity owes you anything whatsoever. You
have been warned.
LICENSE
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
package WxPerl::TreeCtrlMapped;
$VERSION = eval{require version}?version::qv($_):$_ for(0.10.1);
use warnings;
use strict;
use Carp;
use Wx;
use base 'Wx::TreeCtrl';
sub AddRoot {
my $self = shift;
my (@args) = @_;
$args[3] = $self->_new_data($args[3]);
return($self->_map_new($self->SUPER::AddRoot(@args)));
} # end subroutine AddRoot definition
########################################################################
sub AppendItem {
my $self = shift;
my (@args) = @_;
$args[4] = $self->_new_data($args[4]);
return($self->_map_new($self->SUPER::AppendItem(@args)));
} # end subroutine AppendItem definition
########################################################################
sub InsertItem {
my $self = shift;
my (@args) = @_;
$args[4] = $self->_new_data($args[4]);
return($self->_map_new($self->SUPER::InsertItem(@args)));
} # end subroutine InsertItem definition
########################################################################
sub PrependItem {
my $self = shift;
my (@args) = @_;
$args[4] = $self->_new_data($args[4]);
return($self->_map_new($self->SUPER::PrependItem(@args)));
} # end subroutine PrependItem definition
########################################################################
sub Delete {
my $self = shift;
my ($item) = @_;
my $map = $self->{_item_map};
%$map or die "that's going to hurt";
my $mapped_id = $self->get_id($item);
$self->SUPER::Delete($item);
# cleanup after (in case there are events)
delete($map->{$mapped_id});
} # end subroutine Delete definition
########################################################################
sub DeleteAllItems {
my $self = shift;
$self->SUPER::DeleteAllItems;
$self->_clear; # clear after super in case there are events
} # end subroutine DeleteAllItems definition
########################################################################
sub DeleteChildren {
my $self = shift;
my ($item) = @_;
die "not working yet";
} # end subroutine DeleteChildren definition
########################################################################
sub _new_data {
my $self = shift;
my ($thing) = @_;
my ($id, $object) = ($thing);
if(my $ref = ref($thing)) {
($ref eq 'ARRAY') or
croak('must be scalar or [$id, $object] array ref');
($id, $object) = @$thing;
}
return(Wx::TreeItemData->new({id => $id, object => $object}));
} # end subroutine _new_data definition
########################################################################
sub _map_new {
my $self = shift;
my ($item) = @_;
my $id = $self->get_id($item);
$self->_map_item($id, $item);
return($item);
} # end subroutine _map_new definition
########################################################################
sub _map_item {
my $self = shift;
my ($id, $item) = @_;
$self->{_item_map} ||= {};
my $map = $self->{_item_map};
exists($map->{$id}) and croak("attempt to remap id: $id");
$map->{$id} = $item;
} # end subroutine _map_item definition
########################################################################
sub _clear {
my $self = shift;
$self->{_item_map} = {};
} # end subroutine _clear definition
########################################################################
sub get_item {
my $self = shift;
my ($id) = @_;
my $map = $self->{_item_map};
$map or return();
return($map->{$id});
} # end subroutine get_item definition
########################################################################
sub get_id {
my $self = shift;
my ($item) = @_;
my $data = $self->GetPlData($item);
$data or croak("no data for $item");
return($data->{id});
} # end subroutine get_id definition
########################################################################
sub get_data {
my $self = shift;
my ($item) = @_;
unless(ref($item)) { # it is an id
$item = $self->get_item($item);
}
my $data = $self->GetPlData($item);
$data or croak("no data for $item");
return($data->{object});
} # end subroutine get_data definition
########################################################################
sub set_data {
my $self = shift;
my ($item, $object) = @_;
my $id;
unless(ref($item)) { # it is an id
$id = $item;
$item = $self->get_item($item);
}
else {
$id = $self->get_id($item);
}
$self->SetItemData(
$item,
Wx::TreeItemData->new({id => $id, object => $object})
);
} # end subroutine set_data definition
########################################################################
# vi:ts=2:sw=2:et:sta
1;