← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/aggpas/src/agg_math.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/aggpas/src/agg_math.pas
1
 
//----------------------------------------------------------------------------
2
 
// Anti-Grain Geometry - Version 2.4 (Public License)
3
 
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
4
 
//
5
 
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
6
 
// Pascal Port By: Milan Marusinec alias Milano
7
 
//                 milan@marusinec.sk
8
 
//                 http://www.aggpas.org
9
 
// Copyright (c) 2005-2006
10
 
//
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.
15
 
//
16
 
//----------------------------------------------------------------------------
17
 
// Contact: mcseem@antigrain.com
18
 
//          mcseemagg@yahoo.com
19
 
//          http://www.antigrain.com
20
 
//
21
 
//----------------------------------------------------------------------------
22
 
// Bessel function (besj) was adapted for use in AGG library by Andy Wilk
23
 
// Contact: castor.vulgaris@gmail.com
24
 
//
25
 
// [Pascal Port History] -----------------------------------------------------
26
 
//
27
 
// 23.06.2006-Milano: ptrcomp adjustments
28
 
// 18.12.2005-Milano: Unit port establishment
29
 
//
30
 
{ agg_math.pas }
31
 
unit
32
 
 agg_math ;
33
 
 
34
 
INTERFACE
35
 
 
36
 
{$I agg_mode.inc }
37
 
{$Q- }
38
 
{$R- }
39
 
uses
40
 
 Math ,
41
 
 agg_basics ,
42
 
 agg_vertex_sequence ;
43
 
 
44
 
{ GLOBAL VARIABLES & CONSTANTS }
45
 
type
46
 
 double_xy_ptr = ^double_xy;
47
 
 double_xy = record
48
 
   x ,y : double;
49
 
 
50
 
  end;
51
 
 
52
 
 poly_xy_ptr = ^poly_xy;
53
 
 poly_xy = array[0..0 ] of double_xy;
54
 
 
55
 
 storage_xy_ptr = ^storage_xy;
56
 
 storage_xy = record
57
 
   poly : poly_xy_ptr;
58
 
   size : unsigned;
59
 
 
60
 
  end;
61
 
 
62
 
const
63
 
 intersection_epsilon : double = 1.0e-30;
64
 
 
65
 
// Tables for fast sqrt
66
 
