2006-08
   Xah
   xah@xahlee.org
 ∑ http://xahlee.org/

init

The following packages can be found on http://xahlee.org/

Needs["PlaneTiling`"]

Needs["Transform2DPlot`"]

Clear[ WindowPolygon];
WindowPolygon::"usage"="WindowPolygon[p_Polygon, s] will cut a Polygon p open by the scale of 0<s<1. WindowPolygon[gra,s] will cut every Polygon in gra. Usage Example: Needs[\"Graphics`Shapes`\"];Show[Graphics3D[WindowPolygon[Sphere[1,10,8],.7]]]";
WindowPolygon[ poly_Polygon ,scale_]:= Module[{centerP,pts1,pts2},
		pts1=First@ poly;centerP=(Plus@@pts1)/Length@pts1;
		pts2=((#-centerP)scale+centerP) &/@ pts1;Polygon/@ Thread[{pts1,RotateLeft[pts1],RotateLeft[pts2],pts2}]];
WindowPolygon[ g_,scale_]:=g/.l_Polygon:>WindowPolygon[l,scale];

Clear[CenterTrianglizePolygon];
CenterTrianglizePolygon::"usage"="CenterTrianglizePolygon[gra] breaks Polygon in gra into triangles metting at the center of each Polygon. Usage Example: Show[Graphics3D[CenterTrianglizePolygon@Sphere[1,10,8]]]";

CenterTrianglizePolygon[p_Polygon]:=Module[{centerP,pts},pts=First@ p;centerP=(Plus@@pts)/Length@pts;
		Polygon[(#-centerP)scale+centerP &/@ pts];Polygon/@(Join[{centerP},#]&/@Partition[Append[pts,First@pts],2,1])];CenterTrianglizePolygon[g_]:=g/.p_Polygon:>CenterTrianglizePolygon@p;

SetOptions[Graphics,AspectRatio->Automatic,Frame->True]

Show[gra=(Transform2DGraphics[#*.11&])@Graphics[{ColoredLatticeNetwork[3,13,{{Hue[.7], Hue[0],Hue[.35]}}]/.{{Hue[.7|.35],li_Line}->{}}}],AspectRatio->Automatic,Frame->True]

rs=StereographicProjectionPlot3D[gra]

Show[gra=(Transform2DGraphics[#*.9&])@Graphics[{LineTransform[(DirectedLatticeNetwork[3,5,{{True,False}}]),ArrowMotif[{{.5,.4}},.6,0]]}]]

rs=StereographicProjectionPlot3D[gra]

Show[gra=Graphics[{StainedGlassMotif[6,1,0.5`,{20,15}]/.p_Polygon:>{RGBColor[RandomReal[],RandomReal[],RandomReal[]],p}}],AspectRatio->Automatic]

Show[gra=(WindowPolygon[#,.7]&)@(Transform2DGraphics[(#+{-12.5,-11})*1/5&])@gra,AspectRatio->Automatic]

rs=StereographicProjectionPlot3D[gra,PlotRange->All]

Show[gra=Graphics[{StainedGlassMotif[6,1,0,{10,10}]/.p_Polygon:>{RGBColor[RandomReal[],RandomReal[],RandomReal[]],p}}],AspectRatio->Automatic]

Show[gra=(WindowPolygon[#,.5]&)@(WindowPolygon[#,.3]&)@(Transform2DGraphics[(#+{-9,-7})*.25&])@gra,AspectRatio->Automatic]

rs=StereographicProjectionPlot3D[gra,PlotRange->All]

e

Clear[tile1,tile2,gp];
tile1={{Hue[0],Polygon[{{0.25`,0.5`},{-0.25`,0.5`},{-0.25`,-0.5`},{0.25`,-0.5`}}]},{Hue[0.7`],Polygon[{{0.5`,0.25`},{0.5`,-0.25`},{-0.5`,-0.25`},{-0.5`,0.25`}}]}};
tile2=Reverse[tile1];
Show[GraphicsRow[{Graphics[{tile1},AspectRatio->Automatic],Graphics[{tile2},AspectRatio->Automatic]}]]
gp=ColoredLatticePoints[{1,0},{0,1},{1,1} 10,{{1,2,2},{2,1,1}}]/.{{1,Point[pt_]}->Translate2DGraphics[pt][tile1],{2,Point[pt_]}->Translate2DGraphics[pt][tile2]};
Show[Graphics[{gp}],AspectRatio->Automatic]

rs=StereographicProjectionPlot3D[Graphics@gp,PlotRange->All]

JavaView

Export graphics to file for JavaView

eP=3;
tt=OpenWrite["x.mgs"];
WriteString[tt,"Graphics3D["];
WriteString[tt,(StringReplace[#,", "->","]&)@ToString@NumberForm[SetPrecision[Chop[First@rs,10^-(eP+1)],eP],ExponentFunction->(If[-∞<#1<∞,Null,#1]&)]];
WriteString[tt,",Lighting->False]"];
Close@tt;