三维立体画

原文地址：http://shuli.xianyungu.com/three-dimensional-painting-1541
项目地址：https://github.com/MmaOS/Autostereogram

数学函数+随机点

Remove["Global`*"];
width=100;(*单幅宽度*)
nw=6;(*单幅列数*)
height=100;(*单幅高度*)
nh=6;(*单幅行数*)

hxy[{r_,c_},{rr_,cc_}]:=Module[{x=Rescale[r,{1,rr},{-1,1}],y=Rescale[c,{1,cc},{-1,1}]},Floor[width/8(1+Sin[3. Pi x y])]];(*在r行c列处点的高度函数*)

pm0=Range[width];(*初始化点的位置信息*)

r=nh height;
Dynamic[Row[{ProgressIndicator[r/nh/height],"\t已完成：",Floor[100r/nh/height],"%"}]](*显示进度*)

randomPoint=RandomReal[height,{height,width,3}];(*随机生成单幅母板*)
pic=ArrayPlot[Table[
If[c==1,pm=pm0];randomPoint[[Mod[r,height,1],pm[[Mod[c,width,1]]]=pm[[Mod[c+hxy[{r,c},{nh height,nw width}],width,1]]]]],{r,nh height},{c,nw width}],ImageSize->{nw width,nh height}](*根据高度函数绘图，可以使用并行表函数ParallelTable替换这里的Table*)

Export["E:/Autostereogram.png",pic];

数学函数+随机点~动画

Remove["Global`*"];
width=100;(*单幅宽度*)
nw=6;(*单幅列数*)
height=100;(*单幅高度*)
nh=6;(*单幅行数*)

pm0=Range[width];(*初始化点的位置信息*)

t=(2/3);r=nh height;
Dynamic[Column[{Row[{ProgressIndicator[t/(2/3)],"\t总进度：",Floor[100t/(2/3)],"%"}],Row[{ProgressIndicator[r/nh/height],"\t子进度：",Floor[100r/nh/height],"%"}]}]](*显示进度*)

randomPoint=RandomReal[height,{height,width,3}];(*随机生成单幅母板*)

pics=Table[
hxy[{r_,c_},{rr_,cc_}]:=Module[{x=Rescale[r,{1,rr},{-1,1}],y=Rescale[c,{1,cc},{-1,1}]},Floor[width/8(1+Sin[3. Pi (x y+t)])]];(*在r行c列处点的高度函数*)
ArrayPlot[Table[
If[c==1,pm=pm0];randomPoint[[Mod[r,height,1],pm[[Mod[c,width,1]]]=pm[[Mod[c+hxy[{r,c},{nh height,nw width}],width,1]]]]],{r,nh height},{c,nw width}],ImageSize->{nw width,nh height}],{t,1/30,2/3,1/15}];(*根据高度函数绘图，可以使用并行表函数ParallelTable替换这里的Table*)
Export["E:/Autostereogram.gif",pics,"DisplayDurations"->0.1,"AnimationRepetitions"->Infinity];(*导出图像*)

数学函数+图像

Remove["Global`*"];
img=ImageData@Import["ExampleData/lena.tif"];
{height,width}=Dimensions[img][[;;2]];(*单幅高度，单幅宽度*)
nw=6;(*单幅列数*)
nh=6;(*单幅行数*)

hxy[{r_,c_},{rr_,cc_}]:=Module[{x=Rescale[r,{1,rr},{-1,1}],y=Rescale[c,{1,cc},{-1,1}]},Floor[width/8(1+Sin[3. Pi x y])]];(*在r行c列处点的高度函数*)

pm0=Range[width];(*初始化点的位置信息*)

r=nh height;
Dynamic[Row[{ProgressIndicator[r/nh/height],"\t已完成：",Floor[100r/nh/height],"%"}]](*显示进度*)

pic=ArrayPlot[Table[
If[c==1,pm=pm0];img[[Mod[r,height,1],pm[[Mod[c,width,1]]]=pm[[Mod[c+hxy[{r,c},{nh height,nw width}],width,1]]]]],{r,nh height},{c,nw width}],ImageSize->{nw width,nh height}]//ColorNegate(*根据高度函数绘图，可以使用并行表函数ParallelTable替换这里的Table*)
Export["E:/Autostereogram_picture.png",pic];

文字版

以大写英文输出文字 “闲”的三维立体画

width=12;(*单幅宽度*)nw=6;(*单幅列数*)height=50;(*单幅高度*)nh=1;(*单幅行数*)hxyData=ImageData[ColorNegate@Binarize[Rasterize["闲",RasterSize->height,ImageSize->{width nw,height nh},Background->White]]];(*在r行c列处点的高度函数*)pm0=Range[width];(*初始化点的位置信息*)r=nh height;
Dynamic[Row[{ProgressIndicator[r/nh/height],"\t已完成：",Floor[100 r/nh/height],"%"}]](*显示进度*)

randomPoint=RandomChoice[CharacterRange["A","Z"],{height nh,width}];(*随机生成单幅母板*)picString=Table[If[c==1,pm=pm0];
randomPoint[[Mod[r,height,1],pm[[Mod[c,width,1]]]=pm[[Mod[c+hxyData[[r,c]],width,1]]]]],{r,nh height},{c,nw width}];
picString=ArrayFlatten[{{randomPoint,picString}}];(*在字符块左侧加一列*)blankStr=StringJoin[ConstantArray[" ",Floor[width (nw+1)/2-width/2]]];(*空白字符串*)firstLine=blankStr<>"O"<>StringJoin[ConstantArray[" ",width-1]]<>"O"<>blankStr<>"\n";(*首行字符串*)firstLine<>StringRiffle[picString,"\n",""](*文字三维立体画*)