← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/aggpas/particle_demo.dpr

  • 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/particle_demo.dpr
1
 
//
2
 
// AggPas 2.4 RM3 Demo application
3
 
// Note: Press F1 key on run to see more info about this demo
4
 
//
5
 
// Paths: src;src\ctrl;src\svg;src\util;src\platform\win;expat-wrap
6
 
//
7
 
program
8
 
 particle_demo ;
9
 
 
10
 
{DEFINE DISORDER }
11
 
 
12
 
uses
13
 
 Math ,
14
 
 agg_basics ,
15
 
 agg_platform_support ,
16
 
 agg_ctrl ,
17
 
 agg_slider_ctrl ,
18
 
 agg_cbox_ctrl ,
19
 
 agg_renderer_base ,
20
 
 agg_rendering_buffer ,
21
 
 agg_rasterizer_scanline_aa ,
22
 
 agg_scanline_u ,
23
 
 agg_color ,
24
 
 agg_pixfmt ,
25
 
 agg_pixfmt_rgb ,
26
 
 agg_pixfmt_rgba ,
27
 
 agg_renderer_scanline ,
28
 
 agg_path_storage ,
29
 
 agg_conv_transform ,
30
 
 agg_bounding_rect ,
31
 
 agg_span_allocator ,
32
 
 agg_span_gradient ,
33
 
 agg_span_interpolator_linear ,
34
 
 agg_rasterizer_outline_aa ,
35
 
 agg_rendering_buffer_dynarow ,
36
 
 agg_ellipse ,
37
 
 agg_array ,
38
 
 agg_gsv_text ,
39
 
 agg_conv_stroke ,
40
 
 agg_render_scanlines ,
41
 
 agg_trans_affine ,
42
 
 agg_math ;
43
 
 
44
 
{$I agg_mode.inc }
45
 
 
46
 
const
47
 
 flip_y = true;
48
 
 
49
 
var
50
 
 g_rasterizer : rasterizer_scanline_aa;
51
 
 
52
 
 g_scanline : scanline_u8;
53
 
 
54
 
 g_path : path_storage;
55
 
 
56
 
 g_npaths : unsigned = 0;
57
 
 
58
 
 g_x1 : double = 0;
59
 
 g_y1 : double = 0;
60
 
 g_x2 : double = 0;
61
 
 g_y2 : double = 0;
62
 
 
63
 
 g_base_dx : double = 0;
64
 
 g_base_dy : double = 0;
65
 
 
66
 
 g_scale : double = 1.0;
67
 
 
68
 
 g_skew_x : double = 0;
69
 
 g_skew_y : double = 0;
70
 
 
71
 
 g_nclick : int = 0;
72
 
 
73
 
 g_cx ,g_cy ,g_dx ,g_dy ,g_radius : array[0..999 ] of double;
74
 
 
75
 
 g_color1 ,g_color2 ,g_color3 : array[0..999 ] of aggclr;
76
 
 
77
 
 g_gradients : array[0..999 ] of pod_auto_array;
78
 
 
79
 
 g_angle : double = 0;
80
 
 
81
 
 g_center : double = 0;
82
 
 
83
 
 g_dc : double = 0.5;
84
 
 
85
 
 g_cache : array[0..999 ] of rendering_buffer_dynarow_ptr;
86
 
 
87
 
type
88
 
 gradient_tricolor = object(array_base )
89
 
  private
90
 
   m_c1 ,
91
 
   m_c2 ,
92
 
   m_c3 ,
93
 
   m_rc : aggclr;
94
 
 
95
 
  public
96
 
   constructor Construct(c1 ,c2 ,c3 : aggclr );
97
 
 
98
 
   function  size : unsigned; virtual;
99
 
   function  array_operator(i : unsigned ) : pointer; virtual;
100
 
 
101
 
   procedure colors(c1 ,c2 ,c3 : aggclr );
102
 
 
103
 
  end;
104
 
 
105
 
 the_application = object(platform_support )
106
 
  private
107
 
   m_particles ,
108
 
   m_speed     : slider_ctrl;
109
 
   m_use_cache ,
110
 
   m_run       : cbox_ctrl;
111
 
 
112
 
   m_run_flag       ,
113
 
   m_use_cache_flag ,
114
 
   m_first_time     : boolean;
115
 
 
116
 
   m_particles_value ,
117
 
   m_speed_value     : double;
118
 
 
119
 
  public