const
67
 
 g_sqrt_table : array[0..1023 ] of int16u = (0 ,
68
 
  2048,2896,3547,4096,4579,5017,5418,5793,6144,6476,6792,7094,7384,7663,7932,8192,8444,
69
 
  8689,8927,9159,9385,9606,9822,10033,10240,10443,10642,10837,11029,11217,11403,11585,
70
 
  11765,11942,12116,12288,12457,12625,12790,12953,13114,13273,13430,13585,13738,13890,
71
 
  14040,14189,14336,14482,14626,14768,14910,15050,15188,15326,15462,15597,15731,15864,
72
 
  15995,16126,16255,16384,16512,16638,16764,16888,17012,17135,17257,17378,17498,17618,
73
 
  17736,17854,17971,18087,18203,18318,18432,18545,18658,18770,18882,18992,19102,19212,
74
 
  19321,19429,19537,19644,19750,19856,19961,20066,20170,20274,20377,20480,20582,20684,
75
 
  20785,20886,20986,21085,21185,21283,21382,21480,21577,21674,21771,21867,21962,22058,
76
 
  22153,22247,22341,22435,22528,22621,22713,22806,22897,22989,23080,23170,23261,23351,
77
 
  23440,23530,23619,23707,23796,23884,23971,24059,24146,24232,24319,24405,24491,24576,
78
 
  24661,24746,24831,24915,24999,25083,25166,25249,25332,25415,25497,25580,25661,25743,
79
 
  25824,25905,25986,26067,26147,26227,26307,26387,26466,26545,26624,26703,26781,26859,
80
 
  26937,27015,27092,27170,27247,27324,27400,27477,27553,27629,27705,27780,27856,27931,
81
 
  28006,28081,28155,28230,28304,28378,28452,28525,28599,28672,28745,28818,28891,28963,
82
 
  29035,29108,29180,29251,29323,29394,29466,29537,29608,29678,29749,29819,29890,29960,
83
 
  30030,30099,30169,30238,30308,30377,30446,30515,30583,30652,30720,30788,30856,30924,
84
 
  30992,31059,31127,31194,31261,31328,31395,31462,31529,31595,31661,31727,31794,31859,
85
 
  31925,31991,32056,32122,32187,32252,32317,32382,32446,32511,32575,32640,32704,32768,
86
 
  32832,32896,32959,33023,33086,33150,33213,33276,33339,33402,33465,33527,33590,33652,
87
 
  33714,33776,33839,33900,33962,34024,34086,34147,34208,34270,34331,34392,34453,34514,
88
 
  34574,34635,34695,34756,34816,34876,34936,34996,35056,35116,35176,35235,35295,35354,
89
 
  35413,35472,35531,35590,35649,35708,35767,35825,35884,35942,36001,36059,36117,36175,
90
 
  36233,36291,36348,36406,36464,36521,36578,36636,36693,36750,36807,36864,36921,36978,
91
 
  37034,37091,37147,37204,37260,37316,37372,37429,37485,37540,37596,37652,37708,37763,
92
 
  37819,37874,37929,37985,38040,38095,38150,38205,38260,38315,38369,38424,38478,38533,
93
 
  38587,38642,38696,38750,38804,38858,38912,38966,39020,39073,39127,39181,39234,39287,
94
 
  39341,39394,39447,39500,39553,39606,39659,39712,39765,39818,39870,39923,39975,40028,
95
 
  40080,40132,40185,40237,40289,40341,40393,40445,40497,40548,40600,40652,40703,40755,
96
 
  40806,40857,40909,40960,41011,41062,41113,41164,41215,41266,41317,41368,41418,41469,
97
 
  41519,41570,41620,41671,41721,41771,41821,41871,41922,41972,42021,42071,42121,42171,
98
 
  42221,42270,42320,42369,42419,42468,42518,42567,42616,42665,42714,42763,42813,42861,
99
 
  42910,42959,43008,43057,43105,43154,43203,43251,43300,43348,43396,43445,43493,43541,
100
 
  43589,43637,43685,43733,43781,43829,43877,43925,43972,44020,44068,44115,44163,44210,
101
 
  44258,44305,44352,44400,44447,44494,44541,44588,44635,44682,44729,44776,44823,44869,
102
 
  44916,44963,45009,45056,45103,45149,45195,45242,45288,45334,45381,45427,45473,45519,
103
 
  45565,45611,45657,45703,45749,45795,45840,45886,45932,45977,46023,46069,46114,46160,
104
 
  46205,46250,46296,46341,46386,46431,46477,46522,46567,46612,46657,46702,46746,46791,
105
 
  46836,46881,46926,46970,47015,47059,47104,47149,47193,47237,47282,47326,47370,47415,
106
 
  47459,47503,47547,47591,47635,47679,47723,47767,47811,47855,47899,47942,47986,48030,
107
 
  48074,48117,48161,48204,48248,48291,48335,48378,48421,48465,48508,48551,48594,48637,
108
 
  48680,48723,48766,48809,48852,48895,48938,48981,49024,49067,49109,49152,49195,49237,
109
 
  49280,49322,49365,49407,49450,49492,49535,49577,49619,49661,49704,49746,49788,49830,
110
 
  49872,49914,49956,49998,50040,50082,50124,50166,50207,50249,50291,50332,50374,50416,
111
 
  50457,50499,50540,50582,50623,50665,50706,50747,50789,50830,50871,50912,50954,50995,
112
 
  51036,51077,51118,51159,51200,51241,51282,51323,51364,51404,51445,51486,51527,51567,
113
 
  51608,51649,51689,51730,51770,51811,51851,51892,51932,51972,52013,52053,52093,52134,
114
 
  52174,52214,52254,52294,52334,52374,52414,52454,52494,52534,52574,52614,52654,52694,
115
 
  52734,52773,52813,52853,52892,52932,52972,53011,53051,53090,53130,53169,53209,53248,
116
 
  53287,53327,53366,53405,53445,53484,53523,53562,53601,53640,53679,53719,53758,53797,
117
 
  53836,53874,53913,53952,53991,54030,54069,54108,54146,54185,54224,54262,54301,54340,
118
 
  54378,54417,54455,54494,54532,54571,54609,54647,54686,54724,54762,54801,54839,54877,
119
 
  54915,54954,54992,55030,55068,55106,55144,55182,55220,55258,55296,55334,55372,55410,
120
 
  55447,55485,55523,55561,55599,55636,55674,55712,55749,55787,55824,55862,55900,55937,
121
 
  55975,56012,56049,56087,56124,56162,56199,56236,56273,56311,56348,56385,56422,56459,
122
 
  56497,56534,56571,56608,56645,56682,56719,56756,56793,56830,56867,56903,56940,56977,
123
 
  57014,57051,57087,57124,57161,57198,57234,57271,57307,57344,57381,57417,57454,57490,
124
 
  57527,57563,57599,57636,57672,57709,57745,57781,57817,57854,57890,57926,57962,57999,
125
 
  58035,58071,58107,58143,58179,58215,58251,58287,58323,58359,58395,58431,58467,58503,
126
 
  58538,58574,58610,58646,58682,58717,58753,58789,58824,58860,58896,58931,58967,59002,
127
 
  59038,59073,59109,59144,59180,59215,59251,59286,59321,59357,59392,59427,59463,59498,
128
 
  59533,59568,59603,59639,59674,59709,59744,59779,59814,59849,59884,59919,59954,59989,
129
 
  60024,60059,60094,60129,60164,60199,60233,60268,60303,60338,60373,60407,60442,60477,
130
 
  60511,60546,60581,60615,60650,60684,60719,60753,60788,60822,60857,60891,60926,60960,
131
 
  60995,61029,61063,61098,61132,61166,61201,61235,61269,61303,61338,61372,61406,61440,
132
 
  61474,61508,61542,61576,61610,61644,61678,61712,61746,61780,61814,61848,61882,61916,
133
 
  61950,61984,62018,62051,62085,62119,62153,62186,62220,62254,62287,62321,62355,62388,
134
 
  62422,62456,62489,62523,62556,62590,62623,62657,62690,62724,62757,62790,62824,62857,
135
 
  62891,62924,62957,62991,63024,63057,63090,63124,63157,63190,63223,63256,63289,63323,
136
 
  63356,63389,63422,63455,63488,63521,63554,63587,63620,63653,63686,63719,63752,63785,
137
 
  63817,63850,63883,63916,63949,63982,64014,64047,64080,64113,64145,64178,64211,64243,
138
 
  64276,64309,64341,64374,64406,64439,64471,64504,64536,64569,64601,64634,64666,64699,
139
 
  64731,64763,64796,64828,64861,64893,64925,64957,64990,65022,65054,65086,65119,65151,
140
 
  65183,65215,65247,65279,65312,65344,65376,65408,65440,65472,65504 );
