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

« back to all changes in this revision

Viewing changes to components/aggpas/gouraud.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
 
 gouraud ;
9
 
 
10
 
{DEFINE AGG_GRAY8 }
11
 
{$DEFINE AGG_BGR24 }
12
 
{DEFINE AGG_RGB24 }
13
 
{DEFINE AGG_BGRA32 }
14
 
{DEFINE AGG_RGBA32 }
15
 
{DEFINE AGG_ARGB32 }
16
 
{DEFINE AGG_ABGR32 }
17
 
{DEFINE AGG_RGB565 }
18
 
{DEFINE AGG_RGB555 }
19
 
 
20
 
uses
21
 
 agg_basics ,
22
 
 agg_platform_support ,
23
 
 
24
 
 agg_ctrl ,
25
 
 agg_slider_ctrl ,
26
 
 
27
 
 agg_rasterizer_scanline_aa ,
28
 
 agg_scanline ,
29
 
 agg_scanline_u ,
30
 
 agg_scanline_p ,
31
 
 
32
 
 agg_renderer_base ,
33
 
 agg_renderer_scanline ,
34
 
 agg_render_scanlines ,
35
 
 
36
 
 agg_math ,
37
 
 agg_dda_line ,
38
 
 agg_span_allocator ,
39
 
 agg_span_gouraud_rgba ,
40
 
 agg_span_gouraud_gray ,
41
 
 agg_span_solid ,
42
 
 agg_vertex_source ,
43
 
 agg_gamma_functions 
44
 
 
45
 
{$I pixel_formats.inc }
46
 
{$I agg_mode.inc }
47
 
 
48
 
const
49
 
 flip_y = true;
50
 
 
51
 
type
52
 
 the_application = object(platform_support )
53
 
   m_x ,
54
 
   m_y : array[0..2 ] of double;
55
 
 
56
 
   m_dx ,
57
 
   m_dy : double;
58
 
 
59
 
   m_idx : int;
60
 
 
61
 
   m_dilation ,
62
 
   m_gamma    ,
63
 
   m_alpha    : slider_ctrl;
64
 
 
65
 
   constructor Construct(format_ : pix_format_e; flip_y_ : boolean );
66
 
   destructor  Destruct;
67
 
 
68
 
   procedure render_gouraud(sl : scanline_ptr; ras : rasterizer_scanline_aa_ptr );
69
 
 
70
 
   procedure on_draw; virtual;
71
 
 
72
 
   procedure on_mouse_move       (x ,y : int; flags : unsigned ); virtual;
73
 
   procedure on_mouse_button_down(x ,y : int; flags : unsigned ); virtual;
74
 
   procedure on_mouse_button_up  (x ,y : int; flags : unsigned ); virtual;
75
 
 
76
 
   procedure on_key(x ,y : int; key ,flags : unsigned ); virtual;
77
 
 
78
 
  end;
79
 
 
80
 
{ CONSTRUCT }
81
 
constructor the_application.Construct;
82
 
begin
83
 
 inherited Construct(format_ ,flip_y_ );
84
 
 
85
 
 m_dilation.Construct(5 ,5 ,400 - 5 ,11 ,not flip_y_ );
86
 
 m_gamma.Construct   (5 ,5 + 15 ,400 - 5 ,11 + 15 ,not flip_y_ );
87
 
 m_alpha.Construct   (5 ,5 + 30 ,400 - 5 ,11 + 30 ,not flip_y_ );
88
 
 
89
 
 m_idx:=-1;
90
 
 
91
 
 m_x[0 ]:=57;  m_y[0 ]:=60;
92
 
 m_x[1 ]:=369; m_y[1 ]:=170;
93
 
 m_x[2 ]:=143; m_y[2 ]:=310;
94
 
 
95
 
 add_ctrl(@m_dilation );
96
 
 add_ctrl(@m_gamma );
97
 
 add_ctrl(@m_alpha );
98
 
 
99
 
 m_dilation.label_('Dilation=%3.2f' );