120
 
   constructor Construct(format_ : pix_format_e; flip_y_ : boolean );
121
 
   destructor  Destruct;
122
 
 
123
 
   procedure on_init; virtual;
124
 
   procedure on_draw; virtual;
125
 
 
126
 
   procedure on_mouse_button_down(x ,y : int; flags : unsigned ); virtual;
127
 
   procedure on_mouse_move       (x ,y : int; flags : unsigned ); virtual;
128
 
 
129
 
   procedure on_key(x ,y : int; key ,flags : unsigned ); virtual;
130
 
   procedure on_idle; virtual;
131
 
   procedure on_ctrl_change; virtual;
132
 
 
133
 
  end;
134
 
 
135
 
{ CONSTRUCT }
136
 
constructor gradient_tricolor.Construct(c1 ,c2 ,c3 : aggclr );
137
 
begin
138
 
 m_c1:=c1;
139
 
 m_c2:=c2;
140
 
 m_c3:=c3;
141
 
 
142
 
end;
143
 
 
144
 
{ SIZE }
145
 
function gradient_tricolor.size : unsigned;
146
 
begin
147
 
 result:=256;
148
 
 
149
 
end;
150
 
 
151
 
{ ARRAY_OPERATOR }
152
 
function gradient_tricolor.array_operator(i : unsigned ) : pointer;
153
 
begin
154
 
 if i <= 127 then
155
 
  begin
156
 
   i:=i * 2;
157
 
 
158
 
   m_rc.r:=int8u((((m_c2.r - m_c1.r ) * int(i ) ) + (m_c1.r shl 8 ) ) shr 8 );
159
 
   m_rc.g:=int8u((((m_c2.g - m_c1.g ) * int(i ) ) + (m_c1.g shl 8 ) ) shr 8 );
160
 
   m_rc.b:=int8u((((m_c2.b - m_c1.b ) * int(i ) ) + (m_c1.b shl 8 ) ) shr 8 );
161
 
   m_rc.a:=int8u((((m_c2.a - m_c1.a ) * int(i ) ) + (m_c1.a shl 8 ) ) shr 8 );
162
 
 
163
 
  end
164
 
 else
165
 
  begin
166
 
   i:=(i - 127 ) * 2;
167
 
 
168
 
   m_rc.r:=int8u((((m_c3.r - m_c2.r ) * int(i ) ) + (m_c2.r shl 8 ) ) shr 8 );
169
 
   m_rc.g:=int8u((((m_c3.g - m_c2.g ) * int(i ) ) + (m_c2.g shl 8 ) ) shr 8 );
170
 
   m_rc.b:=int8u((((m_c3.b - m_c2.b ) * int(i ) ) + (m_c2.b shl 8 ) ) shr 8 );
171
 
   m_rc.a:=int8u((((m_c3.a - m_c2.a ) * int(i ) ) + (m_c2.a shl 8 ) ) shr 8 );
172
 
 
173
 
  end;
174
 
 
175
 
 result:=@m_rc;
176
 
 
177
 
end;
178
 
 
179
 
{ COLORS }
180
 
procedure gradient_tricolor.colors(c1 ,c2 ,c3 : aggclr );
181
 
begin
182
 
 m_c1:=c1;
183
 
 m_c2:=c2;
184
 
 m_c3:=c3;
185
 
 
186
 
end;
187
 
 
188
 
{ CONSTRUCT }
189
 
constructor the_application.Construct;
190
 
var
191
 
 i : int;
192
 
 c : aggclr;
193
 
 
194
 
begin
195
 
 inherited Construct(format_ ,flip_y_ );
196
 
 
197
 
 m_particles.Construct(5   ,5      ,300 ,12      ,not flip_y_ );
198
 
 m_speed.Construct    (5   ,5 + 15 ,300 ,12 + 15 ,not flip_y_ );
199
 
 m_use_cache.Construct(320 ,5      ,'Use Bitmap Cache' ,not flip_y_ );
200
 
 m_run.Construct      (320 ,5 + 15 ,'Start the Universe!' ,not flip_y_ );
201
 
 
202
 
 m_run_flag      :=true;
203
 
 m_use_cache_flag:=false;
204
 
 
205
 
 i:=0;
206
 
 
207
 
 while i < 1000 do
208
 
  begin
209
 
   g_cache[i ]:=NIL;
210
 
 
211
 
   g_gradients[i ].Construct(256 ,sizeof(aggclr ) );
