#!/Perl/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Tk;
use Tk::ToolBar;
use Tk::ROText;
my $VERSION = 0.1;
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',);
#$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{
forward(
$window{text},
$window{ToolBarEntry}->get(),
-1,
), # /&forward
}, # /sub, -command
);
$window{ToolBarEntry} = $window{ToolBar}->ToolLabEntry(
-label => '',
-labelPack => [-side => "left",
-anchor => "w"],
);
$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(),
1,
), # /&forward
}, # /sub, -command
);
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