#
#--> vectorplot3d( v, ... )      plot the vector u with tail at the origin
#--> vectorplot3d( u, v, ... )   plot the vector v with tail at point u
#
#
# The vectorplot3d command generates a PLOT3D object containing POLYGONS,
# CURVES and TEXT objects.  The input vectors u and v above must be in R^3;
# they may be of type list, vector or Vector but have three real components.
# The options to vectorplot3d are
#
# arrowstyle = smooth|rough|arrow (smooth) the style of the arrow generated
# color|colour = <plot color> (default red) the color of the vector
# thickness = positive (default 1.0) width of the arrow head/body relative to it's length
#             values < 1.0 correspond to "thin" arrows and values > 1.0 to "thick" arrows.
# thickness = skinny|thin|medium|thick|fat labels represening
#             numerical values of 0.25, 0.50, 1.0, 3.0, 6.0
# label = string (default = "" - no label) a label for the vector v
# labelcolor|labelcolour = <plot color> (default black) color for the label
# labelfont = <plot font> (default [TIMES,ROMAN,14]) font for the label
#
# Options on the PLOT3D generated
#
# SCALING(CONSTRAINED)
#
# The scaling for the vector is by default, a 1:1:1 scaling relative
# to the length of the vector.  If the optional argument
# view=[a..b,c..d,e..f] is specified, then the scaling is adjusted to
# the given viewing box.  The thickness parameter should be adjusted
# to make short vectors "thicker" and long vectors "thinner".
#
# This new code has four improvements over plottools[arrow].
# The main one is time efficiency.
# On our machine, it takes the old code 0.17 seconds to construct a 3d vector.
# Our new code takes 0.015 seconds for a "smooth" vector and 0.0088 seconds
# for a "rough" vector.  To obtain this improvement we use
# a simpler algorithm for constructing the rotation matrix A
# to orient a 3-d unit vector u in the direction of the vector w by
# taking advantage of the symmetry of the shape of the vectors.
# Then, for each point on each polygon to represent u, we use evalhf
# to do the matrix multiplication and vector addition, creating an hfarray
# with x,y,z co-ordinates in rows (should be in colums :-) directly.
# The "rough" vector consists of six polygons, two triangles,
# two rectangles, and two octagons, hence 6+8+16=30 points.
# The "smooth" vector has 22 polygons, 10 triangles, 10 rectangles,
# and two dodecahedrons, hence 30+40+20=90 points.
# The "arrow" vector consists of just 2 triangles and 1 line
# representing a stem for the vector and a boundary for the polygons.
# The other improvements are
# 1) The plots[arrow] gives options for the width of the shaft of the arrow,
#    the head of the arrow and relative length of the head of the arrow.
#    The new code provides one parameter which controls the relative width
#    of the arrow verses it's length, namely, 
#    thickness=skinny=0.2,thin=0.5,medium=1.0,thick=3.0,fat=6.0
#    This makes life much simpler for the user.
# 2) The option label = "v" allows the vector head to be easily labelled.
# 3) There are three kinds of vectors, "smooth" and "rough".
#    The rough vector has only six polygons, the smooth one 22.
#    The rough vectors are all in the same color.
#    One of the dodecahedrons, of the smooth vector is is in black to
#    highlight the arrow head when looking from above or below.
#    A plot containing many vectors will rotate more easily.
#    The rough arrow, being a simpler object, will rotate faster.
#
#
# Author Michael Monagan, 2001.
#

macro( ARROWHULL1 = `plots/vectorplot3d/arrowhull1`,
       ARROWNECK1 = `plots/vectorplot3d/arrowneck1`,
       ARROWHULL2 = `plots/vectorplot3d/arrowhull2`,
       ARROWHEAD3 = `plots/vectorplot3d/arrowhead3`,
       ARROWSTEM3 = `plots/vectorplot3d/arrowstem3`,
             NORM = `plots/vectorplot3d/norm`,
             FAST = `plots/vectorplot3d/A.v+b`,
             SIZE = `plots/vectorplot3d/thickness`,
#     vectorplot3d = `plots/vectorplot3d`,
            BLACK = COLOUR(RGB,0,0,0),
              RED = COLOUR(RGB,1,0,0) ):

