Richard Suchenwirth 2003-05-04 - Reading Fred B. Wrixon's "Codes, cyphers & other...", I wanted to try out some simple encryption techniques in Tcl. To start, here is transposition: rearrange the letters in a fixed-length substring, e.g.

 transpose "world" 53214 -> drowl

The pattern may be any string of non-repeating characters, because each of them will be used as variable name. This is quite a braintwister impossible in other languages: the pattern e.g. 3142 is split into the list "3 1 4 2", which is used as names of four variables to take four characters from the split input; the sorted list is iterated over again, and, by double dereferencing, the values of the variables are appended to the result in sorted order.

Decoding ("detransposition" of) the resulting string goes simply by setting the third (optional) argument to numeric nonzero, e.g. 1.

This is only a mild encryption, as the characters of the input text are kept (so frequency statistics of single characters has no problems); best combine it with a substitution, e.g. Caesar.

 proc transpose {string pattern {decode 0}} {
    set lpat [string length $pattern]
    append string [string repeat " " [expr {$lpat-[string length $string]%$lpat}]]
    set patlist [split $pattern ""]
    if !$decode {
       set in [lsort $patlist]
       set out $patlist
    } else {
       set in $patlist
       set out [lsort $patlist]
    }
    set res ""
    foreach $in [split $string ""] {
       foreach pat $out {
          append res [set $pat]
       }
    }
    set res
 }

Testing:

 % transpose "secret message" 3142
 csre emtseas g e
 % transpose [transpose "secret message" 3142] 3142 1
 secret message

---

Another snippet for substitution: the following does an XOR for corresponding characters of message and key (the key being repeated as often as necessary). It is involutory, the same operation brings you the original message back. And if the key is at least as long as the message, and changed every time, this is a one-time pad encryption that is impossible to decrypt:

 proc superimpose {string key} {
   set lkey [string length $key]
   set n [expr {[string length $string]/$lkey}]
   if $n {set key [string repeat $key [incr n]]}
   set res ""
   foreach c [split $string ""] k [split $key ""] {
       if {$c==""} break
       append res [format %c [expr {[scan $c %c]^[scan $k %c]}]]
   }
   set res
 }

 % superimpose [superimpose "secret message" hello] hello
 secret message

---