STEREOGRAPHIC PROJECTIONS

DEFINITIONS

stereo[{x_,y_,z_}]:={y,z}/(Norm[{x,y,z}]+x)

sphereSP=Show[Graphics3D[{
GrayLevel[0.5],Opacity[0.15],
Sphere[{0,0,0},1],Opacity[0.3],
Polygon[{{0,1,1},{0,1,-1},{0,-1,-1},{0,-1,1}}],
Black,Opacity[1],PointSize[0.025],
Point[{-1,0,0}],Text["(100)",{1,0,0}],
Text["(010)",{0,1,0}],
Text["(001)",{0,0,1}]
}
],ParametricPlot3D[{{0,Cos[t],Sin[t]},{Cos[t],Sin[t],0},{Cos[t],0,Sin[t]}},{t,0,2Pi},PlotStyle->Directive[Thin,Black]],
Lighting->"Neutral",Boxed->False
];

StereoPlot[{h_,k_,l_}]:=GraphicsRow[
{Show[
sphereSP,Graphics3D[
{Black,Thickness[0.005],PointSize[0.025],
Dashing[{}],
Line[{{0,0,0},{h,k,l}}],
Opacity[0.5],Dashed,Line[{{-1,0,0},{-1,0,0}+({h,k,l}/Norm[{h,k,l}]-{-1,0,0})}],
Opacity[1],
Point[{h,k,l}/Norm[{h,k,l}]],
Text["("<>ToString[h]<>","<>ToString[k]<>","<>ToString[l]<>")",{h,k,l}/Norm[{h,k,l}]*1.,{-1,-1}],
Blue,
Point[Prepend[stereo[{h,k,l}],0]]
}
],PlotRange->{{-1,1},{-1,1},{-1,1}}*1.02],
Show[Graphics[{Black,Thickness[0.005],PointSize[0.025],
Circle[{0,0},1],
Point[stereo[{1,0,0}]],Text["(1,0,0)",stereo[{1,0,0}],{0,-1}],
Point[stereo[{0,0,1}]],Text["(0,0,1)",stereo[{0,0,1}],{0,-1}],
Point[stereo[{0,1,0}]],Text["(0,1,0)",stereo[{0,1,0}],{-1,-1}],
Text["("<>ToString[h]<>","<>ToString[k]<>","<>ToString[l]<>")",stereo[{h,k,l}],{-1,-1}],
Blue,Point[stereo[{h,k,l}]]
}],
Frame->False,Axes->False,PlotRange->All
]
},ImageSize->8*72]

StereoPlot[{1,1,1}]

sppoint[{h_,k_,l_}]:={Text["("<>ToString[h]<>","<>ToString[k]<>","<>ToString[l]<>")",stereo[{h,k,l}],{-1,-1}],
Blue,Point[stereo[{h,k,l}]]}

pt=Show[Graphics[{Black,Thickness[0.005],PointSize[0.025],
Circle[{0,0},1],
Point[stereo[{1,0,0}]],Text["(1,0,0)",stereo[{1,0,0}],{0,-1}],
Point[stereo[{0,0,1}]],Text["(0,0,1)",stereo[{0,0,1}],{0,-1}],
Point[stereo[{0,1,0}]],Text["(0,1,0)",stereo[{0,1,0}],{-1,-1}],
sppoint/@{{1,1,1},{1,3,0},{1,1,0},{0,1,1},{1,0,1},{3,1,1},{2,2,1}}
}],
Frame->False,Axes->False,PlotRange->All
]

interactive

Manipulate[
StereoPlot[{h,k,l}],
{{h,1},0,10,1,Appearance->"Labeled"},{{k,1},0,10,1,Appearance->"Labeled"},{{l,1},0,10,1,Appearance->"Labeled"},SaveDefinitions->True
]

WULFF CONSTRUCTION

DEFINITIONS

g[{a_,b_,c_},{d_,e_,f_},th_]:=(1+(a*(Cos[th]^2)^d+b*(Cos[2 th]^2)^e+c (Cos[3*th]^2)^f))/(1+a+b+c)

Module[{p},
WulffPlot[g_,{a_,b_,c_},{d_,e_,f_},n_:120,draw_:True]:=Show[Graphics[{Thin,Black,Opacity[0.75],If[draw,Table[p={Cos[t],Sin[t]}*g[{a,b,c},{d,e,f},t];
Line[{p-{Sin[t],-Cos[t]}*1,p+{Sin[t],-Cos[t]}*1}],{t,0,2Pi,2Pi/n}],{}] }],
PolarPlot[g[{a,b,c},{d,e,f},x],{x,0,2Pi},PlotStyle->Directive[Blue,Thick],PlotPoints->200
],PlotRange->{{-1,1},{-1,1}}*1.1,ImageSize->7*72]
]

e=Show[WulffPlot[g,{1,6,3},{0.5,0.3,0.5},600,False],PlotRange->{{-1.1,1.1},{-0.8,0.8}}]

Export["/tmp/wulff.pdf",e]

interactive

Manipulate[WulffPlot[g,{a,b,c},{d,e,f},n,draw],
{{a,1,"γ par. 1"},0.1,10},{{b,2,"γ par. 2"},0.1,10},{{c,2,"γ par. 3"},0.1,10},
{{d,1,"γ par. 4"},0.5,10},{{e,1,"γ par. 5"},0.5,10},{{f,1,"γ par. 6"},0.5,10},
{{draw,True,"Draw Wulff construction"},{True,False}},
{{n,240,"Number of lines"},120,1200,120},SaveDefinitions->True
]