141
 
 
142
 
 g_elder_bit_table : array[0..255 ] of int8 = (
143
 
  0,0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
144
 
  5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
145
 
  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
146
 
  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
147
 
  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
148
 
  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
149
 
  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
150
 
  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7 );
151
 
 
152
 
{ GLOBAL PROCEDURES }
153
 
 function  calc_point_location(x1 ,y1 ,x2 ,y2 ,x ,y : double ) : double;
154
 
 
155
 
 function  point_in_triangle(x1 ,y1 ,x2 ,y2 ,x3 ,y3 ,x ,y : double ) : boolean;
156
 
 
157
 
 function  calc_distance(x1 ,y1 ,x2 ,y2 : double ) : double;
158
 
 
159
 
 function  calc_line_point_distance(x1 ,y1 ,x2 ,y2 ,x ,y : double ) : double;
160
 
 
161
 
 function  calc_intersection(ax ,ay ,bx ,by ,cx ,cy ,dx ,dy : double; x ,y : double_ptr ) : boolean;
162
 
 
163
 
 function  intersection_exists(x1 ,y1 ,x2 ,y2 ,x3 ,y3 ,x4 ,y4 : double ) : boolean;
164
 
 
165
 
 procedure calc_orthogonal(thickness ,x1 ,y1 ,x2 ,y2 : double; x ,y : double_ptr );