212
 
 
213
 
   inc(i );
214
 
 
215
 
  end;
216
 
 
217
 
 add_ctrl(@m_particles );
218
 
 
219
 
 m_particles.range_(10 ,1000 );
220
 
 m_particles.value_(200 );
221
 
 m_particles.label_('Number of Particles=%.0f' );
222
 
 m_particles.no_transform;
223
 
 
224
 
 m_particles_value:=m_particles._value;
225
 
 
226
 
 add_ctrl(@m_speed );
227
 
 
228
 
 m_speed.range_(0.025 ,2.0 );
229
 
 m_speed.value_(1.0 );
230
 
 m_speed.label_('Dark Energy=%.3f' );
231
 
 m_speed.no_transform;
232
 
 
233
 
 m_speed_value:=m_speed._value;
234
 
 m_first_time :=true;
235
 
 
236
 
 add_ctrl(@m_use_cache );
237
 
 
238
 
 c.ConstrDbl                (1   ,1 ,1 );
239
 
 m_use_cache.text_color_    (@c );
240
 
 c.ConstrDbl                (1   ,1 ,1 );
241
 
 m_use_cache.inactive_color_(@c );
242
 
 c.ConstrDbl                (0.8 ,0 ,0 );
243
 
 m_use_cache.active_color_  (@c );
244
 
 
245
 
 m_use_cache.no_transform;
246
 
 
247
 
 add_ctrl(@m_run );
248
 
 
249
 
 c.ConstrDbl          (1   ,1 ,1 );
250
 
 m_run.text_color_    (@c );
251
 
 c.ConstrDbl          (1   ,1 ,1 );
252
 
 m_run.inactive_color_(@c );
253
 
 c.ConstrDbl          (0.8 ,0 ,0 );
254
 
 m_run.active_color_  (@c );
255
 
 
256
 
 m_run.no_transform;
257
 
 m_run.status_(true );
258
 
 
259
 
end;
260
 
 
261
 
{ DESTRUCT }
262
 
destructor the_application.Destruct;
263
 
var
264
 
 i : int;
265
 
 
266
 
begin
267
 
 inherited Destruct;
268
 
 
269
 
 m_particles.Destruct;
270
 
 m_speed.Destruct;
271
 
 m_use_cache.Destruct;
272
 
 m_run.Destruct;
273
 
 
274
 
 i:=0;
275
 
 
276
 
 while i < 1000 do
277
 
  begin
278
 
   if g_cache[i ] <> NIL then
279
 
    dispose(g_cache[i ] ,Destruct );
280
 
 
281
 
   g_gradients[i ].Destruct;
282
 
 
283
 
   inc(i );
284
 
 
285
 
  end;
286
 
 
287
 
end;
288
 
 
289
 
{ RENDER_PARTICLE }
290
 
procedure render_particle(ren : renderer_base_ptr; i : unsigned; x ,y : double );
291
 
var
292
 
 grm : trans_affine;
293
 
 grf : gradient_circle;
294
 
 ell : ellipse;
295
 
 
296
 
 sa : span_allocator;
297
 
 sg : span_gradient;
298
 
 rg : renderer_scanline_aa;
299
 
 
300
 
 inter : span_interpolator_linear;
301
 
 
302
 
 r : double;
303
 
 
304
 
 tas : trans_affine_scaling;
305
 
 tat : trans_affine_translation;
306
 
 
307
 
begin
308
 
 grm.Construct;
309
 
 grf.Construct;
310
 
 ell.Construct;
311
 
 sa.Construct;
312
 
 inter.Construct(@grm );
313
 
 sg.Construct   (@sa ,@inter ,@grf ,@g_gradients[i ] ,0 ,10 );
314
 
 rg.Construct   (ren ,@sg );
315
 
 
316
 
 r:=g_radius[i ];
317
 
 
318
 
 grm.reset;
319
 
 tas.Construct(r / 10.0 );
320
 
 grm.multiply (@tas );
321
 
 tat.Construct(x ,y );
322
 
 grm.multiply (@tat );
323
 
 grm.invert;
324
 
 
325
 
 ell.init(x ,y ,r ,r ,32 );
326
 
 
327
 
 g_rasterizer.add_path(@ell );
328
 
 
329
 
 render_scanlines(@g_rasterizer ,@g_scanline ,@rg );
330
 
 
331
 
 sa.Destruct;
