86 lines
2.6 KiB
Tcl
86 lines
2.6 KiB
Tcl
package require TclOO
|
|
|
|
oo::class create Playfair {
|
|
variable grid lookup excluder
|
|
constructor {{keyword "PLAYFAIR EXAMPLE"} {exclude "J"}} {
|
|
# Tweaking according to exact operation mode
|
|
if {$exclude eq "J"} {
|
|
set excluder "J I"
|
|
} else {
|
|
set excluder [list $exclude ""]
|
|
}
|
|
|
|
# Clean up the keyword source
|
|
set keys [my Clean [append keyword "ABCDEFGHIJKLMNOPQRSTUVWXYZ"]]
|
|
|
|
# Generate the encoding grid
|
|
set grid [lrepeat 5 [lrepeat 5 ""]]
|
|
set idx -1
|
|
for {set i 0} {$i < 5} {incr i} {for {set j 0} {$j < 5} {} {
|
|
if {![info exist lookup([set c [lindex $keys [incr idx]]])]} {
|
|
lset grid $i $j $c
|
|
set lookup($c) [list $i $j]
|
|
incr j
|
|
}
|
|
}}
|
|
|
|
# Sanity check
|
|
if {[array size lookup] != 25} {
|
|
error "failed to build encoding table correctly"
|
|
}
|
|
}
|
|
|
|
# Worker to apply a consistent cleanup/split rule
|
|
method Clean {str} {
|
|
set str [string map $excluder [string toupper $str]]
|
|
split [regsub -all {[^A-Z]} $str ""] ""
|
|
}
|
|
|
|
# These public methods are implemented by a single non-public method
|
|
forward encode my Transform 1
|
|
forward decode my Transform -1
|
|
|
|
# The application of the Playfair cypher transform
|
|
method Transform {direction message} {
|
|
# Split message into true digraphs
|
|
foreach c [my Clean $message] {
|
|
if {![info exists lookup($c)]} continue
|
|
if {![info exists c0]} {
|
|
set c0 $c
|
|
} else {
|
|
if {$c0 ne $c} {
|
|
lappend digraphs $c0 $c
|
|
unset c0
|
|
} else {
|
|
lappend digraphs $c0 "X"
|
|
set c0 $c
|
|
}
|
|
}
|
|
}
|
|
if {[info exists c0]} {
|
|
lappend digraphs $c0 "Z"
|
|
}
|
|
|
|
# Encode the digraphs
|
|
set result ""
|
|
foreach {a b} $digraphs {
|
|
lassign $lookup($a) ai aj
|
|
lassign $lookup($b) bi bj
|
|
if {$ai == $bi} {
|
|
set aj [expr {($aj + $direction) % 5}]
|
|
set bj [expr {($bj + $direction) % 5}]
|
|
} elseif {$aj == $bj} {
|
|
set ai [expr {($ai + $direction) % 5}]
|
|
set bi [expr {($bi + $direction) % 5}]
|
|
} else {
|
|
set tmp $aj
|
|
set aj $bj
|
|
set bj $tmp
|
|
}
|
|
lappend result [lindex $grid $ai $aj][lindex $grid $bi $bj]
|
|
}
|
|
|
|
# Real use would be: return [join $result ""]
|
|
return $result
|
|
}
|
|
}
|