(*
Simple app to visualise the polytopal rearrangements for any great circle in the 2-spherical, (Subscript[AB, 4]) T-4 E-mode configuration space
*)
(*
Analytic form for the (Subscript[AB, 4]) T-4 E-mode B-atom unit vectors
*)
AB4Emode[θ_,ϕ_]:={{(((Sqrt[2]) Cos[θ]-Sin[θ] Sin[ϕ])/(Sqrt[3])),Cos[ϕ] Sin[θ],((Cos[θ]+(Sqrt[2]) Sin[θ] Sin[ϕ])/(Sqrt[3]))},{((-(Sqrt[2]) Cos[θ]+Sin[θ] Sin[ϕ])/(Sqrt[3])),-Cos[ϕ] Sin[θ],((Cos[θ]+(Sqrt[2]) Sin[θ] Sin[ϕ])/(Sqrt[3]))},{Cos[ϕ] Sin[θ],(((Sqrt[2]) Cos[θ]-Sin[θ] Sin[ϕ])/(Sqrt[3])),-((Cos[θ]+(Sqrt[2]) Sin[θ] Sin[ϕ])/(Sqrt[3]))},{-Cos[ϕ] Sin[θ],-(((Sqrt[2]) Cos[θ]-Sin[θ] Sin[ϕ])/(Sqrt[3])),((-Cos[θ]-(Sqrt[2]) Sin[θ] Sin[ϕ])/(Sqrt[3]))}};

FromSphericalCoords[{θ_,φ_}]:=Chop/@{ Cos[φ] Sin[θ], Sin[θ] Sin[φ], Cos[θ]};
(*
360 points along unit circle
*)
grc=Table[{Cos[i],Sin[i],0},{i,0,2π,π/180}]//N;
(*
Heat-map for visualising the configuration space
*)
texture=;
(*
Some paramter settings
*)
wid=0.02;rad=1.003;pl=1.25;
w2=0.001;
(*
Visualisation of the configuration space
*)
map=Show[
SphericalPlot3D[1,{θ,0,Pi},{ϕ,0,2Pi},PlotStyle->Texture[texture],Boxed->False,PlotPoints->80,MaxRecursion->6,Axes->False,Mesh->None,PlotRange->{{-1.3,1.3},{-1.3,1.3},{-1.2,1.4}}],
Graphics3D[{
{,Thickness[.015],Arrowheads[{.07}],Arrow[{{0,0,0},{0,0,1.35}}]},
{,Polygon[{{-pl,-pl,0},{-pl,pl,0},{pl,pl,0},{pl,-pl,0}}]}
,Text[Style["z",25],{0,0,1.5}]}]
];
(*
correction to fit the texture
*)
r2=RotationMatrix[{{1,0,0},Normalize[{Cos[60Degree],Sin[60Degree],0}]}];
(*
Main body 
*)

Manipulate[Block[{l0={0,0,0},p1,p2,p3,p4,rot,rotgrc},
(* rotation matrix for tilting the great circle in the x-y plane to other orientations *)
If[x==0 ∧x==y∧x==z,x=0.0001];
rot=RotationMatrix[{{0,0,1},Normalize[{x,y,z}]}];
(* perform the rotation of the great circle points and convert to configuration space spherical coordinates *)
rotgrc=(ToSphericalCoordinates/@(rot.#&/@grc))[[All,2;;3]];
(* B-atom coordinates at point p in titlted great circle*)
{p1,p2,p3,p4}=AB4Emode[rotgrc[[p,1]],rotgrc[[p,2]]];
(* disks to visualise the great circles swept out by the B-atoms in real space for the titlted great circle in the config space *)
d1=With[{cp=Normalize[Cross[AB4Emode[rotgrc[[1,1]],rotgrc[[1,2]]][[1]],AB4Emode[rotgrc[[90,1]],rotgrc[[90,2]]][[1]]]]},Cylinder[w2{-cp,cp},.88]];
d2=With[{cp=Normalize[Cross[AB4Emode[rotgrc[[1,1]],rotgrc[[1,2]]][[2]],AB4Emode[rotgrc[[90,1]],rotgrc[[90,2]]][[2]]]]},Cylinder[w2{-cp,cp},.88]];
d3=With[{cp=Normalize[Cross[AB4Emode[rotgrc[[1,1]],rotgrc[[1,2]]][[3]],AB4Emode[rotgrc[[90,1]],rotgrc[[90,2]]][[3]]]]},Cylinder[w2{-cp,cp},.88]];
d4=With[{cp=Normalize[Cross[AB4Emode[rotgrc[[1,1]],rotgrc[[1,2]]][[4]],AB4Emode[rotgrc[[90,1]],rotgrc[[90,2]]][[4]]]]},Cylinder[w2{-cp,cp},.88]];
Row[{
(* "molecular" visualisation of the B-atom unit vectors *)
Graphics3D[{
,Ball[l0,.2],
Red,Ball[p1,.12],
Yellow,Ball[p2,.12],
Green,Ball[p3,.12],
Blue,Ball[p4,.12],
,Tube[{l0,p1},.06],Tube[{l0,p2},.06],Tube[{l0,p3},.06],Tube[{l0,p4},.06],
If[disks,{Opacity[op],,d1,,d2,,d3,,d4}],
{,Point[Tuples[{-1.1,1.1},3]]}
},
Axes->True,
AxesLabel->{"x","y","z"},
Ticks->None,
SphericalRegion->True,
Lighting->"Neutral",
Boxed->True,
ImageSize->300 ,PlotLabel->"Configuration"],
(* display the config space and titlted great circle *)
Show[map,Graphics3D[{{White,EdgeForm[None],GeometricTransformation[Cylinder[{{0,0,-wid},{0,0,wid}},rad],r2.rot]},{Black,Ball[r2.FromSphericalCoords[rotgrc[[p]]],.04]}}],ImageSize->180,ViewVertical->{0.2202,-0.3521,0.9097} ,ViewPoint->{1.4738,-2.9659,0.6939} ,ViewCenter->{{0.5,0.5,0.5},{0.5356,0.5222}} ,ViewAngle->0.36282,Lighting->"Neutral",PlotLabel->"Configuration space"]
}]],
"configuration space vector v for rotation: {0,0,1}->v",
Delimiter,
(* confic space tilting vector *)
{{x,0.011,"cx"},-1,1,.01,Appearance->"Open"},
{{y,-0.7,"cy"},-1,1,.01,Appearance->"Open"},
{{z,1,"cz"},-1,1,.01,Appearance->"Open"},
Delimiter,
"Progression around great circle",
{{p,1,""},1,360,1,Appearance->"Open"},
Delimiter,
(* optional display of the visualisation disks + adjustable opacity *)
{{disks,False,"Show great circle disks"},{True,False}},
{{op,1,"Disk opacity"},0,1,.025},
ControlPlacement->Top,SaveDefinitions->True
]

(* Some interesting config space great circle tilt vectors (x,y,z) *)

(* equator in config space *)
{0,0,1};

(* passes through 4 SL-4 points *)
{0.011,-0.55,0.8};

(* meridional antisymmetric orthogonal flexions for T-4-R ⇌ T-4-S *)
{1,0,0};

(* non-meridional antisymmetric orthogonal flexions for T-4-R ⇌ T-4-S *)
{0.96,-0.7,1};