332
 
 sg.Destruct;
333
 
 
334
 
end;
335
 
 
336
 
{ ON_INIT }
337
 
procedure the_application.on_init;
338
 
var
339
 
 n ,i ,j ,d : unsigned;
340
 
 
341
 
 component ,da : int;
342
 
 
343
 
 divisor ,angle ,speed ,k : double;
344
 
 
345
 
 grc : gradient_tricolor;
346
 
 
347
 
 gr : pod_auto_array_ptr;
348
 
 
349
 
 pixf : pixel_formats;
350
 
 ren  : renderer_base;
351
 
 
352
 
begin
353
 
 n:=Trunc(m_particles._value );
354
 
 
355
 
 srand(123 );
356
 
 
357
 
 if m_use_cache._status then
358
 
  divisor:=250.0
359
 
 else
360
 
  divisor:=500.0;
361
 
 
362
 
 if m_first_time then
363
 
  begin
364
 
   i:=0;
365
 
 
366
 
   while i < n do
367
 
    begin
368
 
     g_cx[i ]:=_width / 2 {$IFDEF DISORDER } + rand mod 10 - 5 {$ENDIF };
369
 
     g_cy[i ]:=_height / 2 {$IFDEF DISORDER } + rand mod 10 - 5 {$ENDIF };
370
 
 
371
 
    {$IFDEF DISORDER }
372
 
     if rand and 1 <> 0 then
373
 
      g_dx[i ]:=(rand mod 5000 + 1000 ) / divisor
374
 
     else
375
 
      g_dx[i ]:=-(rand mod 5000 + 1000 ) / divisor;
376
 
 
377
 
     g_dy[i ]:=g_dx[i ];
378
 
 
379
 
     if rand and 1 <> 0 then
380
 
      g_dy[i ]:=-g_dy[i ];
381
 
 
382
 
    //---
383
 
     angle:=(rand mod 10000 ) / 10000.0 * (2.0 / 8.0 ) * pi;
384
 
     da   :=rand and 3;
385
 
     angle:=angle + 2.0 * pi * da / 4.0 + (pi / 10.0 );
386
 
 
387
 
    {$ELSE }
388
 
     angle:=(rand mod 10000 ) / 10000.0 * 2.0 * pi;
389
 
 
390
 
    {$ENDIF }
391
 
 
392
 
     speed:=((rand mod 10000 ) mod 5000 + 1000.0 ) / divisor;
393
 
 
394
 
     g_dx[i ]:=Cos(angle ) * speed;
395
 
     g_dy[i ]:=Sin(angle ) * speed;
396
 
 
397
 
     k:=1.0 - n / 2000.0;
398
 
 
399
 
     g_radius[i ]:=(rand mod 30 + 15 ) * k;
400
 
 
401
 
     g_color1[i ].ConstrInt(rand and $FF ,rand and $FF ,rand and $FF ,0 );
402
 
     g_color2[i ].ConstrInt(rand and $FF ,rand and $FF ,rand and $FF ,255 );
403
 
 
404
 
     component:=rand mod 3;
405
 
 
406
 
     if component = 0 then
407
 
      g_color2[i ].r:=255;
408
 
 
409
 
     if component = 1 then
410
 
      g_color2[i ].g:=255;
411
 
 
412
 
     if component = 2 then
413
 
      g_color2[i ].b:=255;
414
 
 
415
 
    {$IFDEF DISORDER }
416
 
     g_color1[i ]  :=g_color2[i ];
417
 
     g_color1[i ].a:=0;
418
 
 
419
 
    {$ENDIF }
420
 
 
421
 
     g_color3[i ].ConstrInt(rand and $FF ,rand and $FF ,rand and $FF ,0 );
422
 
 
423
 
     grc.Construct(g_color1[i ] ,g_color2[i ] ,g_color3[i ] );
424
 
 
425
 
     gr:=@g_gradients[i ];
426
 
     j :=0;
427
 
 
428
 
     while j < gr.size do
429
 
      begin
430
 
       move(
431
 
        grc.array_operator(j )^ ,
432
 
        gr.array_operator(j )^ ,
433
 
        sizeof(aggclr ) );
434
 
 
435
 
       inc(j );
436
 
 
437
 
      end;
438
 
 
439
 
     inc(i );
440
 
 
441
 
    end;
442
 
 
443
 
   m_first_time:=false;
