← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/inc/graph/fills.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/inc/graph/fills.inc
1
 
{
2
 
    $Id: fills.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
3
 
 
4
 
    This file is part of the Free Pascal run time library.
5
 
    Copyright (c) 1999-2000 by Thomas Schatzl and Carl Eric Codere
6
 
 
7
 
    This include implements polygon filling and flood filling.
8
 
 
9
 
    See the file COPYING.FPC, included in this distribution,
10
 
    for details about the copyright.
11
 
 
12
 
    This program is distributed in the hope that it will be useful,
13
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
 
 
16
 
 **********************************************************************}
17
 
 
18
 
{ simple descriptive name }
19
 
function max(a, b : Longint) : Longint;
20
 
begin
21
 
  max := b;
22
 
  if (a > b) then max := a;
23
 
end;
24
 
 
25
 
{ here too }
26
 
function min(a, b : Longint) : Longint;
27
 
begin
28
 
  min := b;
29
 
  if (a < b) then min := a;
30
 
end;
31
 
 
32
 
procedure fillpoly(numpoints : Word; var polypoints);
33
 
 
34
 
{ disable range check mode }
35
 
{$ifopt R+}
36
 
{$define OPT_R_WAS_ON}
37
 
{$R-}
38
 
{$endif}
39
 
type
40
 
  pedge = ^tedge;
41
 
  tedge = packed record
42
 
    yMin, yMax, x, dX, dY, frac : Longint;
43
 
  end;
44
 
 
45
 
  pedgearray = ^tedgearray;
46
 
  tedgearray = array[0..0] of tedge;
47
 
 
48
 
  ppedgearray = ^tpedgearray;
49
 
  tpedgearray = array[0..0] of pedge;
50
 
 
51
 
var
52
 
  nActive, nNextEdge : Longint;
53
 
  p0, p1 : pointtype;
54
 
  i, j, gap, x0, x1, y, nEdges : Longint;
55
 
  ET : pedgearray;
56
 
  GET, AET : ppedgearray;
57
 
  t : pedge;
58
 
 
59
 
  ptable : ^pointtype;
60
 
 
61
 
 
62
 
begin
63
 
{ /********************************************************************
64
 
  * Add entries to the global edge table.  The global edge table has a
65
 
  * bucket for each scan line in the polygon. Each bucket contains all
66
 
  * the edges whose yMin == yScanline.  Each bucket contains the yMax,
67
 
  * the x coordinate at yMax, and the denominator of the slope (dX)
68
 
*/}
69
 
  getmem(et, sizeof(tedge) * numpoints);
70
 
  getmem(get, sizeof(pedge) * numpoints);
71
 
  getmem(aet, sizeof(pedge) * numpoints);
72
 
 
73
 
  ptable := @polypoints;
74
 
 
75
 
 { check for getmem success }
76
 
 
77
 
  nEdges := 0;
78
 
  for i := 0 to (numpoints-1) do begin
79
 
    p0 := ptable[i];
80
 
    if (i+1) >= numpoints then p1 := ptable[0]
81
 
    else p1 := ptable[i+1];
82
 
   { ignore if this is a horizontal edge}
83
 
    if (p0.y = p1.y) then continue;
84
 
    {swap ptable if necessary to ensure p0 contains yMin}
85
 
    if (p0.y > p1.y) then begin
86
 
      p0 := p1;
87
 
      p1 := ptable[i];
88
 
    end;
89
 
   { create the new edge }
90
 
    et^[nEdges].ymin := p0.y;
91
 
    et^[nEdges].ymax := p1.y;
92
 
    et^[nEdges].x := p0.x;
93
 
    et^[nEdges].dX := p1.x-p0.x;
94
 
    et^[nEdges].dy := p1.y-p0.y;
95
 
    et^[nEdges].frac := 0;
96
 
    get^[nEdges] :=  @et^[nEdges];
97
 
    inc(nEdges);
98
 
  end;
99
 
 { sort the GET on ymin }
100
 
  gap := 1;
101
 
  while (gap < nEdges) do gap := 3*gap+1;
