unit Projections;
interface
uses
	Geomet, Complex, Classes, RefObjects;

type
	TProjection = class(TRefObject)
		function GetZoomScale: Double; virtual; abstract;
		function GetYMirror: Boolean; virtual; abstract;
		function ProjectPoint(const aP: TDPoint): TDPoint; virtual; abstract;
		function UnProjectPoint(const aP: TDPoint): TDPoint; virtual; abstract;
		function ProjectBounds(const aBounds: TDRect): TDRect; virtual;
		function UnProjectBounds(const aBounds: TDRect): TDRect; virtual;
		procedure ProjectContour(aContour: TContour); virtual;
		procedure UnProjectContour(aContour: TContour); virtual;
	end;

	TGroupProjection = class(TProjection)
	private
		FItems: TRefObjectList;
	public
		constructor Create;
		destructor Destroy; override;
		
		function GetZoomScale: Double; override;
		function GetYMirror: Boolean; override;
		function ProjectPoint(const aP: TDPoint): TDPoint; override;
		function UnProjectPoint(const aP: TDPoint): TDPoint; override;
		function ProjectBounds(const aBounds: TDRect): TDRect; override;
		function UnProjectBounds(const aBounds: TDRect): TDRect; override;
		procedure ProjectContour(aContour: TContour); override;
		procedure UnProjectContour(aContour: TContour); override;

		property Items: TRefObjectList read FItems;
	end;

	TTransformMatrixBase = object
		a, b, c,
		d, e, f: Double;
	end;

	TTransformMatrix = object(TTransformMatrixBase)
		procedure Assign(const m: TTransformMatrixBase);
		function Mul(const m: TTransformMatrix): TTransformMatrix;
		function Backward: TTransformMatrix;
	end;

	TMatrixProjection = class(TProjection)
	private
		FDirect,
		FBackward: TTransformMatrix;
		FDirectScale: TDPoint;
		FUpdateCount: Integer;
		FYMirror: Boolean;

		FOnChange: TNotifyEvent;
	public
		constructor Create;

		function GetZoomScale: Double; override;
		function GetYMirror: Boolean; override;

		function ProjectPoint(const aP: TDPoint): TDPoint; override;
		function UnProjectPoint(const aP: TDPoint): TDPoint; override;

		procedure BeginUpdate;
		procedure EndUpdate;

		procedure Clear;
		procedure Assign(aMatrixProjection: TMatrixProjection);
		procedure AddScaling(aX, aY: Double);
		procedure AddTranslation(aX, aY: Double);
		procedure AddRotation(anAngle: Double);
		procedure AddReflection(aX, aY: Boolean);
		procedure AddShear(aX, aY: Double);

		property DirectScale: TDPoint read FDirectScale;
		property OnChange: TNotifyEvent read FOnChange write FOnChange;
	end;

implementation
uses
	Math;

{ TProjection }

function TProjection.ProjectBounds(const aBounds: TDRect): TDRect;
begin
	with ProjectPoint(DPoint(aBounds.X1, aBounds.Y1)) do
		Result.Assign(X, Y, X, Y);
	Result.Expand(ProjectPoint(DPoint(aBounds.X1, aBounds.Y2)));
	Result.Expand(ProjectPoint(DPoint(aBounds.X2, aBounds.Y1)));
	Result.Expand(ProjectPoint(DPoint(aBounds.X2, aBounds.Y2)));
end;

function TProjection.UnProjectBounds(const aBounds: TDRect): TDRect;
begin
	with UnProjectPoint(DPoint(aBounds.X1, aBounds.Y1)) do
		Result.Assign(X, Y, X, Y);
	Result.Expand(UnProjectPoint(DPoint(aBounds.X1, aBounds.Y2)));
	Result.Expand(UnProjectPoint(DPoint(aBounds.X2, aBounds.Y1)));
	Result.Expand(UnProjectPoint(DPoint(aBounds.X2, aBounds.Y2)));
end;

procedure TProjection.ProjectContour(aContour: TContour);
var
	i: Integer;
	aCommands: PContourInternalCommandArray;
	anArcData: PContourInternalArcDataArray;
	aCommand: PContourInternalCommand;
begin
	aContour.BeginUpdate;
	try
		aCommands := aContour.GetInternalCommands;
		anArcData := aContour.GetInternalArcData;
		aCommand := Pointer(aCommands);
		for i := 0 to aContour.CommandCount - 1 do begin
			if aCommand.CommandType in CommandsWithPoint then
				aCommand.Point := ProjectPoint(aCommand.Point);
			Inc(aCommand);
		end;
		if GetYMirror and aContour.HasArcs then begin
			aCommand := Pointer(aCommands);
			for i := 0 to aContour.CommandCount - 1 do begin
				if aCommand.CommandType in ArcCommands then
					with anArcData[aCommand.ArcData] do
						if Convexity <> 0 then
							Convexity := -Convexity;
				Inc(aCommand)
			end;
		end
	finally
		aContour.EndUpdate
	end;