NORM := proc(v) option inline; (v[1]^2+v[2]^2+v[3]^2)^(1/2) end:
#savelib('NORM');

vectorplot3d := proc()
  local p,w,lw,uw,s,t,u,v,a,b,c,d,e,f,as,at,
#        st,nt,pt,tt,mt,
        opts,vco,lco,sx,sy,sz,lf,T,A,M,U,D,O;

#st := time();
#pt := time();

  if nargs=1 or not type(args[2],{list,vector,Vector}) then return vectorplot3d([0,0,0],args) fi;
  (p,w) := args[1],args[2];
  if not type(p,list) then p := [p[1],p[2],p[3]] fi;  
  if not type(w,list) then w := [w[1],w[2],w[3]] fi;  
  (p,w) := evalf(p),evalf(w);
  if not type(p,[numeric$3]) then error "vector of three real constants expected" fi;
  if not type(w,[numeric$3]) then error "vector of three real constants expected" fi;
  lw := NORM(w);
  if lw=0.0 then return PLOT3D() fi;
  uw := w/lw;
  t := p+1.05*w;

  opts := [args[3..nargs]];
  if hasoption( opts, 'color', 'vco', 'opts' ) or
     hasoption( opts, 'colour', 'vco', 'opts') then vco := `plot/color`(vco); else vco := RED fi;
  if hasoption( opts, 'thickness', 'at', 'opts' ) then at := SIZE(at) else at := 1.0 fi;
  if hasoption( opts, 'view', 'v', 'opts' ) then
     v := evalf(v);
     if not type(v,[(numeric..numeric)$3]) then error "invalid view" fi;
     a,b := op(v[1]); sx := abs(b-a);
     c,d := op(v[2]); sy := abs(d-c);
     e,f := op(v[3]); sz := abs(f-e);
     if sx=0.0 or sy=0.0 or sz=0.0 then error "view must not be empty" fi;
     sx,sy,sz := sx/sz,sy/sz,1;
     #O := VIEW(op(v));
     O := NULL;
  else
     #a,b := min(p[1],t[1]), max(p[1],t[1]);
     #c,d := min(p[2],t[2]), max(p[2],t[2]);
     #e,f := min(p[3],t[3]), max(p[3],t[3]);
     #if a=b then a,b := a-1,b+1 fi;
     #if c=d then c,d := c-1,d+1 fi;
     #if e=f then e,f := e-1,f+1 fi;
     sx,sy,sz := 1,1,1;
     O := SCALING(CONSTRAINED);
  fi;

  if hasoption( opts, 'label', 's', 'opts' ) then s := convert(s,string); else s := "" fi;
  if hasoption( opts, 'labelcolor', 'lco', 'opts' ) or
     hasoption( opts, 'labelcolour','lco', 'opts' ) then lco := `plot/color`(lco) 
  else lco := BLACK fi;
  if hasoption( opts, 'labelfont', 'lf', 'opts' ) then lf := `plot/font`(lf)
  else lf := FONT('TIMES','ROMAN',14) fi;
  if s = "" then T := NULL; else T := TEXT([t[1],t[2],t[3]], s, ALIGNRIGHT, lco, lf) fi;

  if hasoption( opts, 'arrowstyle', 'as', 'opts' ) then else as := 'smooth' fi;
  if not member(as,{'rough','smooth','arrow'}) then error "invalid arrowstyle"; fi;

  # Process remaining options, if any
  if opts=[] then else O := O, `plot3d/options3d`(op(opts)) fi;

