File Coverage

blib/lib/Wx/DemoModules/wxTreeCtrl.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

#############################################################################
## Name:        lib/Wx/DemoModules/wxTreeCtrl.pm
## Purpose:     wxPerl demo helper for Wx::TreeCtrl
## Author:      Mattia Barbon
## Modified by:
## Created:     17/02/2001
## RCS-ID:      $Id: wxTreeCtrl.pm 3324 2012-08-09 01:21:55Z mdootson $
## Copyright:   (c) 2001, 2004, 2006 Mattia Barbon
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

package Wx::DemoModules::wxTreeCtrl;

use strict;
use base qw(Wx::TreeCtrl);

use Wx qw(:treectrl :window wxDefaultPosition wxDefaultSize
          wxMOD_ALT wxMOD_SHIFT wxMOD_META wxMOD_CONTROL);
use Wx::Event qw(EVT_TREE_BEGIN_DRAG EVT_TREE_END_DRAG
                 EVT_TREE_SEL_CHANGED EVT_MENU
                 EVT_TREE_KEY_DOWN);

use Wx::DemoModules::lib::Utility;

sub new {
    my( $class, $parent ) = @_;
    my $self = $class->SUPER::new
      ( $parent, -1, wxDefaultPosition, wxDefaultSize,
        wxTR_HAS_BUTTONS|wxTR_EDIT_LABELS|wxSUNKEN_BORDER );

    my $imagelist = Wx::ImageList->new( 16, 16, 1 );
    $imagelist->Add( Wx::GetWxPerlIcon( 1 ) );
    $imagelist->Add
      ( resize_to( Wx::wxTheApp()->GetStdIcon( Wx::wxICON_EXCLAMATION() ),
                   16 ) );

    $self->AssignImageList( $imagelist );
    $self->PopulateTree( 2, 3 );

    EVT_TREE_BEGIN_DRAG( $self, $self, \&OnBeginDrag );
    EVT_TREE_END_DRAG( $self, $self, \&OnEndDrag );
    EVT_TREE_SEL_CHANGED( $self, $self, \&OnSelChange );
    EVT_TREE_KEY_DOWN( $self, $self, \&OnTreeKeyDown );

    # drop down menus
    my $top = Wx::GetTopLevelParent( $self );
    my $treemenu = Wx::Menu->new;
    EVT_MENU( $top, $treemenu->Append( -1, "Traverse" ),
              sub { $self->on_traverse } );
    my $itemmenu = Wx::Menu->new;
    EVT_MENU( $top, $itemmenu->Append( -1, "Rename" ),
              sub { $self->on_rename } );
    EVT_MENU( $top, $itemmenu->Append( -1, "Sort childs ascending" ),
              sub { $self->on_sort( 1 ) } );
    EVT_MENU( $top, $itemmenu->Append( -1, "Sort childs descending" ),
              sub { $self->on_sort( 0 ) } );
    $itemmenu->AppendSeparator;
    EVT_MENU( $top, $itemmenu->Append( -1, "Deselect All" ),
              sub { $self->UnselectAll } );
    $self->{menu} = [ '&Tree Control', $treemenu,
                      '&Items',        $itemmenu ];

    return $self;
}

sub on_sort {
    my( $self, $ascending ) = @_;
    my $item = $self->GetSelection;

    if( !$item->IsOk ) {
        Wx::MessageBox( "Must select an item, first!" );
        return;
    }
    $self->DoSortChildren( $item, $ascending );
}

sub on_rename {
    my( $self ) = @_;
    my $item = $self->GetSelection;

    if( !$item->IsOk ) {
        Wx::MessageBox( "Must select an item, first!" );
        return;
    }
    $self->EditLabel( $item );
}

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

    $self->DoTraverse( $self->GetRootItem, -1 );
}

sub DoTraverse {
    my( $self, $parent ) = @_;

    # non-leaf: display now
    Wx::LogMessage( "%s", $self->GetItemText( $parent ) );

    my( $id, $cookie ) = $self->GetFirstChild( $parent );
    while( $id->IsOk ) {
        # traverse childs first
        if( $self->ItemHasChildren( $id ) ) {
            $self->DoTraverse( $id, -1 );
        } else {
            # display leaf
            Wx::LogMessage( "%s", $self->GetItemText( $id ) );
        }
        ( $id, $cookie ) = $self->GetNextChild( $parent, $cookie );
    }
}