end;

procedure TProjection.UnProjectContour(aContour: TContour);
var
	i: Integer;
	aCommand: TContourCommand;
begin
	aContour.BeginUpdate;
	try
		for i := 0 to aContour.CommandCount - 1 do
			if aContour.CommandTypes[i] in CommandsWithPoint then
				aContour.SetPoint(i, UnprojectPoint(aContour.CommandPoints[i]));
		if GetYMirror and aContour.HasArcs then
			for i := 0 to aContour.CommandCount - 1 do
				if aContour.CommandTypes[i] in ArcCommands then begin
					aCommand := aContour.Commands[i];
					if aCommand.Convexity <> 0 then begin
						aCommand.Convexity := -aCommand.Convexity;
						aContour.Commands[i] := aCommand;
					end
				end
	finally
		aContour.EndUpdate
	end;
end;

{	TGroupProjection }

constructor TGroupProjection.Create;
begin
	inherited Create;
	FItems := TRefObjectList.Create;
end;

destructor TGroupProjection.Destroy;
begin
	FItems.Free;
	inherited Destroy;
end;

function TGroupProjection.GetZoomScale: Double;
var
	i: Integer;
begin
	if FItems.Count = 0 then
		Result := inherited GetZoomScale
	else begin
		Result := TProjection(FItems[0]).GetZoomScale;
		for i := 1 to FItems.Count - 1 do
			Result := Result * TProjection(FItems[i]).GetZoomScale
	end
end;

function TGroupProjection.GetYMirror: Boolean;
var
	i: Integer;
begin
	Result := False;
	for i := 0 to FItems.Count - 1 do
		if TProjection(FItems[i]).GetYMirror then
			Result := not Result;
end;

function TGroupProjection.ProjectPoint(const aP: TDPoint): TDPoint;
var
	i: Integer;
begin
	if FItems.Count = 0 then
		Result := inherited ProjectPoint(aP)
	else begin
		Result := TProjection(FItems.First).ProjectPoint(aP);
		for i := 1 to FItems.Count - 1 do
			Result := TProjection(FItems[i]).ProjectPoint(Result)
	end
end;

function TGroupProjection.UnProjectPoint(const aP: TDPoint): TDPoint;
var
	i: Integer;
begin
	if FItems.Count = 0 then
		Result := inherited UnprojectPoint(aP)
	else begin
		Result := TProjection(FItems.Last).UnprojectPoint(aP);
		for i := FItems.Count - 2 downto 0 do
			Result := TProjection(FItems[i]).UnprojectPoint(Result)
	end
end;

function TGroupProjection.ProjectBounds(const aBounds: TDRect): TDRect;
var
	i: Integer;
begin
	if FItems.Count = 0 then
		Result := inherited ProjectBounds(aBounds)
	else begin
		Result := TProjection(FItems.First).ProjectBounds(aBounds);
		for i := 1 to FItems.Count - 1 do
			Result := TProjection(FItems[i]).ProjectBounds(Result)
	end
end;

function TGroupProjection.UnProjectBounds(const aBounds: TDRect): TDRect;
var
	i: Integer;
begin
	if FItems.Count = 0 then
		Result := inherited UnprojectBounds(aBounds)
	else begin
		Result := TProjection(FItems.Last).UnprojectBounds(aBounds);
		for i := FItems.Count - 2 downto 0 do
			Result := TProjection(FItems[i]).UnprojectBounds(Result)
	end
end;

procedure TGroupProjection.ProjectContour(aContour: TContour);
var
	i: Integer;
begin
	aContour.BeginUpdate;
	try
		for i := 0 to FItems.Count - 1 do
			TProjection(FItems[i]).ProjectContour(aContour);
	finally
		aContour.EndUpdate
	end;
end;

procedure TGroupProjection.UnProjectContour(aContour: TContour);
var
	i: Integer;
begin
	aContour.BeginUpdate;
	try
		for i := FItems.Count - 1 downto 0 do
			TProjection(FItems[i]).UnprojectContour(aContour);
	finally
		aContour.EndUpdate
	end
end;

const
	EmptyTransformMatrix: TTransformMatrix = (
		a:1; b:0; c:0;
		d:0; e:1; f:0
	);

{	TTransformMatrix }
	
procedure TTransformMatrix.Assign(const m: TTransformMatrixBase);
begin
	a := m.a;
	b := m.b;
	c := m.c;
	d := m.d;
	e := m.e;
	f := m.f;
end;

function TTransformMatrix.Mul(const m: TTransformMatrix): TTransformMatrix;
begin
	Result.a := a*m.a + d*m.b;
	Result.b := b*m.a + e*m.b;
	Result.c := c*m.a + f*m.b + m.c;
	Result.d := a*m.d + d*m.e;
	Result.e := b*m.d + e*m.e;
	Result.f := c*m.d + f*m.e + m.f;
end;

function TTransformMatrix.Backward: TTransformMatrix;
var
	aD: Double;