166
 
 
167
 
 procedure dilate_triangle(x1 ,y1 ,x2 ,y2 ,x3 ,y3 : double; x ,y : double_ptr; d : double );
168
 
 
169
 
 function  calc_triangle_area(x1 ,y1 ,x2 ,y2 ,x3 ,y3 : double ) : double;
170
 
 
171
 
 function  calc_polygon_area(st : storage_xy_ptr ) : double;
172
 
 
173
 
 function  calc_polygon_area_vs(st : vertex_sequence_ptr ) : double;
174
 
 
175
 
 function  fast_sqrt(val : unsigned ) : unsigned;
176
 
 
177
 
 function  besj(x : double; n : int ) : double;
178
 
 
179
 
 function  cross_product(x1 ,y1 ,x2 ,y2 ,x ,y : double ) : double;
180
 
 
181
 
 
182
 
IMPLEMENTATION
183
 
{ LOCAL VARIABLES & CONSTANTS }
184
 
{ UNIT IMPLEMENTATION }
185
 
{ calc_point_location }
186
 
function calc_point_location;
187
 
begin
188
 
 result:=(x - x2 ) * (y2 - y1 ) - (y - y2 ) * (x2 - x1 );
189
 
 
190
 
end;
191
 
 
192
 
{ point_in_triangle }
193
 
function point_in_triangle;
194
 
var
195
 
 cp1 ,cp2 ,cp3 : boolean;
196
 
 
197
 
begin
198
 
 cp1:=calc_point_location(x1 ,y1 ,x2 ,y2 ,x ,y ) < 0.0;
199
 
 cp2:=calc_point_location(x2 ,y2 ,x3 ,y3 ,x ,y ) < 0.0;
200
 
 cp3:=calc_point_location(x3 ,y3 ,x1 ,y1 ,x ,y ) < 0.0;
201
 
 
202
 
 result:=(cp1 = cp2 ) and (cp2 = cp3 ) and (cp3 = cp1 );
203
 
 
204
 
end;
205
 
 
206
 
{ calc_distance }
207
 
function calc_distance;
208
 
var
209
 
 dx ,dy : double;
210
 
 
211
 
begin
212
 
 dx:=x2 - x1;
213
 
 dy:=y2 - y1;
214
 
 
215
 
 result:=sqrt(dx * dx + dy * dy );
216
 
 
217
 
end;
218
 
 
219
 
{ calc_line_point_distance }
220
 
function calc_line_point_distance;
221
 
var
222
 
 d  ,
223
 
 dx ,
224
 
 dy : double;
225
 
 
226
 
begin
227
 
 dx:=x2 - x1;
228
 
 dy:=y2 - y1;
229
 
 d :=sqrt(dx * dx + dy * dy );
230
 
 
231
 
 if d < intersection_epsilon then
232
 
  result:=calc_distance(x1 ,y1 ,x ,y )
233
 
 else
234
 
  result:=((x - x2 ) * dy - (y - y2 ) * dx) / d;
235
 
 
236
 
end;
237
 
 
238
 
{ calc_intersection }
239
 
function calc_intersection;
240
 
var
241
 
 r ,
242
 
 
243
 
 num ,
244
 
 den : double;
245
 
 
246
 
begin
247
 
 num:=(ay - cy ) * (dx - cx ) - (ax - cx ) * (dy - cy );
248
 
 den:=(bx - ax ) * (dy - cy ) - (by - ay ) * (dx - cx );
249
 
 
250
 
 if Abs(den ) < intersection_epsilon then
251
 
  result:=false
252
 
  
253
 
 else
254
 
  begin
255
 
   r :=num / den;
256
 
   x^:=ax + r * (bx - ax );
257
 
   y^:=ay + r * (by - ay );
258
 
 
259
 
   result:=true;
260
 
 
261
 
  end;
262
 
 
263
 
end;
264
 
 
265
 
{ intersection_exists }
266
 
function intersection_exists;
267
 
var
268
 
 dx1 ,dy1 ,
269
 
 dx2 ,dy2 : double;