100
 
 m_gamma.label_   ('Linear gamma=%3.2f' );
101
 
 m_alpha.label_   ('Opacity=%3.2f' );
102
 
 
103
 
 m_dilation.value_(0.175 );
104
 
 m_gamma.value_   (0.809 );
105
 
 m_alpha.value_   (1.0 );
106
 
 
107
 
end;
108
 
 
109
 
{ DESTRUCT }
110
 
destructor the_application.Destruct;
111
 
begin
112
 
 inherited Destruct;
113
 
 
114
 
 m_dilation.Destruct;
115
 
 m_gamma.Destruct;
116
 
 m_alpha.Destruct;
117
 
 
118
 
end;
119
 
 
120
 
{ RENDER_GOURAUD }
121
 
procedure the_application.render_gouraud;
122
 
var
123
 
 alpha ,brc ,d ,xc ,yc ,x1 ,y1 ,x2 ,y2 ,x3 ,y3 : double; 
124
 
 
125
 
 pf : pixel_formats;
126
 
 
127
 
{$IFDEF AGG_GRAY8 }
128
 
 span_gen : span_gouraud_gray;
129
 
 
130
 
{$ELSE }
131
 
 span_gen : span_gouraud_rgba;
132
 
 
133
 
{$ENDIF } 
134
 
 
135
 
 ren_base    : renderer_base;
136
 
 span_alloc  : span_allocator;
137
 
 ren_gouraud : renderer_scanline_aa;
138
 
 
139
 
 gm_li : gamma_linear;
140
 
 
141
 
 rgba ,
142
 
 rgbb ,
143
 
 rgbc : aggclr;
144
 
 
145
 
begin
146
 
 alpha:=m_alpha._value;
147
 
 brc  :=1;
148
 
 
149
 
// Initialize structures
150
 
 pixfmt(pf ,rbuf_window );
151
 
 
152
 
 ren_base.Construct   (@pf );
153
 
 span_alloc.Construct;
154
 
 span_gen.Construct   (@span_alloc );
155
 
 ren_gouraud.Construct(@ren_base ,@span_gen );
156
 
 
157
 
 gm_li.Construct(0.0 ,m_gamma._value );
158
 
 ras.gamma      (@gm_li );
159
 
 
160
 
 d:=m_dilation._value;
161
 
 
162
 
// Single triangle
163
 