102
 
  gap := gap div 3;
103
 
  while (gap > 0) do begin
104
 
    for i := gap to (nEdges-1) do begin
105
 
      j := i - gap;
106
 
      while (j >= 0) do begin
107
 
        if (GET^[j]^.ymin <= GET^[j+gap]^.yMin) then break;
108
 
        t := GET^[j];
109
 
        GET^[j] := GET^[j+gap];
110
 
        GET^[j+gap] := t;
111
 
        dec(j, gap);
112
 
      end;
113
 
    end;
114
 
    gap := gap div 3;
115
 
  end;
116
 
  { initialize the active edge table, and set y to first entering edge}
117
 
  nActive := 0;
118
 
  nNextEdge := 0;
119
 
 
120
 
  y := GET^[nNextEdge]^.ymin;
121
 
  { Now process the edges using the scan line algorithm.  Active edges
122
 
  will be added to the Active Edge Table (AET), and inactive edges will
123
 
  be deleted.  X coordinates will be updated with incremental integer
124
 
  arithmetic using the slope (dY / dX) of the edges. }
125
 
  while (nNextEdge < nEdges) or (nActive <> 0) do begin
126
 
    {Move from the ET bucket y to the AET those edges whose yMin == y
127
 
    (entering edges) }
128
 
    while (nNextEdge < nEdges) and (GET^[nNextEdge]^.ymin = y) do begin
129
 
      AET^[nActive] := GET^[nNextEdge];
130
 
      inc(nActive);
131
 
      inc(nNextEdge);
132
 
    end;
133
 
    { Remove from the AET those entries for which yMax == y (leaving
134
 
    edges) }
135
 
    i := 0;
136
 
    while (i < nActive) do begin
137
 
      if (AET^[i]^.yMax = y) then begin
138
 
        dec(nActive);
139
 
        move(AET^[i+1], AET^[i], (nActive-i)*sizeof(pedge));
140
 
      end else
141
 
        inc(i);
142
 
    end;
143
 
 
144
 
    if (y >= 0) then begin
145
 
    {Now sort the AET on x.  Since the list is usually quite small,
146
 
    the sort is implemented as a simple non-recursive shell sort }
147
 
 
148
 
    gap := 1;
149
 
    while (gap < nActive) do gap := 3*gap+1;
150
 
 
151
 
    gap := gap div 3;
152
 
    while (gap > 0) do begin
153
 
      for i := gap to (nActive-1) do begin
154
 
        j := i - gap;
155
 
        while (j >= 0) do begin
156
 
          if (AET^[j]^.x <= AET^[j+gap]^.x) then break;
157
 
          t := AET^[j];
158
 
          AET^[j] := AET^[j+gap];
159
 
          AET^[j+gap] := t;
160
 
          dec(j, gap);
161
 
        end;
162
 
      end;
163
 
      gap := gap div 3;
164
 
    end;
165
 
 
166
 
    { Fill in desired pixels values on scan line y by using pairs of x
167
 
    coordinates from the AET }
168
 
    i := 0;
169
 
    while (i < nActive) do begin
170
 
      x0 := AET^[i]^.x;
171
 
      x1 := AET^[i+1]^.x;
172
 
      {Left edge adjustment for positive fraction.  0 is interior. }
173
 
      if (AET^[i]^.frac > 0) then inc(x0);
174
 
      {Right edge adjustment for negative fraction.  0 is exterior. }
175
 
      if (AET^[i+1]^.frac <= 0) then dec(x1);
176
 
 
177
 
      x0 := max(x0, 0);
178
 
      x1 := min(x1, viewWidth);
179
 
      { Draw interior spans}
180
 
      if (x1 >= x0) then begin
181
 
        PatternLine(x0, x1, y);
182
 
      end;
183
 
 
184
 
      inc(i, 2);
185
 
    end;
186
 
 
187
 
    end;
188
 
 
189
 
    { Update all the x coordinates.  Edges are scan converted using a
190
 
    modified midpoint algorithm (Bresenham's algorithm reduces to the
191
 
    midpoint algorithm for two dimensional lines) }
