enigma: implementation of Enigma cipher machine.

extra/enigma/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/enigma/enigma-tests.factor

@@ -0,0 +1,12 @@
+
+USING: enigma kernel math sequences sorting tools.test ;
+
+IN: enigma.tests
+
+[ t ] [ <reflector> natural-sort 26 iota sequence= ] unit-test
+
+[ "" ] [ "" 4 <enigma> encode ] unit-test
+
+[ "hello, world" ] [
+    "hello, world" 4 <enigma> [ encode ] keep reset-cogs encode
+] unit-test

extra/enigma/enigma.factor

@@ -0,0 +1,46 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays ascii kernel locals math random
+sequences sequences.extras vectors ;
+
+IN: enigma
+
+: <alphabet> ( -- seq )
+    26 iota >array ;
+
+: <cog> ( -- cog )
+    <alphabet> randomize ;
+
+: <reflector> ( -- reflector )
+    <alphabet> dup length iota >vector [ dup empty? ] [
+        [
+            [ delete-random ] [ delete-random ] bi
+            pick exchange
+        ] keep
+    ] until drop ;
+
+TUPLE: enigma cogs prev-cogs reflector ;
+
+: <enigma> ( num-cogs -- enigma )
+    [ <cog> ] replicate dup clone <reflector> enigma boa ;
+
+: reset-cogs ( enigma -- enigma )
+    dup prev-cogs>> >>cogs ;
+
+: special? ( n -- ? )
+    [ 25 > ] [ 0 < ] bi or ;
+
+:: encode ( text enigma -- cipher-text )
+    0 :> ln!
+    enigma cogs>> :> cogs
+    enigma reflector>> :> reflector
+    text >lower [
+        CHAR: a mod dup special? [
+            ln 1 + ln!
+            cogs [ nth ] each reflector nth
+            cogs reverse [ index ] each CHAR: a +
+            cogs length iota [ 6 * 1 + ln mod zero? ] filter
+            cogs [ unclip prefix ] change-nths
+        ] unless
+    ] map ;

extra/enigma/summary.txt

@@ -0,0 +1 @@
+Enigma cipher machine