444
 
 
445
 
  end;
446
 
 
447
 
 if m_use_cache._status then
448
 
  begin
449
 
   i:=0;
450
 
 
451
 
   while i < 1000 do
452
 
    begin
453
 
     if g_cache[i ] <> NIL then
454
 
      dispose(g_cache[i ] ,Destruct );
455
 
 
456
 
     g_cache[i ]:=NIL;
457
 
 
458
 
     inc(i );
459
 
 
460
 
    end;
461
 
 
462
 
   i:=0;
463
 
 
464
 
   while i < n do
465
 
    begin
466
 
     d:=Trunc(g_radius[i ] ) * 2;
467
 
 
468
 
     new(g_cache[i ] ,Construct(d ,d ,d * 4 ) );
469
 
 
470
 
     pixfmt_alpha_blend_rgba(pixf ,g_cache[i ] ,bgra_order );
471
 
 
472
 
     ren.Construct(@pixf );
473
 
 
474
 
     render_particle(@ren ,i ,d / 2 ,d / 2 );
475
 
 
476
 
     inc(i );
477
 
 
478
 
    end;
479
 
 
480
 
  end;
481
 
 
482
 
end;
483
 
 
484
 
{ ON_DRAW }
485
 
procedure the_application.on_draw;
486
 
var
487
 
 i : unsigned;
488
 
 
489
 
 width ,height ,x ,y : int;
490
 
 
491
 
 pf ,pf_pre ,pixf : pixel_formats;
492
 
 
493
 
 r ,r_pre : renderer_base;
494
 
 
495
 
 rs : renderer_scanline_aa_solid;
496
 
 
497
 
 rgba : aggclr;
498
 
 
499
 
 n  : unsigned;
500
 
 tm : double;
501
 
 
502
 
 buf : array[0..63 ] of char;
503
 
 
504
 
 t  : gsv_text;
505
 
 pt : conv_stroke;
506
 
 
507
 
begin
508
 
 width :=rbuf_window._width;
509
 
 height:=rbuf_window._height;
510
 
 
511
 
// Initialize structures
512
 
 pixfmt_bgra32(pf ,rbuf_window );
513
 
 
514
 
 r.Construct (@pf );
515
 
 rs.Construct(@r );
516
 
 
517
 
 g_rasterizer.clip_box(0 ,0 ,width ,height );
518
 
 
519
 
 rgba.ConstrDbl(0 ,0 ,0 );
520
 
 r.clear(@rgba );
521
 
 
522
 
// Render
523
 
 if m_run._status then
524
 
  begin
525
 
   start_timer;
526
 
 
527
 
   n:=Trunc(m_particles._value );
528
 
 
529
 
   if m_use_cache._status then
530
 
    begin
531
 
     pixfmt_bgra32_pre(pf_pre ,rbuf_window );
532
 
     r_pre.Construct  (@pf_pre );
533
 
 
534
 
     i:=0;
535
 
 
536
 
     while i < n do
537
 
      begin
538
 
       if g_cache[i ] <> NIL then
539
 
        begin
540
 
         pixfmt_alpha_blend_rgba(pixf ,g_cache[i ] ,bgra_order );
541
 
 
542
 
         x:=Trunc(g_cx[i ] - g_radius[i ] ) + 1;
543
 
         y:=Trunc(g_cy[i ] - g_radius[i ] ) + 1;
544
 
 
545
 
         r_pre.blend_from(@pixf ,0 ,x ,y ,255 );
546
 
 
547
 
        end;
548
 
 
549
 
       inc(i );
550
 
 
551
 
      end;
552
 
 
553
 
    end
554
 
   else
555
 
    begin
556
 
     i:=0;
557
 
 
558
 
     while i < n do
559
 
      begin
560
 
       render_particle(@r ,i ,g_cx[i ] ,g_cy[i ] );
561
 
 
562
 
       inc(i );
563
 
 
564
 
      end;
565
 
 
566
 
    end;
567
 
 
568
 
   tm:=elapsed_time;
569
 
 
570
 
   t.Construct;
571
 
   t.size_(10.0 );
572
 
 
573
 
   pt.Construct(@t );
574
 
   pt.width_   (1.5 );
575
 
 
576
 
   sprintf(@buf[0 ] ,'%6.1f fps' ,1000.0 / tm );
577
 
 
578
 
   t.start_point_(10.0 ,35.0 );
579
 
   t.text_       (@buf[0 ] );
