Playfair cipher: Difference between revisions
Content added Content deleted
(→{{header|REXX}}: extended the REXX pgm to allow a multi-word cipher (which necessitated changing the order of the 1st two variables). -- ~~~~) |
Walterpachl (talk | contribs) (added ooRexx) |
||
Line 138: | Line 138: | ||
HI DE TH EG OL DI NT HE TR EX ES TU MP |
HI DE TH EG OL DI NT HE TR EX ES TU MP |
||
</pre> |
</pre> |
||
=={{header|ooRexx}}== |
|||
<lang oorexx>/*--------------------------------------------------------------------- |
|||
* REXX program implements a PLAYFAIR cipher (encryption & decryption). |
|||
* 11.11.2013 Walter Pachl revamped, for ooRexx, the REXX program |
|||
* the logic of which was devised by Gerard Schildberger |
|||
* Invoke as rexx pf O abcd efgh ( phrase to be processed |
|||
* Defaults: 'Playfair example.' |
|||
* J |
|||
* 'Hide the gold in the tree stump' |
|||
* Major changes: avoid language elements not allowed in ooRexx |
|||
* show use of a.[expr1,expr2] |
|||
* allow key to be more than one word |
|||
* add restriction of using X or Q in text |
|||
* 12.11.2013 change order of arguments |
|||
* and comment the use of a.[expr1,expr2] |
|||
* Program should run on all Rexxes that have changestr-bif |
|||
*--------------------------------------------------------------------*/ |
|||
Parse Upper Version v |
|||
oorexx=pos('OOREXX',v)>0 |
|||
Parse Arg omit oldk '(' text |
|||
If omit='' Then omit='J' |
|||
If oldk='' Then oldk='Playfair example.' |
|||
If text='' Then text='Hide the gold in the tree stump!!' |
|||
newkey=scrub(oldk,1) |
|||
newtext=scrub(text) |
|||
If newtext=='' Then Call err 'TEXT is empty or has no letters' |
|||
If length(omit)\==1 Then Call err 'OMIT letter must be only one letter' |
|||
If\datatype(omit,'M') Then Call err 'OMIT letter must be a Latin alphabet letter.' |
|||
omit=translate(omit) |
|||
cant='must not contain the "OMIT" character: ' omit |
|||
If pos(omit,newtext)\==0 Then Call err 'TEXT' cant |
|||
If pos(omit,newkey)\==0 Then Call err 'cipher key' cant |
|||
abc='abcdefghijklmnopqrstuvwxyz' |
|||
abcu=translate(abc) /* uppercase alphabet */ |
|||
abcx=space(translate(abcu,,omit),0) /*elide OMIT char from alphabet */ |
|||
xx='X' /* char used for double characters*/ |
|||
If omit==xx Then |
|||
xx='Q' |
|||
If pos(xx,newtext)>0 Then |
|||
Call err 'Sorry,' xx 'is not allowed in text' |
|||
If length(newkey)<3 Then |
|||
Call err 'cipher key is too short, must be at least 3 different letters' |
|||
abcx=space(translate(abcx,,newkey),0) /*remove any cipher characters */ |
|||
grid=newkey||abcx /* only first 25 chars are used*/ |
|||
Say 'old cipher key: ' strip(oldk) |
|||
padl=14+2 |
|||
pad=left('',padl) |
|||
Say 'new cipher key: ' newkey |
|||
padx=left('',padl,"-")'Playfair' |
|||
Say ' omit char: ' omit /* [?] lowercase of double char. */ |
|||
Say ' double char: ' xx |
|||
lxx=translate(xx,abc,abcu) |
|||
Say ' original text: ' strip(text)/* [?] doubled version of Lxx. */ |
|||
Call show 'cleansed',newtext |
|||
lxxlxx=lxx||lxx |
|||
n=0 /* number of grid characters used.*/ |
|||
Do row=1 For 5 /* build array of individual cells*/ |
|||
Do col=1 For 5 |
|||
n=n+1 |
|||
a.row.col=substr(grid,n,1) |
|||
If row==1 Then |
|||
a.0.col=a.1.col |
|||
If col==5 Then Do |
|||
a.row.6=a.row.1 |
|||
a.row.0=a.row.5 |
|||
End |
|||
If row==5 Then Do |
|||
a.6.col=a.1.col |
|||
a.0.col=a.5.col |
|||
End |
|||
End |
|||
End |
|||
etext=playfair(newtext,1) |
|||
Call show 'encrypted',etext |
|||
ptext=playfair(etext,-1) |
|||
Call show 'plain',ptext |
|||
qtext=changestr(xx||xx,ptext,lxx) /*change doubled doublechar-?sing*/ |
|||
qtext=changestr(lxx||xx,qtext,lxxlxx) /*change Xx --? lowercase dblChar*/ |
|||
qtext=space(translate(qtext,,xx),0) /*remove char used for "doubles."*/ |
|||
qtext=translate(qtext) /*reinstate the use of upperchars*/ |
|||
Call show 'decoded',qtext |
|||
Say ' original text: ' newtext /* ·· and show the original text.*/ |
|||
Say '' |
|||
Exit |
|||
playfair: |
|||
/*--------------------------------------------------------------------- |
|||
* encode (e=1) or decode (e=-1) the given text (t) using the grid |
|||
*--------------------------------------------------------------------*/ |
|||
Arg t,e |
|||
d='' |
|||
If e=1 Then Do |
|||
Do k=1 By 1 Until c='' |
|||
c=substr(t,k,1) |
|||
If substr(t,k+1,1)==c Then |
|||
t=left(t,k)||lxx||substr(t,k+1) |
|||
End |
|||
End |
|||
t=translate(t) |
|||
Do j=1 By 2 To length(t) |
|||
c2=strip(substr(t,j,2)) |
|||
If length(c2)==1 Then |
|||
c2=c2||xx /* append X or Q char, rule 1*/ |
|||
Call LR |
|||
Select |
|||
/*- This could/should be used on ooRexx ------------------------- |
|||
When rowl==rowr Then c2=a.[rowl,coll+e]a.[rowr,colr+e] /*rule 2*/ |
|||
When coll==colr Then c2=a.[rowl+e,coll]a.[rowr+e,colr] /*rule 3*/ |
|||
*--------------------------------------------------------------*/ |
|||
When rowl==rowr Then c2=aa(rowl,coll+e)aa(rowr,colr+e) /*rule 2*/ |
|||
When coll==colr Then c2=aa(rowl+e,coll)aa(rowr+e,colr) /*rule 3*/ |
|||
Otherwise c2=a.rowl.colr||a.rowr.coll /*rule 4*/ |
|||
End |
|||
d=d||c2 |
|||
End |
|||
Return d |
|||
aa: |
|||
/*--------------------------------------------------------------------- |
|||
* ooRexx allows to use a.[rowl,coll+e] |
|||
* this function can be removed when ooRexx syntax is used to access a. |
|||
*--------------------------------------------------------------------*/ |
|||
Parse Arg xrow,xcol |
|||
Return a.xrow.xcol |
|||
err: |
|||
/*--------------------------------------------------------------------- |
|||
* Exit with an error message |
|||
*--------------------------------------------------------------------*/ |
|||
Say |
|||
Say '***error!***' arg(1) |
|||
Say |
|||
Exit 13 |
|||
lr: |
|||
/*--------------------------------------------------------------------- |
|||
* get grid positions of the 2 characters |
|||
*--------------------------------------------------------------------*/ |
|||
Parse Value rowcol(left(c2,1)) with rowl coll |
|||
Parse Value rowcol(right(c2,1)) with rowr colr |
|||
Return |
|||
rowcol: procedure Expose grid |
|||
/*--------------------------------------------------------------------- |
|||
* compute row and column of the given character in the 5x5 grid |
|||
*--------------------------------------------------------------------*/ |
|||
Parse Arg c |
|||
p=pos(c,grid) |
|||
col=(p-1)//5+1 |
|||
row=(4+p)%5 |
|||
Return row col |
|||
show: |
|||
/*--------------------------------------------------------------------- |
|||
* Show heading and text |
|||
*--------------------------------------------------------------------*/ |
|||
Arg,y |
|||
Say |
|||
Say right(arg(1) 'text: ',padl) digram(arg(2)) |
|||
result=space(arg(2),0) |
|||
If arg(1)='decoded' Then Do |
|||
result=strip(result,'T',xx) |
|||
End |
|||
Say pad result |
|||
Return |
|||
scrub: Procedure |
|||
/*--------------------------------------------------------------------- |
|||
* Remove all non-letters from the given string, uppercase letters |
|||
* and, if unique=1 remove duplicates |
|||
* 'aB + c1Bb' -> 'ABCBB' or 'ABC', respectively |
|||
*--------------------------------------------------------------------*/ |
|||
Arg xxx,unique /* ARG caps all args */ |
|||
d='' |
|||
used.=0 |
|||
Do While xxx<>'' |
|||
Parse Var xxx c +1 xxx |
|||
If datatype(c,'U') Then |
|||
If (unique=1 & pos(c,d)=0) |, |
|||
unique<>1 Then |
|||
d=d||c |
|||
End |
|||
Return d |
|||
digram: Procedure |
|||
/*--------------------------------------------------------------------- |
|||
* Return the given string as character pairs separated by blanks |
|||
* 'ABCDEF' -> 'AB CD EF' |
|||
* 'ABCDE' -> 'AB CD E' |
|||
*--------------------------------------------------------------------*/ |
|||
Parse Arg x |
|||
d='' |
|||
Do j=1 By 2 To length(x) |
|||
d=d||substr(x,j,2)' ' |
|||
End |
|||
Return strip(d)</lang> |
|||
Output (sample): |
|||
<pre>old cipher key: this is my little key |
|||
new cipher key: THISMYLEK |
|||
omit char: X |
|||
double char: Q |
|||
original text: to be or not to bee |
|||
cleansed text: TO BE OR NO TT OB EE |
|||
TOBEORNOTTOBEE |
|||
encrypted text: IJ DY JV OP MJ IJ DY OA JJ |
|||
IJDYJVOPMJIJDYOAJJ |
|||
plain text: TO BE OR NO TQ TO BE QE QQ |
|||
TOBEORNOTQTOBEQEQQ |
|||
decoded text: TO BE OR NO TT OB EE Q |
|||
TOBEORNOTTOBEE |
|||
original text: TOBEORNOTTOBEE</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |