Playfair cipher: Difference between revisions

Content added Content deleted
m (→‎{{header|REXX}}: added whitespace and changed some comments, made some statements easier to read, added literal constants for better reading.)
Line 2,194: Line 2,194:
=={{header|REXX}}==
=={{header|REXX}}==
Quite a bit of the REXX code deals with error checking, accepting arguments, and displaying the options used, and displaying input and output.
Quite a bit of the REXX code deals with error checking, accepting arguments, and displaying the options used, and displaying input and output.

<br>For ease of viewing and comparing, the output is in capitalized digraphs (which are really ''digrams'') as well as the original input(s).
For ease of viewing and comparing, the output is in capitalized digraphs (which are really ''digrams'') as well as the original input(s).
⚫
<br>Thanks to Walter Pachl, this program is now sensitive of using a suitable ''double character'' when &nbsp; '''X''' &nbsp; is present in the cipher key.

⚫
Thanks to Walter Pachl, this program is now sensitive of using a suitable ''double character'' when &nbsp; '''X''' &nbsp; is present in the cipher key.
<br>Also, more thanks are due to Walter Pachl for finding that the cipher key can't contain the OMIT character.
<br>Also, more thanks are due to Walter Pachl for finding that the cipher key can't contain the OMIT character.

<br>A fair amount of code was added to massage the decrypted encryption to remove doubled &nbsp; '''X'''es &nbsp; so as to match the original text
A fair amount of code was added to massage the decrypted encryption to remove doubled &nbsp; '''X'''es &nbsp; so as to match the original text
<br>(this is the ''possible text'' part of the REXX code).
<br>(this is the &nbsp; &nbsp; ''possible text'' &nbsp; &nbsp; part of the REXX code).
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption and decryption). */
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption and decryption). */
@abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc /*literals for lower and upper ABC's.*/
@abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc /*literals for lower and upper ABC's.*/
parse arg omit key '(' text /*TEXT is the phrase to be used. */
parse arg omit key '(' text /*TEXT is the phrase to be used. */
Line 2,208: Line 2,211:
if omit=='' | omit==',' then omit= 'J' /*the "omitted" character string. */
if omit=='' | omit==',' then omit= 'J' /*the "omitted" character string. */
if text='' then text= 'Hide the gold in the tree stump!!' /*default.*/
if text='' then text= 'Hide the gold in the tree stump!!' /*default.*/
⚫
upper omit @abcU /*uppercase OMIT characters & alphabet.*/
⚫
@cant= 'can''t contain the "OMIT" character: ' omit /*literal used in error text.*/
@uchars= 'unique characters.' /*a literal used below in an error msg.*/
newKey = scrub(key, 1) /*scrub old cipher key ──► newKey */
newKey = scrub(key, 1) /*scrub old cipher key ──► newKey */
newText= scrub(text ) /* " " text ──► newText */
newText= scrub(text ) /* " " text ──► newText */
Line 2,213: Line 2,219:
if length(omit)\==1 then call err 'OMIT letter must be only one letter.'
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.'
if \datatype(omit, 'M') then call err 'OMIT letter must be a Latin alphabet letter.'
⚫
upper omit @abcU /*uppercase OMIT characters & alphabet.*/
⚫
@cant= 'can''t contain the "OMIT" character: ' omit /*literal used in error text*/
if pos(omit, newText)\==0 then call err 'TEXT' @cant
if pos(omit, newText)\==0 then call err 'TEXT' @cant
if pos(omit, newKey) \==0 then call err 'cipher key' @cant
if pos(omit, newKey) \==0 then call err 'cipher key' @cant
Line 2,220: Line 2,224:
xx= 'X' /*character used for double characters.*/
xx= 'X' /*character used for double characters.*/
if omit==xx then xx= 'Q' /* " " " " " */
if omit==xx then xx= 'Q' /* " " " " " */
if length(newKey)<3 then call err ,
if length(newKey)<3 then call err 'cipher key is too short, must be ≥ 3' @uchars
'cipher key is too short, must be ≥ 3 unique characters.'
fill= space( translate(fill, , newKey), 0) /*remove any cipher characters. */
fill= space( translate(fill, , newKey), 0) /*remove any cipher characters. */
grid= newKey || fill /*only first 25 characters are used. */
grid= newKey || fill /*only first 25 characters are used. */
Line 2,231: Line 2,234:
padL= 14 + 2
padL= 14 + 2
call show 'cleansed', newText
call show 'cleansed', newText
#=0 /*number of grid characters used. */
#= 0 /*number of grid characters used. */
do row =1 for 5 /*build array of individual cells. */
do row =1 for 5 /*build array of individual cells. */
do col=1 for 5; #= # + 1; @.row.col= substr(grid, #, 1)
do col=1 for 5; #= # + 1; @.row.col= substr(grid, #, 1)
Line 2,260: Line 2,263:
show: arg ,y; say; say right(arg(1) 'text: ',padL) digram(y); say pad space(y, 0); return
show: arg ,y; say; say right(arg(1) 'text: ',padL) digram(y); say pad space(y, 0); return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
.Playfair: arg T,encrypt; i= -1; if encrypt==1 then i= 1; $=
.Playfair: arg T,encrypt; i= -1; if encrypt==1 then i= 1; $=
do k=1 while i==1; _= substr(T, k, 1); if _==' ' then leave
do k=1 while i==1; _= substr(T, k, 1); if _==' ' then leave
if _==substr(T, k+1, 1) then T= left(T, k) || Lxx || substr(T, k + 1)
if _==substr(T, k+1, 1) then T= left(T, k) || Lxx || substr(T, k + 1)
end /*k*/
end /*k*/
upper T
upper T
do j=1 by 2 to length(T); __= strip( substr(T, j, 2) )
do j=1 by 2 to length(T); __= strip( substr(T, j, 2) )
if LR()==1 then __= __ || xx; call LR /*append X or Q char, rule 1*/
if LR()==1 then __= __ || xx; call LR /*append X or Q char, rule 1*/
select
select /*rule*/
when rowL==rowR then __= @@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
when rowL==rowR then __= @@(rowL, colL+i)@@(rowR, colR+i) /*2*/
when colL==colR then __= @@(rowL+i, colL )@@(rowR+i, colR) /*rule 3*/
when colL==colR then __= @@(rowL+i, colL )@@(rowR+i, colR) /*3*/
otherwise __= @@(rowL, colR )@@(rowR, colL) /*rule 4*/
otherwise __= @@(rowL, colR )@@(rowR, colL) /*4*/
end /*select*/
end /*select*/
$= $ || __
$= $ || __
end /*j*/
end /*j*/
return $
return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
digram: procedure; parse arg x,,$; do j=1 by 2 to length(x)
$= $ || substr(x, j, 2)' '
$= $ || substr(x, j, 2)' '
end /*j*/
end /*j*/
return strip($)
return strip($)
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
Line 2,284: Line 2,287:
$=; do j=1 for length(xxx); _= substr(xxx, j, 1)
$=; do j=1 for length(xxx); _= substr(xxx, j, 1)
if unique==1 then if pos(_, $)\==0 then iterate /*is unique?*/
if unique==1 then if pos(_, $)\==0 then iterate /*is unique?*/
if datatype(_, 'M') then $= $ || _ /*only use Latin letters. */
if datatype(_, 'M') then $= $ || _ /*only use Latin letters. */
end /*j*/
end /*j*/
return $</lang>
return $</lang>
Retrieved from "https://rosettacode.org/wiki/Playfair_cipher"