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 // [Pascal Port History] -----------------------------------------------------
22 //
23 // 12.10.2007-Milano: gradient_radial_focus_extended
24 // 23.06.2006-Milano: ptrcomp adjustments
25 // 27.01.2006-Milano: Unit port establishment
26 //
27 { agg_span_gradient.pas }
28 unit
29 agg_span_gradient ;
30
31 INTERFACE
32
33 {$I agg_mode.inc }
34 {$Q- }
35 {$R- }
36 uses
37 Math ,
38 agg_basics ,
39 agg_span_allocator ,
40 agg_span_generator ,
41 agg_math ,
42 agg_array ,
43 agg_span_interpolator_linear ,
44 agg_color ;
45
46 { TYPES DEFINITION }
47 const
48 gradient_subpixel_shift = 4; //-----gradient_subpixel_shift
49 gradient_subpixel_size = 1 shl gradient_subpixel_shift; //-----gradient_subpixel_size
50 gradient_subpixel_mask = gradient_subpixel_size - 1; //-----gradient_subpixel_mask
51
52 type
53 gradient_linear_color_ptr = ^gradient_linear_color;
54
55 gradient_ptr = ^gradient;
56
57 span_gradient = object(span_generator )
58 downscale_shift : int;
59
60 m_interpolator : span_interpolator_ptr;
61 m_gradient_function : gradient_ptr;
62 m_color_function : array_base_ptr;
63
64 m_d1 ,
65 m_d2 : int;
66
67 constructor Construct(alloc : span_allocator_ptr ); overload;
68 constructor Construct(
69 alloc : span_allocator_ptr;
70 inter : span_interpolator_ptr;
71 gradient_function : gradient_ptr;
72 color_function : array_base_ptr;
73 d1 ,d2 : double ); overload;
74
_interpolatornull75 function _interpolator : span_interpolator_ptr;
_gradient_functionnull76 function _gradient_function : gradient_ptr;
_color_functionnull77 function _color_function : array_base_ptr;
_d1null78 function _d1 : double;
_d2null79 function _d2 : double;
80
81 procedure interpolator_ (i : span_interpolator_ptr );
82 procedure gradient_function_(gf : gradient_ptr );
83 procedure color_function_ (cf : array_base_ptr );
84
85 procedure d1_(v : double );
86 procedure d2_(v : double );
87
generatenull88 function generate(x ,y : int; len : unsigned ) : aggclr_ptr; virtual;
89
90 end;
91
92 gradient_linear_color = object(pod_auto_array )
93 m_c1 ,
94 m_c2 ,
95 m_res : aggclr;
96
97 constructor Construct(c1 ,c2 : aggclr_ptr; size_ : unsigned = 256 );
98
sizenull99 function size : unsigned; virtual;
array_operatornull100 function array_operator(i : unsigned ) : pointer; virtual;
101
102 procedure colors_(c1 ,c2 : aggclr_ptr; size_ : unsigned = 256 );
103
104 end;
105
106 gradient = object
107 constructor Construct;
108
calculatenull109 function calculate(x ,y ,d : int ) : int; virtual; abstract;
110
111 end;
112
113 // Actually the same as radial. Just for compatibility
114 gradient_circle = object(gradient )
calculatenull115 function calculate(x ,y ,d : int ) : int; virtual;
116
117 end;
118
119 gradient_radial = object(gradient )
calculatenull120 function calculate(x ,y ,d : int ) : int; virtual;
121
122 end;
123
124 gradient_radial_d = object(gradient )
calculatenull125 function calculate(x ,y ,d : int ) : int; virtual;
126
127 end;
128
129 gradient_radial_focus = object(gradient )
130 m_radius ,
131 m_focus_x ,
132 m_focus_y : int;
133
134 m_radius2 ,
135 m_trivial : double;
136
137 constructor Construct; overload;
138 constructor Construct(r ,fx ,fy : double ); overload;
139
140 procedure init(r ,fx ,fy : double );
141
radiusnull142 function radius : double;
focus_xnull143 function focus_x : double;
focus_ynull144 function focus_y : double;
145
calculatenull146 function calculate(x ,y ,d : int ) : int; virtual;
147
148 procedure update_values;
149
150 end;
151
152 gradient_radial_focus_extended = object(gradient )
153 m_r ,
154 m_fx ,
155 m_fy : int;
156 m_r2 ,
157 m_fx2 ,
158 m_fy2 ,
159 m_mul : double;
160
161 constructor Construct; overload;
162 constructor Construct(r ,fx ,fy : double ); overload;
163
164 procedure init(r ,fx ,fy : double );
165
radiusnull166 function radius : double;
focus_xnull167 function focus_x : double;
focus_ynull168 function focus_y : double;
169
calculatenull170 function calculate(x ,y ,d : int ) : int; virtual;
171
172 procedure update_values;
173
174 end;
175
176 gradient_x = object(gradient )
calculatenull177 function calculate(x ,y ,d : int ) : int; virtual;
178
179 end;
180
181 gradient_y = object(gradient )
calculatenull182 function calculate(x ,y ,d : int ) : int; virtual;
183
184 end;
185
186 gradient_diamond = object(gradient )
calculatenull187 function calculate(x ,y ,d : int ) : int; virtual;
188
189 end;
190
191 gradient_xy = object(gradient )
calculatenull192 function calculate(x ,y ,d : int ) : int; virtual;
193
194 end;
195
196 gradient_sqrt_xy = object(gradient )
calculatenull197 function calculate(x ,y ,d : int ) : int; virtual;
198
199 end;
200
201 gradient_conic = object(gradient )
calculatenull202 function calculate(x ,y ,d : int ) : int; virtual;
203
204 end;
205
206 gradient_repeat_adaptor = object(gradient )
207 m_gradient : gradient_ptr;
208
209 constructor Construct(gradient : gradient_ptr );
210
calculatenull211 function calculate(x ,y ,d : int ) : int; virtual;
212
213 end;
214
215 gradient_reflect_adaptor = object(gradient )
216 m_gradient : gradient_ptr;
217
218 constructor Construct(gradient : gradient_ptr );
219
calculatenull220 function calculate(x ,y ,d : int ) : int; virtual;
221
222 end;
223
224 { GLOBAL PROCEDURES }
225
226
227 IMPLEMENTATION
228 { LOCAL VARIABLES & CONSTANTS }
229 { UNIT IMPLEMENTATION }
230 { CONSTRUCT }
231 constructor span_gradient.Construct(alloc : span_allocator_ptr );
232 begin
233 inherited Construct(alloc );
234
235 end;
236
237 { CONSTRUCT }
238 constructor span_gradient.Construct(
239 alloc : span_allocator_ptr;
240 inter : span_interpolator_ptr;
241 gradient_function : gradient_ptr;
242 color_function : array_base_ptr;
243 d1 ,d2 : double );
244 begin
245 inherited Construct(alloc );
246
247 m_interpolator :=inter;
248 m_gradient_function:=gradient_function;
249 m_color_function :=color_function;
250
251 downscale_shift:=m_interpolator.subpixel_shift - gradient_subpixel_shift;
252
253 m_d1:=trunc(d1 * gradient_subpixel_size );
254 m_d2:=trunc(d2 * gradient_subpixel_size );
255
256 end;
257
258 { _INTERPOLATOR }
span_gradient._interpolatornull259 function span_gradient._interpolator;
260 begin
261 result:=m_interpolator;
262
263 end;
264
265 { _GRADIENT_FUNCTION }
span_gradient._gradient_functionnull266 function span_gradient._gradient_function;
267 begin
268 result:=m_gradient_function;
269
endnull270 end;
271
272 { _COLOR_FUNCTION }
span_gradient._color_functionnull273 function span_gradient._color_function;
274 begin
275 result:=m_color_function;
276
endnull277 end;
278
279 { _D1 }
span_gradient._d1null280 function span_gradient._d1;
281 begin
282 result:=m_d1 / gradient_subpixel_size;
283
284 end;
285
286 { _D2 }
span_gradient._d2null287 function span_gradient._d2;
288 begin
289 result:=m_d2 / gradient_subpixel_size;
290
291 end;
292
293 { INTERPOLATOR_ }
294 procedure span_gradient.interpolator_;
295 begin
296 m_interpolator:=i;
297
298 end;
299
300 { GRADIENT_FUNCTION_ }
301 procedure span_gradient.gradient_function_;
302 begin
303 m_gradient_function:=gf;
304
305 end;
306
307 { COLOR_FUNCTION_ }
308 procedure span_gradient.color_function_;
309 begin
310 m_color_function:=cf;
311
312 end;
313
314 { D1_ }
315 procedure span_gradient.d1_;
316 begin
317 m_d1:=trunc(v * gradient_subpixel_size );
318
319 end;
320
321 { D2_ }
322 procedure span_gradient.d2_;
323 begin
324 m_d2:=trunc(v * gradient_subpixel_size );
325
326 end;
327
328 { GENERATE }
span_gradient.generatenull329 function span_gradient.generate;
330 var
331 span : aggclr_ptr;
332
333 dd ,d : int;
334
335 begin
336 span:=_allocator.span;
337
338 dd:=m_d2 - m_d1;
339
340 if dd < 1 then
341 dd:=1;
342
343 m_interpolator.begin_(x + 0.5 ,y + 0.5 ,len );
344
345 repeat
346 m_interpolator.coordinates(@x ,@y );
347
348 d:=
349 m_gradient_function.calculate(
350 shr_int32(x ,downscale_shift ) ,
351 shr_int32(y ,downscale_shift ) ,m_d2 );
352
353 d:=((d - m_d1 ) * m_color_function.size ) div dd;
354
355 if d < 0 then
356 d:=0;
357
358 if d >= m_color_function.size then
359 d:=m_color_function.size - 1;
360
361 span^:=aggclr_ptr(m_color_function.array_operator(d ) )^;
362
363 inc(ptrcomp(span ) ,sizeof(aggclr ) );
364
365 m_interpolator.inc_operator;
366
367 dec(len );
368
369 until len = 0;
370
371 result:=_allocator.span;
372
373 end;
374
375 { CONSTRUCT }
376 constructor gradient_linear_color.Construct;
377 begin
378 m_c1:=c1^;
379 m_c2:=c2^;
380
381 m_size:=size_;
382
383 end;
384
385 { SIZE }
gradient_linear_color.sizenull386 function gradient_linear_color.size;
387 begin
388 result:=m_size;
389
390 end;
391
392 { ARRAY_OPERATOR }
gradient_linear_color.array_operatornull393 function gradient_linear_color.array_operator;
394 begin
395 m_res :=m_c1.gradient(@m_c2 ,i / (m_size - 1 ) );
396 result:=@m_res;
397
398 end;
399
400 { COLORS_ }
401 procedure gradient_linear_color.colors_;
402 begin
403 m_c1:=c1^;
404 m_c2:=c2^;
405
406 m_size:=size;
407
408 end;
409
410 { CONSTRUCT }
411 constructor gradient.Construct;
412 begin
413 end;
414
415 { CALCULATE }
gradient_circle.calculatenull416 function gradient_circle.calculate;
417 begin
418 result:=fast_sqrt(x * x + y * y );
419
420 end;
421
422 { CALCULATE }
gradient_radial.calculatenull423 function gradient_radial.calculate;
424 begin
425 result:=fast_sqrt(x * x + y * y );
426
427 end;
428
429 { CALCULATE }
gradient_radial_d.calculatenull430 function gradient_radial_d.calculate;
431 begin
432 result:=trunc(Sqrt(x * x + y * y ) );
433
434 end;
435
436 { CONSTRUCT }
437 constructor gradient_radial_focus.Construct;
438 begin
439 m_radius :=100 * gradient_subpixel_size;
440 m_focus_x:=0;
441 m_focus_y:=0;
442
443 update_values;
444
445 end;
446
447 { CONSTRUCT }
448 constructor gradient_radial_focus.Construct(r ,fx ,fy : double );
449 begin
450 m_radius :=trunc(r * gradient_subpixel_size );
451 m_focus_x:=trunc(fx * gradient_subpixel_size );
452 m_focus_y:=trunc(fy * gradient_subpixel_size );
453
454 update_values;
455
456 end;
457
458 { INIT }
459 procedure gradient_radial_focus.init;
460 begin
461 m_radius :=trunc(r * gradient_subpixel_size );
462 m_focus_x:=trunc(fx * gradient_subpixel_size );
463 m_focus_y:=trunc(fy * gradient_subpixel_size );
464
465 update_values;
466
467 end;
468
469 { RADIUS }
gradient_radial_focus.radiusnull470 function gradient_radial_focus.radius;
471 begin
472 result:=m_radius / gradient_subpixel_size;
473
474 end;
475
476 { FOCUS_X }
gradient_radial_focus.focus_xnull477 function gradient_radial_focus.focus_x;
478 begin
479 result:=m_focus_x / gradient_subpixel_size;
480
481 end;
482
483 { FOCUS_Y }
gradient_radial_focus.focus_ynull484 function gradient_radial_focus.focus_y;
485 begin
486 result:=m_focus_y / gradient_subpixel_size;
487
488 end;
489
490 { CALCULATE }
gradient_radial_focus.calculatenull491 function gradient_radial_focus.calculate;
492 var
493 solution_x ,
494 solution_y ,
495 slope ,yint ,
496 a ,b ,c ,det ,
497 int_to_focus ,
498 cur_to_focus : double;
499
500 begin
501 // Special case to avoid divide by zero or very near zero
502 if x = m_focus_x then
503 begin
504 solution_x:=m_focus_x;
505 solution_y:=0.0;
506
507 if y > m_focus_y then
508 solution_y:=solution_y + m_trivial
509 else
510 solution_y:=solution_y - m_trivial;
511
512 end
513 else
514 begin
515 // Slope of the focus-current line
516 slope:=(y - m_focus_y ) / (x - m_focus_x );
517
518 // y-intercept of that same line
519 yint:=y - (slope * x );
520
521 // Use the classical quadratic formula to calculate
522 // the intersection point
523 a:=(slope * slope ) + 1;
524 b:=2 * slope * yint;
525 c:=yint * yint - m_radius2;
526
527 det:=Sqrt((b * b ) - (4.0 * a * c ) );
528
529 solution_x:=-b;
530
531 // Choose the positive or negative root depending
532 // on where the X coord lies with respect to the focus.
533 if x < m_focus_x then
534 solution_x:=solution_x - det
535 else
536 solution_x:=solution_x + det;
537
538 solution_x:=solution_x / (2.0 * a );
539
540 // Calculating of Y is trivial
541 solution_y:=(slope * solution_x ) + yint;
542
543 end;
544
545 // Calculate the percentage (0...1) of the current point along the
546 // focus-circumference line and return the normalized (0...d) value
547 solution_x:=solution_x - m_focus_x;
548 solution_y:=solution_y - m_focus_y;
549
550 int_to_focus:=solution_x * solution_x + solution_y * solution_y;
551 cur_to_focus:=
552 (x - m_focus_x ) * (x - m_focus_x ) +
553 (y - m_focus_y ) * (y - m_focus_y );
554
555 result:=trunc(Sqrt(cur_to_focus / int_to_focus ) * m_radius );
556
557 end;
558
559 { UPDATE_VALUES }
560 procedure gradient_radial_focus.update_values;
561 var
562 dist ,r ,a : double;
563
564 begin
565 // For use in the quadratic equation
566 m_radius2:=m_radius * m_radius;
567
568 dist:=Sqrt(m_focus_x * m_focus_x + m_focus_y * m_focus_y );
569
570 // Test if distance from focus to center is greater than the radius
571 // For the sake of assurance factor restrict the point to be
572 // no further than 99% of the radius.
573 r:=m_radius * 0.99;
574
575 if dist > r then
576 begin
577 // clamp focus to radius
578 // x = r cos theta, y = r sin theta
579 a:=ArcTan2(m_focus_y ,m_focus_x );
580
581 m_focus_x:=trunc(r * Cos(a ) );
582 m_focus_y:=trunc(r * Sin(a ) );
583
584 end;
585
586 // Calculate the solution to be used in the case where x == focus_x
587 m_trivial:=Sqrt(m_radius2 - (m_focus_x * m_focus_x ) );
588
589 end;
590
591 { CONSTRUCT }
592 constructor gradient_radial_focus_extended.Construct;
593 begin
594 m_r :=100 * gradient_subpixel_size;
595 m_fx:=0;
596 m_fy:=0;
597
598 update_values;
599
600 end;
601
602 { CONSTRUCT }
603 constructor gradient_radial_focus_extended.Construct(r ,fx ,fy : double );
604 begin
605 m_r :=iround(r * gradient_subpixel_size );
606 m_fx:=iround(fx * gradient_subpixel_size );
607 m_fy:=iround(fy * gradient_subpixel_size );
608
609 update_values;
610
611 end;
612
613 { INIT }
614 procedure gradient_radial_focus_extended.init(r ,fx ,fy : double );
615 begin
616 m_r :=iround(r * gradient_subpixel_size );
617 m_fx:=iround(fx * gradient_subpixel_size );
618 m_fy:=iround(fy * gradient_subpixel_size );
619
620 update_values;
621
622 end;
623
624 { RADIUS }
gradient_radial_focus_extended.radiusnull625 function gradient_radial_focus_extended.radius : double;
626 begin
627 result:=m_r / gradient_subpixel_size;
628
629 end;
630
631 { FOCUS_X }
gradient_radial_focus_extended.focus_xnull632 function gradient_radial_focus_extended.focus_x : double;
633 begin
634 result:=m_fx / gradient_subpixel_size;
635
636 end;
637
638 { FOCUS_Y }
gradient_radial_focus_extended.focus_ynull639 function gradient_radial_focus_extended.focus_y : double;
640 begin
641 result:=m_fy / gradient_subpixel_size;
642
643 end;
644
645 { CALCULATE }
gradient_radial_focus_extended.calculatenull646 function gradient_radial_focus_extended.calculate(x ,y ,d : int ) : int;
647 var
648 dx ,dy ,d2 ,d3 : double;
649
650 begin
651 dx:=x - m_fx;
652 dy:=y - m_fy;
653 d2:=dx * m_fy - dy * m_fx;
654 d3:=m_r2 * (dx * dx + dy * dy ) - d2 * d2;
655
656 result:=iround((dx * m_fx + dy * m_fy + Sqrt(Abs(d3 ) ) ) * m_mul );
657
658 end;
659
660 { UPDATE_VALUES }
661 // Calculate the invariant values. In case the focal center
662 // lies exactly on the gradient circle the divisor degenerates
663 // into zero. In this case we just move the focal center by
664 // one subpixel unit possibly in the direction to the origin (0,0)
665 // and calculate the values again.
666 procedure gradient_radial_focus_extended.update_values;
667 var
668 d : double;
669
670 begin
671 m_r2 :=m_r * m_r;
672 m_fx2:=m_fx * m_fx;
673 m_fy2:=m_fy * m_fy;
674
675 d:=(m_r2 - (m_fx2 + m_fy2 ) );
676
677 if d = 0 then
678 begin
679 if m_fx <> 0 then
680 if m_fx < 0 then
681 inc(m_fx )
682 else
683 dec(m_fx );
684
685 if m_fy <> 0 then
686 if m_fy < 0 then
687 inc(m_fy )
688 else
689 dec(m_fy );
690
691 m_fx2:=m_fx * m_fx;
692 m_fy2:=m_fy * m_fy;
693
694 d:=(m_r2 - (m_fx2 + m_fy2 ) );
695
696 end;
697
698 m_mul:=m_r / d;
699
700 end;
701
702 { CALCULATE }
gradient_x.calculatenull703 function gradient_x.calculate;
704 begin
705 result:=x;
706
707 end;
708
709 { CALCULATE }
gradient_y.calculatenull710 function gradient_y.calculate;
711 begin
712 result:=y;
713
714 end;
715
716 { CALCULATE }
gradient_diamond.calculatenull717 function gradient_diamond.calculate;
718 var
719 ax ,ay : int;
720
721 begin
722 ax:=Abs(x );
723 ay:=Abs(y );
724
725 if ax > ay then
726 result:=ax
727 else
728 result:=ay;
729
730 end;
731
732 { CALCULATE }
gradient_xy.calculatenull733 function gradient_xy.calculate;
734 begin
735 if d = 0 then
736 result:=0
737 else
738 result:=Abs(x ) * Abs(y ) div d;
739
740 end;
741
742 { CALCULATE }
gradient_sqrt_xy.calculatenull743 function gradient_sqrt_xy.calculate;
744 begin
745 result:=fast_sqrt(Abs(x ) * Abs(y ) );
746
747 end;
748
749 { CALCULATE }
gradient_conic.calculatenull750 function gradient_conic.calculate;
751 begin
752 result:=trunc(Abs(ArcTan2(y ,x ) ) * d / pi );
753
754 end;
755
756 { CONSTRUCT }
757 constructor gradient_repeat_adaptor.Construct;
758 begin
759 m_gradient:=gradient;
760
761 end;
762
763 { CALCULATE }
gradient_repeat_adaptor.calculatenull764 function gradient_repeat_adaptor.calculate;
765 begin
766 if d = 0 then
767 result:=0
768 else
769 result:=m_gradient.calculate(x ,y ,d ) mod d;
770
771 if result < 0 then
772 inc(result ,d );
773
774 end;
775
776 { CONSTRUCT }
777 constructor gradient_reflect_adaptor.Construct;
778 begin
779 m_gradient:=gradient;
780
781 end;
782
783 { CALCULATE }
gradient_reflect_adaptor.calculatenull784 function gradient_reflect_adaptor.calculate;
785 var
786 d2 : int;
787
788 begin
789 d2:=d shl 1;
790
791 if d2 = 0 then
792 result:=0
793 else
794 result:=m_gradient.calculate(x ,y ,d ) mod d2;
795
796 if result < 0 then
797 inc(result ,d2 );
798
799 if result >= d then
800 result:=d2 - result;
801
802 end;
803
804 END.
805
806