/usr/local/CPAN/Wx-Demo/Wx/DemoModules/wxCaret.pm

• package Wx::DemoModules::wxCaret
  • CharAt
  • Home
  • End
  • FirstLine
  • LastLine
  • PrevChar
  • NextChar
  • PrevLine
  • NextLine
  • new
  • OnChar
  • OnSize
  • OnPaint
  • DoMoveCaret
  • add_to_tags
  • title
• EOF

#############################################################################
## Name:        lib/Wx/DemoModules/wxCaret.pm
## Purpose:     wxPerl demo helper for Wx::Caret
## Author:      Mattia Barbon
## Modified by:
## Created:     12/01/2001
## RCS-ID:      $Id: wxCaret.pm 2189 2007-08-21 18:15:31Z mbarbon $
## 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::wxCaret;

use strict;
use base qw(Wx::ScrolledWindow Class::Accessor::Fast);

use Wx qw(:font :window :keycode wxWHITE wxNORMAL_FONT wxDefaultPosition
          wxDefaultSize wxSOLID);
use Wx::Event qw(EVT_SIZE EVT_PAINT EVT_CHAR);

__PACKAGE__->mk_accessors( qw(text font xchars ychars char_width char_height
                              xmargin ymargin xcaret ycaret) );

sub CharAt {
    my( $this, $x, $y, $char ) = @_;
    my $pos = $x + $y * $this->xchars;

    if( defined $char ) {
        return substr( $this->{text}, $pos, 1 ) = $char;
    } else {
        return substr( $this->{text}, $pos, 1 );
    }
}

# caret motion helpers
sub Home {
    $_[0]->xcaret( 0 );
}

sub End {
    $_[0]->xcaret( $_[0]->xchars - 1 );
}

sub FirstLine {
    $_[0]->ycaret( 0 );
}

sub LastLine {
    $_[0]->ycaret( $_[0]->ychars - 1 );
}

sub PrevChar {
    if( !$_[0]->{xcaret}-- ) {
        $_[0]->End;
        $_[0]->PrevLine;
    }
}

sub NextChar {
    if( ++$_[0]->{xcaret} == $_[0]->xchars ) {
        $_[0]->Home;
        $_[0]->NextLine;
    }
}

sub PrevLine {
    if( !$_[0]->{ycaret}-- ) {
        $_[0]->LastLine;
    }
}

sub NextLine {
    if( ( ++$_[0]->{ycaret} ) == $_[0]->ychars ) {
        $_[0]->FirstLine;
    }
}

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

    $this->SetBackgroundColour( wxWHITE );
    $this->font( Wx::Font->new( 14, wxMODERN, wxNORMAL, wxNORMAL ) );

    my $dc = Wx::ClientDC->new( $this );
    $dc->SetFont( $this->font );
    $this->char_width( $dc->GetCharWidth );
    $this->char_height( $dc->GetCharHeight );

    my $caret = Wx::Caret->new( $this, $this->char_width, $this->char_height );
    $this->SetCaret( $caret );

    $this->xmargin( 5 );
    $this->ymargin( 5 );
    $this->xcaret( 0 );
    $this->ycaret( 0 );
    $caret->Move( $this->xmargin, $this->ymargin );
    $caret->Show;

    EVT_SIZE( $this, \&OnSize );
    EVT_PAINT( $this, \&OnPaint );
    EVT_CHAR( $this, \&OnChar );

    return $this;
}

sub OnChar {
    my( $this, $event ) = @_;

    {
        my $t = $event->GetKeyCode;

        $t == WXK_LEFT   && do { $this->PrevChar, last };
        $t == WXK_RIGHT  && do { $this->NextChar, last };
        $t == WXK_UP     && do { $this->PrevLine, last };
        $t == WXK_DOWN   && do { $this->NextLine, last };
        $t == WXK_HOME   && do { $this->Home, last };
        $t == WXK_END    && do { $this->End, last };
        $t == WXK_RETURN && do { $this->Home, $this->NextLine, last };

        if( $event->AltDown ) {
            $event->Skip;
            last;
        }

        my $ch = chr $event->GetKeyCode;
        $this->CharAt( $this->xcaret, $this->ycaret, $ch );

        my $suspend = Wx::CaretSuspend->new( $this );
        my $dc = Wx::ClientDC->new( $this );
        $dc->SetFont( $this->font );
        $dc->SetBackgroundMode( wxSOLID );
        $dc->DrawText( $ch, $this->xmargin + $this->xcaret * $this->char_width,
                       $this->ymargin + $this->ycaret * $this->char_height );

        $this->NextChar;
    }

    $this->DoMoveCaret;
    $this->Refresh;
}

sub OnSize {
    my( $this, $event ) = @_;

    # resize and clear underlying buffer
    $this->xchars( int( ( $event->GetSize->x - 2 * $this->xmargin ) /
                        $this->char_width ) || 1 );
    $this->ychars( int( ( $event->GetSize->y - 2 * $this->ymargin ) /
                        $this->char_height ) || 1 );
    $this->text( ' ' x ( $this->xchars * $this->ychars ) );

    Wx::LogMessage( 'Panel size is ( %d, %d)', $this->xchars, $this->ychars );

    $event->Skip;
}

sub OnPaint {
    my( $this, $event ) = @_;

    my $suspend = Wx::CaretSuspend->new( $this );
    my $dc = Wx::PaintDC->new( $this );
    $this->PrepareDC( $dc );
    $dc->Clear;
    $dc->SetFont( $this->font );

    foreach my $y ( 0 .. ( $this->ychars - 1 ) ) {
        $dc->DrawText( substr( $this->{text}, $y * $this->xchars, $this->xchars ),
                       $this->xmargin,
                       $this->ymargin + $y * $this->char_height );
    }
}

sub DoMoveCaret {
    my( $this ) = @_;

    Wx::LogStatus( 'Caret is at ( %d, %d )', $this->xcaret, $this->ycaret );

    $this->GetCaret->Move( $this->xmargin + $this->xcaret * $this->char_width,
                           $this->ymargin + $this->ycaret * $this->char_height );
}

sub add_to_tags { qw(misc) }
sub title { 'wxCaret' }

1;