#pt := time()-pt;
#nt := time();

  #B := Matrix([[w[1],w[2],w[3]]]);
  #B := GramSchmidt( NullSpace( B ), 'normalized' );
  #u,v := evalf( op(B) );
  if w[1]=0.0 then
     u := [1.0,0.0,0.0];
     if w[2]=0.0 then
        v := [0.0,1.0,0.0];
     else
        v := [0.0,-w[3]/w[2],1.0];
        v := v/NORM(v);
     fi
  else
     u := [-w[2]/w[1],1.0,0.0];
     u := u/NORM(u);
     v := [-w[3]/w[1],0.0,1.0];
     v := v - u[1]*v[1]*u;
     v := v/NORM(v);
  fi;

  #sx := thickness*sx/lw^(1/2);
  #sy := thickness*sy/lw^(1/2);
  #S := Matrix( [[lw*sx,0,0],[0,lw*sy,0],[0,0,lw*sz]] ): # Relative scaling for view
  #A := <u|v|uw>.S; # Rotation of unit arrow to right position

  sx := at*sx*lw^(1/2);
  sy := at*sy*lw^(1/2);
  sz := sz*lw;
  A := hfarray(1..3,1..3,[[u[1]*sx,v[1]*sy,uw[1]*sz],
                          [u[2]*sx,v[2]*sy,uw[2]*sz],
                          [u[3]*sx,v[3]*sy,uw[3]*sz]]);
  b := hfarray(1..3,p);

#mt := time();
#nt := mt-nt;

  # Compute v' = A.v+b for each point v in ARROWHULL
  M := proc(P,A,T) local n; n := op([2,2,2],P); evalhf(FAST(A,P,n,T)) end;
  if as='smooth' then
     U := POLYGONS( seq(M(u,A,b),u=ARROWHULL1), vco, STYLE(PATCHNOGRID) ):
     D := POLYGONS( seq(M(u,A,b),u=ARROWNECK1), BLACK, STYLE(PATCHNOGRID) );
  elif as='arrow' then
     U := POLYGONS( seq(M(u,A,b),u=ARROWHEAD3), vco, STYLE(PATCHNOGRID) ):
     D :=   CURVES( seq(M(u,A,b),u=ARROWSTEM3), BLACK, STYLE(LINE), THICKNESS(2) );
  else
     U := POLYGONS( seq(M(u,A,b),u=ARROWHULL2), vco, STYLE(PATCHNOGRID) ):
     D := NULL;
  fi;

#mt := time()-mt;
#tt := time()-st;
#lprint(tt,mt/tt,pt/tt,nt/tt);

  PLOT3D( D, U, T, O );

end:
#savelib('vectorplot3d');


FAST := proc(A,P,n,T) local i,j,B;
     B := hfarray(1..n,1..3);
     # Compute B = Transpose (A.P + <T|T|...|T>)
     for i to 3 do
         for j to n do
             B[j,i] := T[i]+A[i,1]*P[1,j]+A[i,2]*P[2,j]+A[i,3]*P[3,j];
         od;
     od;
     B;
end:
#savelib('FAST');

SIZE := proc(s)
     if s='skinny' then 0.25;
     elif s='thin' then 0.5;
     elif s='medium' then 1.0;
     elif s='thick' then 3.0
     elif s='fat' then 6.0;
     elif type(s,numeric) and s > 0 then s
     else error "invalid arrow thickness";
     fi;
end:
#savelib('SIZE');

#
# Defines three kinds of vectors in 3D
# ARROWHULL1 + ARROWNECK1, ARROWHULL2, ARROWHEAD3 + ARROWSTEM3
#
# Author: Michael Monagan 2001.
#

# This "smooth" arrow is constructed with 22 polygons, the "rough" arrow below with 6 polygons
alpha := evalf(Pi/5): N := 10: H := 0.8: # same as plottools[arrow]
ARROWHULL1 := POLYGONS(
   # ten triangles approximating the faces of a cone for the head of the arrow
   evalf( seq( [<cos(theta)/25,sin(theta)/25,0>, <cos(theta)/25,sin(theta)/25,H>,
      <cos(theta+alpha)/25,sin(theta+alpha)/25,H>, <cos(theta+alpha)/25,sin(theta+alpha)/25,0>],
     theta=[seq( i*alpha, i=0..N-1 )] ) ),
   # ten rectangles approximating the sides of a cylinder for the body of the arrow
   evalf( seq( [<0,0,1>,<cos(theta)/10,sin(theta)/10,H>,<cos(theta+alpha)/10,sin(theta+alpha)/10,H>],
   # a ten gon approximating a disk at the bottom of the arrow
     theta=[ seq(i*alpha,i=0..N-1) ] ) ),
   evalf( [seq( <cos(theta)/25,sin(theta)/25,0>, theta=[seq( i*alpha, i=0..N-1 )] )] ) ):
