1
//----------------------------------------------------------------------------
2
// Anti-Grain Geometry - Version 2.4 (Public License)
3
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
5
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
6
// Pascal Port By: Milan Marusinec alias Milano
8
// http://www.aggpas.org
9
// Copyright (c) 2005-2006
11
// Permission to copy, use, modify, sell and distribute this software
12
// is granted provided this copyright notice appears in all copies.
13
// This software is provided "as is" without express or implied
14
// warranty, and with no claim as to its suitability for any purpose.
16
//----------------------------------------------------------------------------
17
// Contact: mcseem@antigrain.com
18
// mcseemagg@yahoo.com
19
// http://www.antigrain.com
21
// [Pascal Port History] -----------------------------------------------------
23
// 23.06.2006-Milano: ptrcomp adjustments
24
// 06.02.2006-Milano: Unit port establishment
38
procedure swap_arrays (a1 ,a2 : double_ptr; n : unsigned );
39
function matrix_pivot (m : double_ptr; row ,Rows ,Cols : unsigned ) : int;
40
function simul_eq_solve(left ,right ,result_ : double_ptr; Size ,RightCols : unsigned ) : boolean;
44
{ LOCAL VARIABLES & CONSTANTS }
45
{ UNIT IMPLEMENTATION }
47
procedure swap_arrays;
61
inc(ptrcomp(a1 ) ,sizeof(double ) );
62
inc(ptrcomp(a2 ) ,sizeof(double ) );
70
function matrix_pivot;
75
max_val ,tmp : double;
86
tmp:=Abs(double_ptr(ptrcomp(m ) + (i * Cols + row ) * sizeof(double ) )^ );
88
if (tmp > max_val ) and
101
if double_ptr(ptrcomp(m ) + (k * Cols + row ) * sizeof(double ) )^ = 0.0 then
112
double_ptr(ptrcomp(m ) + k * Cols * sizeof(double ) ) ,
113
double_ptr(ptrcomp(m ) + row * Cols * sizeof(double ) ) ,
127
function simul_eq_solve;
131
i , j , k ,adx : unsigned;
141
adx:=Size + RightCols;
143
agg_getmem(pointer(tmp ) ,Size * adx * sizeof(double ) );
145
for i:=0 to Size - 1 do
147
for j:=0 to Size - 1 do
148
double_ptr(ptrcomp(tmp ) + (i * adx + j ) * sizeof(double ) )^:=
149
double_ptr(ptrcomp(left ) + (i * Size + j ) * sizeof(double ) )^;
151
for j:=0 to RightCols - 1 do
152
double_ptr(ptrcomp(tmp ) + (i * adx + Size + j ) * sizeof(double ) )^:=
153
double_ptr(ptrcomp(right ) + (i * RightCols + j ) * sizeof(double ) )^;
157
for k:=0 to Size - 1 do
159
if matrix_pivot(tmp ,k ,Size ,Size + RightCols ) < 0 then
160
goto return_false; // Singularity....
162
a1:=double_ptr(ptrcomp(tmp ) + (k * adx + k ) * sizeof(double ) )^;
165
while j < Size + RightCols do
167
double_ptr(ptrcomp(tmp ) + (k * adx + j ) * sizeof(double ) )^:=
168
double_ptr(ptrcomp(tmp ) + (k * adx + j ) * sizeof(double ) )^ / a1;
178
a1:=double_ptr(ptrcomp(tmp ) + (i * adx + k ) * sizeof(double ) )^;
181
while j < Size + RightCols do
183
double_ptr(ptrcomp(tmp ) + (i * adx + j ) * sizeof(double ) )^:=
184
double_ptr(ptrcomp(tmp ) + (i * adx + j ) * sizeof(double ) )^ -
185
a1 * double_ptr(ptrcomp(tmp ) + (k * adx + j ) * sizeof(double ) )^;
197
for k:=0 to RightCols - 1 do
203
double_ptr(ptrcomp(result_ ) + (m * RightCols + k ) * sizeof(double ) )^:=
204
double_ptr(ptrcomp(tmp ) + (m * adx + Size + k ) * sizeof(double ) )^;
210
double_ptr(ptrcomp(result_ ) + (m * RightCols + k ) * sizeof(double ) )^:=
211
double_ptr(ptrcomp(result_ ) + (m * RightCols + k ) * sizeof(double ) )^ -
212
(double_ptr(ptrcomp(tmp ) + (m * adx + j ) * sizeof(double ) )^ *
213
double_ptr(ptrcomp(result_ ) + (j * RightCols + k ) * sizeof(double ) )^ );
235
agg_freemem(pointer(tmp ) ,Size * adx * sizeof(double ) );