view release on metacpan or  search on metacpan

lib/Text/Editor/Easy/Graphic/Tk_glue.pm  view on Meta::CPAN

      $mw->Scrollbar( -command => $call_back_ref, )
      ->pack( -side => $position, -fill => 'y' );
    return $scrollbar;    # inutile mais plus prudent en cas d'ajout...
}

sub create_canva {
    my ( $mw, $color, $zone_ref ) = @_;
    my %zone_local;
    if ( !defined $zone_ref ) {
        %zone_local = (
            'size' => {
                -x         => 0,
                -y         => 0,
                -relwidth  => 1,
                -relheight => 1,
            },
            'name'     => 'none'
        );
        Text::Editor::Easy->reference_zone( \%zone_local );
        $zone_ref = \%zone_local;
    }
    else {
        %zone_local = %$zone_ref;
    }

    #print "DAns create canva : ", $zone_ref->{'name'}, "\n";
    my $size_ref = $zone_local{'size'};
    
    my $canva = $mw->EditorCanva(
        -background => $color,
        #)->pack( -expand => 1, -fill => 'both' );
    )->place( -in => $mw, %{ $size_ref } );
    
    #print "\n\nDump des évènement gérés :\n";
    #Tk::Widget::bindDump( $mw );
    #print "Fin du dump :\n\n";
    
    $canva->CanvasLower;
    return ( $canva, $zone_ref );
}

sub create_font {
    my ( $graphic, $hash_ref ) = @_;
    my @underline;
    if ( $hash_ref->{underline} ) {
        @underline = ( "-underline", 1 );
    }
    my @slant = ( "-slant", "roman" );
    if ( $hash_ref->{slant} ) {
        @slant = ( "-slant", $hash_ref->{slant} );
    }
    return $graphic->[TOP_LEVEL]->fontCreate(
        -family => $hash_ref->{family},
        -size   => $hash_ref->{size},
        -weight => $hash_ref->{weight},
        @underline,
        @slant,
    );
}

sub clipboard_get {
    my ( $self ) = @_;
        
    my $string = $self->[TOP_LEVEL]->SelectionGet( 
        -selection => "CLIPBOARD" ,
        -type => "STRING"
    );
    
    # Null character not managed by Tk (?)
    # My former regular exp didn't work ===> s/x00.*$//
    my @lines = split( /\n/, $string, -1 );
    my $buffer = q{};
    my $line = shift( @lines );
    for my $indice ( 0..length($line)-1 ) {
        my $char = substr( $line, $indice, 1 );
        if ( ord($char) == 0 ) {
            return $buffer;
        }
        $buffer .= $char;
    }

    CONCAT: for my $line ( @lines ) {
        $buffer .= "\n";
        for my $indice ( 0..length($line)-1 ) {
            my $char = substr( $line, $indice, 1 );
            if ( ord($char) == 0 ) {
                return $buffer;
            }
            $buffer .= $char;
        }
    }
    return $buffer;
}

sub clipboard_set {
    my ( $self, $string ) = @_;
        
    #print "Dans clipboard_set de Tk_glue |$self|$string|\n";
    # usefull ?
    $self->[TOP_LEVEL]->clipboardClear;

    $self->[TOP_LEVEL]->clipboardAppend('--', $string);
    return 1;
}

sub manage_event {

    #my ( $self ) = @_;
    #print "On rentre dans la mainloop\n";
    MainLoop;
}

# After initialisation

sub length_text {
    my ( $self, $text, $font ) = @_;
    
    if ( $text =~ /^(-+)/ ) {
        # Le texte "-d" est malheureusement vu comme une option "display_of" de la méthode fontMeasure dans Tk
        # L'appel Tk font->measure ne marchant pas mieux (pas du tout !), il faut décomposer toutes les chaînes qui commencent par un "-"
        my $length = 0;
        $length += $self->[CANVA]->fontMeasure( $font, "$1" );
        $text = substr ( $text, length($1) );
        $length += $self->[CANVA]->fontMeasure( $font, $text );
        return $length;
    }
        
    return $self->[CANVA]->fontMeasure( $font, $text );
}

sub set_scrollbar {
    my ( $self, $top, $bottom ) = @_;

    #$self->[SCROLLBAR]->set ( $top, $bottom);
    return ( $top, $bottom );
}

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

    #return $self->[SCROLLBAR]->get;
}

my $line_offset = 3;

sub create_text_and_mark_it {
    my ( $self, $hash_ref ) = @_;

    my $id = $self->[CANVA]->createText(
        $hash_ref->{abs},
        $hash_ref->{ord},

        #-tag    => ['text', 'just_created'] ,
        -tag    => $hash_ref->{tag},
        -text   => $hash_ref->{text},
        -anchor => $hash_ref->{anchor},
        -font   => $hash_ref->{font},
        -fill   => $hash_ref->{color},
    );
    my ( $x1, $y1, $x2, $y2 ) = $self->[CANVA]->bbox($id);

#    $self->[CANVA]->bind('text', <KeyPress>, sub {}) ;