ARROWNECK1 := POLYGONS(
   # a ten gon approximating a disk at the base of the arrow head, in black
   evalf( [seq( <cos(theta)/9,sin(theta)/9,H>, theta=[seq( i*alpha/2, i=0..2*N-1 )] )] ) ):

# Convert the polygons to hfarrays with x,y,z co-ordinates down each column
# in preparation for multiplication by a 3 by 3 matrix on the left.
ARROWHULL1 := map(Matrix,ARROWHULL1):
ARROWHULL1 := map(convert,ARROWHULL1,listlist):
#ARROWHULL1 := POLYGONS( seq( hfarray(1..3,1..nops(L[1]),L), L=ARROWHULL1 ) ):
ARROWHULL1 := map(hfarray,ARROWHULL1):
ARROWNECK1 := map(Matrix,ARROWNECK1):
ARROWNECK1 := map(convert,ARROWNECK1,listlist):
#ARROWNECK1 := POLYGONS( seq( hfarray(1..3,1..nops(L[1]),L), L=ARROWNECK1 ) ):
ARROWNECK1 := map(hfarray,ARROWNECK1):
#savelib('ARROWHULL1','ARROWNECK1');

# This "rough" arrow is constructed with 6 polygons
alpha := evalf(Pi/4): N := 8: H := 0.8: # same as plottools[arrow]
ARROWHULL2 := POLYGONS( 
   # two perpendicular triangles approximating a cone for the head of the arrow
   [<0.0,0.0,1.0>,<-0.1,0.0,0.8>,<0.1,0.0,0.8>], [<0.0,0.0,1.0>,<0.0,-0.1,0.8>,<0.0,0.1,0.8>],
   # an octagon approximating a disk at the base of the arrow head
   evalf( [seq( <cos(theta)/10,sin(theta)/10,0.8>, theta=[seq( i*alpha, i=0..N-1 )] )] ),
   # two perpendicular rectangles approximating a cylinder for the body of the arrow
   [<-0.04,0.0,0.0>,<-0.04,0.0,0.8>,<+0.04,0.0,0.8>,<+0.04,0.0,0.0>],
   [<0.0,-0.04,0.0>,<0.0,-0.04,0.8>,<0.0,+0.04,0.8>,<0.0,+0.04,0.0>],
   # an octagon approximating a disk at the bottom of the arrow
   evalf( [seq( <cos(theta)/25,sin(theta)/25,0>, theta=[seq( i*alpha, i=0..N-1 )] )] ) ):

ARROWHULL2 := map(Matrix,ARROWHULL2):
ARROWHULL2 := map(convert,ARROWHULL2,listlist):
#ARROWHULL2 := POLYGONS( seq( hfarray(1..3,1..nops(L[1]),L), L=ARROWHULL2 ) ):
ARROWHULL2 := map(hfarray,ARROWHULL2):
#savelib('ARROWHULL2');

# This arrow is constructed with 2 polygons (in color) and 1 curve (in black)
ARROWHEAD3 := POLYGONS( op(1..2,ARROWHULL2) ): # pick up the triangles for the head
ARROWSTEM3 := CURVES( 
   # a heavy line for the stem
   [<0.0,0.0,0.0>,<0.0,0.0,0.8>,
   # a border for the two triangles
   <-0.1,0.0,0.8>,<0.0,0.0,1.0>,<0.1,0.0,0.8>,<0.0,0.0,0.8>,
   <0.0,-0.1,0.8>,<0.0,0.0,1.0>,<0.0,0.1,0.8>,<0.0,0.0,0.8>] ):
ARROWSTEM3 := map(Matrix,ARROWSTEM3):
ARROWSTEM3 := map(convert,ARROWSTEM3,listlist):
ARROWSTEM3 := map(hfarray,ARROWSTEM3):

macro( NORM = NORM, FAST = FAST, SIZE = SIZE, RED = RED, BLACK = BLACK ):
macro( ARROWHULL1 = ARROWHULL1, ARROWNECK1 = ARROWNECK1, 
       ARROWHULL2 = ARROWHULL2, ARROWHEAD3 = ARROWHEAD3,
       ARROWSTEM3 = ARROWSTEM3 ):
