Blooming the Cube

JOR, 13Sep10; 21Mar11

This will be hacked a bit until I can see my way to a general formulation.

Blooming of Latin-cross unfolding of cube.
Using rotation functions.  All openings at same rate, from leaves to root.
Root will be fbot.

Face data structure?
	List of vertex coords
	List of edge lengths
	List of angles.
For this exercise, will only need the first, but perhaps should allow for extensions.
All orderings ccw w. normal pointing to exterior.
I guess I should index from 1 so that I don't have to confusingly sub 1 all over?  Yes. Try it.

Note: Degree converts from radians to degrees. 1/Degree does the reverse.

ResetGlobals[]:=Module[{},
v1={0,0,0};
v2={1,0,0};
v3={1,1,0};
v4={0,1,0};
v5={0,0,1};
v6={1,0,1};
v7={1,1,1};
v8={0,1,1};
(*Force real computation with N[] to avoid symbolic issues*)
Vertices={v1,v2,v3,v4,v5,v6,v7,v8}=N[{v1,v2,v3,v4,v5,v6,v7,v8}];
f1=bot={{v2,v1,v4,v3},{1,1,1,1},π/2{1,1,1,1}};
f2=front={{v1,v2,v6,v5},{1,1,1,1},π/2{1,1,1,1}};
f3=right={{v2,v3,v7,v6},{1,1,1,1},π/2{1,1,1,1}};
f4=back={{v3,v4,v8,v7},{1,1,1,1},π/2{1,1,1,1}};
f5=left={{v4,v1,v5,v8},{1,1,1,1},π/2{1,1,1,1}};
f6=top={{v5,v6,v7,v8},{1,1,1,1},π/2{1,1,1,1}};
Faces={f1,f2,f3,f4,f5,f6};
(*Overwrite those names with indices, so paths become more comprehensible*)
{bot,front,right,back,left,top}={1,2,3,4,5,6};
Print["Vertices and Faces reset."]
];
ResetGlobals[];

text=MapThread[Text[#1,#2]&,{Range[8],Vertices}];

This text variable only works at start.  Need more general mechanism.
Need to think of way to represent duplicate vertices.  Maybe add a list of vertex indices?  Just for id purposes.

ShowIt[showtext_:False]:=Module[{g,glist={}},
If[showtext,
glist={
{Opacity[0.5],Map[Polygon[#[[1]]]&,Faces]}
,text
},
glist={
{Opacity[0.5],Map[Polygon[#[[1]]]&,Faces]}
}
];
g=Graphics3D[glist
(*,Axes->True,AxesLabel->{"x","y","z"},*)
,Boxed->False
(*,PlotRange->{{-1,2},{-2,2},{-0.1,1.75}}*)
,PlotRange->{{-1,2},{-2.1,2},{-0.1,2}}
];
Return[g];
];
Print[ShowIt[True]];

Try this.  Make a list of edges and faces, both referenced by indices into Vertices and Faces lists.  A list of these lists will represent a ordering (postorder traversal?) of spanning tree, and will guide ordering of rotations.
Each path will be a list of {face#, {v#,v#}}.  Now the v# must be indices in that face list.
Order the edge endpoints so that ccw rotation blooms.

Rotate faces ultimately updates vertex coords in hose faces, overwrites.
Global Vertices no longer touched--that is only the start.
This function returns nothing; its effect is global, on the vertices in the Faces struct.
Takes as input a path of fepath fepairs, and rotates all in the path around the start edge.
So only one rotation, but carries along everything down the path with it.

Rotate1Faces[fepath_,δ_]:=Module[{vlist,rot,axis,pbase,fi,vi1,vi2,i,n},
(*Extract special info from 1st fepair*)
{fi,{vi1,vi2}}=fepath[[1]];
If[debug1,Print["Rotate1Faces:{fi,{vi1,vi2}}=",{fi,{vi1,vi2}}]];
vlist = Faces[[fi]][[1]];
pbase=vlist[[vi1]];
axis=vlist[[vi2]]-pbase;
rot=RotationTransform[δ,axis,pbase];
n=Length[fepath];
If[debug1,Print["Rotate1Faces: |fepath|=",n," {pbase,axis}=",{pbase,axis}]];
For[i=1,i≤n,i++,
{fi,{vi1,vi2}}=fepath[[i]];
vlist = Faces[[fi]][[1]];
vlist=Map[rot[#]&,vlist];
(*If[debug1,Print["Rotate1Faces: vlist=",N[vlist]]];*)
(*Overwrite new coords*)
Faces[[fi]][[1]]=vlist;
];(*For*)
];

ResetGlobals[];
debug1=True;
path1={{front,{1,2}},{top,{1,2}}};
path1={{right,{1,2}}};
Rotate1Faces[path1,10 Degree];
ShowIt[True]

Now rotate along entire path.
fepair={f#,{v#,v#}}.
Need to change to rotate a sequence of faces about a particular edge of one, the 1st in the sequence.  So, need to define a new struct.  Maybe this: path of fepairs, from the implied root down to a leaf: {1, 2, 6},
path1={{2,{1,2}},{6,{1,2}}};
So now RotatePath rotates all, then rotates cdr(all), then rotates cddr(all), etc.  Each by δ.

{bot, front, right, back, left, top} = {1, 2, 3, 4, 5, 6};

RotatePath[path_,δ_]:=Module[{i,n,fepath},
If[debug2,Print["RotatePath: path=",path]];
fepath=path; (*Copy b/c will cdr*)
While[Length[fepath]>0,
If[debug2,Print["RotatePath: fepath=",fepath]];
Rotate1Faces[fepath,δ];
(*Now work on tail*)
fepath=Rest[fepath]
];(*While*)
];

ResetGlobals[];
path1={{front,{1,2}},{top,{1,2}}};
debug2=True;
RotatePath[path1,45 Degree];ShowIt[False]

Working!  But realize that this will only work for all equal dihedral angles.  Because all the δ are the same, but they really need to be a fraction of the dihedral angle that needs opening.  So this will work for Platonic solids. OK for now.

Need to define entire unfolding paths.  Each must be a separate path, so watch {}'s.

{bot, front, right, back, left, top} = {1, 2, 3, 4, 5, 6};

Paths={
{{front,{1,2}},{top,{1,2}}},
{{right,{1,2}}},
{{back,{1,2}}},
{{left,{1,2}}}
};

RotateAllPaths[paths_,δ_]:=Module[{i,n},
n=Length[paths];
For[i=1,i≤n,i++,
If[debug3,Print["RotateAllPaths: i=",i," path=",paths[[i]]]];
RotatePath[paths[[i]],δ];
];(*For*)
];

ResetGlobals[];
debug1=False;debug2=debug3=True;
RotateAllPaths[Paths,30 Degree];ShowIt[False]
RotateAllPaths[Paths,30 Degree]ShowIt[False]

Define paths for Z-unfolding. (21Mar11)

Paths={
{{front,{1,2}},{top,{1,2}}, {right, {3,4}}},
{{back,{1,2}},{left,{4,1}}}
};

Working.  Now to figure out how to animate.

ResetGlobals[];
debug1=debug2=debug3=False;
ganim={};
n=20;
δ=(90 Degree)/n;
For[i=1,i≤n,i++,
RotateAllPaths[Paths,δ];
AppendTo[ganim,ShowIt[False]]
];
Print["|ganim|=",Length[ganim]];

Animate[ganim[[i]],{i,Range[n]}]

Directory[]

SetDirectory["/Users/orourke/Documents/Unfolding/Blooming/"]

Export["CubeUnfolding.gif",ganim]