From 2a17c477368391968572ffd83048e03940af9006 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 1 Apr 2015 13:57:25 -0700
Subject: [PATCH] enigma: implementation of Enigma cipher machine.

---
 extra/enigma/authors.txt         |  1 +
 extra/enigma/enigma-tests.factor | 12 +++++++++
 extra/enigma/enigma.factor       | 46 ++++++++++++++++++++++++++++++++
 extra/enigma/summary.txt         |  1 +
 4 files changed, 60 insertions(+)
 create mode 100644 extra/enigma/authors.txt
 create mode 100644 extra/enigma/enigma-tests.factor
 create mode 100644 extra/enigma/enigma.factor
 create mode 100644 extra/enigma/summary.txt

diff --git a/extra/enigma/authors.txt b/extra/enigma/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/enigma/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/enigma/enigma-tests.factor b/extra/enigma/enigma-tests.factor
new file mode 100644
index 0000000000..3113b4c45e
--- /dev/null
+++ b/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
diff --git a/extra/enigma/enigma.factor b/extra/enigma/enigma.factor
new file mode 100644
index 0000000000..e70930a183
--- /dev/null
+++ b/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 ;
diff --git a/extra/enigma/summary.txt b/extra/enigma/summary.txt
new file mode 100644
index 0000000000..f6a5f98669
--- /dev/null
+++ b/extra/enigma/summary.txt
@@ -0,0 +1 @@
+Enigma cipher machine