From 6a0022d67d4baea240897c7e3b24d2b864f06c60 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Mon, 29 Aug 2011 18:15:22 +0100
Subject: more stepping tests

---
 lib/Enigmatic/CryptTrain.pm | 101 ++++++++++++++++++++++++++++++++++++++------
 1 file changed, 89 insertions(+), 12 deletions(-)

(limited to 'lib/Enigmatic/CryptTrain.pm')

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;
-- 
cgit v1.2.3