270
 
 
271
 
begin
272
 
 dx1:=x2 - x1;
273
 
 dy1:=y2 - y1;
274
 
 dx2:=x4 - x3;
275
 
 dy2:=y4 - y3;
276
 
 
277
 
 result:=
278
 
  (((x3 - x2 ) * dy1 - (y3 - y2 ) * dx1 < 0.0 ) <>
279
 
   ((x4 - x2 ) * dy1 - (y4 - y2 ) * dx1 < 0.0 ) ) and
280
 
  (((x1 - x4 ) * dy2 - (y1 - y4 ) * dx2 < 0.0 ) <>
281
 
   ((x2 - x4 ) * dy2 - (y2 - y4 ) * dx2 < 0.0 ) );
282
 
   
283
 
end;
284
 
 
285
 
{ calc_orthogonal }
286
 
procedure calc_orthogonal;
287
 
var
288
 
 d ,dx ,dy : double;
289
 
 
290
 
begin
291
 
 dx:=x2 - x1;
292
 
 dy:=y2 - y1;
293
 
 d :=sqrt(dx * dx + dy * dy );
294
 
 x^:=thickness * dy / d;
295
 
 y^:=thickness * dx / d;
296
 
 
297
 
end;
298
 
 
299
 
{ dilate_triangle }
300
 
procedure dilate_triangle;
301
 
var
302
 
 loc ,
303
 
 dx1 ,dy1 ,
304
 
 dx2 ,dy2 ,
305
 
 dx3 ,dy3 : double;
306
 
 
307
 
begin
308
 
 dx1:=0.0;
309
 
 dy1:=0.0;
310
 
 dx2:=0.0;
311
 
 dy2:=0.0;
312
 
 dx3:=0.0;
313
 
 dy3:=0.0;
314
 
 loc:=calc_point_location(x1 ,y1 ,x2 ,y2 ,x3 ,y3 );
315
 
 
316
 
 if Abs(loc ) > intersection_epsilon then
317
 
  begin
318
 
   if calc_point_location(x1 ,y1 ,x2 ,y2 ,x3 ,y3 ) > 0.0 then
319
 
    d:=-d;
320
 
 
321
 
   calc_orthogonal(d ,x1 ,y1 ,x2 ,y2 ,@dx1 ,@dy1 );
322
 
   calc_orthogonal(d ,x2 ,y2 ,x3 ,y3 ,@dx2 ,@dy2 );
323
 
   calc_orthogonal(d ,x3 ,y3 ,x1 ,y1 ,@dx3 ,@dy3 );
324
 
 
325
 
  end;
326
 
 
327
 
 x^:=x1 + dx1; inc(ptrcomp(x ) ,sizeof(double ) );
328
 
 y^:=y1 - dy1; inc(ptrcomp(y ) ,sizeof(double ) );
329
 
 x^:=x2 + dx1; inc(ptrcomp(x ) ,sizeof(double ) );
330
 
 y^:=y2 - dy1; inc(ptrcomp(y ) ,sizeof(double ) );
331
 
 x^:=x2 + dx2; inc(ptrcomp(x ) ,sizeof(double ) );
332
 
 y^:=y2 - dy2; inc(ptrcomp(y ) ,sizeof(double ) );
333
 
 x^:=x3 + dx2; inc(ptrcomp(x ) ,sizeof(double ) );
334
 
 y^:=y3 - dy2; inc(ptrcomp(y ) ,sizeof(double ) );
335
 
 x^:=x3 + dx3; inc(ptrcomp(x ) ,sizeof(double ) );
336
 
 y^:=y3 - dy3; inc(ptrcomp(y ) ,sizeof(double ) );
337
 
 x^:=x1 + dx3; inc(ptrcomp(x ) ,sizeof(double ) );
338
 
 y^:=y1 - dy3; inc(ptrcomp(y ) ,sizeof(double ) );
339
 
 
340
 
end;
341
 
 
342
 
{ calc_triangle_area }
343
 
function calc_triangle_area;
344
 
begin
345
 
 result:=(x1 * y2 - x2 * y1 + x2 * y3 - x3 * y2 + x3 * y1 - x1 * y3 ) * 0.5;
