summaryrefslogtreecommitdiff
path: root/lib/Enigmatic/CryptTrain.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Enigmatic/CryptTrain.pm')
-rw-r--r--lib/Enigmatic/CryptTrain.pm101
1 files changed, 89 insertions, 12 deletions
diff --git a/lib/Enigmatic/CryptTrain.pm b/lib/Enigmatic/CryptTrain.pm
index 06a11d2..4d4b6c6 100644
--- a/lib/Enigmatic/CryptTrain.pm
+++ b/lib/Enigmatic/CryptTrain.pm
@@ -4,6 +4,8 @@ use Enigmatic::Types qw(Letter RotorPos);
use MooseX::Types::Moose qw(ArrayRef);
use Moose::Util::TypeConstraints;
+with 'Enigmatic::Role::Rotate';
+
has rotors => (
isa => ArrayRef[class_type('Enigmatic::Rotor')],
traits => ['Array'],
@@ -36,8 +38,42 @@ has positions => (
position_at => 'get',
positions => 'elements',
},
+ lazy_build => 1,
);
+sub _build_positions {
+ my ($self) = @_;
+
+ my @ret = (0) x $self->rotor_count;
+ return \@ret;
+}
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+
+ my $args = $class->$orig(@_);
+
+ if ($args->{positions}) {
+
+ warn "pos: @{$args->{positions}}\n";
+
+ for my $pos (@{$args->{positions}}) {
+ $pos = to_RotorPos($pos);
+ }
+
+ warn "pos: @{$args->{positions}}\n";
+ }
+
+ return $args;
+};
+
+around set_position => sub {
+ my ($orig,$self,$idx,$pos) = @_;
+
+ return $self->$orig($idx,to_RotorPos($pos));
+};
+
sub map {
my $self = shift;
my ($letter) = pos_validated_list(
@@ -45,15 +81,34 @@ sub map {
{ isa => Letter },
);
- for my $element (
- $self->rotors,
- $self->reflector,
- (reverse $self->rotors),
- ) {
- $letter = $element->map($letter);
- }
+ my $max_idx = $self->rotor_count -1;
+
+ my $log='';
+
$self->step_positions();
+ for my $idx (0..$max_idx) {
+ my $rotor = $self->rotor_at($idx);$log.="($idx:";
+ my $position = $self->position_at($idx);$log.="$position)";
+
+ $letter = _rotate_by($letter,$position);$log.=$letter;
+ $letter = $rotor->map($letter);$log.=$letter;
+ $letter = _rotate_by($letter,-$position);$log.=$letter;
+ }
+
+ $letter = $self->reflector->map($letter);$log.="r${letter}r";
+
+ for my $idx (reverse 0..$max_idx) {
+ my $rotor = $self->rotor_at($idx);$log.="($idx:";
+ my $position = $self->position_at($idx);$log.="$position)";
+
+ $letter = _rotate_by($letter,$position);$log.=$letter;
+ $letter = $rotor->inverse_map($letter);$log.=$letter;
+ $letter = _rotate_by($letter,-$position);$log.=$letter;
+ }
+
+ warn "$log\n";
+
return $letter;
}
@@ -72,14 +127,36 @@ sub rotor_window_at {
return ['A'..'Z']->[$self->position_at($idx)]
}
+sub rotor_windows {
+ my ($self) = @_;
+
+ my @ret = map { $self->rotor_window_at($_) } 0 .. $self->rotor_count -1;
+ return @ret;
+}
+
sub step_positions {
my ($self) = @_;
- for my $pos (0 .. $self->rotor_count -1) {
- $self->_inc_position($pos);
- my $rot = $self->rotor_at($pos);
- last
- unless $rot->has_notch_at($self->rotor_window_at($pos));
+ # from http://users.telenet.be/d.rijmenants/en/enigmatech.htm#steppingmechanism
+ # the mechanism is:
+ # - the first rotor always steps
+ # - if there is a notch at the current position, both the rotor
+ # with the notch, and the next one, will step
+
+ my $max_idx = $self->rotor_count -1;
+ my @will_step = (0) x $max_idx;
+ $will_step[0]=1; # the first rotor always steps
+
+ for my $idx (0 .. $max_idx) {
+ my $rot = $self->rotor_at($idx);
+ my $notch = $rot->has_notch_at($self->rotor_window_at($idx));
+ $will_step[$idx] = $will_step[$idx+1] = 1 if $notch;
+ }
+
+ $will_step[3] = 0; # the fourth rotor never steps
+
+ for my $idx (0 .. $max_idx) {
+ $self->_inc_position($idx) if $will_step[$idx];
}
return;