sub PopulateTree {
    my( $self, $childs, $depth ) = @_;

    my $root = $self->AddRoot( 'Root', -1, -1,
                               Wx::TreeItemData->new( 'Data' ) );
    $self->PopulateRecursively( $root, $childs, $depth );
}

sub PopulateRecursively {
    my( $self, $parent, $childs, $depth ) = @_;
    my( $text, $item );

    use Wx qw(wxITALIC_FONT wxRED wxBLUE);

    foreach my $i ( 1 .. $childs ) {
        my $text = ( $depth > 0 ) ? "Node $i/$childs" : "Leaf $i/$childs";

        $item = $self->AppendItem( $parent, $text, 0, 1,
                                   Wx::TreeItemData->new( $text ) );
        $self->SetItemFont( $item, wxITALIC_FONT ) if $depth == 0;
        $self->SetItemBackgroundColour( $item, wxBLUE ) if $depth == 1;
        $self->SetItemTextColour( $item, wxRED ) if $depth == 2;

        if( $i == 2 ) {
            my $t = Wx::TreeItemData->new; $t->SetData( "Foo $i" );
            $self->SetItemData( $item, $t );
        }
        $self->SetPlData( $item, "Bar $i" )
          if $i == 3;
        $self->GetItemData( $item )->SetData( "A" )
          if $i == 4;

        $self->PopulateRecursively( $item, $childs + 1, $depth - 1 )
          if $depth >= 1;
    }
}

sub DoSortChildren {
    my( $self, $item, $ascending ) = @_;

    $self->{reverse_sort} = !$ascending;
    $self->SortChildren( $item );
}

sub OnCompareItems {
    my( $self, $item1, $item2 ) = @_;

    if( $self->{reverse_sort} ) {
        return $self->SUPER::OnCompareItems( $item2, $item1 );
    } else {
        return $self->SUPER::OnCompareItems( $item1, $item2 );
    }
}

sub OnBeginDrag {
    my( $self, $event ) = @_;

    if( $event->GetItem != $self->GetRootItem ) {
        $self->{dragged_item} = $event->GetItem;

        Wx::LogMessage( "Dragging %s",
                        $self->GetItemText( $self->{dragged_item} ) );

        $event->Allow;
    } else {
        Wx::LogMessage( "This item can't be dragged" );
    }
}

# this is only a test: a real implementation probably will
# move ( mot copy ) a node, and probably the node childrens, too
# and drop the item at the right place ( not just append it )
sub OnEndDrag {
    my( $self, $event ) = @_;
    my( $src, $dst ) = ( $self->{dragged_item}, $event->GetItem );

    if( $dst->IsOk && !$self->ItemHasChildren( $dst ) ) {
        # copy to parent
        $dst = $self->GetParent( $dst );
    }

    if( !$dst->IsOk ) {
        Wx::LogMessage( "Can't drop here" );
        return;
    }

    my $text = $self->GetItemText( $src );
    Wx::LogMessage( "'%s' copied to '%s'", $text, $self->GetItemText( $dst ) );
    $self->AppendItem( $dst, $text, -1 );
}

sub OnSelChange {
    my( $self, $event ) = @_;
    my $item = $event->GetItem;
    my $data;

    Wx::LogMessage( 'Text: %s', $self->GetItemText( $item ) );
    if( $data = $self->GetItemData( $item ) ) {
        Wx::LogMessage( 'Data: %s', $data->GetData );
    }
    Wx::LogMessage( 'Perl data: %s', $self->GetPlData( $item ) );
}

sub OnTreeKeyDown {
    my( $self, $event ) = @_;
    my $keycode = $event->GetKeyCode;
    my $output = qq(KEYCODE: $keycode);

    # Wx >= 0.9911
    if( defined( &Wx::TreeEvent::GetKeyEvent ) ) {
    	my $modifiers = $event->GetKeyEvent->GetModifiers;
    	$output .= qq( MODIFIERS:);
    	if( $modifiers & wxMOD_ALT ) {
    		$output .= qq( Alt);
    	}
    	if( $modifiers & wxMOD_SHIFT ) {
    		$output .= qq( Shift);
    	}
    	if( $modifiers & wxMOD_CONTROL ) {
		    $output .= qq( Control);
    	}
        if( $modifiers & wxMOD_META ) {
			$output .= qq( Meta);
    	}
    }
    Wx::LogMessage( qq(Keys $output) );

}


sub menu { @{$_[0]->{menu}} }
sub add_to_tags { qw(controls) }
sub title { 'wxTreeCtrl' }

1;