192
 
    for i := 0 to (nActive-1) do begin
193
 
      t := AET^[i];
194
 
      { update the fraction by dX}
195
 
      inc(t^.frac, t^.dX);
196
 
 
197
 
      if (t^.dX < 0) then
198
 
        while ( -(t^.frac) >= t^.dY) do begin
199
 
          inc(t^.frac, t^.dY);
200
 
          dec(t^.x);
201
 
        end
202
 
      else
203
 
        while (t^.frac >= t^.dY) do begin
204
 
          dec(t^.frac, t^.dY);
205
 
          inc(t^.x);
206
 
        end;
207
 
    end;
208
 
    inc(y);
209
 
    if (y >= ViewHeight) then break;
210
 
  end;
211
 
  freemem(et, sizeof(tedge) * numpoints);
212
 
  freemem(get, sizeof(pedge) * numpoints);
213
 
  freemem(aet, sizeof(pedge) * numpoints);
214
 
end;
215
 
 
216
 
 
217
 
{ maximum supported Y resultion }
218
 
const
219
 
  MaxYRes = 2048;
220
 
  { changing this to 1 or 2 doesn't improve performance noticably }
221
 
  YResDiv = 4;
222
 
 
223
 
type
224
 
  PFloodLine = ^TFloodLine;
225
 
  TFloodLine = record
226
 
    next: PFloodLine;
227
 
    x1 : smallint;
228
 
    x2 : smallint;
229
 
    y  : smallint;
230
 
  end;
231
 
 
232
 
  TDrawnList  = Array[0..(MaxYRes - 1) div YResDiv] of PFloodLine;
233
 
 
234
 
var
235
 
   DrawnList : TDrawnList;
236
 
   Buffer : Record                         { Union for byte and word addressing of buffer }
237
 
     ByteIndex : Word;
238
 
     WordIndex : Word;
239
 
     Case Boolean Of
240
 
        False : (Bytes : Array [0..StdBufferSize-1] Of Byte);
241
 
        True  : (Words : Array [0..(StdBufferSize DIV 2)-1] Of Word);
242
 
     End;
243
 
 
244
 
  s1, s2, s3 : PWordArray;                { Three buffers for scanlines                 }
245
 
 
246
 
 
247
 
  Procedure PushPoint (x, y : smallint);
248
 
  {********************************************************}
249
 
  { Adds a  point to the list of points to check if we     }
250
 
  { need to draw. Doesn't add the point if there is a      }
251
 
  { buffer overflow.                                       }
252
 
  {********************************************************}
253
 
  Begin
254
 
    If Buffer.WordIndex<(StdBufferSize DIV 2)-3 then
255
 
     Begin
256
 
       Buffer.Words[Buffer.WordIndex]:=x;
257
 
       Buffer.Words[Buffer.WordIndex+1]:=y;
258
 
       Inc (Buffer.WordIndex,2);
259
 
     End
260
 
  End;
261
 
 
262
 
  Procedure PopPoint (Var x, y : smallint);
263
 
  {********************************************************}
264
 
  { Removes a point from the list of points to check, if   }
265
 
  { we try to access an illegal point, then the routine    }
266
 
  { returns -1,-1 as a coordinate pair.                    }
267
 
  {********************************************************}
268
 
  Begin
269
 
   If Buffer.WordIndex>1 then
270
 
    Begin
271
 
      x:=Buffer.Words[Buffer.WordIndex-2];
272
 
      y:=Buffer.Words[Buffer.WordIndex-1];
273
 
      Dec (Buffer.WordIndex,2);
274
 
    End
275
 
   Else
276
 
    Begin
277
 
      x:=-1;
278
 
      y:=-1;
279
 
    End;
280
 
  End;
281
 
 
282
 
 
283
 
 
284
 
 
285
 
 
286
 
 
287
 
  {********************************************************}
288
 
  { Procedure AddLinePoints()                              }
289
 
  {--------------------------------------------------------}
290
 
  { Adds a line segment to the list of lines which will be }
291
 
  { drawn to the screen. The line added is on the specified}
292
 
  { Y axis, from the x1 to x2 coordinates.                 }
293
 
  {********************************************************}
294
 
  Procedure AddLinePoints(x1,x2,y: smallint);
295
 
   var temp: PFloodLine;
296
 
   begin
297
 
     new(temp);
298
 
     temp^.x1 := x1;
299
 
     temp^.x2 := x2;
300
 
     temp^.y := y;
301
 
     temp^.next := DrawnList[y div YResDiv];
302
 
     DrawnList[y div YResDiv] := temp;
303
 
   end;
304
 
 
305
 
  {********************************************************}
306
 
  { Procedure AlreadyDrawn()                               }
307
 
  {--------------------------------------------------------}
308
 
  { This routine searches through the list of segments     }
309
 
  { which will be drawn to the screen, and determines  if  }
310
 
  { the specified point (x,y) will already be drawn.       }
311
 
  { i.e : Checks if the x,y point lies within a known      }
312
 
  { segment which will be drawn to the screen. This makes  }
313
 
  { sure that we don't draw some segments two times.       }
314
 
  { Return TRUE if the point is already in the segment list}
315
 
  { to draw, otherwise returns FALSE.                      }
316
 
  {********************************************************}
317
 
  Function AlreadyDrawn(x, y: smallint): boolean;
318
 
  var
319
 
    temp : PFloodLine;
320
 
   begin
321
 
    AlreadyDrawn := false;
322
 
    temp := DrawnList[y div YResDiv];
323
 
    while assigned(temp) do
324
 
      begin
325
 
        if (temp^.y = y) and
326
 
           (temp^.x1 <= x) and
327
 
           (temp^.x2 >= x) then
328
 
          begin
329
 
            AlreadyDrawn := true;
330
 
            exit;
331
 
          end;
332
 
        temp := temp^.next;
333
 
      end;
334
 
   end;
335
 
 
336
 
  {********************************************************}
337
 
  { Procedure CleanUpDrawnList                             }
338
 
  {--------------------------------------------------------}
339
 
  { removes all elements from the DrawnList. Doesn't init  }
340
 
  { elements of it with NILL                               }
341
 
  {********************************************************}
342
 
  Procedure CleanUpDrawnList;
343
 
  var
344
 
    l: longint;
345
 
    temp1, temp2: PFloodLine;
346
 
  begin
347
 
    for l := 0 to high(DrawnList) do
348
 
      begin
349
 
        temp1 := DrawnList[l];
350
 
        while assigned(temp1) do
351
 
          begin
352
 
            temp2 := temp1;
353
 
            temp1 := temp1^.next;
354
 
            dispose(temp2);
355
 
          end;
356
 
      end;
357
 
  end;
358
 
 
359
 
 
360
 
  Procedure FloodFill (x, y : smallint; Border: word);
361
 
  {********************************************************}
362
 
  { Procedure FloodFill()                                  }
363
 
  {--------------------------------------------------------}
364
 
  { This routine fills a region of the screen bounded by   }
365
 
  { the <Border> color. It uses the current fillsettings   }
366
 
  { for the flood filling. Clipping is supported, and      }
367
 
  { coordinates are local/viewport relative.               }
368
 
  {********************************************************}
369
 
  Var
370
 
   stemp: PWordArray;
371
 
   Beginx : smallint;
372
 
   d, e : Byte;
373
 
   Cont : Boolean;
374
 
   BackupColor : Word;
375
 
   x1, x2, prevy: smallint;
376
 
  Begin
377
 
    FillChar(DrawnList,sizeof(DrawnList),0);
378
 
    { init prevy }
379
 
    prevy := 32767;
380
 
    { Save current drawing color }
381
 
    BackupColor := CurrentColor;
382
 
    CurrentColor := FillSettings.Color;
383
 
    { MaxX is based on zero index }
384
 
    GetMem (s1,(ViewWidth+1)*2);  { A pixel color represents a word }
385
 
    GetMem (s2,(ViewWidth+1)*2);  { A pixel color represents a word }
386
 
    GetMem (s3,(ViewWidth+1)*2);  { A pixel color represents a word }
387
 
    if (not assigned(s1)) or (not assigned(s2)) or (not assigned(s3)) then
388
 
      begin
389
 
        _GraphResult := grNoFloodMem;
390
 
        exit;
391
 
      end;
392
 
    If (x<0) Or (y<0) Or
393
 
       (x>ViewWidth) Or (y>ViewHeight) then Exit;
394
 
    { Index of points to check  }
395
 
    Buffer.WordIndex:=0;
396
 
    PushPoint (x,y);
397
 
    While Buffer.WordIndex>0 Do
398
 
     Begin
399
 
       PopPoint (x,y);
400
 
       { Get the complete lines for the following }
401
 
       If y <> prevy then
402
 
         begin
403
 
           If (prevy - y = 1) then
404
 
             { previous line was one below the new one, so the previous s2 }
405
 
             { = new s1                                                    }
406
 
             Begin
407
 
               stemp := s3;
408
 
               s3 := s1;
409
 
               s1 := s2;
410
 
               s2 := stemp;
411
 
               GetScanline(0,ViewWidth,y-1,s2^);
412
 
             End
413
 
           Else If (y - prevy = 1) then
414
 
             { previous line was one above the new one, so the previous s3 }
415
 
             { = new s1                                                    }
416
 
             Begin
417
 
               stemp := s2;
418
 
               s2 := s1;
419
 
               s1 := s3;
420
 
               s3 := stemp;
421
 
               GetScanline(0,ViewWidth,y+1,s3^);
422
 
             End
423
 
           Else
424
 
             begin
425
 
               GetScanline(0,ViewWidth,y-1,s2^);
426
 
               GetScanline(0,ViewWidth,y,s1^);
427
 
               GetScanline(0,ViewWidth,y+1,s3^);
428
 
             end;
429
 
         end;
430
 
       prevy := y;
431
 
       { check the current scan line }
432
 
       While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
433
 
       d:=0;
434
 
       e:=0;
435
 
       dec(x);
436
 
       Beginx:=x;
437
 
       REPEAT
438
 
         { check the above line }
439
 
         If y<ViewHeight then
440
 
           Begin
441
 
              Cont:=(s3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
442
 
              If (e=0) And Cont then
443
 
                Begin
444
 
                  PushPoint (x,y+1);
445
 
                  e:=1;
446
 
                End
447
 
              Else
448
 
                If (e=1) And Not Cont then e:=0;
449
 
           End;
450
 
        { check the line below }
451
 
        If (y>0) then
452
 
          Begin
453
 
            Cont:=(s2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
454
 
            If (d=0) And Cont then
455
 
              Begin
456
 
                PushPoint (x,y-1);
457
 
                d:=1;
458
 
              End
459
 
            Else
460
 
              If (d=1) And Not Cont then d:=0;
461
 
          End;
462
 
        Dec (x);
463
 
       Until (x<0) Or (s1^[x]=Border);
464
 
       { swap the values }
465
 
       x1:=x+1;
466
 
       x2:=BeginX;
467
 
       if x1 > x2 then
468
 
         Begin
469
 
           x:=x1;
470
 
           x1:=x2;
471
 
           x2:=x;
472
 
         end;
473
 
       { Add to the list of drawn lines }
474
 
       AddLinePoints(x1,x2,y);
475
 
       PatternLine (x1,x2,y);
476
 
     End; { end while }
477
 
 
478
 
    FreeMem (s1,(ViewWidth+1)*2);
479
 
    FreeMem (s2,(ViewWidth+1)*2);
480
 
    FreeMem (s3,(ViewWidth+1)*2);
481
 
    CleanUpDrawnList;
482
 
    CurrentColor := BackUpColor;
483
 
  End;
484
 
 
485
 
{ restore previous range check mode }
486
 
{$ifdef OPT_R_WAS_ON}
487
 
{$R+}
488
 
{$endif}
489
 
{
490
 
  $Log: fills.inc,v $
491
 
  Revision 1.4  2005/02/14 17:13:30  peter
492
 
    * truncate log
493
 
 
494
 
}