(*
  
   Simple Mathematica package for computations with surfaces in space.
      
      Matthias Weber 
    Mathematical Sciences Research Institute 
    1000 Centennial Drive Berkeley, CA 94720 USA 
    email : weber@msri.org
  
  *)

BeginPackage["Own`Surfaces`"];

TangentVectors::usage = 
    "TangentVectors[f,{u,v}] returns the coordinate tangent vectors of f, \
where f is a vector depending on u and v.";

FirstFundamentalForm::usage = 
    "FirstFundamentalForm[f,{u,v}] returns the first fundamental form of f in \
the (u,v) coordinates. FirstFundamentalForm[{Xu, Xv}] returns the first \
fundamental form if expressions for the coordinate tangent fields are \
given.";

AreaForm::usage = 
    "AreaForm[f,{u,v}] returns the area form of a surface parameterization f \
in the (u,v) coordinates.";

SurfaceArea::usage = 
    "SurfaceArea[f,{u,u0,u1},{v,v0,v1}] computes the surface area ofthe \
surface parameterization f over the coordinate domain u0<=u<=u1,v0<=v<=v1.";

NormalVector::usage = 
    "NormalVector[f,{u,v}] or NormalVector[{Xu,Xv}] compute the normal vector \
of a surface parameterization in the (u,v) coordinate.";

SecondFundamentalForm::usage = 
    "SecondFundamentalForm[f,{u,v}] or SecondFundamentalForm[{Xu,Xv},n,{u,v}] \
computes the second fundamental form of a surface parameterization in the \
(u,v) coordinate.";

MeanCurvature::usage := 
    "MeanCurvature[f,{u,v}] computes the mean curvatureof a surface \
parameterization in the (u,v) coordinate.";

GaussianCurvature::usage := 
    "GaussianCurvature[f,{u,v}] computes the mean curvature of a surface \
parameterization in the (u,v) coordinate.";

WeingartenMap::usage = 
    "WeingartenMap[f,{u,v}] computes the Weingarten map of a surface \
parameterization in the (u,v) coordinate.";

Begin["`Private`"];

Unprotect[
    TangentVectors,
    FirstFundamentalForm,
    AreaForm,
    SurfaceArea,
    NormalVector,
    SecondFundamentalForm,
    MeanCurvature,
    GaussianCurvature,
    WeingartenMap
    ];

TangentVectors[f_, {u_, v_}] :=
    {Simplify[D[f, u]], 
      Simplify[D[f, v]]
      };

FirstFundamentalForm[f_, {u_, v_}] :=
    Block[
      {Xu,
        Xv,
        gE,
        gF,
        gG},
      {Xu , Xv} = TangentVectors[f, {u, v}] ;
      gE = Simplify[Xu . Xu] ;
      gF = Simplify[Xu . Xv] ;
      gG = Simplify[Xv . Xv] ;
      {{ gE, gF}, {gF, gG}} 
      ];

FirstFundamentalForm[{Xu_, Xv_}] :=
    Block[
      {gE,
        gF,
        gG},
      gE = Simplify[Xu . Xu] ;
      gF = Simplify[Xu . Xv] ;
      gG = Simplify[Xv . Xv] ;
      {{ gE, gF}, {gF, gG}} 
      ];

AreaForm[f_, {u_, v_}] := 
    PowerExpand[Sqrt[Det[FirstFundamentalForm[f, {u, v}]]]];

SurfaceArea[sf_, {u_, u0_, u1_}, {v_, v0_, v1_}] :=
    Block[
      {frm = AreaForm[sf, {u, v}]},
      Simplify[Integrate[frm, {u, u0, u1}, {v, v0, v1}]
        ]
      ];

NormalVector[{Xu_, Xv_}] :=
    Module[
      {t},
      t = Simplify[
          Cross[Xu, Xv]
          ] ;
      Simplify[t /Sqrt[t.t] ]
      ];

NormalVector[f_, {u_, v_}] := NormalVector[TangentVectors[f, {u, v}]];

SecondFundamentalForm[ff_, {u_, v_}] :=
    Block[
      {Xu ,
        Xv,
        nrm,
        Nu,
        Nv,
        e,
        f,
        g},
      {Xu , Xv} = TangentVectors[ff, {u, v}] ;
      nrm = NormalVector[{Xu , Xv}];
      Nu = Simplify[D[nrm, u]] ;
      Nv = Simplify[D[nrm, v]] ;
      e = - Simplify[Xu . Nu] ;
      f = - Simplify[Xu . Nv] ;
      g = - Simplify[Xv . Nv] ;
      {{e, f}, {f, g}} 
      ];

SecondFundamentalForm[{Xu_, Xv_}, nrm_, {u_, v_}] :=
    Block[
      {Nu,
        Nv ,
        e, 
        f, 
        g},
	Nu = Simplify[D[nrm, u]] ;
	Nv = Simplify[D[nrm, v]] ;
	e = - Simplify[Xu . Nu] ;
	f = - Simplify[Xu . Nv] ;
	g = - Simplify[Xv . Nv] ;
	{{e, f}, {f, g}} 
      ];

MeanCurvature[f_, {u_, v_}] :=
    Block[
      {Xu,
        Xv,
        nrm},
      {Xu , Xv} = TangentVectors[f, {u, v}];
      nrm = NormalVector[{Xu , Xv}];
      Simplify[Tr[
          Inverse[
              FirstFundamentalForm[{Xu , Xv}]].
            SecondFundamentalForm[{Xu , Xv}, nrm, {u, v}]
          ]
        ]
      ];

GaussianCurvature[f_, {u_, v_}] :=
    Block[
      {Xu,
        Xv,
        nrm},
      {Xu , Xv} = TangentVectors[f, {u, v}] ;
      nrm = NormalVector[{Xu , Xv}];
      Simplify[Det[
            SecondFundamentalForm[{Xu , Xv}, nrm, {u, v}]]/
          Det[FirstFundamentalForm[{Xu , Xv}]
            ]
        ]
      ];

WeingartenMap[f_, {u_, v_}] :=
    Block[
      {Xu,
        Xv,
        nrm},
      {Xu , Xv} = TangentVectors[f, {u, v}] ;
      nrm = NormalVector[{Xu , Xv}];
      Simplify[
        Inverse[
            FirstFundamentalForm[{Xu , Xv}]].
          SecondFundamentalForm[{Xu , Xv}, nrm, {u, v}]
        ]
      ];
		
Protect[
    TangentVectors,
    FirstFundamentalForm,
    AreaForm,
    SurfaceArea,
    NormalVector,
    SecondFundamentalForm,
    MeanCurvature,
    GaussianCurvature,
    WeingartenMap
    ];

End[];

EndPackage[];

