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

« back to all changes in this revision

Viewing changes to components/aggpas/aa_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
[ 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:
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
 
 aa_demo ;
9
 
 
10
 
uses
11
 
 agg_basics ,
12
 
 agg_platform_support ,
13
 
 agg_math ,
14
 
 
15
 
 agg_color ,
16
 
 agg_pixfmt ,
17
 
 agg_pixfmt_rgb ,
18
 
 
19
 
 agg_ctrl ,
20
 
 agg_slider_ctrl ,
21
 
 agg_cbox_ctrl ,
22
 
 
23
 
 agg_renderer_base ,
24
 
 agg_renderer_scanline ,
25
 
 agg_rasterizer_scanline_aa ,
26
 
 agg_scanline ,
27
 
 agg_scanline_p ,
28
 
 agg_scanline_u ,
29
 
 agg_render_scanlines ,
30
 
 
31
 
 agg_gamma_functions ,
32
 
 agg_path_storage ,
33
 
 agg_conv_stroke ,
34
 
 agg_vertex_source ;
35
 
 
36
 
{$I agg_mode.inc }
37
 
 
38
 
const
39
 
 flip_y = true;
40
 
 
41
 
type
42
 
 square = object
43
 
   m_size : double;
44
 
 
45
 
   constructor Construct(size : double );
46
 
 
47
 
   procedure draw(ras : rasterizer_scanline_aa_ptr; sl : scanline_ptr; ren : renderer_scanline_ptr; x ,y : double );
48
 
 
49
 
  end;
50
 
 
51
 
 renderer_enlarged = object(renderer_scanline )
52
 
   m_ras : rasterizer_scanline_aa;
53
 
   m_sl  : scanline_u8;
54
 
   m_ren : renderer_scanline_aa_solid_ptr;
55
 
 
56
 
   m_square : square;
57
 
   m_color  : aggclr;
58
 
   m_size   : double;
59
 
 
60
 
   constructor Construct(ren : renderer_scanline_aa_solid_ptr; size : double );
61
 
   destructor  Destruct;
62
 
 
63
 
   procedure color  (c : aggclr_ptr ); virtual;
64
 
   procedure prepare(u : unsigned ); virtual;
65
 
   procedure render (sl : scanline_ptr ); virtual;
66
 
 
67
 
  end;
68
 
 
69
 
 the_application = object(platform_support )
70
 
   m_x ,
71
 
   m_y : array[0..2 ] of double;
72
 
 
73
 
   m_dx ,
74
 
   m_dy : double;
75
 
 
76
 
   m_idx : int;
77
 
 
78
 
   m_slider1 ,
79
 
   m_slider2 : slider_ctrl;
80
 
 
81
 
   constructor Construct(format_ : pix_format_e; flip_y_ : boolean );
82
 
   destructor  Destruct;
83
 
 
84
 
   procedure on_draw; virtual;
85
 
 
86
 
   procedure on_mouse_move       (x ,y : int; flags : unsigned ); virtual;
87
 
   procedure on_mouse_button_down(x ,y : int; flags : unsigned ); virtual;
88
 
   procedure on_mouse_button_up  (x ,y : int; flags : unsigned ); virtual;
89
 
 
90
 
   procedure on_key(x ,y : int; key ,flags : unsigned ); virtual;
91
 
 
92
 
  end;
93
 
 
94
 
{ CONSTRUCT }
95
 
constructor square.Construct;
96
 
begin
97
 
 m_size:=size;
98
 
 
99
 
end;
100
 
 
101
 
{ DRAW }
102
 
procedure square.Draw;
103
 
begin
104
 
 ras.reset;
105
 
 
106
 
 ras.move_to_d(x * m_size ,y * m_size );
107
 
 ras.line_to_d(x * m_size + m_size ,y * m_size );
108
 
 ras.line_to_d(x * m_size + m_size ,y * m_size + m_size );
109
 
 ras.line_to_d(x * m_size ,y * m_size + m_size );
110
 
 
111
 
 render_scanlines(ras ,sl ,ren );
112
 
 
113
 
end;
114
 
 
115
 
{ CONSTRUCT }
116
 
constructor renderer_enlarged.Construct;
117
 
begin
118
 
 m_square.Construct(size );
119
 
 
120
 
 m_ras.Construct;
121
 
 m_sl.Construct;
122
 
 m_color.Construct;
123
 
 
124
 
 m_ren :=ren;
125
 
 m_size:=size;
126
 
 
127
 
end;
128
 
 
129
 
{ DESTRUCT }
130
 
destructor renderer_enlarged.Destruct;
131
 
begin
132
 
 m_ras.Destruct;
133
 
 m_sl.Destruct;
134
 
 
135
 
end;
136
 
 
137
 
{ COLOR }
138
 
procedure renderer_enlarged.color;
139
 
begin
140
 
 m_color:=c^;
141
 
 
142
 
end;
143
 
 
144
 
{ PREPARE }
145
 
procedure renderer_enlarged.prepare;
146
 
begin
147
 
end;
148
 
 
149
 
{ RENDER }
150
 
procedure renderer_enlarged.render;
151
 
var
152
 
 y ,x ,a ,
153
 
 num_pix : int;
154
 
 
155
 
 num_spans : unsigned;
156
 
 
157
 
 span   : span_u8_ptr;
158
 
 covers : int8u_ptr;
159
 
 
160
 
 rgba : aggclr;
161
 
 
162
 
begin
163
 
 y        :=sl.y;
164
 
 num_spans:=sl.num_spans;
165
 
 span     :=sl.begin_;
166
 
 
167
 
 repeat
168
 
  x      :=span.x;
169
 
  covers :=span.covers;
170
 
  num_pix:=span.len;
171
 
 
172
 
  repeat
173
 
   a:=shr_int32(covers^ * m_color.a ,8 );
174
 
 
175
 
   inc(ptrcomp(covers ) ,sizeof(int8u ) );
176
 
 
177
 
   rgba.ConstrInt(m_color.r ,m_color.g ,m_color.b ,a );
178
 
   m_ren.color_  (@rgba );
179
 
   m_square.draw (@m_ras ,@m_sl ,m_ren ,x ,y );
180
 
 
181
 
   inc(x );
182
 
   dec(num_pix );
183
 
 
184
 
  until num_pix = 0;
185
 
 
186
 
  dec(num_spans );
187
 
 
188
 
 until num_spans = 0;
189
 
 
190
 
end;
191
 
 
192
 
{ CONSTRUCT }
193
 
constructor the_application.Construct;
194
 
begin
195
 
 inherited Construct(format_ ,flip_y_ );
196
 
 
197
 
 m_slider1.Construct(80 ,10 ,600 - 10 ,19 ,not flip_y );
198
 
 m_slider2.Construct(80 ,10 + 20 ,600 - 10 ,19 + 20 ,not flip_y_ );
199
 
 
200
 
 m_idx:=-1;
201
 
 
202
 
 m_x[0 ]:=57;    m_y[0 ]:=100;
203
 
 m_x[1 ]:=369;   m_y[1 ]:=170;
204
 
 m_x[2 ]:=143;   m_y[2 ]:=310;
205
 
 
206
 
 add_ctrl(@m_slider1 );
207
 
 add_ctrl(@m_slider2 );
208
 
 
209
 
 m_slider1.range_    (8.0 ,100.0 );
210
 
 m_slider1.num_steps_(23 );
211
 
 m_slider1.value_    (32.0 );
212
 
 
213
 
 m_slider2.range_(0.1 ,3.0 );
214
 
 m_slider2.value_(1.0 );
215
 
 
216
 
 m_slider1.label_('Pixel size=%1.0f' );
217
 
 m_slider2.label_('Gamma=%4.3f' );
218
 
 
219
 
 m_slider1.no_transform;
220
 
 m_slider2.no_transform;
221
 
 
222
 
end;
223
 
 
224
 
{ DESTRUCT }
225
 
destructor the_application.Destruct;
226
 
begin
227
 
 inherited Destruct;
228
 
 
229
 
 m_slider1.Destruct;
230
 
 m_slider2.Destruct;
231
 
 
232
 
end;
233
 
 
234
 
{ ON_DRAW }
235
 
procedure the_application.on_draw;
236
 
var
237
 
 size_mul : int;
238
 
 
239
 
 pixf : pixel_formats;
240
 
 
241
 
 rb  : renderer_base;
242
 
 ren : renderer_scanline_aa_solid;
243
 
 ras : rasterizer_scanline_aa;
244
 
 sl  : scanline_u8;
245
 
 
246
 
 rgba  : aggclr;
247
 
 gm_no : vertex_source;
248
 
 gm_pw : gamma_power;
249
 
 
250
 
 ren_en : renderer_enlarged;
251
 
 
252
 
 ps : path_storage;
253
 
 pg : conv_stroke;
254
 
 
255
 
begin
256
 
// Initialize structures
257
 
 pixfmt_bgr24(pixf ,rbuf_window );
258
 
 
259
 
 rb.Construct (@pixf );
260
 
 ren.Construct(@rb );
261
 
 
262
 
 rgba.ConstrDbl(1 ,1 ,1 );
263
 
 rb.clear(@rgba );
264
 
 
265
 
 sl.Construct;
266
 
 ras.Construct;
267
 
 
268
 
// Draw Zoomed Triangle
269
 
 size_mul:=trunc(m_slider1._value );
270
 
 
271
 
 gm_pw.Construct(m_slider2._value );
272
 
 ras.gamma      (@gm_pw );
273
 
 
274
 
 ren_en.Construct(@ren ,size_mul );
275
 
 
276
 
 rgba.ConstrInt(0 ,0 ,0 ,255 );
277
 
 ren_en.color  (@rgba );
278
 
 
279
 
 ras.reset;
280
 
 ras.move_to_d(m_x[0 ] / size_mul ,m_y[0 ] / size_mul );
281
 
 ras.line_to_d(m_x[1 ] / size_mul ,m_y[1 ] / size_mul );
282
 
 ras.line_to_d(m_x[2 ] / size_mul ,m_y[2 ] / size_mul );
283
 
 
284
 
 render_scanlines(@ras ,@sl ,@ren_en );
285
 
 
286
 
// Draw final triangle bottom-left
287
 
 rgba.ConstrInt(0 ,0 ,0 );
288
 
 ren.color_    (@rgba );
289
 
 
290
 
 render_scanlines(@ras ,@sl ,@ren );
291
 
 
292
 
// Draw The Supposed Triangle over
293
 
 gm_no.Construct;
294
 
 ras.gamma(@gm_no );
295
 
 
296
 
 ps.Construct;
297
 
 pg.Construct(@ps );
298
 
 pg.width_   (2.0 );
299
 
 
300
 
 rgba.ConstrInt(0 ,150 ,160 ,200 );
301
 
 ren.color_    (@rgba );
302
 
 
303
 
 ps.remove_all;
304
 
 ps.move_to(m_x[0 ] ,m_y[0 ] );
305
 
 ps.line_to(m_x[1 ] ,m_y[1 ] );
306
 
 
307
 
 ras.add_path(@pg );
308
 
 
309
 
 render_scanlines(@ras ,@sl ,@ren );
310
 
 
311
 
 ps.remove_all;
312
 
 ps.move_to(m_x[1 ] ,m_y[1 ] );
313
 
 ps.line_to(m_x[2 ] ,m_y[2 ] );
314
 
 
315
 
 ras.add_path(@pg );
316
 
 
317
 
 render_scanlines(@ras ,@sl ,@ren );
318
 
 
319
 
 ps.remove_all;
320
 
 ps.move_to(m_x[2 ] ,m_y[2 ] );
321
 
 ps.line_to(m_x[0 ] ,m_y[0 ] );
322
 
 
323
 
 ras.add_path(@pg );
324
 
 
325
 
 render_scanlines(@ras ,@sl ,@ren );
326
 
 
327
 
// Render the controls
328
 
 render_ctrl(@ras ,@sl ,@ren ,@m_slider1 );
329
 
 render_ctrl(@ras ,@sl ,@ren ,@m_slider2 );
330
 
 
331
 
// Free AGG resources
332
 
 ras.Destruct;
333
 
 sl.Destruct;
334
 
 
335
 
 pg.Destruct;
336
 
 ps.Destruct;
337
 
 
338
 
 ren_en.Destruct;
339
 
 
340
 
end;
341
 
 
342
 
{ ON_MOUSE_MOVE }
343
 
procedure the_application.on_mouse_move;
344
 
var
345
 
 dx ,dy : double;
346
 
 
347
 
begin
348
 
 if flags and mouse_left <> 0 then
349
 
  begin
350
 
   if m_idx = 3 then
351
 
    begin
352
 
     dx:=x - m_dx;
353
 
     dy:=y - m_dy;
354
 
 
355
 
     m_x[1 ]:=m_x[1 ] - (m_x[0 ] - dx );
356
 
     m_y[1 ]:=m_y[1 ] - (m_y[0 ] - dy );
357
 
     m_x[2 ]:=m_x[2 ] - (m_x[0 ] - dx );
358
 
     m_y[2 ]:=m_y[2 ] - (m_y[0 ] - dy );
359
 
     m_x[0 ]:= dx;
360
 
     m_y[0 ]:= dy;
361
 
 
362
 
     force_redraw;
363
 
     exit;
364
 
 
365
 
    end;
366
 
 
367
 
   if m_idx >= 0 then
368
 
    begin
369
 
     m_x[m_idx ]:=x - m_dx;
370
 
     m_y[m_idx ]:=y - m_dy;
371
 
 
372
 
     force_redraw;
373
 
 
374
 
    end; 
375
 
 
376
 
  end
377
 
 else
378
 
  on_mouse_button_up(x ,y ,flags );
379
 
 
380
 
end;
381
 
 
382
 
{ ON_MOUSE_BUTTON_DOWN }
383
 
procedure the_application.on_mouse_button_down;
384
 
var
385
 
 i : unsigned;
386
 
 
387
 
begin
388
 
 if flags and mouse_left <> 0 then
389
 
  begin
390
 
   i:=0;
391
 
 
392
 
   while i < 3 do
393
 
    begin
394
 
     if Sqrt((x - m_x[ i ] ) * (x - m_x[i ] ) + (y - m_y[i ] ) * (y - m_y[i ] ) ) < 10.0 then
395
 
      begin
396
 
       m_dx :=x - m_x[i ];
397
 
       m_dy :=y - m_y[i ];
398
 
       m_idx:=i;
399
 
 
400
 
       break;
401
 
 
402
 
      end;
403
 
 
404
 
     inc(i );
405
 
 
406
 
    end;
407
 
 
408
 
   if i = 3 then
409
 
    if point_in_triangle(m_x[0 ] ,m_y[0 ] ,m_x[1 ] ,m_y[1 ] ,m_x[2 ] ,m_y[2 ] ,x ,y ) then
410
 
     begin
411
 
      m_dx :=x - m_x[0 ];
412
 
      m_dy :=y - m_y[0 ];
413
 
      m_idx:=3;
414
 
 
415
 
     end;
416
 
 
417
 
  end;
418
 
 
419
 
end;
420
 
 
421
 
{ ON_MOUSE_BUTTON_UP }
422
 
procedure the_application.on_mouse_button_up;
423
 
begin
424
 
 m_idx:=-1;
425
 
 
426
 
end;
427
 
 
428
 
{ ON_KEY }
429
 
procedure the_application.on_key;
430
 
begin
431
 
 if key = key_f1 then
432
 
  message_(
433
 
   'Demonstration of the Anti-Aliasing principle with Subpixel Accuracy.'#13 +
434
 
   'The triangle is rendered two times, with its "natural" size (at the bottom-left)'#13 +
435
 
   'and enlarged. To draw the enlarged version there was a special scanline'#13 +
436
 
   'renderer written (see class renderer_enlarged in the source code).'#13#13+
437
 
   'How to play with:'#13#13 +
438
 
   'You can drag the whole triangle as well as each vertex of it.'#13 +
439
 
   'Also change "Gamma" to see how it affects the quality of Anti-Aliasing.' +
440
 
   #13#13'Note: F2 key saves current "screenshot" file in this demo''s directory.  ' );
441
 
 
442
 
end;
443
 
 
444
 
VAR
445
 
 app : the_application;
446
 
 
447
 
BEGIN
448
 
 app.Construct(pix_format_bgr24 ,flip_y );
449
 
 app.caption_ ('AGG Example. Anti-Aliasing Demo (F1-Help)' );
450
 
 
451
 
 if app.init(600 ,400 ,window_resize ) then
452
 
  app.run;
453
 
 
454
 
 app.Destruct;
455
 
 
456
 
END.
 
 
b'\\ No newline at end of file'