BeginPackage["r2r2tools`"]

genProj::usage = "genProj[s,e[1],...,e[n-1]] generates the (n-1)xn matrix of
a projection mapping R^n -> R^(n-1). The vectors s and e[i] must have n components.
Vector s gives the direction of the projection line, {e[1],..,e[n-1]} is the basis
of the range."

genRot4D::usage = "genRot4D[a,b,w] generates a rotation matrix in the 4D space.
Vectors a and b span an invariant subspace, w gives the angle of rotation."

ortBasis::usage = "ortBasis[b] is an auxiliary function for generating orthonormal
bases. b is a list of vectors (often only one) that are used as the first vectors
in the generation of the basis."

genNet4D::usage = "genNet4D[w[s,t],{s,s1,s2,ds},{t,t1,t2,dt}] generates a list
of Polygons based on the net of points on the 4D surface w[s,t] =
= {u[s,t],v[s,t],x[s,t],y[s,t]}. Examples: If rectangular coordinates are used,
w[x,y] = {u[x,y],v[x,y],x,y}. If polar coordinates are used, w[r,phi] =
{u[r Cos[phi],r Sin[phi]],v[r Cos[phi],r Sin[phi]],r Cos[phi],r Sin[phi]}."

test4D::usage = "test4D[x] tests whether x is numerical vector in 4D space."

ax4D::usage = "ax4D[d,dst] generates a list of 4D graphics defining a 4D
coordinate axes (with appropriate colors). d is the length of the axes to be
drawn, dst defines an offset vector for the origin of the axes."

opts::usage = "opts[d] generates a list of options to be used for animations.
d is used in PlotRange option."

genLiveGr3D::usage = "genLiveGr3D[gr4D] generates a 3D graphics with controls
that can be exported for LiveGraphics3D. The controls are points which can be
moved and which define the view direction in the 4D space." 

rectcontrols::usage = "Slide controls for LiveGraphics3D, controlling the
rectangular components of the view direction."

sphercontrols::usage = "Slide controls for LiveGraphics3D, controlling the
4D spherical angles of the view direction."

f::usage = "Control: angle of 4D spherical coordinates, between 0 and 2Pi."

t1::usage = "Control: angle of 4D spherical coordinates, between 0 and Pi."

t2::usage = "Control: angle of 4D spherical coordinates, between 0 and Pi."

c1::usage = "Control: first rectangular coordinate, between -1 and 1."

c2::usage = "Control: second rectangular coordinate, between -1 and 1."

c3::usage = "Control: third rectangular coordinate, between -1 and 1."

c4::usage = "Control: fourth rectangular coordinate, between -1 and 1."

Begin["`Private`"]

genProj[s_, b__] := Module[{n, p}, n = Cross[b];
      p = IdentityMatrix[Length[s]] - (1/n.s)*Outer[Times, s, n];
      Drop[Inverse[Transpose[{b, s}]].p, -1]];

genRot4D[a_, b_, w_] := 
    Module[{ker, c, d, r, b0, b1}, ker = NullSpace[{a, b}];
      {{c, d}, r} = QRDecomposition[Transpose[ker]];
      b0 = {a, b, c, d};
      b1 = {a, b, Cos[w]*c - Sin[w]*d, Sin[w]*c + Cos[w]*d};
      Transpose[Inverse[b0].b1]];

ortBasis[b_List] := 
    QRDecomposition[Transpose[Flatten[{b, NullSpace[b]}, 1]]][[1]];

genNet4D[w_, {x_, x1_, x2_, dx_}, {y_, y1_, y2_, dy_}] := 
    Module[{t}, t = N[Table[w, {x, x1, x2, dx}, {y, y1, y2, dy}]]; 
      Table[Polygon[{t[[i, j]], t[[i + 1, j]], t[[i + 1, j + 1]], 
            t[[i, j + 1]], t[[i, j]]}], {i, 1, Dimensions[t][[1]] - 1}, {j, 1,
           Dimensions[t][[2]] - 1}]];

test4D[x_] := And[VectorQ[x, NumericQ], Length[x] == 4];

ax4D[d_,dst_] := {Thickness[0.005],
    {RGBColor[1, 0, 0], Line[{{0, 0, 0, 0}, {d, 0, 0, 0}}]},
    {RGBColor[0, 1, 0], Line[{{0, 0, 0, 0}, {0, d, 0, 0}}]},
    {RGBColor[0, 0, 1], Line[{{0, 0, 0, 0}, {0, 0, d, 0}}]},
    {RGBColor[0.8, 0.8, 0], Line[{{0, 0, 0, 0}, {0, 0, 0, d}}]}} /. 
    x_?test4D :> x + {-dst, -dst, 0, 0};

opts[d_] := {Boxed -> False, PlotRange -> {{-d, d}, {-d, d}, {-d, d}}, 
    ImageSize -> 400};

rectcontrols = {Line[{{7, -3, 0}, {7, 3, 0}}], Point[{7, 0, 0}],
    {RGBColor[1, 0, 0], Point[{7, c1, 0}]}, 
    Line[{{8, -3, 0}, {8, 3, 0}}], Point[{8, 0, 0}],
    {RGBColor[1, 0, 0], Point[{8, c2, 0}]}, 
    Line[{{9, -3, 0}, {9, 3, 0}}], Point[{9, 0, 0}],
    {RGBColor[1, 0, 0], Point[{9, c3, 0}]}, 
    Line[{{10, -3, 0}, {10, 3, 0}}], Point[{10, 0, 0}],
    {RGBColor[1, 0, 0], Point[{10, c4, 0}]}};

sphercontrols = {Line[{{7, 0, 0}, {7, 2 Pi, 0}}], Point[{7, 0, 0}], Point[{7, 2 Pi, 0}],
    {RGBColor[1, 0, 0], Point[{7, f, 0}]}, 
    Line[{{8, 0, 0}, {8, Pi, 0}}], Point[{8, 0, 0}], Point[{8, Pi, 0}],
    {RGBColor[1, 0, 0], Point[{8, t1, 0}]}, 
    Line[{{9, 0, 0}, {9, Pi, 0}}], Point[{9, 0, 0}], Point[{9, Pi, 0}],
    {RGBColor[1, 0, 0], Point[{9, t2, 0}]}};

genLiveGr3D[gr4D_,ctrl_,d_,dst_] := Module[{s,e1,e2,e3,b,p},
    s = {Sin[t1] Sin[t2] Cos[f], Sin[t1] Sin[t2] Sin[f], Sin[t1] Cos[t2], Cos[t1]};
    e1 = D[s, f]/Sin[t1]/Sin[t2]; e2 = D[s, t2]/Sin[t1]; e3 = D[s, t1];
    b = {s, e1, e2, e3};
    p = Simplify[Apply[genProj, b]];
    Graphics3D[{{gr4D,ax4D[d,dst]} /. x_?test4D :> p.x, ctrl}, Boxed -> False]];

End[]

EndPackage[]
