Playfair cipher: Difference between revisions

=={{header|REXX}}==

<lang rexx>/*REXX program implements a PLAYFAIR cypher (encryption & decryption).*/

arg oldK noX _ . '(' oldX

if oldK=='' | oldK==',' then oldK='Playfair example'

if noX=='' | noX==',' then noX='J'

if oldX ='' then oldX='Hide the gold in the tree stump!!' /*default.*/

say ' old cypher=' oldK

oldK=scrub(oldK) /*use only Latin alphabet letters*/

newX=scrub(oldX) /* " " " " " */

if _\=='' then call err 'too many arguments specified.'

if newX=='' then call err 'PHRASE is empty or has no letters'

if length(noX)\==1 then call err '"ommitted" letter must be only one letter'

if length(newK)<3 then call err 'cypher key is too short, must be > 1 character.'

if \isLet(noX) then call err '"omitted" letter must be a Latin alphabet letter.'

if pos(noX,oldX)\==0 then call err 'PHRASE can''t contain the "OMIT" character: ' noX

fill=space(translate('ABCDEFGHIJKLMNOPQRSTUVWXYZ',,noX),0)

/* [↑] remove the NOX character*/

newK= /* [↓] remove any duplicate chars*/

do j=1 for length(oldK); _=substr(oldK,j,1)

if pos(_,newK)==0 then newK=newK || _

end /*j*/

fill=space(translate(fill,,newK),0) /*remove any cypher characters. */

grid=left(newK || fill,26) /*use only the first 25 chars. */

say ' new cypher=' newK

say ' grid fill=' fill

say ' grid text=' grid

say ' old phrase=' oldX

say ' new phrase=' newX

say ' new digram=' digram(newX)

#=0

do row =1 for 5 /*build grid (individual cells).*/

do col=1 for 5; #=#+1; @.row.col=substr(grid,#,1)

if row==1 then @.0.col=@.1.col

if col==5 then @.row.6=@.row.1

if row==5 then @.6.col=@.1.col

if row==5 then @.0.col=@.5.col

if col==5 then @.row.0=@.row.5

end /*col*/

end /*row*/

say

cText=.playfair(newX, 1); say ' cypher text=' digram(cText)

pText=.playfair(cText,0); say ' plain text=' digram(pText)

exit /*stick a fork in it, we're done.*/

/*──────────────────────────────────one-line subroutines────────────────*/

@@: parse arg Xrow,Xcol; return @.Xrow.Xcol

err: say; say '***error!***' arg(1); say; exit 13

isLet: return datatype(arg(1),'Mixed')

row: ?=pos(arg(1),grid); Xpos=(?-1)//5+1; return (4+?)%5

/*──────────────────────────────────LR subroutine───────────────────────*/

LR: L=left(__,1); R=right(__,1); len=length(__)

rowL=row(L); colL=Xpos; rowR=row(R); colR=Xpos; return

/*──────────────────────────────────SCRUB subroutine────────────────────*/

scrub: procedure; arg stuff /*ARG capitalizes all arguments.*/

$=; do j=1 for length(stuff); _=substr(stuff,j,1)

if isLet(_) then $=$||_ /*only use Latin alphabet letters*/

end /*j*/

return $

/*──────────────────────────────────DIGRAM subroutine───────────────────*/

digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)

$=$ || substr(x,j,2)' '

end /*j*/

return strip($)

/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/

.playfair: parse arg T,encrypt; i=-1; if encrypt then i=1; $=

do k=1 while encrypt; _=substr(T,k,1); if _==' ' then leave

if _==substr(T,k+1,1) then T=left(T,k) || 'X' || substr(T,k+1)

end /*k*/

do j=1 by 2 to length(T); __=strip(substr(T,j,2)); call LR

if len==1 | L==R then __=L || 'X' /*append an "X" character, rule 1*/

call LR

select

when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/

when colL==colR then __=@@(rowL+i,colL )@@(rowR+i,colR) /*rule 3*/

otherwise __=@@(rowL, colR )@@(rowR, colL) /*rule 4*/

end /*select*/

call LR

$=$ || __

end /*j*/

return $</lang>

'''output''' when using the default inputs:

<pre style="overflow:scroll">

old cypher= Playfair example

new cypher= PLAYFIREXM

grid fill= BCDGHKNOQSTUVWZ

grid text= PLAYFIREXMBCDGHKNOQSTUVWZ

old phrase= Hide the gold in the tree stump!!

new phrase= HIDETHEGOLDINTHETREESTUMP

cypher text= DN EF NH FH aI IP NN DF II HK HK II Iy

plain text= HI DE HC EG PL DI NN HE NI EN EN NI MP

</pre>