346
 
 
347
 
end;
348
 
 
349
 
{ calc_polygon_area }
350
 
function calc_polygon_area;
351
 
var
352
 
 i : unsigned;
353
 
 v : double_xy_ptr;
354
 
 
355
 
 x ,y ,sum ,xs ,ys : double;
356
 
 
357
 
begin
358
 
 sum:=0.0;
359
 
 x  :=st.poly[0 ].x;
360
 
 y  :=st.poly[0 ].y;
361
 
 xs :=x;
362
 
 ys :=y;
363
 
 
364
 
 if st.size > 0 then
365
 
  for i:=1 to st.size - 1 do
366
 
   begin
367
 
    v:=@st.poly[i ];
368
 
 
369
 
    sum:=sum + (x * v.y - y * v.x );
370
 
 
371
 
    x:=v.x;
372
 
    y:=v.y;
373
 
 
374
 
   end;
375
 
 
376
 
 result:=(sum + x * ys - y * xs ) * 0.5;
377
 
 
378
 
end;
379
 
 
380
 
{ calc_polygon_area_vs }
381
 
function calc_polygon_area_vs;
382
 
var
383
 
 i : unsigned;
384
 
 v : vertex_dist_ptr;
385
 
 
386
 
 x ,y ,sum ,xs ,ys : double;
387
 
 
388
 
begin
389
 
 sum:=0.0;
390
 
 x  :=vertex_dist_ptr(st.array_operator(0 ) ).x;
391
 
 y  :=vertex_dist_ptr(st.array_operator(0 ) ).y;
392
 
 xs :=x;
393
 
 ys :=y;
394
 
 
395
 
 if st.size > 0 then
396
 
  for i:=1 to st.size - 1 do
397
 
   begin
398
 
    v:=st.array_operator(i );
399
 
 
400
 
    sum:=sum + (x * v.y - y * v.x );
401
 
 
402
 
    x:=v.x;
403
 
    y:=v.y;
404
 
 
405
 
   end;
406
 
 
407
 
 result:=(sum + x * ys - y * xs ) * 0.5;
408
 
 
409
 
end;
410
 
 
411
 
{ fast_sqrt }
412
 
function fast_sqrt;
413
 
var
414
 
 bit : int;
415
 
 
416
 
 t ,shift : unsigned;
417
 
 
418
 
begin
419
 
 t  :=val;
420
 
 bit:=0;
421
 
 
422
 
 shift:=11;
423
 
 
424
 
//The following piece of code is just an emulation of the
425
 
//Ix86 assembler command "bsr" (see below). However on old
426
 
//Intels (like Intel MMX 233MHz) this code is about twice
427
 
//faster (sic!) then just one "bsr". On PIII and PIV the
428
 
//bsr is optimized quite well.
429
 
 bit:=t shr 24;
430
 
 
431
 
 if bit <> 0 then
432
 
  bit:=g_elder_bit_table[bit ] + 24
433
 
  
434
 
 else
435
 
  begin
436
 
   bit:=(t shr 16 ) and $FF;
437
 
 
438
 
   if bit <> 0 then
439
 
    bit:=g_elder_bit_table[bit ] + 16
440
 
   else
441
 
    begin
442
 
     bit:=(t shr 8 ) and $FF;
443
 
 
444
 
     if bit <> 0 then
445
 
      bit:=g_elder_bit_table[bit ] + 8
446
 
     else
447
 
      bit:=g_elder_bit_table[t ];
448
 
 
449
 
    end;
450
 
 
451
 
  end;
452
 
 
453
 
// This is calculation sqrt itself.
454
 
 bit:=bit - 9;
455
 
 
456
 
 if bit > 0 then
457
 
  begin
458
 
   bit  :=(shr_int32(bit ,1 ) ) + (bit and 1 );
459
 
   shift:=shift - bit;
460
 
   val  :=val shr (bit shl 1 );
461
 
 
462
 
  end;
463
 
 
464
 
 result:=g_sqrt_table[val ] shr shift;
465
 
 
466
 
end;
467
 
 
468
 
//--------------------------------------------------------------------besj
469
 
