Arrows, our3DdisplacementForm, our3DShow, and newShow

(* Clear[newTestCone] ; newTestCone[direction_, headPointAt_] :=  ( &# ... 62371;Prepend[Table[{ Cos[t], Sin[t], -5}/20, {t, 0, 2π, π/3}], {0, 0, 0}]]) *)

Clear[newPolygonCone] ; newPolygonCone[direction_, headPointAt_] := Map[(# + headPointAt) &, Map[AyAx[direction, 2] . #& , myCone, {3}], {3} ]

{dirCone[aD], dirCone[bD], dirCone[cD], dirCone[dD]} = newPolygonCone[#, {0, 0, 0}] & /@   {aD, bD, cD, dD} ; (* These are precomputed for speed *)

dirCone[dD]

(* Clear[cone] ; cone[direction_, headPointAt_] := Polygon[(# + headPointAt) & /@ ... epend[Table[{ Cos[t], Sin[t], -5}/20, {t, 0, 2π, π/3}], {0, 0, 0}]] ] *)

(* Clear[cone] ; cone[direction_, headPointAt_] := Polygon[(# + headPointAt) & /@ dirCone[direction] ] *)

Clear[cone] ; cone[direction_, headPointAt_] := Map[(# + headPointAt) &, dirCone[direction], {3} ]

(*Clear[aArrow, bArrow, cArrow, dArrow] ; aArrow[xyz_, aD_, th_] := {RGBColor[ ... xyz_, dD_, th_] := {RGBColor[.5, .5, 1], Thickness[th], Line[{xyz - dD, xyz}], cone[dD, xyz]} ; *)

Clear[myArrow] ; myArrow[xyz_, aD, th_] := {RGBColor[1, .28, .71], Thickness[th], Line[{xyz - ... ow[xyz_, dD, th_] := {RGBColor[.5, .5, 1], Thickness[th], Line[{xyz - dD, xyz}], cone[dD, xyz]} ;

RowBox[{Show, [, RowBox[{RowBox[{Graphics3D, [, RowBox[{{, RowBox[{RowBox[{myArrow, [, RowBox[ ... , , RowBox[{-, 1.943}], ,, , 1.5}], }}]}], ,, Lighting->False, ,, PlotRangeAll}], ]}]

[Graphics:../HTMLFiles/4LetterWalksInDiamondLattice_164.gif]

⁃Graphics3D⁃

Graphics3D//Options

Clear[displacementsForabcd, our3DdisplacementForm, our3DShow] ;  displacementsForabcd[ ... {FontFamily"Times", FontSlant"Italic", FontSize7}]] ;

Clear[newShow] ; newShow[x_String, th_, vp_] := our3DShow[Characters[x], verticesOfTetrahedronDisplacementsForabcd, th, vp]

Created by Mathematica  (February 18, 2004)