(* ::Package:: *) (* :Title: Arrow Graphics Primitives *) (* :Context: Graphics`Arrow` *) (* :Author: John M. Novak *) (* :Summary: This package handled compatability between the old pre-V6 Arrow.m package and the new V6 Arrow primitive. *) (* :Package Version: 2.0 *) (* :Mathematica Version: 6.0 *) (* :Copyright: Copyright 1992-2007, Wolfram Research, Inc.*) (* :History: V 0.9 June 1992 by John M. Novak. V 1.0 October 1992 by John M. Novak--substantial revisions. V 1.0.1 March 1994 by John M. Novak -- bug fixes, including zero check in the PostScript. V 1.0.2 February 1997 by John M. Novak -- bug fix for DisplayString. V 1.0.3 February 1998 by John M. Novak -- fix to allow Arrow objects in Epilog or Prolog of any graphics object V 2.0 December 2003 by John M. Novak -- turn package into a compatability layer for the new Arrow primitive. *) (* :Keywords: Arrow, Vector, PostScript, Graphics *) (* :Sources: *) (* :Discussion: The compatability layer is implemented as an overload of the Arrow primitive, so that old-style primitives are converted to new-style primitives during evaluation. Note the implementation as an evaluation object, not a formatting object; I believe this is correct for the application, but it may turn out to be appropriate to put in a formatting hook at some point. Note that based on the current design, a zero-length V6 arrow does not render at all; hence this package has to convert to regular primitives for the zero-length case. *) Message[General::obspkg, "Graphics`Arrow`"] BeginPackage["Graphics`Arrow`"] HeadShape::usage = "HeadShape is an obsolete option for the Arrow primitive; it specifies \ the shape of the arrow's head by Automatic, which specifies that the \ shape is described by the parameters HeadLength, HeadCenter, and \ HeadWidth, or it can be a list of a subset of the Mathematica graphics \ primitives, drawn in the coordinate system scaled by HeadScaling. The \ coordinate system is centered at the head of the arrow, with the negative \ direction moving towards the tail of the arrow."; HeadScaling::usage = "HeadScaling is an obsolete option for the Arrow primitive; it specifies \ the scaling used in the coordinate system for drawing the \ arrowhead. Automatic scales the system to the graphic, where \ {0,0} is at the head of the arrow, and the system is rotated along \ the arrow, and the distance between 0 and 1 is equivalent to the width of \ the graphic. Relative scales the coordinates of the arrowhead so that {0,0} \ is at the head of the arrow, {-1,0} at the tail. Absolute scales to \ the same coordinate system used in the device coordinate \ system, rotated along the arrow, with {0,0} at the head."; ZeroShape::usage = "ZeroShape is an obsolete option for the Arrow primitive; it specifies \ the shape of an arrow with no length (and hence no direction) in a form \ similar to that of the HeadShape option. Note that the \ parameterized form of HeadShape is not available. The coordinate system \ is not rotated, but is scaled to HeadScaling. Automatic sets \ the default zero arrow (a point.)"; HeadLength::usage = "HeadLength is an obsolete option for the Arrow primitive. It is used when \ HeadShape -> Automatic. It describes the length of the arrowhead, scaled \ according to HeadScaling."; HeadWidth::usage = "HeadWidth is an obsolete option for the Arrow primitive. It is used when \ HeadShape -> Automatic. It describes the width of the arrowhead, relative \ to the length of the arrowhead (specified by HeadLength.)"; HeadCenter::usage = "HeadCenter is an obsolete option for the Arrow primitive. It is used when \ HeadShape -> Automatic. It describes the location of the center of the \ base of the arrowhead along the length of the arrow, as a factor of the \ length of the arrowhead. That is, if HeadCenter -> 0, the arrow will be \ two lines; if HeadCenter -> 1, the arrowhead will be a perfect triangle; \ otherwise, the arrowhead will be four-sided."; Relative::usage = "Relative is a possible value for the HeadScaling option to Arrow. \ It specifies that the coordinate system in which the arrowhead is rendered \ should be scaled to the length of the arrow, where {0,0} is at the head \ of the arrow and {-1,0} is at the tail of the arrow."; Absolute::usage = "Absolute is a possible value for the HeadScaling option to Arrow. \ It specifies that the device scaling should be used for the \ arrowhead."; Begin["`Private`"] issueObsoleteFunMessage[fun_, context_] := Message[General::obspkgfn, fun, context]; (* A little utility function for checking numeric values. *) numberQ[x_] := NumberQ[N[x]] (* overload the definition of Arrow *) protected = Unprotect[Arrow]; If[FreeQ[Options[Arrow], HeadScaling], Options[Arrow] = Options[Arrow] ~Join~ {HeadScaling -> Automatic, HeadLength -> Automatic, HeadCenter -> 1, HeadWidth -> .5, HeadShape -> Automatic, ZeroShape -> Automatic}; ] Arrow[{bx_?numberQ, by_?numberQ}, {ex_?numberQ, ey_?numberQ}, opts___?OptionQ] := (issueObsoleteFunMessage[Arrow,"Graphics`Arrow`"]; If[bx == ex && by == ey, renderzeroarrow[{bx, by}, opts], {Arrowheads[{getarrowhead[{bx, by}, {ex, ey}, opts]}], Arrow[{{bx, by}, {ex, ey}}]} ]) (* update FE's syntax checking *) SyntaxInformation[Arrow] = {"ArgumentsPattern" -> {{__, _.}, _., OptionsPattern[]}} Protect @@ protected; (* function to handle a zero-length arrow; current Arrow design does not support this functionality, so I must output raw primitives. *) renderzeroarrow[pt_, opts___] := Module[{shape, scaling}, {shape, scaling} = {ZeroShape, HeadScaling}/. Flatten[{opts, Options[Arrow]}]; If[shape === Automatic, Point[pt], translateandfixcoords[shape, scaling, pt] ] ] (* function to generate appropriate ArrowHeads specification based on old Arrow args *) getarrowhead[{x1_, y1_}, {x2_, y2_}, opts___] := Module[{scale, shape, length, width, center}, {scale, shape, length, width, center} = {HeadScaling, HeadShape, HeadLength, HeadWidth, HeadCenter}/. Flatten[{opts, Options[Arrow]}]; If[shape === Automatic, shape = makehead[scale, length, width, center] ]; If[scale === Relative, scale = Sqrt[(x2 - x1)^2 + (y2 - y1)^2], shape = translateandfixcoords[shape, scale, {0, 0}]; scale = 1 ]; {scale, 1, Graphics[shape]} ] makehead[scale_, ilen_, wid_, cent_] := Module[{len = If[!numberQ[ilen], defaultlen[scale], ilen]}, Polygon[{{0, 0}, {-len, (len * wid)/2}, {-(len * cent), 0}, {-len, -(len * wid)/2}, {0,0}}] ] defaultlen[Relative] = 0.05 defaultlen[Absolute] = 3 defaultlen[_] = 0.05 (* utilities *) (* translateandfixcoords translates a graphics primitive and adjusts the coordinate system scaling. Since this package is just a support for the old Arrow.m package, I don't need to handle a full range of graphics primitives, only those supported in arrow heads in the old package. *) translateandfixcoords[shape_List, scale_, pt_] := translateandfixcoords[#, scale, pt] & /@ shape translateandfixcoords[Polygon[p_], scale_, pt_] := Polygon[fixscaling[#, scale, pt]& /@ p] translateandfixcoords[Line[l_], scale_, pt_] := Line[fixscaling[#, scale, pt]& /@ l] translateandfixcoords[Point[p_], scale_, pt_] := Point[fixscaling[p, scale, pt]] translateandfixcoords[any_, _, _] := any (* fixscaling[pt_, Automatic, basept_] := Scaled[pt, basept] *) fixscaling[pt_, Automatic, basept_] := pt + basept fixscaling[pt_, Absolute, basept_] := Offset[pt, basept] fixscaling[pt_, Relative, basept_] := pt + basept End[] EndPackage[]