-
Notifications
You must be signed in to change notification settings - Fork 12
/
AAMLinearWarp.pas
179 lines (145 loc) · 6.1 KB
/
AAMLinearWarp.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
// ###################################################################
// #### This file is part of the mrimageutils project, depends on
// #### the mathematics library project and is
// #### offered under the licence agreement described on
// #### http://www.mrsoft.org/
// ####
// #### Copyright:(c) 2014, Michael R. . All rights reserved.
// ####
// #### Unless required by applicable law or agreed to in writing, software
// #### distributed under the License is distributed on an "AS IS" BASIS,
// #### WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// #### See the License for the specific language governing permissions and
// #### limitations under the License.
// ###################################################################
unit AAMLinearWarp;
// ##############################################################
// ##### Linear warping using a triangulation and linear interpolation
// ##############################################################
interface
uses SysUtils, Classes, AAMWarp, Matrix, LinearTriangulationTransformation,
BaseMathPersistence, PtsDefinitions, Triangulation;
// ################################################################
// #### Texture warper which uses a triangulation and linear interpolation
// as base
type
TLinearAAMWarper = class(TCustomAAMWarper)
protected
fLinearWarp : TLinearTriangulationMapping;
procedure DefineProps; override;
function PropTypeOfName(const Name : string) : TPropType; override; //
function OnLoadObject(const Name : String; obj : TBaseMathPersistence) : boolean; override;
class function ClassIdentifier : String; override;
public
function MapTexture(FromPts : TDoubleMatrix; img : TDoubleMatrix) : TDoubleMatrix; override;
constructor Create(ToPts : TDoubleMatrix; DestImgWidth, DestImgHeight : integer; NumColorPlanes : integer); override;
destructor Destroy; override;
end;
// ################################################################
// #### Texture warper which uses a triangulation and linear interpolation
// extended for the use in the inverse compositional aam's
type
TICLinearAAMWarper = class(TLinearAAMWarper)
private
function GetTriangles: TBaseTriangulation;
protected
class function ClassIdentifier : String; override;
public
property Triangulation : TBaseTriangulation read GetTriangles;
function LinearInterpolatorFactors(x, y : integer; var ptIdx : TTriangleDef; var alpha, beta, gamma : single) : boolean;
class procedure MapPoint(const xFrom, yFrom : double; const TriFrom : TTrianglePts; var xTo, yTo : double; const TriTo : TTrianglePts);
end;
TICLinearAAMWarperClass = class of TICLinearAAMWarper;
implementation
uses Registration, DelaunyMapping;
{ TLinearAAMWarper }
const cAAMLinWarper = 'AAMLinearWarpObj';
class function TLinearAAMWarper.ClassIdentifier: String;
begin
Result := 'AAMLinearWarp';
end;
constructor TLinearAAMWarper.Create(ToPts: TDoubleMatrix; DestImgWidth,
DestImgHeight: integer; NumColorPlanes : integer);
var ptsObj : TPtsMappingObj;
begin
inherited Create(ToPts, DestImgWidth, DestImgHeight, NumColorPlanes);
fLinearWarp := TDelaunyTriangulationMapping.Create;
ptsObj := TPtsMappingObj.Create(ToPts, False);
try
fLinearWarp.InitTriangulation(ptsObj, DestImgWidth, DestImgHeight);
fLinearWarp.InitPtsForMapping(ptsObj);
finally
ptsObj.Free;
end;
end;
procedure TLinearAAMWarper.DefineProps;
begin
// init base class properties
inherited;
if Assigned(fLinearWarp) then
AddObject(cAAMLinWarper, fLinearWarp);
end;
function TLinearAAMWarper.PropTypeOfName(const Name: string): TPropType;
begin
if CompareText(Name, cAAMLinWarper) = 0
then
Result := ptObject
else
Result := inherited PropTypeOfName(Name);
end;
destructor TLinearAAMWarper.Destroy;
begin
fLinearWarp.Free;
inherited;
end;
function TLinearAAMWarper.MapTexture(FromPts, img: TDoubleMatrix): TDoubleMatrix;
begin
// note the warping mechanism only needs references no fixed objects
fLinearWarp.InitPtsForMapping(FromPts);
Result := fLinearWarp.MapImage(img, NumColorPlanes);
end;
function TLinearAAMWarper.OnLoadObject(const Name: String;
obj: TBaseMathPersistence): boolean;
begin
Result := True;
if CompareText(Name, cAAMLinWarper) = 0
then
fLinearWarp := obj as TLinearTriangulationMapping
else
Result := inherited OnLoadObject(Name, Obj);
end;
{ TICLinearAAMWarper }
class function TICLinearAAMWarper.ClassIdentifier: String;
begin
Result := 'ICAAMLinearWarp';
end;
function TICLinearAAMWarper.GetTriangles: TBaseTriangulation;
begin
Result := fLinearWarp.Triangulation;
end;
function TICLinearAAMWarper.LinearInterpolatorFactors(x, y: integer; var ptIdx : TTriangleDef; var alpha,
beta, gamma: single) : boolean;
var pt : TPointf2D;
begin
pt.x := x;
pt.y := y;
Result := fLinearWarp.CalcFactorsForPoints(pt, ptIdx, alpha, beta, gamma);
end;
class procedure TICLinearAAMWarper.MapPoint(const xFrom, yFrom: double;
const TriFrom: TTrianglePts; var xTo, yTo: double; const TriTo: TTrianglePts);
var c, alpha, beta, gamma : double;
begin
c := TriFrom[1].x*TriFrom[2].y - TriFrom[1].x*TriFrom[0].y - TriFrom[0].x*TriFrom[2].y -
Trifrom[2].x*TriFrom[2].y + TriFrom[2].x*TriFrom[0].y + TriFrom[0].x*TriFrom[1].y;
c := 1/c;
alpha := (yFrom*TriFrom[2].x - xFrom*TriFrom[2].y + xFrom*Trifrom[1].y - yFrom*TriFrom[1].y +
TriFrom[1].x*TriFrom[2].y - TriFrom[2].x*TriFrom[1].y)*c;
beta := (-yFrom*TriFrom[2].x + yFrom*TriFrom[0].x + TriFrom[2].x*TriFrom[0].y + xFrom*TriFrom[2].y -
TriFrom[0].x*TriFrom[2].y - TriFrom[2].x*TriFrom[1].y)*c;
gamma := 1 - alpha - beta;
xTo := alpha*TriTo[0].x + beta*TriTo[1].x + gamma*TriTo[2].x;
yTo := alpha*TriTo[0].x + beta*TriTo[1].y + gamma*TriTo[2].y;
end;
initialization
RegisterMathIO(TLinearAAMWarper);
end.