begin
	aD := a*e - b*d;
	if aD = 0 then
		Result := EmptyTransformMatrix
	else begin
		Result.a := e/aD;
		Result.b := -b/aD;
		Result.c := (b*f - c*e)/aD;
		Result.d := -d/aD;
		Result.e := a/aD;
		Result.f := (c*d - a*f)/aD;
	end;
end;


{	TMatrixProjection }

constructor TMatrixProjection.Create;
begin
	inherited Create;
	Clear;
end;

function TMatrixProjection.GetZoomScale: Double;
begin
	with FDirectScale do
		if X = Y then
			Result := X
		else
			Result := Sqrt(X * Y);
end;

function TMatrixProjection.GetYMirror: Boolean;
begin
	Result := FYMirror;
end;

function TMatrixProjection.ProjectPoint(const aP: TDPoint): TDPoint;
begin
	with FDirect do begin
		Result.x := a*aP.x + b*aP.y + c;
		Result.y := d*aP.x + e*aP.y + f
	end;
end;

function TMatrixProjection.UnProjectPoint(const aP: TDPoint): TDPoint;
begin
	with FBackward do begin
		Result.x := a*aP.x + b*aP.y + c;
		Result.y := d*aP.x + e*aP.y + f
	end;
end;

procedure TMatrixProjection.BeginUpdate;
begin
	Inc(FUpdateCount);
end;

procedure TMatrixProjection.EndUpdate;
begin
	Dec(FUpdateCount);
	if (FUpdateCount = 0) and Assigned(FOnchange) then
		FOnChange(Self)
end;

procedure TMatrixProjection.Assign(aMatrixProjection: TMatrixProjection);
begin
	BeginUpdate;
	try
		FDirectScale := aMatrixProjection.DirectScale;
		FDirect := aMatrixProjection.FDirect;
		FBackward := aMatrixProjection.FBackward;
		FYMirror := aMatrixProjection.FYMirror;
	finally
		EndUpdate
	end
end;

procedure TMatrixProjection.Clear;
begin
	BeginUpdate;
	try
		FDirectScale := DPoint(1, 1);
		FDirect := TTransformMatrix(EmptyTransformMatrix);
		FBackward := TTransformMatrix(EmptyTransformMatrix);
		FYMirror := False;
	finally
		EndUpdate
	end
end;

var
	Scaling: TTransformMatrix = (
		a:{aX}1; b:0; c:0;
		d:0; e:{aY}1; f:0);

procedure TMatrixProjection.AddScaling(aX, aY: Double);
begin
	BeginUpdate;
	try
		with Scaling do begin
			a := aX;
			e := aY;
		end;
		
		FDirect := FDirect.Mul(Scaling);
		FBackward := FDirect.Backward;
		FDirectScale.X := Abs(FDirectScale.X * aX);
		FDirectScale.Y := Abs(FDirectScale.Y * aY);
		if aY < 0 then
			FYMirror := not FYMirror;
	finally
		EndUpdate
	end
end;

var
	Translation: TTransformMatrix = (
		a:1; b:0; c:{aX}0;
		d:0; e:1; f:{aY}0);

procedure TMatrixProjection.AddTranslation(aX, aY: Double);
begin
	BeginUpdate;
	try
		with Translation do begin
			c := aX;
			f := aY;
		end;
		FDirect := FDirect.Mul(Translation);
		FBackward := FDirect.Backward;
	finally
		EndUpdate
	end
end;

var
	Rotation: TTransformMatrix = (
		a:1; b:1; c:0;
		d:1; e:1; f:0);

procedure TMatrixProjection.AddRotation(anAngle: Double);
var
	aSin, aCos: Extended;
begin
	BeginUpdate;
	try
		SinCos(anAngle, aSin, aCos);
		with Rotation do begin
			a := aCos;
			b := -aSin;
			d := aSin;
			e := aCos;
		end;
		FDirect := FDirect.Mul(Rotation);
		FBackward := FDirect.Backward;
	finally
		EndUpdate
	end
end;

var
	Reflection: TTransformMatrix = (
		a:{aX}1; b:0; c:0;
		d:0; e:{aY}1; f:0);

procedure TMatrixProjection.AddReflection(aX, aY: Boolean);
begin
	BeginUpdate;
	try
		with Reflection do begin
			if aX then a := -1 else a := 1;
			if aY then e := -1 else e := 1;
		end;
		FDirect := FDirect.Mul(Reflection);
		FBackward := FDirect.Backward;
		if aY then
			FYMirror := not FYMirror;
	finally
		EndUpdate
	end;
end;

var
	Shear: TTransformMatrix = (
		a:1; b:{aY}1; c:0;
		d:{aX}1; e:1; f:0);

procedure TMatrixProjection.AddShear(aX, aY: Double);
begin
	BeginUpdate;
	try
		with Shear do begin
			b := aY;
			d := aX;
		end;
		FDirect := FDirect.Mul(Shear);
		FBackward := FDirect.Backward;
	finally
		EndUpdate
	end
end;



end.

