(*
Encryption algorithm
Mathematica code for
Joao Carlos Leandro da Silva,
"3D cryptography"
article published on my website:
www.rainbowofprimes.com
on 26/1/2014.
c. Joao Carlos Leandro da Silva
All Rights Reserved.
*)

(* For string s with length of string equal to one,
this algorithm will transform the given string into a constant three-dimensional figure, that is, the resulting figure will always be the same. *)

(* For string s with length of string greater than one,
this algorithm will transform the given string into a variable three-dimensional figure, that is, the resulting figure will always be different. *)

(* CODE *)

ClearAll["Global`*"]

(* Define encryption function *)

encryption[s_]:=(If[StringQ[s]&& StringLength[s]>0 ,code=ToCharacterCode[s],Print["Error! Invalid Input."]];

max=Length[code];
char=Map[IntegerString,code];
insert[u_String]:=StringInsert[u,"0",1];

r=1;While[r≤max,
If[StringLength[char[[r]]]==3,char[[r]]=char[[r]],char[[r]]=insert[char[[r]]]];
r++];char;

n=FromDigits[Apply[StringJoin,char]];
If[StringLength[s]==1,p=NextPrime[n^2+1,1],p=RandomPrime[{(10^5),(10^6)}]];
m=Mod[FromDigits[IntegerDigits[n,2]],p];
While[m==0|| m==1,m=Mod[FromDigits[IntegerDigits[n,2]],p=NextPrime[3p+1]]];
m;

number=IntegerDigits[m,2];
plus=IntegerDigits[m+1,2];
minus=IntegerDigits[m-1,2];
center=Append[PadLeft[number,First[Sort[Map[Length,{number,plus,minus}],Greater]]],0];right=Append[PadLeft[plus,First[Sort[Map[Length,{number,plus,minus}],Greater]]],0];left=Append[PadLeft[minus,First[Sort[Map[Length,{number,plus,minus}],Greater]]],0];

j=1;
adj=0;
seq={};
While[j≤Length[center]-1,
If[j==1&&First[Take[Transpose[{left,center,right}][[j]],{2,2}]]==1,
adj=Count[Transpose[{left,center,right}][[j]],1]+Count[Transpose[{left,center,right}][[j+1]],1]-1];
If[First[Take[Transpose[{left,center,right}][[j]],{2,2}]]==1,adj=Count[Transpose[{left,center,right}][[j-1]],1]+Count[Transpose[{left,center,right}][[j]],1]+Count[Transpose[{left,center,right}][[j+1]],1]-1,adj=0];
seq=Append[seq,adj];
j++];

If[Length[seq]>1&&First[seq]==0,seq=Drop[seq,1],seq=seq];

k=1;
rep={};
While[k≤Length[seq],
If[seq[[k]]==0,col={Opacity[0.0],Cuboid[{0,Length[seq]-k,0}]},
Which[seq[[k]]==1,col={Orange,Cuboid[{0,0,0}]},seq[[k]]==2,col={Red,Cuboid[{0,Length[seq]-k,0}],Red,Cuboid[{0,Length[seq]-k,1}]},seq[[k]]==3,col={Green,Cuboid[{0,Length[seq]-k,0}],Green,Cuboid[{0,Length[seq]-k,1}],Green,Cuboid[{0,Length[seq]-k,2}]},seq[[k]]==4,col={Lighter[Purple],Cuboid[{0,Length[seq]-k,0}],Lighter[Purple],Cuboid[{0,Length[seq]-k,1}],Lighter[Purple],Cuboid[{0,Length[seq]-k,2}],Lighter[Purple],Cuboid[{0,Length[seq]-k,3}]},
seq[[k]]==5,col={Yellow,Cuboid[{0,Length[seq]-k,0}],Yellow,Cuboid[{0,Length[seq]-k,1}],Yellow,Cuboid[{0,Length[seq]-k,2}],Yellow,Cuboid[{0,Length[seq]-k,3}],Yellow,Cuboid[{0,Length[seq]-k,4}]},seq[[k]]==6,col={Darker[Green],Cuboid[{0,Length[seq]-k,0}],Darker[Green],Cuboid[{0,Length[seq]-k,1}],Darker[Green],Cuboid[{0,Length[seq]-k,2}],Darker[Green],Cuboid[{0,Length[seq]-k,3}],Darker[Green],Cuboid[{0,Length[seq]-k,4}],Darker[Green],Cuboid[{0,Length[seq]-k,5}]},seq[[k]]==7,
col={Black,Cuboid[{0,Length[seq]-k,0}],Black,Cuboid[{0,Length[seq]-k,1}],Black,Cuboid[{0,Length[seq]-k,2}],Black,Cuboid[{0,Length[seq]-k,3}],Black,Cuboid[{0,Length[seq]-k,4}],Black,Cuboid[{0,Length[seq]-k,5}],Black,Cuboid[{0,Length[seq]-k,6}]},seq[[k]]==8,col={Brown,Cuboid[{0,Length[seq]-k,0}],Brown,Cuboid[{0,Length[seq]-k,1}],Brown,Cuboid[{0,Length[seq]-k,2}],Brown,Cuboid[{0,Length[seq]-k,3}],Brown,Cuboid[{0,Length[seq]-k,4}],Brown,Cuboid[{0,Length[seq]-k,5}],Brown,Cuboid[{0,Length[seq]-k,6}],Brown,Cuboid[{0,Length[seq]-k,7}]}]];
rep=Append[rep,col];
k++];

Graphics3D[rep])

(* EXAMPLE *)

(* Call the encryption function with input "Joao" *)

encryption["Joao"]