Bacon cipher: Difference between revisions

Content added Content deleted
No edit summary
No edit summary
Line 1,004:
LETSHAUESOMEFUNWITHBACONCIPHER
</pre>
 
=={{header|Common Lisp}}==
 
====Association tables====
 
Work in progress
 
1. Note
 
Masks are stored in association lists.
 
<pre>#\x -> assoc -> mask -> rassoc -> #\x</pre>
 
For instance.
 
<pre>(cdr (assoc #\a +abc+)) = (A A A A A) (car (rassoc '(A A A A A) +abc+) = #\a </pre>
 
2. Program
 
<lang lisp>;; 22.06.14
 
(defconstant +abc+
'((#\a . (A A A A A)) (#\b . (A A A A B)) (#\c . (A A A B A))
(#\d . (A A A B B)) (#\e . (A A B A A)) (#\f . (A A B A B))
(#\g . (A A B B A)) (#\h . (A A B B B)) (#\i . (A B A A A))
(#\j . (A B A A B)) (#\k . (A B A B A)) (#\l . (A B A B B))
(#\m . (A B B A A)) (#\n . (A B B A B)) (#\o . (A B B B A))
(#\p . (A B B B B)) (#\q . (B A A A A)) (#\r . (B A A A B))
(#\s . (B A A B A)) (#\t . (B A A B B)) (#\u . (B A B A A))
(#\v . (B A B A B)) (#\w . (B A B B A)) (#\x . (B A B B B))
(#\y . (B B A A A)) (#\z . (B B A A B)) (#\space . (B B B A A))))
 
(defun encode (txt msg &optional mask)
(let (cipher)
(setf msg (string-downcase msg))
(loop for c across msg do
(setf mask (append mask (cdr (assoc c +abc+)))))
(setf txt (string-downcase txt))
(loop for c across txt always mask do
(when (alpha-char-p c)
(when (eq (car mask) 'B)
(setf c (char-upcase c)))
(setf mask (cdr mask)))
(setf cipher (append cipher (list c))))
(return-from encode (coerce cipher 'string)))))
 
(defun decode (txt)
(let (key mask)
(setf txt (remove-if-not 'alpha-char-p txt))
(loop for c across txt do
(if (lower-case-p c)
(setf mask (append mask '(A)))
(setf mask (append mask '(B))))
(when (= (length mask) 5)
(setf key (append key (list (car (rassoc mask +abc+ :test #'equal)))))
(setf mask nil)))
(return-from decode (coerce key 'string))))</lang>
 
3. Example
 
<pre>(defconstant +monologue-plaintext+ (concatenate 'string
"I've known adventures, seen places you people will never see, I've been Offw"
"orld and back... frontiers ! I've stood on the back deck of a blinker bound "
"for the Plutition Camps with sweat in my eyes watching stars fight on the sh"
"oulder of Orion... I’ve felt wind in my hair, riding test boats off the blac"
"k galaxies and seen an attack fleet burn like a match and disappear. I've se"
"en it, felt it..."))
 
(defconstant +monologue-ciphertext+ (concatenate 'string
"I'VE knOwn ADveNtures, seEn plACes YoU PEoplE will NEvER SEe, i'Ve beEn offw"
"oRld anD BaCK... FRon"))
 
(defconstant +monologue-key+
"« Tears in rain »")</pre>
 
4. Execution
 
{{out}}
<pre>(encode +monologue-plaintext+ +monologue-key+)
"I'VE knOwn ADveNtures, seEn plACes YoU PEoplE will NEvER SEe, i'Ve beEn offwoRl
d anD BaCK... FRon"
(decode +monologue-ciphertext+)
" tears in rain "</pre>
 
That's All Folks !
 
''cyril nocton (cyril.nocton@gmail.com)''
 
=={{header|D}}==