580
 
 
581
 
   g_rasterizer.add_path(@pt );
582
 
 
583
 
   rgba.ConstrDbl(1 ,1 ,1 );
584
 
   rs.color_     (@rgba );
585
 
 
586
 
   render_scanlines(@g_rasterizer ,@g_scanline ,@rs );
587
 
 
588
 
   t.Destruct;
589
 
   pt.Destruct;
590
 
 
591
 
  end;
592
 
 
593
 
// Render the controls
594
 
 render_ctrl(@g_rasterizer ,@g_scanline ,@rs ,@m_particles );
595
 
 render_ctrl(@g_rasterizer ,@g_scanline ,@rs ,@m_speed );
596
 
 render_ctrl(@g_rasterizer ,@g_scanline ,@rs ,@m_use_cache );
597
 
 render_ctrl(@g_rasterizer ,@g_scanline ,@rs ,@m_run );
598
 
 
599
 
end;
600
 
 
601
 
{ ON_MOUSE_BUTTON_DOWN }
602
 
procedure the_application.on_mouse_button_down;
603
 
begin
604
 
 if (flags and mouse_left <> 0 ) or
605
 
    (flags and mouse_right <> 0 ) then
606
 
  force_redraw;
607
 
 
608
 
end;
609
 
 
610
 
{ ON_MOUSE_MOVE }
611
 
procedure the_application.on_mouse_move;
612
 
begin
613
 
 on_mouse_button_down(x ,y ,flags );
614
 
 
615
 
end;
616
 
 
617
 
{ ON_KEY }
618
 
procedure the_application.on_key;
619
 
begin
620
 
 if key = key_f1 then
621
 
  message_(
622
 
   'Demonstration of using the bitmap cache.'#13#13 +
623
 
   'Cached bitmaps are descended from AGG renderer_base    '#13 +
624
 
   'and on_draw method just alpha blended to the scene.' );
625
 
 
626
 
end;
627
 
 
628
 
{ ON_IDLE }
629
 
procedure the_application.on_idle;
630
 
var
631
 
 n ,i : unsigned;
632
 
 
633
 
 x1 ,y1 ,x2 ,y2 ,dx ,dy ,cx ,cy ,max_dist ,d : double;
634
 
 
635
 
begin
636
 
 n:=Trunc(m_particles._value );
637
 
 
638
 
 x1:=-100;
639
 
 y1:=-100;
640
 
 x2:=_width + 100;
641
 
 y2:=_height + 100;
642
 
 dx:=Cos(g_angle ) * g_center;
643
 
 dy:=Sin(g_angle ) * g_center;
644
 
 cx:=dx + _width / 2;
645
 
 cy:=dy + _height / 2;
646
 
 
647
 
 max_dist:=Sqrt(_width * _width / 2 + _height * _height / 2 );
648
 
 
649
 
 g_angle :=g_angle + 5.0 * pi / 180.0;
650
 
 g_center:=g_center + g_dc;
651
 
 
652
 
 if g_center > max_dist / 2 then
653
 
  begin
654
 
   g_center:=max_dist / 2;
655
 
   g_dc    :=-g_dc;
656
 
 
657
 
  end;
658
 
 
659
 
 if g_center < 10.0 then
660
 
  begin
661
 
   g_center:=10.0;
662
 
   g_dc    :=-g_dc;
663
 
 
664
 
  end;
665
 
 
666
 
 i:=0;
667
 
 
668
 
 while i < n do
669
 
  begin
670
 
   g_cx[i ]:=g_cx[i ] + g_dx[i ] * m_speed._value;
671
 
   g_cy[i ]:=g_cy[i ] + g_dy[i ] * m_speed._value;
672
 
 
673
 
   d:=calc_distance(g_cx[i ] ,g_cy[i ] ,cx ,cy );
674
 
 
675
 
   if d > max_dist then
676
 
    begin
677
 
     g_cx[i ]:=cx;
678
 
     g_cy[i ]:=cy;
679
 
 
680
 
    end;
681
 
 
682
 
  {$IFDEF DISORDER }