{ rgba.ConstrDbl   (1 ,0 ,0 ,alpha );
164
 
 rgbb.ConstrDbl   (0 ,1 ,0 ,alpha );
165
 
 rgbc.ConstrDbl   (0 ,0 ,1 ,alpha );
166
 
 span_gen.colors  (@rgba ,@rgbb ,@rgbc );
167
 
 span_gen.triangle(m_x[0 ] ,m_y[0 ] ,m_x[1 ] ,m_y[1 ] ,m_x[2 ] ,m_y[2 ] ,d );
168
 
 
169
 
 ras.add_path    (@span_gen);
170
 
 render_scanlines(ras ,sl ,@ren_gouraud );{}
171
 
 
172
 
// Six triangles
173
 
 xc:=(m_x[0 ] + m_x[1 ] + m_x[2 ] ) / 3.0;
174
 
 yc:=(m_y[0 ] + m_y[1 ] + m_y[2 ] ) / 3.0;
175
 
 
176
 
 x1:=(m_x[1 ] + m_x[0 ] ) / 2 - (xc - (m_x[1 ] + m_x[0 ] ) / 2 );
177
 
 y1:=(m_y[1 ] + m_y[0 ] ) / 2 - (yc - (m_y[1 ] + m_y[0 ] ) / 2 );
178
 
 
179
 
 x2:=(m_x[2 ] + m_x[1 ] ) / 2 - (xc - (m_x[2 ] + m_x[1 ] ) / 2 );
180
 
 y2:=(m_y[2 ] + m_y[1 ] ) / 2 - (yc - (m_y[2 ] + m_y[1 ] ) / 2 );
181
 
 
182
 
 x3:=(m_x[0 ] + m_x[2 ] ) / 2 - (xc - (m_x[0 ] + m_x[2 ] ) / 2 );
183
 
 y3:=(m_y[0 ] + m_y[2 ] ) / 2 - (yc - (m_y[0 ] + m_y[2 ] ) / 2 );
184
 
 
185
 
 rgba.ConstrDbl   (1 ,0 ,0 ,alpha );
186
 
 rgbb.ConstrDbl   (0 ,1 ,0 ,alpha );
187
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
188
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
189
 
 span_gen.triangle(m_x[0 ] ,m_y[0 ] ,m_x[1 ] ,m_y[1 ] ,xc ,yc ,d );
190
 
 
191
 
 ras.add_path    (@span_gen );
192
 
 render_scanlines(ras ,sl ,@ren_gouraud );
193
 
 
194
 
 rgba.ConstrDbl   (0 ,1 ,0 ,alpha );
195
 
 rgbb.ConstrDbl   (0 ,0 ,1 ,alpha );
196
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
197
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
198
 
 span_gen.triangle(m_x[1 ] ,m_y[1 ] ,m_x[2 ] ,m_y[2 ] ,xc ,yc ,d );
199
 
 
200
 
 ras.add_path    (@span_gen );
201
 
 render_scanlines(ras ,sl ,@ren_gouraud );
202
 
 
203
 
 rgba.ConstrDbl   (0 ,0 ,1 ,alpha );
204
 
 rgbb.ConstrDbl   (1 ,0 ,0 ,alpha );
205
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
206
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
207
 
 span_gen.triangle(m_x[2 ] ,m_y[2 ] ,m_x[0 ] ,m_y[0 ] ,xc ,yc ,d );
208
 
 
209
 
 ras.add_path    (@span_gen );
210
 
 render_scanlines(ras ,sl ,@ren_gouraud );
211
 
 
212
 
 brc:=1 - brc;
213
 
 
214
 
 rgba.ConstrDbl   (1 ,0 ,0 ,alpha );
215
 
 rgbb.ConstrDbl   (0 ,1 ,0 ,alpha );
216
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
217
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
218
 
 span_gen.triangle(m_x[0 ] ,m_y[0 ] ,m_x[1 ] ,m_y[1 ] ,x1 ,y1 ,d );
219
 
 
220
 
 ras.add_path    (@span_gen );
221
 
 render_scanlines(ras ,sl ,@ren_gouraud );
222
 
 
223
 
 rgba.ConstrDbl   (0 ,1 ,0 ,alpha );
224
 
 rgbb.ConstrDbl   (0 ,0 ,1 ,alpha );
225
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
226
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
227
 
 span_gen.triangle(m_x[1 ] ,m_y[1 ] ,m_x[2 ] ,m_y[2 ] ,x2 ,y2 ,d );
228
 
 
229
 
 ras.add_path    (@span_gen);
230
 
 render_scanlines(ras ,sl ,@ren_gouraud );
231
 
 
232
 
 rgba.ConstrDbl   (0 ,0 ,1 ,alpha );
233
 
 rgbb.ConstrDbl   (1 ,0 ,0 ,alpha );
234
 
 rgbc.ConstrDbl   (brc ,brc ,brc ,alpha );
235
 
 span_gen.colors_ (@rgba ,@rgbb ,@rgbc );
236
 
 span_gen.triangle(m_x[2 ] ,m_y[2 ] ,m_x[0 ] ,m_y[0 ] ,x3 ,y3 ,d );
237
 
 
238
 
 ras.add_path    (@span_gen );
239
 
 render_scanlines(ras ,sl ,@ren_gouraud );{}
240
 
 
241
 
// Free AGG resources
242
 
 span_alloc.Destruct;
243
 
 
244
 
end;
245
 
 
246
 
{ ON_DRAW }
247
 
procedure the_application.on_draw;
248
 
var
249
 
 pf : pixel_formats;
250
 
 
251
 
 ren_base  : renderer_base;
252
 
 ren_solid : renderer_scanline_aa_solid;
253
 
 
254
 
 ras : rasterizer_scanline_aa;
255
 
 sl  : scanline_u8;
256
 
 
257
 
 rgba  : aggclr;
258
 
 gm_no : vertex_source;
259
 
 
260
 
begin
261
 
// Initialize structures
262
 
 pixfmt(pf ,rbuf_window );
263
 
 
264
 
 ren_base.Construct (@pf );
265
 
 ren_solid.Construct(@ren_base );
266
 
 
267
 
 rgba.ConstrDbl(1 ,1 ,1 );
268
 
 ren_base.clear(@rgba );
269
 
 
270
 
 sl.Construct;
271
 
 ras.Construct;
272
 
 
273
 
// Render gouraud
274
 
 render_gouraud(@sl ,@ras );
275
 
 
276
 
// Render the controls
277
 
 gm_no.Construct;
278
 
 ras.gamma(@gm_no );
279
 
 
280
 
 render_ctrl(@ras ,@sl ,@ren_solid ,@m_dilation );
281
 
 render_ctrl(@ras ,@sl ,@ren_solid ,@m_gamma );
282
 
 render_ctrl(@ras ,@sl ,@ren_solid ,@m_alpha );
283
 
 
284
 
// Free AGG resources
285
 
 sl.Destruct;
286
 
 ras.Destruct;
287
 
 
288
 
end;
289
 
 
290
 
{ ON_MOUSE_MOVE }
291
 
procedure the_application.on_mouse_move;
292
 
var
293
 
 dx ,dy : double;
294
 
 
295
 
begin
296
 
 if flags and mouse_left <> 0 then
297
 
  begin
298
 
   if m_idx = 3 then
299
 
    begin
300
 
     dx:=x - m_dx;
301
 
     dy:=y - m_dy;
302
 
 
303
 
     m_x[1 ]:=m_x[1 ] - (m_x[0 ] - dx );
304
 
     m_y[1 ]:=m_y[1 ] - (m_y[0 ] - dy );
305
 
     m_x[2 ]:=m_x[2 ] - (m_x[0 ] - dx );
306
 
     m_y[2 ]:=m_y[2 ] - (m_y[0 ] - dy );
307
 
     m_x[0 ]:=dx;
308
 
     m_y[0 ]:=dy;
309
 
 
310
 
     force_redraw;
311
 
     exit;
312
 
 
313
 
    end;
314
 
 
315
 
   if m_idx >= 0 then
316
 
    begin
317
 
     m_x[m_idx ]:=x - m_dx;
318
 
     m_y[m_idx ]:=y - m_dy;
319
 
 
320
 
     force_redraw;
321
 
 
322
 
    end;
323
 
  
324
 
  end
325
 
 else
326
 
  on_mouse_button_up(x ,y ,flags );
327
 
 
328
 
end;
329
 
 
330
 
{ ON_MOUSE_BUTTON_DOWN }
331
 
procedure the_application.on_mouse_button_down;
332
 
var
333
 
 i : unsigned;
334
 
 
335
 
 sl  : scanline_u8;
336
 
 ras : rasterizer_scanline_aa;
337
 
 buf : array[0..99 ] of char;
338
 
 
339
 
begin
340
 
 if flags and mouse_right <> 0 then
341
 
  begin
342
 
   sl.Construct;
343
 
   ras.Construct;
344
 
 
345
 
   start_timer;
346
 
 
347
 
   for i:=0 to 99 do
348
 
    render_gouraud(@sl ,@ras );
349
 
 
350
 
   sprintf (@buf[0 ] ,'Time=%2.2f ms' ,elapsed_time );
351
 
   message_(@buf[0 ] );
352
 
 
353
 
   sl.Destruct;
354
 
   ras.Destruct;
355
 
 
356
 
  end;
357
 
 
358
 
 if flags and mouse_left <> 0 then
359
 
  begin
360
 
   i:=0;
361
 
 
362
 
   while i < 3 do
363
 
    begin
364
 
     if Sqrt((x-m_x[i ] ) * (x-m_x[i ] ) + (y-m_y[i ] ) * (y-m_y[i ] ) ) < 10.0 then
365
 
      begin
366
 
       m_dx :=x - m_x[i ];
367
 
       m_dy :=y - m_y[i ];
368
 
       m_idx:=i;
369
 
 
370
 
       break;
371
 
 
372
 
      end;
373
 
 
374
 
     inc(i );
375
 
 
376
 
    end;
377
 
 
378
 
   if i = 3 then
379
 
    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
380
 
     begin
381
 
      m_dx :=x - m_x[0 ];
382
 
      m_dy :=y - m_y[0 ];
383
 
      m_idx:=3;
384
 
 
385
 
     end;
386
 
 
387
 
  end;
388
 
 
389
 
end;
390
 
 
391
 
{ ON_MOUSE_BUTTON_UP }
392
 
procedure the_application.on_mouse_button_up;
393
 
begin
394
 
 m_idx:=-1;
395
 
 
396
 
end;
397
 
 
398
 
{ ON_KEY }
399
 
procedure the_application.on_key;
400
 
var
401
 
 dx ,dy : double;
402
 
 
403
 
begin
404
 
 dx:=0;
405
 
 dy:=0;
406
 
 
407
 
 case key of
408
 
  key_left  : dx:=0.1;
409
 
  key_right : dx:=0.1;
410
 
  key_up    : dy:=0.1;
411
 
  key_down  : dy:=-0.1;
412
 
 
413
 
 end;
414
 
 
415
 
 m_x[0 ]:=m_x[0 ] + dx;
416
 
 m_y[0 ]:=m_y[0 ] + dy;
417
 
 m_x[1 ]:=m_x[1 ] + dx;
418
 
 m_y[1 ]:=m_y[1 ] + dy;
419
 
 
420
 
 force_redraw;
421
 
 
422
 
 if key = key_f1 then
423
 
  message_(
424
 
   'Gouraud shading. It''s a simple method of interpolating colors in a triangle. '#13 +
425
 
   'There''s no "cube" drawn, there''re just 6 triangles. You define a triangle '#13 +
426
 
   'and colors in its vertices. When rendering, the colors will be linearly interpolated. '#13 +
427
 
   'But there''s a problem that appears when drawing adjacent triangles with Anti-Aliasing.'#13 +
428
 
   'Anti-Aliased polygons do not "dock" to each other correctly, there visual artifacts '#13 +
429
 
   'at the edges appear. I call it "the problem of adjacent edges". AGG has a simple '#13 +
430
 
   'mechanism that allows you to get rid of the artifacts, just dilating the polygons '#13 +
431
 
   'and/or changing the gamma-correction value. But it''s tricky, because the values '#13 +
432
 
   'depend on the opacity of the polygons. In this example you can change the opacity, '#13 +
433
 
   'the dilation value and gamma.'#13#13 +
434
 
   'How to play with:'#13#13 +
435
 
   'Use the left mouse button to drag the Red, Green and Blue corners of the "cube".'#13 +
436
 
   'Use the right mouse button to issue a performance test (100x).' +
437
 
   #13#13'Note: F2 key saves current "screenshot" file in this demo''s directory.  ' );
438
 
 
439
 
end;
440
 
 
441
 
VAR
442
 
 app : the_application;
443
 
 
444
 
BEGIN
445
 
 app.Construct(pix_format ,flip_y );
446
 
 app.caption_ ('AGG Example. Gouraud Shading (F1-Help)' );
447
 
 
448
 
 if app.init(400 ,320 ,window_resize ) then
449
 
  app.run;
450
 
 
451
 
 app.Destruct;
452
 
 
453
 
END.
 
 
b'\\ No newline at end of file'