<<Graphics`Colors`
<<Graphics`Arrow`
<<Graphics`Animation`
<<Graphics`Shapes`

LiveForm[g_] := NumberForm[InputForm[N[g]], 5]

WriteLiveForm[filename_, g_] := (
        WriteString[filename, 
        ToString[NumberForm[InputForm[N[g]], 5]]];
        Close[filename];)

unhide[g_] := Show[g,{DisplayFunction -> $DisplayFunction}]

brokenline[u_,v_] := 
 Line[Table[t u + (1-t) v,{t,0,1,1/10}]]

Off[ParametricPlot3D::ppcom]
Off[ParametricPlot::ppcom]

algtopdir = "/home/pm1nps/teach/algtop"
webdir = "/home/pm1nps/myweb/courses/algtop/pictures"

gifdir  = webdir
epsdir  = StringJoin[algtopdir,"/notes/eps"]
(* livedir = StringJoin[algtopdir,"/live"] *)
livedir = webdir

giffile[name_]  := StringJoin[ gifdir,"/",name,".gif"]
epsfile[name_]  := StringJoin[ epsdir,"/",name,".eps"]
livefile[name_] := StringJoin[livedir,"/",name,".m"]

gifsave[name_,g_,opt___] :=  Export[giffile[name],g,"GIF",opt]
epssave[name_,g_,opt___] :=  Export[epsfile[name],g,"EPS",opt]
livesave[name_,g_] :=  WriteLiveForm[livefile[name],g]

animsave[name_,g_List,opt___] := 
 Module[{dir,i},
  dir = StringJoin[webdir,"/",name];
  If[FileType[dir] == None, CreateDirectory[dir] ];
  Do[
   Export[StringJoin[dir,"/",ToString[i],".gif"],g[[i+1]],opt],
   {i,0,Length[g]-1}
  ]
 ]

makeanim[name_String,F_,opt___] :=
 animsave[name,Table[F[t],{t,0.,1.001,0.1}],opt]

makeanim[name_Symbol,opt___] :=
 animsave[ToString[name],Table[name[t],{t,0.,1.001,0.1}],opt]

reloop[L_] := 
 Join[
  {First[L],First[L],First[L]},
  L,
  {Last[L],Last[L],Last[L]},
  Reverse[L]
 ]

(* Parametrisations of standard surfaces			*)

circ[th_] := {Cos[th],Sin[th]}

sph[th_,ph_]    := {Cos[th] Sin[ph],Sin[th] Sin[ph],Cos[ph]}

sph[r_,th_,ph_] := r sph[th,ph]

cyl[th_,z_]     := {Cos[th],Sin[th],z}

stor[th_,ph_,r_] :=
 (2 + r Cos[ph]){Cos[th],Sin[th],0} + r Sin[ph]{0,0,1}

mob[th_,r_] := stor[th,th/2,r]

tor[th_,ph_] := stor[th,ph,1]



pplot[f_,min_,max_,n_] :=
 Module[{step},
  step = (max - min)/n;
  Table[
   Line[{f[t],f[t+step]}],
   {t,min,max,step}
  ]
 ]

curve[c_] := 
 Graphics[{
  Thickness[0.01],
  Table[
   {Hue[t],Line[{c[2 Pi t],c[2 Pi (t+0.01)]}]},
   {t,0.,1.,0.01}
  ]
 }]

curve3D[c_] := 
 Graphics3D[{
  Thickness[0.01],
  Table[
   {Hue[t],Line[{c[2 Pi t],c[2 Pi (t+0.01)]}]},
   {t,0.,1.,0.01}
  ]
 }]

translate[u_,g_] :=
 g /. {Line[l_List]    :> Line[(# + u) & /@ l],
       Polygon[l_List] :> Polygon[(# + u) & /@ l],
       Point[v_] :> Point[u + v]}



(********************************************************************)

ListPoints[g_Graphics3D] := 
 N[Flatten[
    g[[1]] /. {Polygon[l_List] :> Point /@ l,
               Line[l_List] :> Point /@ l,
               RGBColor[___] :> {},
               Hue[___] :> {},
               PointSize[___] :> {},
               Thickness[___] :> {}}] /. Point[l_List] :> l];

ListPoints[l_List] := Flatten[ListPoints /@ l,1]

BoundingBox[x_] := ({Min[#],Max[#]} &) /@ Transpose[ListPoints[x]]