[ REQ 5229]: WriteOOGL

[roseman at dimension4.math.uiowa.edu]

I want to make an animation for Geomview by using Mathematica.

So I begin with a standard sort of thing to make a Mathematica  
"animation" (see code below).

If I input <<Geomview.m and run this function, then the pictures  
appears in a geomview window WITH ARROWS IN CORRECT COLOR.

My idea is to use  WriteOOGL to write some files which I can then use  
with the Geomview Animate module.  (See code below)

Almost everything is fine.  The problem I have (BTW I am working on a  
Next with Geomview 1.5) is that THE ARROWS ARE ALL BLACK.  (But note  
that the little axes come thru in green as expected).

Is this a bug in WriteOOGL ?

Note in the code below, the WriteOOGL is on the very last line.
If this line is commented out and the line above it us uncommented,  
one gets the original code I was working with ath produces a regular  
Mma "animation".  (BTW this is not my code, except for the  FileName2  
function, the last line and use of "iter" for the filenames.

If the code below is messed up in formating via e-mail--I can ftp a  
better copy. 


(********************* This sets things up *********)

Off[General::spell];
Off[General::spell1];
Off[ParametricPlot3D::ppcom]
Needs["Graphics`Colors`"]
SetOptions[Graphics,Axes->False,AxesOrigin->{0,0},AspectRatio->Automat 
ic];
SetOptions[Graphics3D,ViewPoint->{5,2,1},Boxed->False,AspectRatio->Aut 
omatic];
SetOptions[ParametricPlot3D,ViewPoint->{5,2,1},AspectRatio->Automatic] 
;
SetOptions[Plot3D,ViewPoint->{5,2,1},AspectRatio->Automatic];
SetOptions[ParametricPlot,AspectRatio->Automatic];
SetOptions[Plot,AspectRatio->Automatic];

colorQ[a_]:=(Head[a]===RGBColor);
grayQ[a_]:=(Head[a]===GrayLevel);
thickQ[a_]:=(Head[a]===Thickness);
absthickQ[a_]:=(Head[a]===AbsoluteThickness);
notruleQ[u_] := !(Head[u]===Rule);
ruleQ[u_] := (Head[u]===Rule);
Cross::usage = "Cross[a,b] returns the cross product of a and b.";

Norm::usage = "Norm[expr] returns the Euclidean length of the
		vector, 'expr'.";
Norm[a_?VectorQ] := Sqrt[a.a];

Angle[a_?VectorQ,b_?VectorQ] := ArcCos[(a.b)/(Norm[a] Norm[b])]

Proj[a_?VectorQ,b_?VectorQ] := ((a.b)/(b.b))b
			
Cross[a_?VectorQ,b_?VectorQ]:={a[[2]]b[[3]]-a[[3]]b[[2]], 

				a[[3]]b[[1]]-a[[1]]b[[3]],
				a[[1]]b[[2]]-a[[2]]b[[1]]};

tol = .5*10^-6;
				
OrthUp[a_?VectorQ] :=
	Module[{b,c,d,f},
		d = N[a/Norm[a]];
		If[Chop[d[[3]]^2 - 1,tol] == 0, b={1,0,0} ,
		b = {0,0,1} - d[[3]] d; b = b/Norm[b];];
	Return[b]];
	
OrthSet[a_?VectorQ] :=
	Module[{b,c,d},
		d = N[a/Norm[a]];
		If[Chop[d[[1]],tol]==0,b={1,0,0},
			 If[Chop[d[[2]],tol]==0,b={0,1,0},
			  b={-d[[2]],d[[1]],0}]];
			b=b/Norm[b];c = Cross[d,b];
	Return[{b,c/Norm[c],d}]];

				
Rotate[a_?VectorQ,theta_] :=
	Module[{u,v,r},
		u = OrthSet[a];
		v = Transpose[u];
		r =  
N[{{Cos[theta],-Sin[theta],0},{Sin[theta],Cos[theta],0},{0,0,1}}];
	Return[v.r.u]];
Vector2D[tail_,tip_,opts___]:=
	Module[{ntail,ntip,sopts,Punit,up,arrow},
	ntail = N[tail];
	ntip = N[tip];
	
	sopts = Join[Select[{opts},colorQ],Select[{opts},
				 
thickQ],Select[{opts},absthickQ],Select[{opts},grayQ]];

If[Chop[ntail.ntail+ntip.ntip,tol] == 0,
			(*too small to plot or not number*)
			Return[Graphics[Point[{0,0}]]];
	,						
If[Chop[(ntip-ntail).(ntip-ntail),tol] == 0,
		Return[Graphics[{Join[sopts,{Line[{ntail,ntip}]}]}]];
	,
	Punit = (.075 Norm[ntip-ntail]/Norm[ntip-ntail]) (ntip-ntail)  
;
	up = 0.15 {-Punit[[2]],Punit[[1]]};
	arrow = Line[{ntail,ntip,ntip-Punit+up,ntip,ntip-Punit-up}];
	]];
Return[Graphics[{Join[{AbsoluteThickness[2]},Join[sopts,{arrow}]]}]];
];

Vector3D[tail_,tip_,opts___]:=
	Module[{ntail,ntip,sopts,Punit,up,u2,u3,u4,rotmat,arrow},
	ntail = N[tail];
	ntip = N[tip];
	
	sopts = Join[Select[{opts},colorQ],Select[{opts},
				 
thickQ],Select[{opts},absthickQ],Select[{opts},grayQ]];

If[Chop[ntail.ntail+ntip.ntip,tol] == 0,
			(*too small to plot or not number*)
			Return[Graphics3D[Point[{0,0,0}]]];					
	,		
If[Chop[(ntip-ntail).(ntip-ntail),tol] == 0,
		 
Return[Graphics3D[{Join[sopts,{Line[{ntail,ntip}]}]}]];
	,
	Punit = (ntip-ntail);
	rotmat = Rotate[Punit,N[Pi/2]];
	up = OrthUp[Punit];
	Punit = .075 Punit;
	up = .15 Norm[Punit] up;
	u2 = rotmat.up;
	u3 = rotmat.u2;
	u4 = rotmat.u3;
	arrow = Line[{ntail,ntip,
				ntip - Punit + up,ntip,
				ntip - Punit + u2,ntip,
				ntip - Punit + u3,ntip,
				ntip - Punit + u4}];
	]];
Return[Graphics3D[{Join[{AbsoluteThickness[2]},Join[sopts,{arrow}]]}]] 
;
];
aRCtAN[y_,x_] := Module[{v},
	If[ Chop[N[x],tol] == 0 ,If[ N[y] < 0, v = -N[Pi/2], v =  
N[Pi/2]],
		v = N[ArcTan[y/x]];
		If[ x < 0 && y < 0, v = N[Pi -  v],v]];
	Return[v]];
Arc2D[X_,Y_,opts___] := Graphics[{opts,
		Disk[{0,0},1,{Min[
							aRCtAN[
						N[X[[2]]],N[X[[1]]]
								]
							,
							aRCtAN[
							 
N[Y[[2]]],N[Y[[1]]]
								]
						]
						,
					Max[
							aRCtAN[
						N[X[[2]]],N[X[[1]]]
								]
							,
							aRCtAN[
							 
N[Y[[2]]],N[Y[[1]]]
								]
						]}
				]}
				];
Arc3D[X_,Y_] := 

	Module[{t,U,V},
		U[V_]:= N[(1/Sqrt[V.V]) V];
		Return[Graphics3D[
		Polygon[Append[Table[U[t X + (1-t)  
Y],{t,0,1,0.1}],{0,0,0}]]
				]
		]
	];		
(*Zero Arrow causes trouble. Put in Vector?*)
Vector[tail_,tip_,opts___]:=
	If[Length[N[tail]]==2,Return[Vector2D[tail,tip,opts]],
		Return[Vector3D[tail,tip,opts]]];
		
Arrow[vec_,opts___]:= 

	Module[{a,b},
				If[Length[N[vec]]==2,
				 
a=ToExpression["Tail"]/.Select[{opts},ruleQ]/.
					 
{ToExpression["Tail"]->{0,0}};
				Return[Vector2D[a,a+vec,opts]],
				 
a=ToExpression["Tail"]/.Select[{opts},ruleQ]/.
					 
{ToExpression["Tail"]->{0,0,0}};
				Return[Vector3D[a,a+vec,opts]]]
				];
Frame2D[delta_] := 

      Graphics[{
            {Green,Line[{{-delta/4,0},{delta,0}}]},
                    Text["x",{1.01 delta,0}],
            {Green,Line[{{0,-delta/4},{0,delta}}]},
                    Text["y",{0, 1.01 delta}]}];
Frame3D[delta_] := 

      Graphics3D[{
            {Green,Line[{{-delta/4,0,0},{delta,0,0}}]},
                    Text["x",{1.01 delta,0,0}],
            {Green,Line[{{0,-delta/4,0},{0,delta,0}}]},
                    Text["y",{0, 1.01 delta,0}],
            {Green,Line[{{0,0,-delta/4},{0,0,delta}}]},
                    Text["z",{0,0,1.01 delta}]}];
View2D[stuff_] := Show[stuff,Frame2D[1]];
View3D[stuff_] := Show[stuff,Frame3D[1]];
The FlyBy Function
FlyBy[
	theGraphic_, 

	thePath_List:{pathVariable, -0.5, 1.5},
	pathRange_List:{pathVariable, -3, 3, 0.5}]:= 

	Do[
		Show[theGraphic, ViewPoint->thePath]
	,pathRange]

(******************** Here is the stuff to produce annimation****)
(**********  and some of my own code to make geomview files****)

FileName2Place[firstPart_String, i_Integer] :=
If[i <10, firstPart<>"0"<>ToString[i],
firstPart<>ToString[i]]



Clear[x,y,z,t,X];
x[t_] :=  2Cos[t/2];
y[t_] :=  2Sin[t/2]Cos[t/2];
z[t_] :=  2Cos[t/2];

X[t_] := {x[t],y[t],z[t]};
V[t_] := X'[t];
A[t_] := V'[t];

T[t_] := (1/Norm[V[t]]) V[t];
Av[t_] := ((A[t].V[t])/(V[t].V[t])) V[t];
An[t_] := A[t] - Av[t];
curve = ParametricPlot3D[X[t],{t,-Pi,3Pi},
PlotRange->{{-2.5,2.5},{-2.5,2.5},{-2.5,2.5}},Axes->None,
DisplayFunction->Identity
];
iter = 0;
Do[
arrows = {Arrow[X[t], Blue],
Arrow[T[t],Tail->X[t],Red,AbsoluteThickness[3]],
Arrow[A[t],Tail->X[t],Orange],
Arrow[Av[t],Tail->X[t],Brown],
Arrow[An[t],Tail->X[t]],Frame3D[1]};

iter = iter +1;
(*Show[curve,arrows,DisplayFunction->$DisplayFunction]; *)
WriteOOGL[FileName2Place[
    "/roseman/DeptStuff/22m026/mma/myframe", iter],
      Show[curve,arrows,DisplayFunction->$DisplayFunction]]
                                          

,{t,-Pi,3Pi,.3}];