unit ArrowDraw;

{ ArrowDraw: a Pascal unit to aid in the drawing of lines and arrows }
{ }
{ Created by Philippe Casgrain, philippe@casgrain.com }
{ Part of The R Package for Multivariate and Spatial Statistics }
{ Département des sciences biologiques, Université de Montréal }
{ C.P. 6128, succ. "Centre-Ville" }
{ Montréal, Québec }
{ Canada H3C 3J7 }
{ http://www.fas.umontreal.ca/BIOL/legendre/ }
{ }
{ Permission to redistribute freely is hereby granted. Modify at will. }
{ All I ask if you use this code is a mention in your about box and an email telling me you have used it. }
{ }

interface

	uses
		Types, QuickDraw;

{ Draw line from beginPt to endPt, with an arrowhead at the end, using your choice of style }
{ Assumes that the grafport is correctly set, of course }
	procedure ArrowDraw (beginPt, endPt: Point; arrowStyle: Integer);

implementation

	procedure ArrowDraw (beginPt, endPt: Point; arrowStyle: Integer);
		var
			saveRecordPicture: Handle;
			curPort: GrafPtr;
			theArrow: PolyHandle;
			r11, r12, r21, r22, tx, ty, theta: double;

		procedure InitRotate (origH, origV: Integer; theta: double);
		begin
{ Prepare the transformation matrix. See Fundamentals of Computer Graphics pp. 253-4 }
			r11 := Cos(theta);
			r12 := Sin(theta);
			r21 := -Sin(theta);
			r22 := Cos(theta);
			tx := origH * (1 - Cos(theta)) + origV * Sin(theta);
			ty := origV * (1 - Cos(theta)) - origH * Sin(theta);
		end; { InitRotate }

		procedure Rotate (oldH, oldV: double; var h, v: Integer);
		begin
			h := Trunc(oldH * r11 + oldV * r21 + tx); { To keep the value of h when computing v... }
			v := Trunc(oldH * r12 + oldV * r22 + ty);
		end; { Rotate }

{ These are procedures to draw different styles of arrowheads. It  is easy to add a new arrow style. }
{  Simply draw the arrowhead on graph paper (arrow's end pointing to the top) and record the LineTo }
{  sequence necessary to complete the polygon. Then, apply the rotation function to each vertex and }
{  voilà! instant, correctly-rotated arrowhead. }

{ Draw a Canvas-style 'indented' arrow... }
		procedure IndentedArrow;
			const
				height = 8;
				base = 8;
				indent = 2;
			var
				h, v: Integer;
		begin
			Rotate(endPt.h - (base / 2), endPt.v + height, h, v);
			LineTo(h, v);
			Rotate(endPt.h, endPt.v + (height - indent), h, v);
			LineTo(h, v);
			Rotate(endPt.h + (base / 2), endPt.v + height, h, v);
			LineTo(h, v);
		end; { IndentedArrow }

{ Draw a regular, triangular arrow }
		procedure TriangularArrow;
			const
				height = 8;
				base = 8;
			var
				h, v: Integer;
		begin
			Rotate(endPt.h - (base / 2), endPt.v + height, h, v);
			LineTo(h, v);
			Rotate(endPt.h + (base / 2), endPt.v + height, h, v);
			LineTo(h, v);
		end; { TriangularArrow }

	begin { ArrowDraw }
		GetPort(curPort);
{ Draw baseline }
		MoveTo(beginPt.h, beginPt.v);
		LineTo(endPt.h, endPt.v);

{ Arrowhead rotation angle }
		if (beginPt.h = endPt.h) then
			begin { division by zero in this case! }
				theta := pi / 2;
				if beginPt.v > endPt.v then { reverse rotation }
					theta := -theta;
			end
		else
			theta := Arctan((beginPt.v - endPt.v) / (beginPt.h - endPt.h));
		if (beginPt.h - endPt.h) > 0 then
			theta := theta - (pi / 2)
		else
			theta := theta + (pi / 2);
{ Initialize the rotation matrices }
		InitRotate(endPt.h, endPt.v, theta);

{ Stop PICT recording (if any) by setting picSave to nil }
		saveRecordPicture := curPort^.picSave;
		curPort^.picSave := nil;

{ Draw arrowhead starts here }
		MoveTo(endPt.h, endPt.v);
		if arrowStyle = 0 then { 0: don't draw an arrow }
			theArrow := nil
		else
			theArrow := OpenPoly;

		case arrowStyle of
			0: 
				;
			1: 
				IndentedArrow;
			2: 
				TriangularArrow;

			otherwise
				TriangularArrow;
		end; { case }

		if theArrow <> nil then
			ClosePoly;

{ Restart PICT recording (if any) }
		curPort^.picSave := saveRecordPicture;

		if theArrow <> nil then
			begin
				FillPoly(theArrow, qd.black);
				KillPoly(theArrow);
			end; { if theArrow <> nil }
	end; { ArrowDraw }

end. { unit }