683
 
  {
684
 
   if g_cx[i ] < x1 then
685
 
    begin
686
 
     g_cx[i ]:=cx;
687
 
     g_cy[i ]:=cy;
688
 
 
689
 
    end;
690
 
 
691
 
   if g_cx[i ] > x2 then
692
 
    begin
693
 
     g_cx[i ]:=cx;
694
 
     g_cy[i ]:=cy;
695
 
 
696
 
    end;
697
 
 
698
 
   if g_cy[i ] < y1 then
699
 
    begin
700
 
     g_cx[i ]:=cx;
701
 
     g_cy[i ]:=cy;
702
 
 
703
 
    end;
704
 
 
705
 
   if g_cy[i ] > y2 then
706
 
    begin
707
 
     g_cx[i ]:=cx;
708
 
     g_cy[i ]:=cy;
709
 
 
710
 
    end;
711
 
 
712
 
  {}
713
 
   if g_cx[i ] < x1 then
714
 
    begin
715
 
     g_cx[i ]:=x1;
716
 
     g_dx[i ]:=-g_dx[i ];
717
 
 
718
 
    end;
719
 
 
720
 
   if g_cx[i ] > x2 then
721
 
    begin
722
 
     g_cx[i ]:=x2;
723
 
     g_dx[i ]:=-g_dx[i];
724
 
 
725
 
    end;
726
 
 
727
 
   if g_cy[i ] < y1 then
728
 
    begin
729
 
     g_cy[i ]:=y1;
730
 
     g_dy[i ]:=-g_dy[i ];
731
 
 
732
 
    end;
733
 
 
734
 
   if g_cy[i ] > y2 then
735
 
    begin
736
 
     g_cy[i ]:=y2;
737
 
     g_dy[i ]:=-g_dy[i ];
738
 
 
739
 
    end;
740
 
 
741
 
  {}
742
 
  {$ENDIF }
743
 
 
744
 
   inc(i );
745
 
 
746
 
  end;
747
 
 
748
 
 force_redraw;
749
 
 
750
 
end;
751
 
 
752
 
{ ON_CTRL_CHANGE }
753
 
procedure the_application.on_ctrl_change;
754
 
var
755
 
 stop ,over : boolean;
756
 
 
757
 
begin
758
 
 if m_run_flag <> m_run._status then
759
 
  begin
760
 
   wait_mode_(not m_run._status );
761
 
 
762
 
   m_run_flag:=m_run._status;
763
 
 
764
 
   if m_run_flag then
765
 
    begin
766
 
     m_first_time:=true;
767
 
 
768
 
     on_init;
769
 
 
770
 
    end;
771
 
 
772
 
  end
773
 
 else
774
 
  begin
775
 
   stop:=false;
776
 
   over:=false;
777
 
 
778
 
   if m_use_cache._status <> m_use_cache_flag then
779
 
    begin
780
 
     m_use_cache_flag:=m_use_cache._status;
781
 
 
782
 
     stop:=false;
783
 
     over:=true;
784
 
 
785
 
    end;
786
 
 
787
 
   if m_particles._value <> m_particles_value then
788
 
    begin
789
 
     m_particles_value:=m_particles._value;
790
 
 
791
 
     stop:=true;
792
 
     over:=false;
793
 
 
794
 
    end;
795
 
 
796
 
   if m_speed._value <> m_speed_value then
797
 
    begin
798
 
     m_speed_value:=m_speed._value;
799
 
 
800
 
     stop:=false;
801
 
     over:=false;
802
 
 
803
 
    end;
804
 
 
805
 
   if stop then
806
 
    begin
807
 
     wait_mode_   (true );
808
 
     m_run.status_(false );
809
 
 
810
 
    end
811
 
   else
812
 
    if over then
813
 
     on_init;
814
 
 
815
 
  end;
816
 
 
817
 
end;
818
 
 
819
 
VAR
820
 
 app : the_application;
821
 
 
822
 
BEGIN
823
 
 app.Construct(pix_format_bgra32 ,flip_y );
824
 
 app.caption_ ('Renesis project -- Particles demo. (F1-Help)' );
825
 
 
826
 
 g_scanline.Construct;
827
 
 g_rasterizer.Construct;
828
 
 g_path.Construct;
829
 
 
830
 
 if app.init(600 ,500 ,window_resize ) then
831
 
  begin
832
 
   app.wait_mode_(false );
833
 
   app.run;
834
 
 
835
 
  end;
836
 
 
837
 
 g_rasterizer.Destruct;
838
 
 g_scanline.Destruct;
839
 
 g_path.Destruct;
840
 
 
841
 
 app.Destruct;
842
 
 
843
 
END.
 
 
b'\\ No newline at end of file'