package Text::Editor::Easy::Abstract; use warnings; use strict; =head1 NAME Text::Editor::Easy::Abstract - The module that manages everything that is displayed. =head1 VERSION Version 0.1 =cut our $VERSION = '0.1'; =head1 SYNOPSIS There are 2 (or 3 if we include the "Text::Editor::Easy::File_manager" module) complex modules in the "Text::Editor::Easy" tree. This module and the "Text::Editor::Easy::Comm" which handles communication between threads. If you create a "Text::Editor::Easy" object, this module will be called very often. Lots of methods are redirected here (but you don't even have to know that this module exists, thanks to "Text::Editor::Easy::Comm"). At the beginning (in 2006), there was only this "module-program". Little by little, this module has grown and has soon become an ugly mess (well, it still is !). When I decided to access the "text data" to be displayed in an another module, it became much simpler. At this very moment, I began to use more than one thread, and the number of different modules grew rapidly. This was the very good thing threads has brougth me : simplification by partition. This module has only limited knowledge of what is in the file. It knows only what it has to display according to the police size and to the screen size. When there is space to fill up, it asks "File_manager" for data. "File_manager" can provide data before or after a referenced line. When the user modify something, this module informs "File_manager". As soon a line is no more on the screen, this module forgets it (destroy it for speed reason) : it relies entirely on "File_manager" to memorize what should be. This trick has a big advantage. In fact, with my module, you can Edit text file of unlimited size with the same speed as little file. Not much Editors can do that. For huge file, my perl Editor is still usable whereas most C Editors are not. Of course, you could develop a C Editor with the same principle, ... good luck. With perl, it's just funny. In C, it's pure work. =cut # Affichage use Text::Editor::Easy::Graphic::Tk_glue; # Syntaxe use Text::Editor::Easy::Syntax::perl_assist; # Communication use Text::Editor::Easy::Comm qw(anything_for_me get_task_to_do execute_this_task reference_event_conditions); use Scalar::Util qw(refaddr); use Devel::Size qw(size total_size); my $origin = 'graphic'; # Gestion de la provenance des actions my $sub_origin; # Idem # Chaque element ligne de la liste chaînée fera référence à un tableau contenant les elements suivants use constant { #------------------------------------ # LINE_REF : Lignes de texte #------------------------------------ TEXT => 0, # Texte de la ligne NEXT => 1 , # Element texte qui suit cet element (juste à droite ou premier de la ligne suivante) PREVIOUS => 2 , # Element texte qui precède cet element (juste à gauche ou dernier element de la ligne precedente) FIRST => 3, # Premier element texte de la ligne, première ligne du segment #LINE_NUMBER => 4, # A supprimer SIZE => 5, # Absisse maximum de la ligne PREVIOUS_SAME => 6, # booléen : la ligne précédente est "la même" : mode "wrap" HEIGHT => 7, NEXT_SAME =>, 10, # booléen : la ligne suivante est "la même" : mode "wrap" DISPLAYED => 8, # booléen : la ligne est affichée à l'écran REF => 9 , # Référence à stoker pour communiquer avec le thread gestionnaire du fichier et des mises à jour ORD => 11, LAST => 13, # Référence au dernier élément texte du segment : jamais utilisé ! # alors que seulement la 1ère et la dernière sont utiles pour le positionnement de la scollbar #------------------------------------ # CURSOR_REF #------------------------------------ VIRTUAL_ABS => 0, POSITION_IN_TEXT => 1, POSITION_IN_DISPLAY => 2, TEXT_REF => 3, #ABS => 4, POSITION_IN_LINE => 5, #------------------------------------ # TEXT_REF #------------------------------------ # Element texte (element FIRST de chaque element de ligne, $text_ref ...) #TEXT => 0, #NEXT => 1, # Element texte suivant (juste à droite ou premier de la ligne suivante) #PREVIOUS => 2, # Element texte précédant (juste à gauche ou dernier element de la ligne precedente) ID => 3, # Identifiant affecté par Tk à l'element texte du canevas correspondant ABS => 4, FONT => 5, WIDTH => 6 , # Indique la largeur de l'element (compte-tenu de la fonte), équivalent à : LINE_REF => 7, # Reference à l'element ligne (c'est-à-dire à une reference de tableau) COLOR => 8, # Couleur d'affichage #------------------------------------ # SCREEN_REF #------------------------------------ MARGIN => 0, VERTICAL_OFFSET => 1, #HORIZONTAL_OFFSET => 2, # Supprimé WRAP => 4, LINE_HEIGHT => 8, FONT_HEIGHT => 9, #HEIGHT => 7, #------------------------------------ # EDIT_REF #------------------------------------ INSER => 0, SCREEN => 1, SEGMENT => 2, SUB_REF => 3, GRAPHIC => 4, REGEXP => 5, CALC_LINE => 6, CURSOR => 7, FILE => 8, RETURN => 10, # Test de redirection UNIQUE => 11, # Text::Editor::Easy unique identifier INIT_TAB => 12, PARENT => 13, REDIRECT => 14, ASSIST => 15, }; use Text::Editor::Easy::Key; my %key = ( 'Insert' => \&Text::Editor::Easy::Key::inser, 'Prior' => \&Text::Editor::Easy::Key::page_up, 'Next' => \&Text::Editor::Easy::Key::page_down, 'Down' => \&Text::Editor::Easy::Key::down, 'Up' => \&Text::Editor::Easy::Key::up, 'Home' => \&Text::Editor::Easy::Key::home, 'End' => \&Text::Editor::Easy::Key::end, 'Left' => \&Text::Editor::Easy::Key::left, 'Right' => \&Text::Editor::Easy::Key::right, # Fonctions déroutées vers Text::Editor::Easy pour récupérer l'objet Abstract en entrée des procédures # (utilisation du mécanisme d'AUTOLOAD du package Text::Editor::Easy) 'Return' => [ \&Text::Editor::Easy::enter, { 'indent' => 'auto' } ], 'KP_Enter' => [ \&Text::Editor::Easy::enter, { 'indent' => 'auto' } ], 'Delete' => [ \&Text::Editor::Easy::erase, 1 ], 'BackSpace' => \&Text::Editor::Easy::Key::backspace, 'ctrl_End' => \&Text::Editor::Easy::Key::end_file, 'ctrl_Home' => \&Text::Editor::Easy::Key::top_file, 'ctrl_Right' => \&Text::Editor::Easy::Key::jump_right, 'ctrl_Left' => \&Text::Editor::Easy::Key::jump_left, 'ctrl_q' => \&Text::Editor::Easy::Key::query_segments, 'ctrl_Q' => \&Text::Editor::Easy::Key::query_segments, 'ctrl_s' => \&Text::Editor::Easy::Key::save, 'ctrl_S' => \&Text::Editor::Easy::Key::save, 'F3' => \&Text::Editor::Easy::next_search, 'ctrl_c' => \&Text::Editor::Easy::Key::copy_line, 'ctrl_C' => \&Text::Editor::Easy::Key::copy_line, 'ctrl_r' => \&revert, 'ctrl_R' => \&revert, 'ctrl_v' => \&Text::Editor::Easy::Key::paste, 'ctrl_V' => \&Text::Editor::Easy::Key::paste, 'ctrl_w' => \&Text::Editor::Easy::Key::wrap, 'ctrl_W' => \&Text::Editor::Easy::Key::wrap, 'ctrl_x' => \&Text::Editor::Easy::Key::cut_line, 'ctrl_X' => \&Text::Editor::Easy::Key::cut_line, 'ctrl_Up' => \&Text::Editor::Easy::Key::jump_up, 'ctrl_Down' => \&Text::Editor::Easy::Key::jump_down, 'alt_Up' => \&Text::Editor::Easy::Key::move_up, 'alt_Down' => \&Text::Editor::Easy::Key::move_down, 'ctrl_p' => \&increase_line_space, 'ctrl_P' => \&increase_line_space, 'ctrl_m' => \&decrease_line_space, 'ctrl_M' => \&decrease_line_space, 'ctrl_plus' => \&increase_font, 'ctrl_shift_n' => \&Text::Editor::Easy::Key::print_screen_number, 'ctrl_shift_N' => \&Text::Editor::Easy::Key::print_screen_number, 'ctrl_shift_l' => \&Text::Editor::Easy::Key::display_cursor_display, 'ctrl_shift_L' => \&Text::Editor::Easy::Key::display_cursor_display, 'ctrl_shift_p' => \&Text::Editor::Easy::Key::list_display_positions, 'ctrl_shift_P' => \&Text::Editor::Easy::Key::list_display_positions, 'alt_ampersand' => \&Text::Editor::Easy::Key::sel_first, 'alt_eacute' => \&Text::Editor::Easy::Key::sel_second, ); my %font; my %color; my %abstract ; # A une référence d'éditeur unique, on fait correspondre un objet Abstract # Redirection my %redirect = do "Text/Editor/Easy/Data/Events.pm"; my %event_zone; my %use; sub new { my ( $classe, $hash_ref, $editor, $unique_ref ) = @_; #print "Dans Abstract::new : ", $hash_ref->{'zone'}->{'name'}, "\n"; # Début construction my $edit_ref = bless [], $classe; $edit_ref->[UNIQUE] = $unique_ref; $abstract{$unique_ref} = $edit_ref; #$edit_ref->[QUEUE] = $hash_ref->{graphic_queue}; $edit_ref->[INSER] = 1; if ( $hash_ref->{return} ) { $edit_ref->[RETURN] = $hash_ref->{return}; } # Affectation des fonctions de redirection for my $redirect ( keys %redirect ) { my $redirect_ref = $hash_ref->{$redirect}; if ( defined $redirect_ref ) { if ( $redirect_ref->{'mode'} eq 'async' ) { #print "Redirection de $redirect asynchrone...\n"; $edit_ref->[REDIRECT]{$redirect} = $redirect; } else { my $use = $redirect_ref->{'use'}; if ( defined $use and !$use{$use} ) { eval "use $use"; #print "EVAL use $use en erreur\n$@\n" if ($@); $use{$use} = 1; } my $package = $redirect_ref->{'package'}; $package = 'main' if ( !defined $package ); if ( my $sub = $redirect_ref->{'sub'} ) { my $string = "\\&" . $package . "::$sub"; #print "STRING $string|$package\n"; $edit_ref->[REDIRECT]{$redirect} = eval "\\&${package}::$sub"; #$edit_ref->[REDIRECT]{$redirect} = eval $string; } if ( my $init_ref = $redirect_ref->{'init'} ) { my @init = @$init_ref; my $string = "\\&" . $package . "::" . shift(@init); #print "STRING $string|$package\n"; #$edit_ref->[REDIRECT]{$redirect} = eval "\\&$package::$sub"; my $sub_ref = eval $string; $sub_ref->( $editor, @init ); } } } } reference_event_conditions( $unique_ref, $hash_ref ); #$edit_ref->[FILE] = $ARGV[0] || "../test.hst"; $edit_ref->[FILE] = $hash_ref->{file} || '*buffer*'; $edit_ref->[SCREEN][VERTICAL_OFFSET] = 0; $edit_ref->[SCREEN][WRAP] = 0; #$edit_ref->[CALC_LINE] = 0; $edit_ref->[PARENT] = $editor; #print "Edit_ref $edit_ref est lié à $editor (", ref ($editor), ")\n"; $edit_ref->[ASSIST] = 0; if ( my $tab_ref = $hash_ref->{'highlight'} ) { if ( my $use = $tab_ref->{'use'} ) { eval "use $use"; #print "EVAL use $use en erreur\n$@\n" if ($@); if ( $use eq 'Text::Editor::Easy::Syntax::Perl_glue' ) { $edit_ref->[ASSIST] = 1; } } my $package; $package = $tab_ref->{'package'}; $package = 'main' if ( !defined $package ); my $sub = $tab_ref->{'sub'}; $edit_ref->[SUB_REF] = eval "\\&${package}::$sub"; } my ( $width, $height, $x_offset, $y_offset ) = ( 1272, 740, 0, 0 ); # for my screen if ( defined $hash_ref->{'width'} ) { $width = $hash_ref->{'width'}; } if ( defined $hash_ref->{'height'} ) { $height = $hash_ref->{'height'}; } if ( defined $hash_ref->{'x_offset'} ) { $x_offset = $hash_ref->{'x_offset'}; } if ( defined $hash_ref->{'y_offset'} ) { $y_offset = $hash_ref->{'y_offset'}; } $edit_ref->[GRAPHIC] = Text::Editor::Easy::Graphic->new( { 'title' => $edit_ref->[FILE], 'width' => $width, 'height' => $height, 'x_offset' => $x_offset, 'y_offset' => $y_offset, 'vertical_scrollbar_sub' => \&scrollbar_move, 'vertical_scrollbar_position' => 'right', 'background' => 'light grey', 'clic' => \&clic_text, 'mouse_move' => \&move_text, 'resize' => \&resize, 'key_press' => \&key_press, 'mouse_wheel_event' => \&mouse_wheel_event, #'key_release' => \&key_release, %{$hash_ref}, 'editor_ref' => $edit_ref, } ); $edit_ref->[SCREEN][FONT_HEIGHT] = 15; $edit_ref->[SCREEN][LINE_HEIGHT] = $edit_ref->[GRAPHIC]->line_height; $edit_ref->[SCREEN][MARGIN] = $edit_ref->[GRAPHIC]->margin; # Gestion des fontes à étudier ... my $default_font = $edit_ref->[GRAPHIC]->create_font( { 'family' => 'courier', 'size' => $edit_ref->[SCREEN][FONT_HEIGHT], 'weight' => 'normal', } ); my $bold_font = $edit_ref->[GRAPHIC]->create_font( { 'family' => 'courier', #'size' => $edit_ref->[SCREEN][FONT_HEIGHT] +15, 'size' => $edit_ref->[SCREEN][FONT_HEIGHT], 'weight' => 'bold', } ); my $underline_font = $edit_ref->[GRAPHIC]->create_font( { 'family' => 'courier', 'size' => $edit_ref->[SCREEN][FONT_HEIGHT], 'weight' => 'normal', # 'underline' => 1, 'slant' => 'italic', } ); my $font_comment = $edit_ref->[GRAPHIC]->create_font( { 'family' => 'lucidabright', 'size' => $edit_ref->[SCREEN][FONT_HEIGHT], 'weight' => 'normal', #'slant' => 'italic', } ); %font = ( 'default' => $default_font, 'comment' => $font_comment, 'error' => $default_font, 'blue' => $default_font, 'dark red' => $default_font, 'dark green' => $default_font, 'green' => $default_font, 'dark blue' => $default_font, 'dark purple' => $default_font, 'yellow' => $default_font, 'black' => $default_font, 'red' => $default_font, 'pink' => $default_font, 'Comment_Normal' => $font_comment, 'Comment_POD' => $font_comment, 'Directive' => $bold_font, 'Label' => $default_font, 'Quote' => $default_font, 'String' => $default_font, 'Subroutine' => $bold_font, 'Variable_Scalar' => $default_font, 'Variable_Array' => $bold_font, 'Variable_Hash' => $bold_font, 'Variable_Typeglob' => $bold_font, 'Whitespace' => $default_font, 'Character' => $default_font, 'Keyword' => $bold_font, 'Builtin_Function' => $bold_font, 'Builtin_Operator' => $bold_font, 'Operator' => $default_font, 'Bareword' => $default_font, 'Package' => $bold_font, 'Number' => $default_font, 'Symbol' => $bold_font, 'CodeTerm' => $bold_font, 'DATA' => $default_font, 'DEFAULT' => $default_font, ); %color = ( 'default' => '#000000000000', 'comment' => 'blue', 'error' => 'red', 'blue' => 'blue', 'dark red' => 'dark red', 'dark green' => 'dark green', 'green' => 'green', 'dark blue' => 'dark blue', 'dark purple' => 'purple', 'yellow' => 'orange', 'black' => 'black', 'red' => 'red', 'pink' => 'black', 'Comment_Normal' => 'dark green', 'Comment_POD' => 'orange', 'Directive' => 'dark blue', 'Label' => 'dark red', 'Quote' => 'firebrick', 'String' => 'deep pink', 'Subroutine' => 'dark green', 'Variable_Scalar' => 'dark blue', 'Variable_Array' => 'navy blue', 'Variable_Hash' => 'dark green', 'Variable_Typeglob' => 'purple', 'Whitespace' => 'blue', 'Character' => 'dark cyan', 'Keyword' => 'black', 'Builtin_Function' => 'black', 'Builtin_Operator' => 'black', 'Operator' => 'firebrick', 'Bareword' => 'dark red', 'Package' => 'gold4', 'Number' => 'black', 'Symbol' => 'black', 'CodeTerm' => 'brown', 'DATA' => 'RoyalBlue4', 'DEFAULT' => 'violet red', ); $edit_ref->[INIT_TAB] = $hash_ref->{config}; return $edit_ref; } # Fin sub init_ref my %ref_sub; sub examine_external_request { #while ( anything_for_me ) { # Ne marche pas bien sous Linux (?) if ( anything_for_me() ) { my ( $what, $call_id, @param ) = get_task_to_do(); $origin = $call_id; $sub_origin = $what; execute_this_task( $what, $call_id, @param ); } $origin = "graphic"; $sub_origin = undef; } sub test { my ( $self, @param ) = @_; # Génération d'un dead lock print "Début test : ", cursor_position_in_display($self), "\n"; if (wantarray) { print "Dans test : Contexte de liste\n"; $self->[PARENT]->append("Dans test : Contexte de liste"); return ( $param[4]->{cursor_pos_in_line}, $param[3] ); } elsif ( defined(wantarray) ) { print "Dans test : Contexte scalaire\n"; if ( $param[1] eq 'test undef' ) { return; } else { return $param[2]; } } else { print "Dans TEST : Contexte vide\n"; } } # On donne la main au gestionnaire d'évènement : le thread principal n'exécutera plus que examine_external_request périodiquement sub manage_event { my $compteur = 0; for ( keys %abstract ) { $compteur += 1; $abstract{$_}->[GRAPHIC]->manage_event(); last; } if ( !$compteur ) { print STDERR "Can't call manage_event loop when no Text::Editor::Easy is created\n"; } } #------------------------------------------------- # "From file to memory" functions #------------------------------------------------- sub read_next_line { my ( $edit_ref, $prev_line_ref ) = @_; my $ref; if ($prev_line_ref) { $ref = $prev_line_ref->[REF]; } my ( $last, $text ) = $edit_ref->[PARENT]->next_line($ref); if ( !$last ) { return; } my $line_ref; $line_ref->[REF] = $last; chomp $text; # Suppression des \r éventuels : lecture d'un fichier Windows sous UNIX # voir aussi l'instruction "read PRG" qui utilise le binmode dans write_file() lors de la sauvegarde du fichier édité $text =~ s/\r//g; # Suppression des tabulations ... $text =~ s/\t/ /g; $line_ref->[TEXT] = $text; if ($prev_line_ref) { $line_ref->[PREVIOUS] = $prev_line_ref; $prev_line_ref->[NEXT] = $line_ref; } create_text_in_line( $edit_ref, $line_ref ); return $line_ref; } sub create_line_ref_from_ref { # Création d'une ligne isolée pour affichage my ( $edit_ref, $ref, $text ) = @_; if ( !defined($text) ) { $text = $edit_ref->[PARENT]->get_text_from_ref($ref); } return if ( !defined $text ); my $line_ref; $line_ref->[REF] = $ref; chomp $text; # Suppression des \r éventuels : lecture d'un fichier Windows sous UNIX # voir aussi l'instruction "read PRG" qui utilise le binmode dans write_file() lors de la sauvegarde du fichier édité $text =~ s/\r//g; # Suppression des tabulations ... $text =~ s/\t/ /g; $line_ref->[TEXT] = $text; create_text_in_line( $edit_ref, $line_ref ); return $line_ref; } sub read_previous_line { my ( $edit_ref, $next_line_ref ) = @_; my $ref; if ($next_line_ref) { $ref = $next_line_ref->[REF]; } my ( $first, $text ) = $edit_ref->[PARENT]->previous_line($ref); if ( !$first ) { # On est au début du fichier return; } my $line_ref; $line_ref->[REF] = $first; chomp $text; # Suppression des \r éventuels : lecture d'un fichier Windows sous UNIX # voir aussi l'instruction "read PRG" qui utilise le binmode dans write_file() lors de la sauvegarde du fichier édité $text =~ s/\r//g; # Suppression des tabulations ... $text =~ s/\t/ /g; $line_ref->[TEXT] = $text; if ($next_line_ref) { $line_ref->[NEXT] = $next_line_ref; $next_line_ref->[PREVIOUS] = $line_ref; } create_text_in_line( $edit_ref, $line_ref ); return $line_ref; } #---------------------------------------------------------- # "In memory" functions #---------------------------------------------------------- sub create_text_in_line { my ( $edit_ref, $line_ref ) = @_; # Suppression de tous les éventuels éléments texte contenus dans la ligne # Affichage de la mémoire avant / après : gain ? my @text_element; if ( $edit_ref->[SUB_REF] ) { # Une procédure de gestion de la coloration syntaxique a été donnée : on l'appelle @text_element = $edit_ref->[SUB_REF]->( $line_ref->[TEXT] ); } else { # Pas de procédure de coloration syntaxique récupérée : # il n'y aura qu'un seul élément texte sur la ligne avec la police "default" $text_element[0] = [ $line_ref->[TEXT], 'default' ]; } my $previous_element_ref; my $abs = $edit_ref->[SCREEN][MARGIN]; my $total_letters = 0; ELT: for my $element_ref (@text_element) { my $text_ref ; # Cette variable est locale, mais elle subsitera après le 'for' (références créées) $text_ref->[TEXT] = $element_ref->[0]; if ( ( length( $text_ref->[TEXT] ) == 0 ) and ( length( $line_ref->[TEXT] ) != 0 ) ) { next ELT; } $total_letters += length( $text_ref->[TEXT] ); my $format = $element_ref->[1]; if ( !$font{$format} ) { print "Pas de font pour le format : $format\n"; exit 1; } $text_ref->[FONT] = $font{$format}; $text_ref->[COLOR] = $color{$format}; if ( !$color{$format} ) { print "Pas de couleur pour le format : $format\n"; exit 1; } #print "graphic = $edit_ref->[GRAPHIC],$text_ref->[TEXT]:$text_ref->[FONT]:\n"; $text_ref->[WIDTH] = $edit_ref->[GRAPHIC] ->length_text( $text_ref->[TEXT], $text_ref->[FONT] ); $text_ref->[ABS] = $abs; $abs += $text_ref->[WIDTH]; $text_ref->[LINE_REF] = $line_ref; #$line_ref->[SIZE] += $text_ref->[WIDTH]; if ($previous_element_ref) { $previous_element_ref->[NEXT] = $text_ref; $text_ref->[PREVIOUS] = $previous_element_ref; } else { $line_ref->[FIRST] = $text_ref; } $previous_element_ref = $text_ref; } $line_ref->[SIZE] = $abs; if ( $total_letters != length( $line_ref->[TEXT] ) ) { print "Eléments renvoyés incohérents pour la ligne |$total_letters|$line_ref->[TEXT]|", length( $line_ref->[TEXT] ), "|\n"; print "\n\n===> pas de coloration syntaxique pour cette ligne\n"; print "$line_ref->[TEXT]\n"; # Suppression des éléments précédemment créés my $text_ref = $line_ref->[FIRST]; print "$text_ref->[TEXT]"; while ( $text_ref->[NEXT] ) { if ( $text_ref->[PREVIOUS] ) { undef $text_ref->[PREVIOUS][NEXT]; undef $text_ref->[PREVIOUS]; } print "$text_ref->[NEXT][TEXT]"; #undef $text_ref->[LINE_REF]; $text_ref = $text_ref->[NEXT]; } $line_ref->[FIRST][TEXT] = $line_ref->[TEXT]; $text_ref->[FONT] = $font{"default"}; $text_ref->[COLOR] = $color{"default"}; $text_ref->[WIDTH] = $edit_ref->[GRAPHIC] ->length_text( $text_ref->[TEXT], $text_ref->[FONT] ); $text_ref->[ABS] = $edit_ref->[SCREEN][MARGIN]; $text_ref->[LINE_REF] = $line_ref; $line_ref->[SIZE] = $text_ref->[WIDTH] + $edit_ref->[SCREEN][MARGIN]; } return $line_ref; # Valeur de retour sans intérêt ? } sub delete_text_in_line { my ( $edit_ref, $line_ref ) = @_; # On ne sait pas travailler avec des morceaux de lignes (mode wrap) # --> concaténation, il faudra réafficher... while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; } while ( $line_ref->[NEXT_SAME] ) { concat( $edit_ref, $line_ref, 'bottom' ); } my $text_ref = $line_ref->[FIRST]; my $next_text_ref; while ( $text_ref->[NEXT] ) { $next_text_ref = $text_ref->[NEXT]; undef $text_ref->[NEXT]; undef $next_text_ref->[PREVIOUS]; $text_ref = $next_text_ref; } undef $next_text_ref->[PREVIOUS]; undef $line_ref->[FIRST]; return $line_ref; } #---------------------------------------------------------- # From memory to display functions #---------------------------------------------------------- sub display_text_from_memory { my ( $edit_ref, $text_ref, $ord, $tag_ref ) = @_; my @tag; if ( defined $tag_ref ) { @tag = ( 'tag', $tag_ref ); } else { @tag = ( 'tag', [ 'text', 'just_created' ] ); } my ( $width, $height ); ( $text_ref->[ID], $width, $height ) = $edit_ref->[GRAPHIC]->create_text_and_mark_it( { 'abs' => $text_ref->[ABS] - $edit_ref->[SCREEN][VERTICAL_OFFSET], 'ord' => $ord, 'text' => $text_ref->[TEXT], 'anchor' => 'sw', 'font' => $text_ref->[FONT], 'color' => $text_ref->[COLOR], @tag } ); # if (!$text_ref->[WIDTH]) { $text_ref->[WIDTH] = $edit_ref->[GRAPHIC]->length_text( $text_ref->[TEXT], $text_ref->[FONT] ); #$text_ref->[ORD] = $ord; #print "|", $text_ref->[TEXT], "|", $width, "|", $text_ref->[WIDTH], "|", $height, "|\n"; # } return ( $text_ref->[WIDTH], $height ); } sub check_cursor { # Une ligne complète vient d'être affichée my ( $edit_ref, $line_ref ) = @_; if ( $edit_ref->[CURSOR] and $edit_ref->[CURSOR][LINE_REF] and $line_ref->[REF] == $edit_ref->[CURSOR][LINE_REF][REF] ) { # On utilise maintenant [CURSOR][POSITION_IN_LINE] my $prev_line_ref = start_line($line_ref); my $position = $edit_ref->[CURSOR][POSITION_IN_LINE]; while ( $position > length( $prev_line_ref->[TEXT] ) ) { $position -= length( $prev_line_ref->[TEXT] ); $prev_line_ref = $prev_line_ref->[NEXT]; } position_cursor_in_display( $edit_ref, $prev_line_ref, $position ); } } sub trunc { # Appelée lorsque l'on est en mode 'wrap' et que la ligne est trop longue par rapport à la largeur de l'écran # On vient de lire un élément texte de trop qu'il va falloir tronquer : # $current_curs est trop grand (il comprend la totalité du mot à tronquer), # mais on ne sait pas de combien my ( $edit_ref, $line_ref, $text_ref, $current_curs, $where ) = @_; my $position = 0; { my $length_substr = 0; while ( ( $text_ref->[ABS] + $length_substr ) < ( $edit_ref->[SCREEN][WIDTH] - $edit_ref->[SCREEN][MARGIN] ) ) { $position += 1; my $substr = substr( $text_ref->[TEXT], 0, $position ); $length_substr = $edit_ref->[GRAPHIC]->length_text( $substr, $text_ref->[FONT] ); } } if ($position) { # On ne peut pas avoir un nombre de caractères négatifs : on sait que le texte précédent rentre # (il n'a pas dépassé la longueur pour déclencher le trunc avant, mais il peut être tombé sur la limite : égalité) # Il est possible de ne mettre aucun caractère du "$text_ref" actuel mais pas -1 # ==> Le test de "$position" à vrai est donc pour le cas où l'on ne rentre même pas dans la # boucle "while" précédente # Ce cas très particulier arrive uniquement lorsqu'il y a égalité entre $text_ref->[ABS] et la partie droite $position -= 1; } #print "Dans trunc MT |", length($line_ref->[TEXT]), "| M1 |", $position, "| M2 |", length($line_ref->[TEXT]) - $position, "|\n"; return divide_line( $edit_ref, $line_ref, $text_ref, $current_curs - length( $text_ref->[TEXT] ) + $position, $position, $where ); } sub divide_line { # On divise une ligne en 2 (création d'une nouvelle ligne) : # - soit parce que l'on est en mode 'wrap' et que la ligne est trop longue (dans # ce cas, $new est 'false') # - soit parce que l'on en crée une (appui sur "return"), $new est 'true' # # my ( $edit_ref, $line_ref, $text_ref, $position_in_line, $position_in_text, $where, $new ) = @_; $edit_ref->[GRAPHIC]->change_text_item_property( $text_ref->[ID], substr( $text_ref->[TEXT], 0, $position_in_text ), ); my $new_line_ref; $new_line_ref->[TEXT] = substr( $line_ref->[TEXT], $position_in_line ); $line_ref->[TEXT] = substr( $line_ref->[TEXT], 0, $position_in_line ); my $first_text_ref; @{$first_text_ref} = @{$text_ref}; # Eléments égaux, mais référence différente $first_text_ref->[TEXT] = substr( $text_ref->[TEXT], $position_in_text ); $text_ref->[TEXT] = substr( $text_ref->[TEXT], 0, $position_in_text ); undef $first_text_ref->[PREVIOUS]; if ( $position_in_text == 0 ) { undef $text_ref->[PREVIOUS][NEXT]; undef $text_ref->[PREVIOUS]; } undef $text_ref->[NEXT]; # Mise à jour de $first_text_ref->[WIDTH] à voir if ( $first_text_ref->[NEXT] ) { $first_text_ref->[NEXT][PREVIOUS] = $first_text_ref; } # Recalcul de la hauteur de la ligne fraichement tronquée $line_ref->[HEIGHT] = 0; my $temp_text_ref = $line_ref->[FIRST]; while ($temp_text_ref) { my ( $width, $height ) = $edit_ref->[GRAPHIC]->size_id( $temp_text_ref->[ID] ); $line_ref->[HEIGHT] = $height if ( $height > $line_ref->[HEIGHT] ); $temp_text_ref = $temp_text_ref->[NEXT]; } $new_line_ref->[FIRST] = $first_text_ref; $new_line_ref->[PREVIOUS] = $line_ref; if ( !$new ) { $new_line_ref->[PREVIOUS_SAME] = 1; } $new_line_ref->[NEXT] = $line_ref->[NEXT]; $new_line_ref->[NEXT_SAME] = $line_ref->[NEXT_SAME]; $line_ref->[NEXT][PREVIOUS] = $new_line_ref; $line_ref->[NEXT] = $new_line_ref; if ( !$new ) { $line_ref->[NEXT_SAME] = 1; } else { $line_ref->[NEXT_SAME] = 0; } while ($first_text_ref) { $first_text_ref->[LINE_REF] = $new_line_ref; $first_text_ref = $first_text_ref->[NEXT]; } if ( length( $text_ref->[TEXT] ) == 0 ) { suppress_text( $edit_ref, $text_ref ); } $new_line_ref->[REF] = $line_ref->[REF]; if ( $edit_ref->[CURSOR][LINE_REF] == $line_ref ) { if ( $edit_ref->[CURSOR][POSITION_IN_DISPLAY] > length( $line_ref->[TEXT] ) ) { $edit_ref->[CURSOR][POSITION_IN_DISPLAY] -= length( $line_ref->[TEXT] ); $edit_ref->[CURSOR][LINE_REF] = $new_line_ref; # Impossible de positionner le curseur à ce stade : les éléments texte ne sont pas encore créés } } return $new_line_ref; } sub concat { my ( $edit_ref, $line_ref, $where ) = @_; # Si l'on concatène, c'est que l'on n'a pas encore affiché : # par précaution, il faut supprimer tous les éléments texte canevas # des 2 lignes à concaténer, car si sur une des 2 lignes concaténées, il # y en a une qui est déjà affichée, on va la réafficher et perdre la référence # des éléments texte canevas précédents (qui ne seront donc plus supprimables) suppress_from_screen_line( $edit_ref, $line_ref ); suppress_from_screen_line( $edit_ref, $line_ref->[NEXT] ); $line_ref->[TEXT] = $line_ref->[TEXT] . $line_ref->[NEXT][TEXT]; if ( $line_ref->[NEXT][NEXT] ) { $line_ref->[NEXT][NEXT][PREVIOUS] = $line_ref; } $line_ref->[NEXT_SAME] = $line_ref->[NEXT][NEXT_SAME]; my $text_ref = $line_ref->[FIRST]; while ( $text_ref->[NEXT] ) { $text_ref = $text_ref->[NEXT]; } $text_ref->[NEXT] = $line_ref->[NEXT][FIRST]; $line_ref->[NEXT][FIRST][PREVIOUS] = $text_ref; while ( $text_ref->[NEXT] ) { $text_ref = $text_ref->[NEXT]; $text_ref->[LINE_REF] = $line_ref; } if ( $edit_ref->[CURSOR][LINE_REF] == $line_ref->[NEXT] ) { $edit_ref->[CURSOR][LINE_REF] = $line_ref; $edit_ref->[CURSOR][POSITION_IN_DISPLAY] += length( $line_ref->[TEXT] ) - length( $line_ref->[NEXT][TEXT] ); } $line_ref->[NEXT] = $line_ref->[NEXT][NEXT]; return $line_ref; # display_everything ( $edit_ref ); } sub suppress_from_screen_line { my ( $edit_ref, $line_ref, $speed ) = @_; my $text_ref = $line_ref->[FIRST]; while ($text_ref) { #print "$text_ref->[TEXT]|"; $edit_ref->[GRAPHIC]->delete_text_item( $text_ref->[ID], $speed ); delete $text_ref->[ID]; my $next_ref = $text_ref->[NEXT]; delete $text_ref->[PREVIOUS]; delete $text_ref->[NEXT]; $text_ref = $next_ref; #last TEXT if ( !$text_ref ); } #print "\n"; $line_ref->[DISPLAYED] = 0; # Libération de la référence et ménage interne à Abstract.pm } sub suppress_from_screen_complete_line { my ( $edit_ref, $line_ref ) = @_; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; } suppress_from_screen_line( $edit_ref, $line_ref ); while ( $line_ref->[NEXT_SAME] ) { $line_ref = $line_ref->[NEXT]; suppress_from_screen_line( $edit_ref, $line_ref ); } } sub suppress_text { my ( $edit_ref, $text_ref ) = @_; if ( $text_ref->[ID] ) { $edit_ref->[GRAPHIC]->delete_text_item( $text_ref->[ID] ); } if ( $text_ref->[PREVIOUS] ) { $text_ref->[PREVIOUS][NEXT] = $text_ref->[NEXT]; } if ( $text_ref->[NEXT] ) { $text_ref->[NEXT][PREVIOUS] = $text_ref->[PREVIOUS]; } } sub clic_text { my ( $edit_ref, $x, $y ) = @_; if ( $origin eq 'graphic' and !$sub_origin ) { $sub_origin = 'clic'; } my $line_ref = get_line_ref_from_ord( $edit_ref, $y ); #my $display_ref = get_display_ref_from_ord($edit_ref, $y); my $display_ref = get_display_ref_from($line_ref); my $pos = get_position_from_line_and_abs( $edit_ref, $line_ref, $x ); my $ref_under_cursor = $line_ref->[REF]; if ( my $sub_ref = $edit_ref->[REDIRECT]{'clic_last'} ) { $edit_ref->[PARENT]->redirect( $sub_ref, $edit_ref, { 'line' => $ref_under_cursor, 'display' => $display_ref, 'display_pos' => $pos, } ); } else { cursor_set( $edit_ref, { 'x' => $x, 'y' => $y } ); $edit_ref->[GRAPHIC]->canva_focus; $edit_ref->deselect; cursor_make_visible($edit_ref); } } sub move_text { my ( $edit_ref, $x, $y ) = @_; if ( $origin eq 'graphic' and !$sub_origin ) { $sub_origin = 'motion'; print "Move text : $x|$y|\n"; } my $line_ref = get_line_ref_from_ord( $edit_ref, $y ); #my $display_ref = get_display_ref_from_ord($edit_ref, $y); my $display_ref = get_display_ref_from($line_ref); my $display_pos = get_position_from_line_and_abs( $edit_ref, $line_ref, $x ); my $line_pos = $display_pos; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; $line_pos += length( $line_ref->[TEXT] ); } my $ref_under_cursor = $line_ref->[REF]; # La redirection n'est pas forcément référencée dans le thread Motion # Cela aura pour effet d'arrêter l'exécution d'une procédure que l'utilisateur souhaite abandonner (effet souhaité) $edit_ref->[PARENT]->redirect( 'motion_last', $edit_ref, { 'line' => $ref_under_cursor, 'display' => $display_ref, 'display_pos' => $display_pos, 'line_pos' => $line_pos, } ); } sub deselect { my ($self) = @_; $self->[GRAPHIC]->delete_select; } sub get_position_from_line_and_abs { my ( $edit_ref, $line_ref, $x ) = @_; my $position = 0; my $text_ref = $line_ref->[FIRST]; while ( $text_ref->[ NEXT ] # Ne pas creer de tableau par autovivification si pas d'element NEXT and $text_ref->[NEXT][ABS] - $edit_ref->[SCREEN][VERTICAL_OFFSET] < $x ) { $position += length( $text_ref->[TEXT] ); $text_ref = $text_ref->[NEXT]; } # On pourrait, pour optimisation, renvoyer $text_ref (on va le rechercher à nouveau par la suite) my $text = $text_ref->[TEXT]; my $abs = $text_ref->[ABS]; my $cursor_position_in_text_item = 0; # On travaille par moitie de caractère return $position if ( !defined $text ); # Bug à voir CAR: for ( 1 .. length($text) ) { my $sous_chaine = substr( $text, $_ - 1, 1 ); my $increment = $edit_ref->[GRAPHIC]->length_text( $sous_chaine, $text_ref->[FONT] ); if ( ( $abs + $increment / 2 ) > ( $x + $edit_ref->[SCREEN][VERTICAL_OFFSET] ) ) { last CAR; } $abs += $increment; $cursor_position_in_text_item += 1; } return $position + $cursor_position_in_text_item; } sub get_line_number_from_ord { my ( $edit_ref, $y ) = @_; my $line = $y / $edit_ref->[SCREEN][LINE_HEIGHT]; return ( int($line) ); } sub select_text_element { my ( $edit_ref, $text_ref, $cursor_position_in_text, $start_text ) = @_; $edit_ref->[CURSOR][TEXT_REF] = $text_ref; $edit_ref->[CURSOR][LINE_REF] = $text_ref->[LINE_REF]; $edit_ref->[GRAPHIC]->position_cursor_in_text_item( $edit_ref->[CURSOR][TEXT_REF][ID], $cursor_position_in_text, # Pour GTK2, manipulation du curseur incompréhensible... ou impossible $edit_ref->[CURSOR][ABS], $edit_ref->[CURSOR][LINE_REF][ORD], ); if ( defined($start_text) ) { $edit_ref->[CURSOR][POSITION_IN_DISPLAY] = $cursor_position_in_text + $start_text; $edit_ref->[CURSOR][POSITION_IN_LINE] = calc_line_position_from_display_position( $edit_ref->[CURSOR] ); } $edit_ref->[CURSOR][POSITION_IN_TEXT] = $cursor_position_in_text; } sub calc_line_position_from_display_position { my ($cursor_ref) = @_; my $line_ref = $cursor_ref->[LINE_REF]; my $position = $cursor_ref->[POSITION_IN_DISPLAY]; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; $position += length( $line_ref->[TEXT] ); } return $position; } sub resize { my ( $edit_ref, $width, $height ) = @_; if ( $origin eq 'graphic' and !$sub_origin ) { $sub_origin = 'resize'; } $edit_ref->[SCREEN][WIDTH] = $width; $edit_ref->[SCREEN][HEIGHT] = $height; if ( !$edit_ref->[SCREEN][FIRST] ) { # Au premier resize $edit_ref->[PARENT]->get_synchronized; init($edit_ref); # On lance le "serveur" de thread mais uniquement lorsque l'éditeur est affiché entièrement (revoir dans le cas multi-fichier # ==> désactivation puis réactivation ?) #print "Dans Abstract resize, lancement de examine_external_request\n"; # Cette boucle, "multi-instances", ne doit être lancée qu'une seule fois (==> dans verify_graphic ?) # Donc pas dans le premier resize de chaque éditeur $edit_ref->[GRAPHIC] ->launch_loop( \&examine_external_request, $edit_ref ); } # En cas de resize, on réaffiche en gardant constante la position de départ de la première ligne entière my $line_ref = get_first_complete_line($edit_ref); $edit_ref->display( $line_ref->[REF], { 'at' => 'top' } ); } sub init { my ($edit_ref) = @_; my $ref; if ( $edit_ref->[INIT_TAB]{first_line_number} ) { my $line = $edit_ref->[PARENT] ->number( $edit_ref->[INIT_TAB]{first_line_number} ); $ref = $line->ref if ($line); } else { my $line = $edit_ref->[PARENT]->number(1); $ref = $line->ref if ($line); $edit_ref->[INIT_TAB]{first_line_pos} = 0; } my $line_ref; if ( !$ref ) { $line_ref = read_next_line($edit_ref); if ( !$line_ref ) { # Fichier vide : en pratique, pour affichage, une ligne vide $line_ref->[TEXT] = ""; $line_ref->[REF] = $edit_ref->[PARENT]->get_ref_for_empty_structure; create_text_in_line( $edit_ref, $line_ref ); } } else { $line_ref = create_line_ref_from_ref( $edit_ref, $ref ); # Cas où la ligne est indéfinie à gérer } $edit_ref->display( $line_ref->[REF], { 'at' => 'top' } ); # Positionnement du curseur my $ref_cursor; if ( $edit_ref->[INIT_TAB]{cursor_line_number} ) { $ref_cursor = $edit_ref->[PARENT] ->go_to( $edit_ref->[INIT_TAB]{cursor_line_number} ); } else { $ref_cursor = $line_ref->[REF]; $edit_ref->[INIT_TAB]{cursor_pos_in_line} = 0; } #print "Référence trouvée pour le curseur : $ref\n"; # Recherche de la référence parmi les lignes déjà créées lors du display_from_top_line my $cursor_line_ref = $edit_ref->[SCREEN][FIRST]; REF: while ( $cursor_line_ref->[REF] != $ref_cursor ) { #print "Référence courante : ", $cursor_line_ref->[REF], "\n"; if ( $cursor_line_ref->[NEXT] ) { $cursor_line_ref = $cursor_line_ref->[NEXT]; } else { last REF; } } if ( $cursor_line_ref->[REF] != $ref_cursor ) { # A la dernière sauvegarde de session, le curseur n'était pas dans la zone affichable # Pour l'instant non géré : on le place au début de la première ligne affichée à l'écran # A modifier éventuellement lorsque le curseur pourra être hors de l'écran à l'initialisation $cursor_line_ref = $line_ref; $edit_ref->[INIT_TAB]{cursor_pos_in_line} = 0; } $edit_ref->[CURSOR][LINE_REF] = $cursor_line_ref; cursor_set( $edit_ref, $edit_ref->[INIT_TAB]{cursor_pos_in_line} ); } sub get_first_complete_line { my ($edit_ref) = @_; # A partir de quelle ligne afficher et à quelle position : on regarde la position de $edit_ref->[SCREEN][FIRST] if ( !$edit_ref->[SCREEN][FIRST] ) { return; } my $line_ref = $edit_ref->[SCREEN][FIRST]; while ($line_ref->[ORD] + $line_ref->[HEIGHT] < 0 or $line_ref->[PREVIOUS_SAME] ) { # Très rare de ne pas avoir de NEXT==> uniquement si la ligne occupe plus d'un écran if ( !$line_ref->[NEXT] ) { return $edit_ref->[SCREEN][FIRST]; } $line_ref = $line_ref->[NEXT]; } return $line_ref; } sub clear_screen { my ($edit_ref) = @_; my $line_to_suppress_ref = $edit_ref->[SCREEN][FIRST]; return if ( !$line_to_suppress_ref ); #SUPP: while ($line_to_suppress_ref->[DISPLAYED] ) { SUPP: while ( $line_to_suppress_ref->[NEXT] ) { suppress_from_screen_line( $edit_ref, $line_to_suppress_ref ); $line_to_suppress_ref = $line_to_suppress_ref->[NEXT]; last SUPP if ( !$line_to_suppress_ref ); } # Vérification pour traquer le bug des lignes qui ne s'effacent pas $edit_ref->[GRAPHIC]->clear_screen; } sub key_press { my ( $edit_ref, $key, $ascii, $options_ref ) = @_; if ( $origin eq 'graphic' and !$sub_origin ) { $sub_origin = 'key_press'; } #clear_screen ( $edit_ref ); #$edit_ref->[GRAPHIC]->clear_screen; #print "KEY |$key| ASCII |", ord($ascii), "| CTRL |"; my $key_code; if ( $options_ref->{'ctrl'} ) { #print "OUI"; $key_code = 'ctrl'; } else { #print "NON"; } #print "| ALT |"; if ( $options_ref->{'alt'} ) { #print "OUI"; $key_code .= '_' if ($key_code); $key_code .= 'alt'; } else { #print "NON"; } #print "| SHIFT |"; if ( $options_ref->{'shift'} ) { #print "OUI"; $key_code .= '_' if ($key_code); $key_code .= 'shift'; } else { #print "NON"; } $key_code .= '_' if ($key_code); $key_code .= $key; #print "$key_code\n"; #return; if ( $key{$key_code} ) { # Une touche speciale a ete appuyee if ( ref( $key{$key_code} ) eq "CODE" ) { #print "Touche spéciale...\n"; #$key{$key_code}->( $edit_ref ); $key{$key_code}->( $edit_ref->[PARENT] ); } else { my @tab = @{ $key{$key_code} }; my $code_ref = shift @tab; #$code_ref->( $edit_ref, @tab ); $code_ref->( $edit_ref->[PARENT], @tab ); } return; } #print "|$key|$ascii|" if ( $alt_key ); #print "|$key|$ascii|"; return if ( length($ascii) != 1 ); # assist doit pointer sur une référence à un package ou une fonction return insert( $edit_ref, $ascii, { 'assist' => $edit_ref->[ASSIST], 'indent' => 'auto' } ); } sub cursor_make_visible { my ($edit_ref) = @_; #print "Dans cursor_make_visible $edit_ref|", $edit_ref->[UNIQUE], "|\n"; verify_if_cursor_is_visible_horizontally($edit_ref); verify_if_cursor_is_visible_vertically($edit_ref); } sub verify_if_cursor_is_visible_horizontally { my ($edit_ref) = @_; # bottom my ( $top, $bottom, $displayed ); my $cursor_line_ref = $edit_ref->[CURSOR][LINE_REF]; # Vérification que la ligne qui porte le curseur fait bien partie des lignes affichées if ( $cursor_line_ref == $edit_ref->[SCREEN][FIRST] ) { $top = 1; $displayed = 1; } else { my $line_ref = $edit_ref->[SCREEN][FIRST]; LINE: while ( $line_ref->[NEXT] ) { $line_ref = $line_ref->[NEXT]; if ( $line_ref == $cursor_line_ref ) { $displayed = 1; last LINE; } } if ( $edit_ref->[SCREEN][LAST] == $cursor_line_ref ) { $bottom = 1; } } if ( !$displayed ) { print "Ligne non affichée : display\n"; return $edit_ref->display( $cursor_line_ref->[REF], { 'at' => 'middle' } ); } # La ligne qui contient le curseur est déjà affichée sur le 'canevas' # ==> il est possible qu'elle ne soit pas visible ou qu'elle soit tronquée # Inutile d'essayer de caser la ligne si l'écran est trop petit : tests supplémentaires à faire # On suppose maintenant que l'écran est assez grand pour positionner au moins 2 lignes entières en hauteur # Vérification en haut if ( !$cursor_line_ref->[PREVIOUS] ) { my $previous_line_ref = read_previous_line( $edit_ref, $cursor_line_ref ); if ( !$previous_line_ref ) { # On positionne la ligne qui contient le curseur en haut de l'écran my $ord = $cursor_line_ref->[ORD]; return screen_move( $edit_ref, 0, $cursor_line_ref->[HEIGHT] - $ord ); } $edit_ref->[SCREEN][FIRST] = display_line_from_bottom( $edit_ref, $previous_line_ref, $cursor_line_ref->[ORD] - $cursor_line_ref->[HEIGHT] ); } # On a une ligne précédente # Le curseur est bien positionné vis-à-vis du haut si la ligne précédente est vue entièrement my $previous_line_ref = $cursor_line_ref->[PREVIOUS]; if ( $previous_line_ref->[ORD] - $previous_line_ref->[HEIGHT] < 0 ) { screen_move( $edit_ref, 0, $previous_line_ref->[HEIGHT] - $previous_line_ref->[ORD] ); } # Le curseur est assez loin du haut, on regarde en bas my $next_line_ref = $cursor_line_ref->[NEXT]; if ( !$next_line_ref ) { $next_line_ref = read_next_line( $edit_ref, $cursor_line_ref ); if ( !$next_line_ref ) { # On positionne la ligne qui contient le curseur en bas de l'écran my $shift = $edit_ref->[SCREEN][HEIGHT] - $cursor_line_ref->[ORD]; return if ( $shift > 0 ); return screen_move( $edit_ref, 0, $shift ); } $edit_ref->[SCREEN][LAST] = display_line_from_top( $edit_ref, $next_line_ref, $cursor_line_ref->[ORD] ); } # On a une ligne suivante # Le curseur est bien positionné vis-à-vis du bas si la ligne suivante est vue entièrement if ( $next_line_ref->[ORD] > $edit_ref->[SCREEN][HEIGHT] ) { return screen_move( $edit_ref, 0, $edit_ref->[SCREEN][HEIGHT] - $next_line_ref->[ORD] ); } } sub verify_if_cursor_is_visible_vertically { my ($edit_ref) = @_; if ( $edit_ref->[SCREEN][WRAP] ) { # # On fait confiance au mode "wrap" pour ne pas être obligé de se décaler à droite ou à gauche # if ( $edit_ref->[SCREEN][VERTICAL_OFFSET] ) { # # On annule donc tout éventuel décalage # my $decalage = -$edit_ref->[SCREEN][VERTICAL_OFFSET]; # $edit_ref->[CURSOR][ABS] -= $decalage; # $edit_ref->[SCREEN][VERTICAL_OFFSET] = 0; # $canva->move( 'text', -$decalage, 0 ); # } return; } if ( $edit_ref->[CURSOR][ABS] + 20 > $edit_ref->[SCREEN][WIDTH] ) { my $decalage = $edit_ref->[CURSOR][ABS] + 20 - $edit_ref->[SCREEN][WIDTH]; $edit_ref->[CURSOR][ABS] -= $decalage; $edit_ref->[CURSOR][VIRTUAL_ABS] -= $decalage; $edit_ref->[SCREEN][VERTICAL_OFFSET] += $decalage; $edit_ref->[GRAPHIC]->move_tag( 'text', -$decalage, 0 ); } if ( $edit_ref->[CURSOR][ABS] < $edit_ref->[GRAPHIC]->margin ) { my $decalage = 10 - $edit_ref->[CURSOR][ABS]; $edit_ref->[CURSOR][ABS] += $decalage; $edit_ref->[CURSOR][VIRTUAL_ABS] += $decalage; $edit_ref->[SCREEN][VERTICAL_OFFSET] -= $decalage; $edit_ref->[GRAPHIC]->move_tag( 'text', $decalage, 0 ); } } sub update_vertical_scrollbar { my ($edit_ref) = @_; return ( 0.2, 0.4 ); # Seules les positions dans le fichier nous interesse # Non, impossible : les positions dans le fichier sont trop lourdes à mettre à jour en cas de saisie # Il faut utiliser le nombre de lignes. Lorsque ce nombre n'est pas connu au départ (lecture d'un # morceau de fichier) il faut calculer la taille moyenne d'une ligne en caractères et faire une # estimation du nombre total de lignes à partir de cette taille moyenne my $start_cursor = get_line_number_from_ord( $edit_ref, 0 ); my $end_cursor = get_line_number_from_ord( $edit_ref, $edit_ref->[SCREEN][HEIGHT] ) - 2; if ( $end_cursor < $start_cursor ) { $end_cursor = $start_cursor + 1; } my ( $first_ln, $last_ln ) = get_extreme_line_number(); my $real_end = $last_ln - $first_ln; return $edit_ref->[GRAPHIC]->set_scrollbar( ( $start_cursor - $first_ln ) / $real_end, ( $end_cursor - $first_ln ) / $real_end, ); } sub scrollbar_move { my ( $edit_ref, $action, $value, $unit ) = @_; # print "Action $action, value $value, unit $unit\n"; if ( $action eq "moveto" ) { my ( $x, $y ) = $edit_ref->[GRAPHIC]->get_scrollbar(); if ( $value < 0 ) { $value = 0; } if ( $value > 1 ) { $value = 1; } # Il ne faut pas forcément agir : si l'on veut descendre alors que l'on est déjà en bas... $edit_ref->[GRAPHIC]->set_scrollbar( $value, $value + $y - $x ); print "Action $action, value $value\n"; move_to($value); } else { # $action = 'scroll' if ( ( $value == 1 ) and ( $unit eq 'units' ) ) { screen_move( $edit_ref, 0, 1 ); } if ( ( $value == -1 ) and ( $unit eq 'units' ) ) { screen_move( $edit_ref, 0, -1 ); } } } sub suppress_top_invisible_lines { my ($edit_ref) = @_; my $screen_ref = $edit_ref->[SCREEN]; # On ne suprrime les "lignes fichier" qu'entièrement (avec le mode wrap, certaines "lignes fichiers" s'étalent sur # plusieurs "lignes écran") my $line_ref = $screen_ref->[FIRST]; while ( $line_ref->[NEXT_SAME] ) { $line_ref = $line_ref->[NEXT]; } if ( $line_ref->[ORD] < 0 ) { $screen_ref->[FIRST] = $line_ref->[NEXT] ; # Attention, bug subtil si pas de next (écran minuscule) suppress_from_screen_line( $edit_ref, $line_ref, 'for_speed' ); $line_ref->[NEXT][PREVIOUS] = undef; # Peut-être plusieurs lignes à supprimer ... while ( $line_ref->[PREVIOUS] ) { $line_ref = $line_ref->[PREVIOUS]; suppress_from_screen_line( $edit_ref, $line_ref, 'for_speed' ); $line_ref->[NEXT][PREVIOUS] = undef; } } } sub suppress_bottom_invisible_lines { my ($edit_ref) = @_; my $screen_ref = $edit_ref->[SCREEN]; # On ne suprrime les "lignes fichier" qu'entièrement (avec le mode wrap, certaines "lignes fichiers" s'étalent sur # plusieurs "lignes écran") my $line_ref = $screen_ref->[LAST]; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; } if ( $line_ref->[ORD] - $line_ref->[HEIGHT] > $screen_ref->[HEIGHT] ) { $screen_ref->[LAST] = $line_ref->[PREVIOUS]; $line_ref->[PREVIOUS][NEXT] = undef; # Peut-être plusieurs lignes à supprimer ... suppress_from_screen_line( $edit_ref, $line_ref, 'for_speed' ); while ( $line_ref->[NEXT] ) { $line_ref = $line_ref->[NEXT]; suppress_from_screen_line( $edit_ref, $line_ref, 'for_speed' ); $line_ref->[PREVIOUS][NEXT] = undef; } } } sub mouse_wheel_event { my ( $edit_ref, $obj, $d ) = @_; my $unit = 1; if ( $d == 4 ) { $unit = -1; } scrollbar_move( $edit_ref, 'scroll', $unit, 'units' ); } sub screen_set_wrap { my ($edit_ref) = @_; return if ( $edit_ref->[SCREEN][WRAP] ); wrap($edit_ref); } sub screen_unset_wrap { my ($edit_ref) = @_; return if ( !$edit_ref->[SCREEN][WRAP] ); wrap($edit_ref); } sub wrap { my ($edit_ref) = @_; # A partir de quelle ligne afficher et à quelle position : on regarde la position de screen_ref->[FIRST] my $line_ref = get_first_complete_line($edit_ref); clear_screen($edit_ref); if ( $edit_ref->[SCREEN][WRAP] ) { $edit_ref->[SCREEN][WRAP] = 0; } else { $edit_ref->[SCREEN][WRAP] = 1; # Suppression de l'éventuel décalage vertical $edit_ref->[SCREEN][VERTICAL_OFFSET] = 0; } $edit_ref->display( $line_ref->[REF], { 'at' => 'top' } ); #cursor_make_visible ( $edit_ref ); } sub change_title { my ( $edit_ref, $title ) = @_; print "Dans change title : $title\n"; $edit_ref->[GRAPHIC]->change_title($title); } sub inser { my ($edit_ref) = @_; if ( $edit_ref->[INSER] ) { $edit_ref->[INSER] = 0; } else { $edit_ref->[INSER] = 1; } } sub editor_insert_mode { my ($edit_ref) = @_; return $edit_ref->[INSER]; } sub editor_set_insert { my ($edit_ref) = @_; $edit_ref->[INSER] = 1; } sub editor_set_replace { my ($edit_ref) = @_; $edit_ref->[INSER] = 0; } sub start_line { my ($line_ref) = @_; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; } return $line_ref; } sub return_complete_line { my ($line_ref) = @_; $line_ref = start_line($line_ref), my $text = $line_ref->[TEXT]; while ( $line_ref->[NEXT_SAME] ) { $line_ref = $line_ref->[NEXT]; $text .= $line_ref->[TEXT]; } return $text; } sub get_line_number { my ( $edit_ref, $line_ref ) = @_; return $edit_ref->[PARENT]->get_line_number_from_ref( $line_ref->[REF] ); } sub get_displayed_editor { my ($edit_ref) = @_; #print "Dans Abstract : $edit_ref\n"; return $edit_ref->[GRAPHIC]->get_displayed_editor(); } sub get_screen_size { my ($edit_ref) = @_; return ( $edit_ref->[SCREEN][WIDTH], $edit_ref->[SCREEN][HEIGHT] ); } sub change_reference { my ($edit_ref) = @_; $edit_ref->[GRAPHIC]->change_reference( $edit_ref, $edit_ref->[FILE] ); } sub increase_font { my ($edit_ref) = @_; print "Taille de la fonte actuelle : $edit_ref->[SCREEN][FONT_HEIGHT]\n"; $edit_ref->[SCREEN][FONT_HEIGHT] += 1; my %distinct_fonts; for my $font ( values %font ) { $distinct_fonts{$font} = $font; } for my $font ( keys %distinct_fonts ) { $edit_ref->[GRAPHIC]->set_font_size( $distinct_fonts{$font}, $edit_ref->[SCREEN][FONT_HEIGHT] ); } $edit_ref->[SCREEN][LINE_HEIGHT] = 17 * $edit_ref->[SCREEN][FONT_HEIGHT] / 13; } #sub get_positions { # return { # "first_line_number" => $top_true_line_number, # "first_line_pos" => $top_screen_line_number, # "cursor_line_number" => $cursor_true_line_number, # "cursor_pos_in_line" => $edit_ref->[CURSOR][POSITION_IN_DISPLAY] # }; #} ###################################################################### # # INTERFACE # ###################################################################### sub insert { my ( $edit_ref, $text, $options_ref ) = @_; $text =~ s/\t/ /g; # Suppression des tabulations cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); #----------------------------------------------------- # Gestion des "\n" : # ----> Appels récursifs à changer pour optimisation mais très efficace pour le codage #----------------------------------------------------- my (@lines) = split( /(\n)/, $text ) ; # Parenthèses pour ne pas ignorer les "empty trailing fields" if ( scalar(@lines) > 1 ) { my @ref; # Liste des références des lignes modifiées ou créées INSERT: for my $index ( 0 .. $#lines ) { if ( $lines[$index] eq "\n" ) { # Envoi d'un "\n" : création d'une ligne my @ref1 = enter( $edit_ref, $options_ref ) ; # Récupération en contexte de liste # Gestion du code retour (construction du tableau des références modifiées) if ( !@ref or $ref[$#ref] ne $ref1[0] ) { push @ref, @ref1; # 1 ou 2 éléments insérés dans @ref } else { # Ici, on est sûr d'avoir 2 lignes retournées par "enter" (l'élément $ref1[1] existe) push @ref, $ref1[1]; } } else { # Le texte a insérer ici ne contient plus aucun "\n" my ($ref) = insert( $edit_ref, $lines[$index], $options_ref ) ; # Appel récursif # Gestion du code retour (construction du tableau des références modifiées) next INSERT if ( !defined $ref ); if ( !@ref or $ref[$#ref] ne $ref ) { push @ref, $ref ; # Mise dans le tableau seulement si pas déjà (insertion retour chariot d'avant, même ref) } } } # Gestion du code retour pour une demande qui contenait des "\n"; if (wantarray) { # En contexte liste, on renvoie la liste des références modifées return @ref; } else { # En contexte scalaire, on renvoie le nombre de lignes modifiées return scalar(@ref); } } #----------------------------------------------------- # Fin de la gestion des "\n" : # Si on est ici, c'est que $text ne contient pas de "\n"; #----------------------------------------------------- if ( !defined( $options_ref->{'insert'} ) ) { # Récupération du "mode inser" courant de l'éditeur si pas défini par l'appelant $options_ref->{'insert'} = $edit_ref->[INSER]; } my $line_ref = $edit_ref->[CURSOR][LINE_REF]; my ( $top_ord, $bottom_ord ) = get_line_ords($line_ref); suppress_from_screen_line( $edit_ref, $line_ref ); $line_ref = delete_text_in_line( $edit_ref, $line_ref ); my $initial_text = $line_ref->[TEXT]; # On a ici tout ce qu'il faut : le texte complet de la ligne, la position dans cette ligne entière # La position du bas de la ligne pour le mode wrap et le mode "inser" ( $line_ref->[TEXT] ) = $edit_ref->[PARENT]->insert_text( $initial_text, $text, $edit_ref->[CURSOR][POSITION_IN_LINE], $options_ref->{'insert'}, $line_ref->[REF], ); $edit_ref->[CURSOR][POSITION_IN_LINE] += length($text); create_text_in_line( $edit_ref, $line_ref ); my $bottom_line_ref = display_line_from_top( $edit_ref, $line_ref, $top_ord ); my ( $new_top_ord, $new_bottom_ord ) = get_line_ords($bottom_line_ref); if ( $bottom_line_ref->[ORD] != $bottom_ord ) { #print "Move de ", $bottom_line_ref->[ORD] - $bottom_ord, "\n"; move_bottom( $edit_ref, $bottom_line_ref->[ORD] - $bottom_ord, $bottom_line_ref ); } #print "TOP dernière ligne =", $bottom_line_ref->[ORD] - $bottom_line_ref->[HEIGHT], "\n"; #print "bottom dernière ligne =", $bottom_line_ref->[ORD] , "\n"; ( $new_top_ord, $new_bottom_ord ) = get_line_ords($bottom_line_ref); # Assistance à la saisie # = évènement de fin de transfert, origin 'graphic' seulement if ( $options_ref->{'assist'} ) { assist_on_inserted_text( $edit_ref->[PARENT], $text, $edit_ref->[CURSOR][LINE_REF][TEXT] ); } if ( my $sub_ref = $edit_ref->[REDIRECT]{'insert_last'} ) { # Redirection vers une fonction utilisateur #$sub_ref = 'cursor_set_last' if ( $sub_ref eq '1' ); # Asynchrone return $edit_ref->[PARENT]->redirect( $sub_ref, $edit_ref, { 'line' => $edit_ref->[CURSOR][LINE_REF][REF], 'line_pos' => $edit_ref->[CURSOR][POSITION_IN_LINE], 'text' => $text, 'initial' => $initial_text, 'origin' => $origin, 'sub_origin' => $sub_origin, } ); } # Optimisation des insertions 'programmé' à voir (un seul appel à la fin à faire... à voir) cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); # Gestion du code retour : attention, l'insertion ne modifie pas forcément la ligne if ( $line_ref->[TEXT] eq $initial_text ) { if (wantarray) { return ; # Aucune référence de ligne à renvoyer car aucune ligne modifiée } else { return 0; # Aucune ligne modifiée } } else { if (wantarray) { return ( $line_ref->[REF] ); # Référence de la ligne modifiée } else { return 1; # 1 ligne modifiée } } } sub enter { # <=> insert("\n") my ( $edit_ref, $options_ref ) = @_; cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); my $line_ref = $edit_ref->[CURSOR][LINE_REF]; # Pour repositionnement à la fin my ( $top_ord, $bottom_ord ) = get_line_ords($line_ref); # Suppression de la ligne ... écran ! ===> à corriger ? suppress_from_screen_line( $edit_ref, $line_ref ); $line_ref = delete_text_in_line( $edit_ref, $line_ref ); # Optimisation my $initial_text = $line_ref->[TEXT]; my $pos = $edit_ref->[CURSOR][POSITION_IN_DISPLAY]; # Ligne écran !!! my $ref = $line_ref->[REF]; # Pour assistance à la saisie (auto-indentation éventuelle après insertion du "\n") my $initial_left_text = substr( $initial_text, 0, $pos ); # Modification de l'ancienne ligne et création de la nouvelle pour l'objet éditeur my ( $text, $new_text, $new_ref ) = $edit_ref->[PARENT]->insert_return( $initial_text, $pos, $ref, ); #--------------------------------------------------------------------------------------- # Affichage des 2 lignes (modifiée et créée) #--------------------------------------------------------------------------------------- # Modification de la liste chaînée my $new_line_ref; $new_line_ref->[PREVIOUS] = $line_ref; $new_line_ref->[TEXT] = $new_text; $new_line_ref->[NEXT] = $line_ref->[NEXT]; $new_line_ref->[REF] = $new_ref; if ( $line_ref->[NEXT] ) { $line_ref->[NEXT][PREVIOUS] = $new_line_ref; } $line_ref->[NEXT] = $new_line_ref; $line_ref->[TEXT] = $text; # Création des éléments texte dans les 2 lignes (coloration syntaxique) create_text_in_line( $edit_ref, $line_ref ); create_text_in_line( $edit_ref, $new_line_ref ); # Affichage de la ligne modifiée my $before_ref = display_line_from_top( $edit_ref, $line_ref, $top_ord ); # Affichage de la ligne créée my $after_ref = display_line_from_top( $edit_ref, $new_line_ref, $before_ref->[ORD] ); # Fin de l'affichage des 2 lignes (modifiée et créée) #--------------------------------------------------------------------------------------- if ( !$after_ref->[NEXT] ) { # Il n'y a rien après $after_ref ===> elle devient donc la dernière ligne écran $edit_ref->[SCREEN][LAST] = $after_ref; } # Déplacement des lignes du bas my $how_much = $after_ref->[ORD] - $bottom_ord; move_bottom( $edit_ref, $how_much, $after_ref ); # On déplace le curseur au début de la nouvelle ligne : optimisation possible : pas de réactualisation du tag 'bottom' nécessaire ... à faire cursor_set( $edit_ref, 0, $new_ref ); # Aide à la saisie (si indentation automatique) if ( defined( $options_ref->{'indent'} ) ) { indent_on_return( $edit_ref, $initial_left_text ); } cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); # Gestion du code retour if ( $text ne $initial_text ) { # La première ligne a été modifiée if (wantarray) { return ( $ref, $new_ref ); # Référence de la ligne créée } else { return 2; # 1 ligne modifiée, 1 ligne créée } } else { # La première ligne est intacte (on était à la fin lors de l'insertion) if (wantarray) { return $new_ref; } else { return 1; # 1 seule ligne créée } } } # Valeurs de retour à gérer pour les 2 fonctions suivantes sub delete_return { my ($edit_ref) = @_; cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); my $cursor = $edit_ref->[CURSOR]; # On supprimer un retour charriot : il y a donc forcément une ligne qui suit my $line_ref = $cursor->[LINE_REF]; # Erreurs à l'appel, on renvoie undef return if ( !$line_ref ); return if ( $cursor->[POSITION_IN_DISPLAY] != length( $line_ref->[TEXT] ) ); return if ( $line_ref->[NEXT_SAME] ); return if ( !$line_ref->[NEXT] ); my ( $top_ord, undef ) = get_line_ords($line_ref); my ( undef, $bottom_ord ) = get_line_ords( $line_ref->[NEXT] ); suppress_from_screen_line( $edit_ref, $line_ref ); $line_ref = delete_text_in_line( $edit_ref, $line_ref ); # line_ref est une ligne entière (mode wrap annulé provisoirement pour cette ligne) suppress_from_screen_line( $edit_ref, $line_ref->[NEXT] ); $line_ref->[NEXT] = delete_text_in_line( $edit_ref, $line_ref->[NEXT] ); my ( $text, $concat ) = $edit_ref->[PARENT] ->delete_key( $line_ref->[TEXT], $edit_ref->[CURSOR][POSITION_IN_DISPLAY], $line_ref->[REF], ); $line_ref->[TEXT] = $text; # Le texte vaut le cumul des 2 lignes (travail de delete_key) die "Pas de concaténation sur suppression de \\n\n" if ( $concat ne "yes" ); $line_ref->[NEXT][TEXT] = ""; # Le texte a déjà été concaténé par la procédure delete_key # concat (modif liste chaînée) le ferai à nouveau concat( $edit_ref, $line_ref, 'bottom' ); create_text_in_line( $edit_ref, $line_ref ); my $bottom_line_ref = display_line_from_top( $edit_ref, $line_ref, $top_ord ); # Déplacement des lignes du bas my $how_much = $bottom_line_ref->[ORD] - $bottom_ord; move_bottom( $edit_ref, $how_much, $bottom_line_ref ); } sub erase { my ( $edit_ref, $number ) = @_; return if ( $number == 0 ); cursor_make_visible($edit_ref) if ( $origin eq 'graphic' ); my $line_ref = $edit_ref->[CURSOR][LINE_REF]; # line_ref est une ligne entière (mode wrap annulé provisoirement pour cette ligne) # Par défaut, il faut supprimer un caractère, sauf... my $cursor_pos = $edit_ref->[CURSOR][POSITION_IN_DISPLAY]; my $length_line = length( $line_ref->[TEXT] ); if ( $cursor_pos + $number > $length_line ) { # Appels récursifs while ($number) { my $suppress; if ( $number > $length_line - $cursor_pos ) { $suppress = $length_line - $cursor_pos; erase( $edit_ref, $suppress ); delete_return($edit_ref); $length_line = length( $edit_ref->[CURSOR][LINE_REF] ); $number -= $suppress + 1; $cursor_pos = 0; } else { $suppress = $number; erase( $edit_ref, $suppress ); $number = 0; } } return; } my ( $top_ord, $bottom_ord ) = get_line_ords($line_ref); suppress_from_screen_line( $edit_ref, $line_ref ); $line_ref = delete_text_in_line( $edit_ref, $line_ref ); my $ref = $line_ref->[REF]; my ($text) = $edit_ref->[PARENT]->erase_text( $number, $line_ref->[TEXT], $edit_ref->[CURSOR][POSITION_IN_DISPLAY], $line_ref->[REF], ); $line_ref->[TEXT] = $text; create_text_in_line( $edit_ref, $line_ref ); my $bottom_line_ref = display_line_from_top( $edit_ref, $line_ref, $top_ord ); # Déplacement des lignes du bas my $how_much = $bottom_line_ref->[ORD] - $bottom_ord; move_bottom( $edit_ref, $how_much, $bottom_line_ref ); if (wantarray) { return 1; } else { return $ref; } } sub display { my ( $edit_ref, $ref, $options_ref ) = @_; my $at = $options_ref->{'at'}; my $ord; if ( defined $at and $at =~ /^ord_(\d+)/ ) { $ord = $1; } elsif ( defined $at ) { if ( $at eq 'top' ) { $ord = 0; } elsif ( $at eq 'bottom' ) { $ord = $edit_ref->[SCREEN][HEIGHT]; } elsif ( $at eq 'middle' ) { $ord = $edit_ref->[SCREEN][HEIGHT] / 2; } else { $ord = $edit_ref->[SCREEN][HEIGHT] / 4; } } else { # On positionne la ligne vers le haut (middle_top) $ord = $edit_ref->[SCREEN][HEIGHT] / 4; } # Vérification de la validité de la ligne avant effacement de l'écran my $top_line_ref; if ( $ref =~ /^(\d+)_/ ) { ($top_line_ref) = get_line_ref_from_display_ref( $edit_ref, $ref ); } else { $top_line_ref = create_line_ref_from_ref( $edit_ref, $ref ); } return if ( !$top_line_ref ); # Si on veut optimiser et ne pas tout supprimer, alors il ne faut pas appeler display # Pour être propre, il faudrait supprimer toutes les références utilisées actuellement clear_screen($edit_ref); display_reference( $edit_ref, $ref, $ord, $options_ref->{'from'} ); #Appel en boucle pour affichage de toutes les lignes # Recuperation de la derniere ligne qui devrait etre affichee display_bottom_of_the_screen($edit_ref); # On a fini l'affichage du bas, mais il reste peut-être des lignes à afficher en haut de $top_line_ref display_top_of_the_screen($edit_ref); return update_vertical_scrollbar($edit_ref); } sub display_reference { my ( $edit_ref, $ref, $ord, $from ) = @_; if ( $ref =~ /^(\d+)_/ ) { display_reference_line( $edit_ref, $1, $ord, $from ); my ($line_ref) = get_line_ref_from_display_ref( $edit_ref, $ref ); if ( !$line_ref ) { # On avait vérifié avant ! Impossible, normalement ... print "Curieux...\n"; $line_ref = $edit_ref->[SCREEN][LAST]; } my $y; if ( !$from or $from eq 'top' ) { $y = $ord - $line_ref->[ORD] + $line_ref->[HEIGHT]; } elsif ( $from eq 'middle' ) { $y = $ord - $line_ref->[ORD] + int( $line_ref->[HEIGHT] / 2 ); } else { $y = $ord - $line_ref->[ORD]; } screen_move( $edit_ref, 0, $y ); return; } display_reference_line( $edit_ref, $ref, $ord, $from ); if ( defined $from and $from eq 'middle' ) { my ( $top_ord, $bottom_ord ) = get_line_ords( $edit_ref->[SCREEN][LAST] ); my $y = $ord - $bottom_ord + int( ( $bottom_ord - $top_ord ) / 2 ); screen_move( $edit_ref, 0, $y ); } } sub display_reference_line { my ( $edit_ref, $ref, $ord, $from ) = @_; my $top_line_ref = create_line_ref_from_ref( $edit_ref, $ref ); if ( !$from or $from eq 'top' ) { $edit_ref->[SCREEN][LAST] = display_line_from_top( $edit_ref, $top_line_ref, $ord ); $edit_ref->[SCREEN][FIRST] = $top_line_ref; } else { $edit_ref->[SCREEN][FIRST] = display_line_from_bottom( $edit_ref, $top_line_ref, $ord ); $edit_ref->[SCREEN][LAST] = $edit_ref->[SCREEN][FIRST]; while ( $edit_ref->[SCREEN][LAST][NEXT_SAME] ) { $edit_ref->[SCREEN][LAST] = $edit_ref->[SCREEN][LAST][NEXT]; } } } #------------------------------------------------------------------- # Gestion des méthodes de l'objet interne "cursor" #------------------------------------------------------------------- sub cursor_position_in_display { my ($self) = @_; return $self->[CURSOR][POSITION_IN_DISPLAY]; } sub cursor_position_in_text { my ($self) = @_; return $self->[CURSOR][POSITION_IN_TEXT]; } sub cursor_abs { my ($self) = @_; return $self->[CURSOR][ABS]; } sub cursor_virtual_abs { my ($self) = @_; return $self->[CURSOR][VIRTUAL_ABS]; } sub cursor_line { my ($self) = @_; if (wantarray) { my $line_ref = $self->[CURSOR][LINE_REF]; return ( return_complete_line($line_ref), $line_ref->[REF] ); } else { return $self->[CURSOR][LINE_REF][REF]; } } sub cursor_display { my ($self) = @_; return get_display_ref_from( $self->[CURSOR][LINE_REF] ); } sub cursor_set { my ( $edit_ref, $options_ref, $ref ) = @_; # Cas à traiter le plus rapidement car le plus fréquent : positionnement sur la même ligne fichier (pas de $ref) if ( !defined($ref) and !ref $options_ref ) { return position_cursor_in_line( $edit_ref, $edit_ref->[CURSOR][LINE_REF], $options_ref ); } # Recherche du positionnement vertical (ligne fichier ou ligne écran) my ( $line_ref, $type ) = search_line_ref_and_type( $edit_ref, $options_ref, $ref ); return if ( !$line_ref ); if ( $type eq 'call' ) { #print STDERR "On n'a pas trouvé la ligne dans les lignes affichées...\n"; my ( $top, $bottom ) = display( $edit_ref, $line_ref, { 'at' => 'middle' } ); # Attention, le positionnement peut planter si $ref est bidon ==> tester le code retour return if ( !defined $top ); #print "Réaffichage pour positionnement éloigné |$top|$bottom|\n"; # Maintenant que la ligne est affiché, on peut positionner normalement (appel récursif) return cursor_set( $edit_ref, $options_ref, $ref ); } # La ligne de positionnement et le type de positionnement sont connus ici (ordonnée 'y' connue) # Recherche de l'abscisse ('x') my $position; my $keep_virtual; if ( !ref $options_ref ) { $position = $options_ref; } else { $keep_virtual = $options_ref->{'keep_virtual'}; } if ( !defined $position and ref $options_ref ) { if ( my $char = $options_ref->{'char'} ) { $position = $char; } if ( !defined $position and my $x = $options_ref->{'x'} ) { $position = get_position_from_line_and_abs( $edit_ref, $line_ref, $x ); $type = 'display'; # On force le mode display puisque l'on a calculé # la position du curseur par rapport à une ligne affichée et à une abscisse (visuel) } } if ( $type eq 'display' ) { return position_cursor_in_display( $edit_ref, $line_ref, $position, $keep_virtual ); } else { return position_cursor_in_line( $edit_ref, $line_ref, $position, $keep_virtual ); } } sub search_line_ref_and_type { my ( $edit_ref, $options_ref, $ref ) = @_; my $line_ref; # Recherche d'une ligne écran ... # ...dans les options (prioritaires) if ( ref $options_ref eq 'HASH' and my $display = $options_ref->{'display'} ) { ($line_ref) = get_line_ref_from_display_ref( $edit_ref, $display ); return if ( !$line_ref ); return ( $line_ref, 'display' ); } # ...dans le 3ème paramètre $ref if ( defined $ref and $ref =~ /_/ ) { ($line_ref) = get_line_ref_from_display_ref( $edit_ref, $ref ); return if ( !$line_ref ); return ( $line_ref, 'display' ); } # Recherche d'une ligne fichier ... # ... dans les options if ( ref $options_ref eq 'HASH' and my $line = $options_ref->{'line'} ) { $line_ref = get_line_ref_from_ref( $edit_ref, $line ); return ( $line, 'call' ) if ( !$line_ref ); # La référence n'est pas à l'écran return ( $line_ref, 'line' ); } # ... dans la référence (3ème paramètre) if ( defined $ref and $ref =~ /^\d+$/ ) { $line_ref = get_line_ref_from_ref( $edit_ref, $ref ); return ( $ref, 'call' ) if ( !$line_ref ); # La référence n'est pas à l'écran return ( $line_ref, 'line' ); } # Recherche d'un positionnement par ordonnée à l'écran if ( ref $options_ref eq 'HASH' and my $ord = $options_ref->{'y'} ) { my $line_ref = get_line_ref_from_ord( $edit_ref, $ord ); return ( $line_ref, 'display' ); } # On n'a pas réussi à récupérer une ligne du paramétrage # ==> on se positionne sur la ligne courante $line_ref = $edit_ref->[CURSOR][LINE_REF]; return ( $edit_ref->[CURSOR][LINE_REF], 'line' ); } sub get_line_ref_from_ord { my ( $self, $ord ) = @_; my $line_ref = $self->[SCREEN][FIRST]; while ($line_ref) { if ( $line_ref->[ORD] > $ord ) { return $line_ref; } $line_ref = $line_ref->[NEXT]; } return; # Pas trouvé } sub get_display_ref_from_ord { my ( $self, $ord ) = @_; my $line_ref = $self->[SCREEN][FIRST]; my $indice = 1; while ($line_ref) { if ( $line_ref->[ORD] > $ord ) { return $line_ref->[REF] . '_' . $indice; } if ( $line_ref->[NEXT_SAME] ) { $indice += 1; } else { $indice = 1; } $line_ref = $line_ref->[NEXT]; } return; # Pas trouvé } sub position_cursor_in_line { my ( $edit_ref, $line_ref, $position_in_line, $keep_virtual ) = @_; $position_in_line = 0 if ( !$position_in_line ); my $position = $position_in_line; $line_ref = start_line($line_ref); LINE: while ( length( $line_ref->[TEXT] ) < $position ) { if ( !$line_ref->[NEXT_SAME] ) { $position = length( $line_ref->[TEXT] ); last LINE; } $position -= length( $line_ref->[TEXT] ); $line_ref = $line_ref->[NEXT]; } return position_cursor_in_display( $edit_ref, $line_ref, $position, $keep_virtual, $position_in_line ); } sub position_cursor_in_display { my ( $edit_ref, $line_ref, $position, $keep_virtual, $position_in_line ) = @_; $position = 0 if ( !defined $position ); my $cursor_ref = $edit_ref->[CURSOR]; my $previous_line_ref = $cursor_ref->[LINE_REF]; $cursor_ref->[LINE_REF] = $line_ref; $cursor_ref->[POSITION_IN_DISPLAY] = $position; if ( !defined $position_in_line ) { $cursor_ref->[POSITION_IN_LINE] = calc_line_position_from_display_position($cursor_ref); } else { $cursor_ref->[POSITION_IN_LINE] = $position_in_line; } my $text_ref = $line_ref->[FIRST]; my $length_text = length( $text_ref->[TEXT] ); TXT: while ( $length_text < $position ) { $position -= $length_text; if ( !$text_ref->[NEXT] ) { # Il n'y a pas assez de caractères pour effectuer le positionnement demandé # ==> on se positionne sur le dernier élément texte de la ligne $position = $length_text; last TXT; } else { $text_ref = $text_ref->[NEXT]; } $length_text = length( $text_ref->[TEXT] ); } select_text_element( $edit_ref, $text_ref, $position ); my $increment = $edit_ref->[GRAPHIC]->length_text( substr( $text_ref->[TEXT], 0, $cursor_ref->[POSITION_IN_TEXT] ), $text_ref->[FONT], ); $cursor_ref->[ABS] = $text_ref->[ABS] + $increment - $edit_ref->[SCREEN][VERTICAL_OFFSET]; if ( !defined $keep_virtual or !$keep_virtual ) { $cursor_ref->[VIRTUAL_ABS] = $cursor_ref->[ABS]; } # Positionnement correct du tag "bottom' # ==> Couteux : à ne faire que si la "hauteur" du curseur à changé if ( $line_ref != $previous_line_ref ) { #print "Tag BOTTOM de $cursor_ref->[LINE_REF][ORD] à $edit_ref->[SCREEN][LAST][ORD]\n"; $edit_ref->[GRAPHIC]->position_bottom_tag_for_text_lower_than( $cursor_ref->[LINE_REF][ORD], $edit_ref->[SCREEN][LAST][ORD], ); } if ( my $sub_ref = $edit_ref->[REDIRECT]{'cursor_set_last'} ) { # Redirection vers une fonction utilisateur #$sub_ref = 'cursor_set_last' if ( $sub_ref eq '1' ); # Asynchrone return $edit_ref->[PARENT]->redirect( $sub_ref, $edit_ref, { 'line' => $line_ref->[REF], 'display' => get_display_ref_from($line_ref), 'display_pos' => $cursor_ref->[POSITION_IN_DISPLAY], 'line_pos' => $cursor_ref->[POSITION_IN_LINE], 'origin' => $origin, 'sub_origin' => $sub_origin, } ); } # On renvoie toujours la position dans la ligne fichier elsif (wantarray) { my $ref = $line_ref->[REF]; return ( $ref, $cursor_ref->[POSITION_IN_LINE] ); } else { return $cursor_ref->[POSITION_IN_LINE]; } } sub cursor_get { my ($self) = @_; my $cursor = $self->[CURSOR]; my $position = $cursor->[POSITION_IN_DISPLAY]; my $line_ref = $cursor->[LINE_REF]; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; $position += length( $line_ref->[TEXT] ); } if (wantarray) { return ( $cursor->[LINE_REF][REF], $position, $cursor->[POSITION_IN_DISPLAY], $cursor->[POSITION_IN_TEXT], $cursor->[ABS], $cursor->[VIRTUAL_ABS], ); } else { return $position; } } #------------------------------------------------------------------- # Gestion des méthodes de l'objet interne "screen" #------------------------------------------------------------------- sub screen_first { my ($self) = @_; return get_display_ref_from( $self->[SCREEN][FIRST] ); } sub screen_font_height { my ($self) = @_; return $self->[SCREEN][FONT_HEIGHT]; } sub screen_height { my ($self) = @_; return $self->[SCREEN][HEIGHT]; } sub screen_x_offset { my ($self) = @_; return $self->[SCREEN][VERTICAL_OFFSET]; } sub screen_last { my ($self) = @_; return get_display_ref_from( $self->[SCREEN][LAST] ); } sub screen_margin { my ($self) = @_; return $self->[SCREEN][MARGIN]; } sub screen_width { my ($self) = @_; return $self->[SCREEN][WIDTH]; } sub screen_wrap { my ($self) = @_; return $self->[SCREEN][WRAP]; } sub screen_set_width { my ( $self, $width ) = @_; my ( undef, $height, $x, $y ) = $self->[GRAPHIC]->get_geometry; $self->[GRAPHIC]->set_geometry( $width, $height, $x, $y ); # Le set_width va être générateur d'un resize # Ce resize va commencer au moment où le thread qui a lancé set_width aura a nouveau la main # (les threads travaillent "simultanément") # return "Fin de set_width"; } sub screen_set_height { my ( $self, $height ) = @_; my ( $width, undef, $x, $y ) = $self->[GRAPHIC]->get_geometry; $self->[GRAPHIC]->set_geometry( $width, $height, $x, $y ); } sub screen_set_x_corner { my ( $self, $x ) = @_; my ( $width, $height, undef, $y ) = $self->[GRAPHIC]->get_geometry; $self->[GRAPHIC]->set_geometry( $width, $height, $x, $y ); } sub screen_set_y_corner { my ( $self, $y ) = @_; my ( $width, $height, $x, undef ) = $self->[GRAPHIC]->get_geometry; $self->[GRAPHIC]->set_geometry( $width, $height, $x, $y ); } sub screen_number { my ( $self, $number ) = @_; # Renvoie le nombre de lignes affichées dans la zone visible : #Attention ! Parfois [SCREEN][FIRST] et/ou [SCREEN][LAST] ne sont pas visibles # Les lignes peuvent avoir des hauteurs différentes # Si $number est renseigné, renvoie la '$number' ligne écran my $line_ref = $self->[SCREEN][FIRST]; while ( $line_ref->[ORD] < 0 and $line_ref->[NEXT] ) { $line_ref = $line_ref->[NEXT]; } if ( $line_ref->[ORD] < 0 ) { # En principe impossible ! return if ( defined $number ); return 0; } my $current_number; while ( $line_ref->[ORD] - $line_ref->[HEIGHT] < $self->[SCREEN][HEIGHT] ) { $current_number += 1; if ( defined $number and $number == $current_number ) { return get_display_ref_from($line_ref); } $line_ref = $line_ref->[NEXT]; last if ( !$line_ref ); last if ( !$line_ref ); } return $current_number; } sub get_line_ref_from_ref { my ( $self, $ref ) = @_; my $line_ref = $self->[SCREEN][FIRST]; while ( $line_ref->[REF] != $ref and $line_ref->[NEXT] ) { $line_ref = $line_ref->[NEXT]; } if ( $line_ref->[REF] == $ref ) { return $line_ref; } else { return; } } sub line_displayed { my ( $self, $ref ) = @_; #print "Dans line_displayed : $ref\n"; my $count = 0; my @ref; my $indice = 1; my $line_ref = $self->[SCREEN][FIRST]; while ( $line_ref != $self->[SCREEN][LAST] ) { if ( $line_ref->[REF] == $ref ) { push @ref, $ref . "_" . $indice++; $count += 1; } $line_ref = $line_ref->[NEXT]; } if ( $self->[SCREEN][LAST][REF] == $ref ) { $count += 1; push @ref, $ref . "_" . $indice++; } #print "COUNT $count, @ref\n"; if (wantarray) { return @ref; } else { return $count; } } sub line_select { my ( $self, $ref, $first, $last, $color ) = @_; return if ( !defined $ref ); #print "In line_select : $self|$ref|$first|$last|\n"; my $line_ref = get_line_ref_from_ref( $self, $ref ); if ( !$line_ref ) { # La ligne fichier n'est pas à l'écran, on ne peut pas la sélectionner print STDERR "Sélection impossible, ligne non à l'écran\n"; return; } if ( !defined $first ) { $first = 0; } my $text = $self->[PARENT]->get_text_from_ref($ref); my $length = length($text); $last = $length if ( !defined $last ); if ( $first > $last ) { my $temp = $last; $last = $first; $first = $temp; } if ( $first < 0 ) { if ( my $previous_ref = $line_ref->[PREVIOUS] ) { my $new_ref = $previous_ref->[REF]; my $length_text = length( $self->[PARENT]->get_text_from_ref($new_ref) ); my $new_first = $length_text + $first; my $new_last = $length_text + $last; return $self->line_select( $new_ref, $new_first, $new_last, $color ); } else { $first = 0; } } if ( $first > $length ) { my $next_ref = $line_ref->[NEXT]; while ( $next_ref and $next_ref->[NEXT_SAME] ) { $next_ref = $next_ref->[NEXT]; } if ($next_ref) { my $new_ref = $next_ref->[REF]; return $self->line_select( $new_ref, $first - $length, $last - $length, $color ); } else { return; } } #print "4 |$first|$last|\n"; return if ( $last == $first ); #print "OK, on va sélectionner...|$first|$last|\n"; my $return_value = q{}; #print "Line select : 1 |$return_value|\n"; my $offset = $self->[SCREEN][VERTICAL_OFFSET]; DISPLAY: while ($last) { # On ne réutilise pas display_select pour un peu plus d'efficacité if ( !defined $line_ref ) { print STDERR "Problème de cohérence entre Abstract et File_manager\n"; return $return_value; } my $text = $line_ref->[TEXT]; my $length = length($text); if ( $first > $length ) { $line_ref = $line_ref->[NEXT]; $first -= $length; $last -= $length; next DISPLAY; } my $left = line_ref_abs( $self, $line_ref, $first ); my $bottom = $line_ref->[ORD]; my $top = $bottom - $line_ref->[HEIGHT]; my $right; #print "Line select : 2 |$return_value|\n"; if ( $last <= $length ) { $right = line_ref_abs( $self, $line_ref, $last ); $return_value .= substr( $text, $first, $last - $first ); $last = 0; } else { $right = line_ref_abs( $self, $line_ref, $length ); $first = 0; $last -= $length; if ( $line_ref->[NEXT] and !$line_ref->[NEXT_SAME] ) { $return_value .= substr( $text, $first, $length - $first ) . "\n"; } #print "Line select : 3 |$return_value|\n"; } $self->[GRAPHIC] ->select( $left - $offset, $top, $right - $offset, $bottom, $color ); $line_ref = $line_ref->[NEXT]; } #print "Line select : retourne $return_value\n"; return $return_value; } sub bind_key { my ( $self, $hash_ref ) = @_; my $use = $hash_ref->{'use'}; eval "use $use" if ( defined $use ); print "EVAL use $use en erreur\n$@\n" if ($@); my $sub = $hash_ref->{'sub'}; my $package = $hash_ref->{'package'}; my $key = $hash_ref->{'key'}; #print "Dans bind key...$sub, $package, $key, $use\n"; if ( !defined $sub and $key{$key} ) { delete $key{$key}; return; } # Vérification de la bonne valeur de key_code à faire (ctrl, alt et shift) my $string = "\\&" . $package . "::$sub"; #print "STRING $string|$package\n"; #$edit_ref->[REDIRECT]{$redirect} = eval "\\&$package::$sub"; $key{$key} = eval $string; #$key{$key} = eval "\\&$package::$sub"; print "key_code =$key{$key}\n"; return; } sub display_text { my ( $self, $ref_display ) = @_; #print "REF NUM dans [TEXT]; } print "Pas trouvé\n"; return; } sub display_next { my ( $self, $ref_display ) = @_; my ( $line_ref, $ref, $count ) = get_line_ref_from_display_ref( $self, $ref_display ); if ( $line_ref and $line_ref->[NEXT] ) { return get_display_ref_from( $line_ref->[NEXT] ); } return; } sub display_ord { my ( $self, $ref_display ) = @_; my ($line_ref) = get_line_ref_from_display_ref( $self, $ref_display ); if ($line_ref) { return $line_ref->[ORD]; } return; } sub display_height { my ( $self, $ref_display ) = @_; my ($line_ref) = get_line_ref_from_display_ref( $self, $ref_display ); if ($line_ref) { return $line_ref->[HEIGHT]; } return; } sub display_number { my ( $self, $ref_display ) = @_; # Renvoie le numéro de la ligne écran (peut être négatif) my ($search_ref) = get_line_ref_from_display_ref( $self, $ref_display ); return if ( !$search_ref ); # Si $number est renseigné, renvoie la '$number' ligne écran my $trouve; my $current_number = 0; my $line_ref = $self->[SCREEN][FIRST]; if ( $search_ref == $line_ref ) { $trouve = $current_number; } while ( $line_ref->[ORD] < 0 and $line_ref ) { $current_number += 1; $line_ref = $line_ref->[NEXT]; if ( $search_ref == $line_ref ) { $trouve = $current_number; } } if ( defined $trouve ) { return $trouve - $current_number + 1; } $current_number = 0; while ($line_ref) { $current_number += 1; if ( $search_ref == $line_ref ) { return $current_number; } $line_ref = $line_ref->[NEXT]; } return; } sub display_previous { my ( $self, $ref_display ) = @_; my ( $line_ref, $ref, $count ) = get_line_ref_from_display_ref( $self, $ref_display ); if ( $line_ref and $line_ref->[PREVIOUS] ) { return get_display_ref_from( $line_ref->[PREVIOUS] ); } return; } sub get_line_ref_from_display_ref { my ( $self, $ref_display ) = @_; my ( $ref, $num ) = split( /_/, $ref_display ); my $count = 0; my $line_ref = $self->[SCREEN][FIRST]; my $next; while ($line_ref) { if ( $line_ref->[REF] == $ref ) { $count += 1; if ( $count == $num ) { return ( $line_ref, $ref, $count ); } } $line_ref = $line_ref->[NEXT]; } return; } sub get_display_ref_from { my ($line_ref) = @_; return if ( !$line_ref ); my $ref = $line_ref->[REF]; my $count = 1; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; $count += 1; } return $ref . '_' . $count; } sub display_next_is_same { my ( $self, $ref_display ) = @_; my ( $line_ref, $ref, $count ) = get_line_ref_from_display_ref( $self, $ref_display ); if ($line_ref) { if ( $line_ref->[NEXT_SAME] ) { # peut ne pas être défini return 1; } return 0; } return; } sub display_previous_is_same { my ( $self, $ref_display ) = @_; my ( $line_ref, $ref, $count ) = get_line_ref_from_display_ref( $self, $ref_display ); if ($line_ref) { if ( $line_ref->[PREVIOUS_SAME] ) { # peut ne pas être défini return 1; } return 0; } return; } sub display_abs { my ( $edit_ref, $display_ref, $pos ) = @_; my ($line_ref) = get_line_ref_from_display_ref( $edit_ref, $display_ref ); return if ( !$line_ref ); if ( !defined $pos ) { $pos = length( $line_ref->[TEXT] ); } return line_ref_abs( $edit_ref, $line_ref, $pos ); } sub line_ref_abs { my ( $edit_ref, $line_ref, $pos ) = @_; my $text_ref = $line_ref->[FIRST]; while ( $text_ref and $pos > length( $text_ref->[TEXT] ) ) { $pos -= length( $text_ref->[TEXT] ); $text_ref = $text_ref->[NEXT]; } print "Hors display!\n" if ( !$text_ref ); return if ( !$text_ref ); # position demandée hors display #print "$pos|", $text_ref->[TEXT], "\n"; my $abs = $text_ref->[ABS]; return $abs if ( $pos == 0 ); my $sous_chaine = substr( $text_ref->[TEXT], 0, $pos ); my $increment = $edit_ref->[GRAPHIC]->length_text( $sous_chaine, $text_ref->[FONT] ); return $increment + $abs; } sub display_select { my ( $self, $display_ref, $first, $last, $mode ) = @_; my ($line_ref) = get_line_ref_from_display_ref( $self, $display_ref ); return if ( !$line_ref ); $first = 0 if ( !defined $first ); my $max = length( $line_ref->[TEXT] ); $last = $max if ( !defined $last or $last > $max ); # Bug à voir : si l'on ne met pas à jour la ligne de l'onglet, la ligne existe dans Abstract mais pas dans Tk ? #print "DISPLAY ", $line_ref->[TEXT], "|$first|$last|\n"; my $left = line_ref_abs( $self, $line_ref, $first ); #print "last = $last\n"; my $right = line_ref_abs( $self, $line_ref, $last ); #print "right = $right\n"; my $bottom = $line_ref->[ORD]; my $top = $bottom - $line_ref->[HEIGHT]; $self->[GRAPHIC]->select( $left, $top, $right, $bottom, $mode ); } sub parent { my ($self) = @_; return $self->[PARENT]; } sub move_bottom { my ( $self, $how_much, $previous_line_ref ) = @_; return if ( $how_much == 0 ); $self->[GRAPHIC]->move_tag( 'bottom', 0, $how_much ); while ( $previous_line_ref->[NEXT] ) { $previous_line_ref = $previous_line_ref->[NEXT]; $previous_line_ref->[ORD] += $how_much; } if ( $how_much > 0 ) { suppress_bottom_invisible_lines($self); } else { display_bottom_of_the_screen($self); } } sub screen_move { my ( $self, $x, $y ) = @_; return if ( $x == 0 and $y == 0 ); $self->[GRAPHIC]->move_tag( 'all', $x, $y ); my $line_ref = $self->[SCREEN][FIRST]; while ($line_ref) { $line_ref->[ORD] += $y; $line_ref = $line_ref->[NEXT]; } if ( $y > 0 ) { suppress_bottom_invisible_lines($self); display_top_of_the_screen($self); } else { suppress_top_invisible_lines($self); display_bottom_of_the_screen($self); } } sub display_bottom_of_the_screen { # Parallèle de la fonction "suppress_bottom_invisible_lines" my ($edit_ref) = @_; my $screen_ref = $edit_ref->[SCREEN]; my $last_ref = $screen_ref->[LAST]; DISPLAY: while ( $last_ref->[ORD] < $screen_ref->[HEIGHT] ) { my $line_ref = read_next_line( $edit_ref, $last_ref ); #print "Lu :$line_ref->[TEXT]\n"; if ($line_ref) { $last_ref = display_line_from_top( $edit_ref, $line_ref, $last_ref->[ORD] ); $screen_ref->[LAST] = $last_ref; # Ajout du tag 'bottom' add_tag_complete( $edit_ref, $last_ref, 'bottom' ); } else { return; } } } sub display_top_of_the_screen { # Parallèle de la fonction "suppress_bottom_invisible_lines" my ($edit_ref) = @_; my $screen_ref = $edit_ref->[SCREEN]; my $first_ref = $screen_ref->[FIRST]; DISPLAY: while ( $first_ref->[ORD] - $first_ref->[HEIGHT] > 0 ) { my $line_ref = read_previous_line( $edit_ref, $first_ref ); if ($line_ref) { $first_ref = display_line_from_bottom( $edit_ref, $line_ref, $first_ref->[ORD] - $first_ref->[HEIGHT] ); $screen_ref->[FIRST] = $first_ref; } else { return; } } } sub display_line_from_top { # ord est le bas de la ligne en-dessous de laquelle il faut écrire my ( $edit_ref, $line_ref, $ord ) = @_; my $graphic = $edit_ref->[GRAPHIC]; $line_ref->[HEIGHT] = 0; my ( $overwrite_ref, $still_to_display_ref ) = display_with_tag( $edit_ref, $line_ref, $ord, ['just_created'] ); while ( defined $still_to_display_ref ) { $graphic->move_tag( 'just_created', 0, $overwrite_ref->[HEIGHT] ); $graphic->delete_tag('just_created'); $ord += $overwrite_ref->[HEIGHT]; $overwrite_ref->[ORD] = $ord; ( $overwrite_ref, $still_to_display_ref ) = display_with_tag( $edit_ref, $still_to_display_ref, $ord, ['just_created'] ); } $graphic->move_tag( 'just_created', 0, $overwrite_ref->[HEIGHT] ); $graphic->delete_tag('just_created'); $overwrite_ref->[ORD] = $ord + $overwrite_ref->[HEIGHT]; # print "D|", $overwrite_ref->[ORD] - $overwrite_ref->[HEIGHT], "|", # $overwrite_ref->[HEIGHT], "|", $overwrite_ref->[ORD], "|", # $overwrite_ref->[TEXT], "\n"; check_cursor( $edit_ref, $line_ref ); return $overwrite_ref; } sub display_line_from_bottom { # ord est le haut de la ligne au-dessus de laquelle il faut écrire my ( $edit_ref, $line_ref, $ord ) = @_; $line_ref->[HEIGHT] = 0; my ( $overwrite_ref, $still_to_display_ref ) = display_with_tag( $edit_ref, $line_ref, $ord, ['just_created'] ); while ( defined $still_to_display_ref ) { $overwrite_ref->[ORD] = $ord; ( $overwrite_ref, $still_to_display_ref ) = display_with_tag( $edit_ref, $still_to_display_ref, $ord ); $edit_ref->[GRAPHIC] ->move_tag( 'just_created', 0, -$overwrite_ref->[HEIGHT] ); my $previous_line_ref = $overwrite_ref; while ( $previous_line_ref->[PREVIOUS_SAME] ) { $previous_line_ref = $previous_line_ref->[PREVIOUS]; $previous_line_ref->[ORD] -= $overwrite_ref->[HEIGHT]; } if ($still_to_display_ref) { add_tag( $edit_ref, $overwrite_ref, 'just_created' ); } } $edit_ref->[GRAPHIC]->delete_tag('just_created'); $overwrite_ref->[ORD] = $ord; check_cursor( $edit_ref, $line_ref ); return $line_ref; } sub add_tag { my ( $self, $line_ref, $tag ) = @_; my $text_ref = $line_ref->[FIRST]; while ($text_ref) { $self->[GRAPHIC]->add_tag( $tag, $text_ref->[ID] ); $text_ref = $text_ref->[NEXT]; } } sub add_tag_complete { my ( $self, $line_ref, $tag ) = @_; while ( $line_ref->[PREVIOUS_SAME] ) { $line_ref = $line_ref->[PREVIOUS]; } add_tag( $self, $line_ref, $tag ); while ( $line_ref->[NEXT_SAME] ) { $line_ref = $line_ref->[NEXT]; add_tag( $self, $line_ref, $tag ); } } sub display_with_tag { my ( $edit_ref, $line_ref, $ord, $tag_ref ) = @_; if ( !defined $tag_ref ) { $tag_ref = 'text'; } else { push @{$tag_ref}, 'text'; } my $text_ref = $line_ref->[FIRST]; $line_ref->[HEIGHT] = 0; my $current_abs = $edit_ref->[SCREEN][MARGIN]; my $current_curs = 0; TEXT: while ($text_ref) { $text_ref->[ABS] = $current_abs; my ( $width, $height ) = display_text_from_memory( $edit_ref, $text_ref, $ord, $tag_ref ); $current_abs += $width; $line_ref->[HEIGHT] = $height if ( $height > $line_ref->[HEIGHT] ); $current_curs += length( $text_ref->[TEXT] ); if ( $edit_ref->[SCREEN][WRAP] and $current_abs > ( $edit_ref->[SCREEN][WIDTH] - $edit_ref->[SCREEN][MARGIN] ) ) { my $new_line_ref = trunc( $edit_ref, $line_ref, $text_ref, $current_curs, 'bottom' ); return ( $line_ref, $new_line_ref ); } $text_ref = $text_ref->[NEXT]; } return $line_ref; } sub get_line_ords { my ($line_ref) = @_; my $previous_ref = $line_ref; while ( $previous_ref->[PREVIOUS_SAME] ) { $previous_ref = $previous_ref->[PREVIOUS]; } while ( $line_ref->[NEXT_SAME] ) { $line_ref = $line_ref->[NEXT]; } return ( $previous_ref->[ORD] - $previous_ref->[HEIGHT], $line_ref->[ORD] ); } sub save_search { my ( $self, $exp, $line_start, $line_stop, $pos_start ) = @_; print "POS START = $pos_start\n"; $self->[REGEXP] = { 'line_start' => $line_start, 'line_stop' => $line_stop, 'pos_start' => $pos_start, 'exp' => $exp, }; } sub load_search { my ($self) = @_; return $self->[REGEXP]; } sub focus { my ( $self, $hash_ref ) = @_; on_top( $self, $hash_ref ); #$self->deselect; $self->[GRAPHIC]->focus; } sub on_top { my ( $self, $hash_ref ) = @_; # hash_ref est défini qu'en création my $zone = $self->[GRAPHIC]->get_zone; #print "Dans abstract on_top : zone = $zone, $self->[PARENT]|", # $self->[PARENT]->ref, "|\n"; my $graphic = Text::Editor::Easy::Graphic->get_graphic_focused_in_zone($zone); if ( defined $graphic and ref $graphic eq 'Text::Editor::Easy::Graphic' ) { return if ( $graphic == $self->[GRAPHIC] ); #print "Réel changement de on_top...\n"; $graphic->forget; } $self->[GRAPHIC]->on_top; # Recherche de tous les éditeurs qui ont "on_top" comme évènements : à revoir (un peu long) # Appel en asynchrone (modification pour pourvoir partager des variables compliquées dans Tab.pm) #for my $abstract_ref ( values %abstract ) { # if ( my $sub_ref = $abstract_ref->[REDIRECT]{'on_top_last'} ) { # $abstract_ref->[PARENT]->redirect( $sub_ref, $abstract_ref, { # 'editor' => $self->[UNIQUE], # 'zone' => $zone, # } # ); # } #} return if ( !defined $zone ); my $event_ref = $event_zone{$zone}; if ( defined $event_ref and my $data_ref = $event_ref->{'on_top_editor_change'} ) { $data_ref->{'sub_ref'} ->( $self->[PARENT], $data_ref->{'tab_ref'}, $hash_ref ); } } sub empty { # Vidage de l'éditeur my ($self) = @_; # Horribles fuites mémoires !! # ------------------------------ #sleep 2; clear_screen($self); $self->[PARENT]->empty_internal; #print "Taille self avant nettoyage :", total_size($self) , "\n"; clean($self); #print "Taille self après nettoyage :", total_size($self), "\n"; my $line_ref; $line_ref->[TEXT] = ""; $line_ref->[REF] = $self->[PARENT]->get_ref_for_empty_structure; create_text_in_line( $self, $line_ref ); $self->display( $line_ref->[REF], { 'at' => 'top' } ); # Positionnement du curseur cursor_set( $self, 0, $line_ref->[REF] ); #sleep 2; } sub clean { my ($self) = @_; my $to_delete_ref = $self->[SCREEN][FIRST]; $self->[SCREEN][FIRST] = 0; while ($to_delete_ref) { my $next_ref = $to_delete_ref->[NEXT]; $to_delete_ref->[NEXT] = 0; $to_delete_ref->[PREVIOUS] = 0; $to_delete_ref = $next_ref; } $self->[SCREEN][LAST] = 0; } sub abstract_eval { my ( $self, $program ) = @_; print "\n\n$program\n", threads->tid, "$origin, $sub_origin\n"; eval "$program"; print $@ if ($@); } sub abstract_size { my $total; for my $self ( sort keys %abstract ) { my $size = total_size( $abstract{$self} ); print "Taille $self : $size\n"; $total += $size; } print "=> Taille totale : $total\n"; } sub increase_line_space { my ($self) = values %abstract; print "In increase_line_offset\n"; $self->[GRAPHIC]->increase_line_offset; resize_all(); } sub decrease_line_space { my ($self) = values %abstract; print "In increase_line_offset\n"; $self->[GRAPHIC]->decrease_line_offset; resize_all(); } sub resize_all { #my @zones = Text::Editor::Easy::Zone->list; #ZONE: for my $zone ( @zones ) { #print "Zone $zone\n"; #my $graphic = Text::Editor::Easy::Graphic->get_graphic_focused_in_zone ( $zone ); for my $abstract_ref ( values %abstract ) { #if ( $graphic == $abstract_ref->[GRAPHIC] ) { print "Text::Editor::Easy $abstract_ref->[UNIQUE]\n"; $abstract_ref->deselect; resize( $abstract_ref, $abstract_ref->[SCREEN][WIDTH], $abstract_ref->[SCREEN][HEIGHT] ); #next ZONE; #} } #} } sub reference_zone_event { my ( $self, $name, $event, $hash_ref ) = @_; print "Dans reference_zone_event $name,$event, ", $hash_ref->{sub}[0], $hash_ref->{sub}[1], "\n"; my $use = $hash_ref->{'use'}; if ( defined $use and !$use{$use} ) { eval "use $use"; print "EVAL use $use en erreur\n$@\n" if ($@); $use{$use} = 1; } my $package = $hash_ref->{'package'}; $package = 'main' if ( !defined $package ); if ( my $sub = $hash_ref->{'sub'}[0] ) { $event_zone{$name}{$event}{sub_ref} = eval "\\&${package}::$sub"; $event_zone{$name}{$event}{tab_ref} = $hash_ref->{sub}[1]; } } sub abstract_join { my ( $self, $tid ) = @_; print "Dans abstract_join tid = $tid\n"; threads->object($tid)->join; return $tid; } sub exit { my ($rc) = @_; Text::Editor::Easy::Comm::untie_print(); print "Dans exit |$rc|\n"; exit 0 if ( !$rc or $rc =~ /\D/ ); exit $rc; } =head1 FUNCTIONS =head2 abstract_eval =head2 abstract_join =head2 abstract_size =head2 add_tag =head2 add_tag_complete =head2 assist_on_inserted_text =head2 bind_key =head2 calc_line_position_from_display_position =head2 change_reference =head2 change_title =head2 check_cursor =head2 clean =head2 clear_screen =head2 clic_text =head2 concat =head2 create_line_ref_from_ref =head2 create_text_in_line =head2 cursor_abs =head2 cursor_display =head2 cursor_get =head2 cursor_line =head2 cursor_make_visible =head2 cursor_position_in_display =head2 cursor_position_in_text =head2 cursor_set =head2 cursor_virtual_abs =head2 decrease_line_space =head2 delete_return =head2 delete_text_in_line =head2 deselect =head2 display =head2 display_abs =head2 display_bottom_of_the_screen =head2 display_height =head2 display_line_from_bottom =head2 display_line_from_top =head2 display_next =head2 display_next_is_same =head2 display_number =head2 display_ord =head2 display_previous =head2 display_previous_is_same =head2 display_reference =head2 display_reference_line =head2 display_select =head2 display_text =head2 display_text_from_memory =head2 display_top_of_the_screen =head2 display_with_tag =head2 divide_line =head2 editor_insert_mode =head2 editor_set_insert =head2 editor_set_replace =head2 else =head2 empty =head2 enter =head2 erase =head2 examine_external_request =head2 exit =head2 focus =head2 for =head2 get_display_ref_from =head2 get_display_ref_from_ord =head2 get_displayed_editor =head2 get_first_complete_line =head2 get_line_number =head2 get_line_number_from_ord =head2 get_line_ords =head2 get_line_ref_from_display_ref =head2 get_line_ref_from_ord =head2 get_line_ref_from_ref =head2 get_position_from_line_and_abs =head2 get_screen_size =head2 if =head2 increase_font =head2 increase_line_space =head2 indent_on_return =head2 init =head2 inser =head2 insert =head2 key_press =head2 line_displayed =head2 line_ref_abs =head2 line_select =head2 load_search =head2 manage_event =head2 mouse_wheel_event =head2 move_bottom =head2 move_text =head2 new =head2 on_top =head2 parent =head2 position_cursor_in_display =head2 position_cursor_in_line =head2 read_next_line =head2 read_previous_line =head2 reference_zone_event =head2 resize =head2 resize_all =head2 return_complete_line =head2 revert =head2 save_search =head2 screen_first =head2 screen_font_height =head2 screen_height =head2 screen_last =head2 screen_line_height =head2 screen_margin =head2 screen_move =head2 screen_number =head2 screen_set_height =head2 screen_set_width =head2 screen_set_wrap =head2 screen_set_x_corner =head2 screen_set_y_corner =head2 screen_unset_wrap =head2 screen_width =head2 screen_wrap =head2 screen_x_offset =head2 screen_y_offset =head2 scrollbar_move =head2 search_line_ref_and_type =head2 select_text_element =head2 start_line =head2 suppress_bottom_invisible_lines =head2 suppress_from_screen_complete_line =head2 suppress_from_screen_line =head2 suppress_text =head2 suppress_top_invisible_lines =head2 test =head2 test_suppress_indent =head2 trunc =head2 update_vertical_scrollbar =head2 verify_if_cursor_is_visible_horizontally =head2 verify_if_cursor_is_visible_vertically =head2 wrap =head1 COPYRIGHT & LICENSE Copyright 2008 Sebastien Grommier, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;