// Function BESJ calculates Bessel function of first kind of order n
470
 
// Arguments:
471
 
//     n - an integer (>=0), the order
472
 
//     x - value at which the Bessel function is required
473
 
//--------------------
474
 
// C++ Mathematical Library
475
 
// Convereted from equivalent FORTRAN library
476
 
// Converetd by Gareth Walker for use by course 392 computational project
477
 
// All functions tested and yield the same results as the corresponding
478
 
// FORTRAN versions.
479
 
//
480
 
// If you have any problems using these functions please report them to
481
 
// M.Muldoon@UMIST.ac.uk
482
 
//
483
 
// Documentation available on the web
484
 
// http://www.ma.umist.ac.uk/mrm/Teaching/392/libs/392.html
485
 
// Version 1.0   8/98
486
 
// 29 October, 1999
487
 
//--------------------
488
 
// Adapted for use in AGG library by Andy Wilk (castor.vulgaris@gmail.com)
489
 
//------------------------------------------------------------------------
490
 
{ besj }
491
 
function besj;
492
 
var
493
 
 i ,m1 ,m2 ,m8 ,imax : int;
494
 
 
495
 
 d ,b ,b1 ,c2 ,c3 ,c4 ,c6 : double;
496
 
 
497
 
begin
498
 
 if n < 0 then
499
 
  begin
500
 
   result:=0;
501
 
 
502
 
   exit;
503
 
 
504
 
  end;
505
 
 
506
 
 d:=1E-6;
507
 
 b:=0;
508
 
 
509
 
 if Abs(x ) <= d then
510
 
  begin
511
 
   if n <> 0 then
512
 
    result:=0
513
 
   else
514
 
    result:=1;
515
 
 
516
 
   exit;
517
 
 
518
 
  end;
519
 
 
520
 
 b1:=0; // b1 is the value from the previous iteration
521
 
 
522
 
// Set up a starting order for recurrence
523
 
 m1:=trunc(Abs(x ) + 6 );
524
 
 
525
 
 if Abs(x ) > 5 then
526
 
  m1:=trunc(Abs(1.4 * x + 60 / x ) );
527
 
 
528
 
 m2:=trunc(n + 2 + Abs(x ) / 4 );
529
 
 
530
 
 if m1 > m2 then
531
 
  m2:=m1;
532
 
 
533
 
// Apply recurrence down from curent max order
534
 
 repeat
535
 
  c3:=0;
536
 
  c2:=1E-30;
537
 
  c4:=0;
538
 
  m8:=1;
539
 
 
540
 
  if m2 div 2 * 2 = m2 then
541
 
   m8:=-1;
542
 
 
543
 
  imax:=m2 - 2; 
544
 
 
545
 
  for i:=1 to imax do
546
 
   begin
547
 
    c6:=2 * (m2 - i ) * c2 / x - c3;
548
 
    c3:=c2;
549
 
    c2:=c6;
550
 
 
551
 
    if m2 - i - 1 = n then
552
 
     b:=c6;
553
 
 
554
 
    m8:=-1 * m8;
555
 
 
556
 
    if m8 > 0 then
557
 
     c4:=c4 + 2 * c6;
558
 
 
559
 
   end;
560
 
 
561
 
  c6:=2 * c2 / x - c3;
562
 
 
563
 
  if n = 0 then
564
 
   b:=c6;
565
 
 
566
 
  c4:=c4 + c6;
567
 
  b :=b / c4;
568
 
  
569
 
  if Abs(b - b1 ) < d then
570
 
   begin
571
 
    result:=b;
572
 
 
573
 
    exit;
574
 
 
575
 
   end;
576
 
 
577
 
  b1:=b;
578
 
  
579
 
  inc(m2 ,3 );
580
 
 
581
 
 until false;
582
 
 
583
 
end;
584
 
 
585
 
{ CROSS_PRODUCT }
586
 
function cross_product(x1 ,y1 ,x2 ,y2 ,x ,y : double ) : double;
587
 
begin
588
 
 result:=(x - x2 ) * (y2 - y1 ) - (y - y2 ) * (x2 - x1 );
589
 
 
590
 
end;
591
 
 
592
 
END.
593