1 ! Copyright (C) 2011 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays ascii kernel locals math random
5 sequences sequences.extras vectors ;
9 : <alphabet> ( -- seq )
13 <alphabet> randomize ;
15 : <reflector> ( -- reflector )
16 <alphabet> dup length <iota> >vector [ dup empty? ] [
18 [ delete-random ] [ delete-random ] bi
23 TUPLE: enigma cogs prev-cogs reflector ;
25 : <enigma> ( num-cogs -- enigma )
26 [ <cog> ] replicate dup clone <reflector> enigma boa ;
28 : reset-cogs ( enigma -- enigma )
29 dup prev-cogs>> >>cogs ;
32 [ 25 > ] [ 0 < ] bi or ;
34 :: encode ( text enigma -- cipher-text )
37 enigma reflector>> :> reflector
39 CHAR: a mod dup special? [
41 cogs [ nth ] each reflector nth
42 cogs reverse [ index ] each CHAR: a +
43 cogs length <iota> [ 6 * 1 + ln mod zero? ] filter
44 cogs [ unclip prefix ] change-nths