#!/Perl/bin/perl use strict; use warnings; use Data::Dumper; use Tk; use Tk::ToolBar; use Tk::ROText; my $VERSION = 0.1; my @whitespaceOptions = ( [ 'Whitespaces ignorieren'=>1], ['Whitespaces verschieben'=>0], ); my $bindWhitespaceValue = undef; my $_debug = 0; my $mw = Tk::MainWindow->new(-width=>640,-height=>480); $mw->packPropagate(0); $mw->update(); # User-Interface: # Eine große Box die den zu untersuchenden Text enthält # Buttons für das das Verschieben der Zeichen auf der Skala # Entry für die Anzahl der Verschiebungen # Checkbox für whitespaces # reset-button für Text (Text in variable zwischenspeichern) # ---- # Optional: # event. merken welche verschiebung durchgeführt wurde um die rücksicherung nicht # durch eine Variable erledigen zu lassen # die häufigsten Zeichen des Textes und Kombinationen # ---- # Textfeld auslesen: get('1.0', 'end') # Textfeld löschen: delete('1.0','end'); # -- [ GUI ] -- # my %window = (); # Kontainer für alle Fenster-Elemente (anstatt Variablen) $window{text} = $mw->Scrolled('Text',-scrollbars=>'se',); $window{debugCaption} = $mw->Label(-text=>'Debug:',-justify=>'left',); $window{debug} = $mw->Scrolled( 'ROText', -scrollbars=>'se', -height=>6, -bg => 'black', -fg => 'orange', -wrap => 'word', ); $window{text}->pack(-side=>'top',-fill=>'x',-anchor=>'w',); if( $_debug ){ $window{debugCaption}->pack(-side=>'top',-fill=>'x',-anchor=>'w',); $window{debug}->pack(-side=>'top',-fill=>'x',-anchor=>'w',); } $window{ToolBar} = $mw->ToolBar(-movable => 1, -side => 'bottom'); $window{ToolBarLeft} = $window{ToolBar}->ToolButton( -image => 'navback22', -tip => 'back', -command => sub{ back( $window{text}, $window{ToolBarEntry}->get(), $bindWhitespaceValue, ), # /&forward }, # /sub, -command ); $window{ToolBarEntry} = $window{ToolBar}->ToolEntry(); $window{ToolBarEntry}->insert('0.0', 1); # verscheibung vordefinieren $window{ToolBarRight} = $window{ToolBar}->ToolButton( -image => 'navforward22', -tip => 'forward', -command => sub{ forward( $window{text}, $window{ToolBarEntry}->get(), $bindWhitespaceValue, ), # /&forward }, # /sub, -command ); $window{ToolBarSeparator1} = $window{ToolBar}->separator(); $window{ToolBarOptionmenu} = $window{ToolBar}->ToolOptionmenu( -options => \@whitespaceOptions, -variable => \$bindWhitespaceValue, ); #$checkbutton->select MainLoop; sub forward { my $textfeld = shift; my $verschiebung = shift; my $ignWhitespaces = shift; my $altText = $textfeld->get('0.0','end'); my $neuText = undef; # neuer Text komm thier rein foreach my $z ( split("", $altText) ) { # sollen whitespaces ignoriert werden? (und ist das aktuelle zeichen eins?) if ( $ignWhitespaces and $z =~ m/\s/ ){ $neuText .= $z; }else{ $neuText .= chr((ord($z)+$verschiebung)); } } # /foreach @text chop $neuText; # letztes Leerzeichen wegmachen, da die Textarea beim insert immer eines dran hängt # textfeld löschen $textfeld->delete('0.0', 'end'); # neuen, codierten Text einfügen $textfeld->insert('0.0', $neuText); } # /forward sub back { my $textfeld = shift; my $verschiebung = shift; my $ignWhitespaces = shift; $verschiebung *= -1; forward($textfeld, $verschiebung, $ignWhitespaces); } # /back