hedgewars/uLandOutline.pas
author unc0rr
Sun, 02 Dec 2012 01:25:11 +0400
changeset 8178 8bd087478b48
parent 8145 6408c0ba4ba1
child 8330 aaefa587e277
permissions -rw-r--r--
Fix QSettings problems: - Reopen file in ReadOnly mode if it was open in ReadWrite mode and is being read. This is needed for stupid QSettings which opens file in ReadWrite mode just to call readAll() on it. - Implement setSize(0)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     1
unit uLandOutline;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     2
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     3
interface
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     4
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     5
uses uConsts, SDLh, uFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     6
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     7
type TPixAr = record
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     8
              Count: Longword;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
     9
              ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    10
              end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    11
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    12
procedure DrawEdge(var pa: TPixAr; Color: Longword);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    13
procedure FillLand(x, y: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    14
procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    15
procedure RandomizePoints(var pa: TPixAr);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    16
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    17
implementation
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    18
6491
736479f3d348 Some cleanup here and there
unc0rr
parents: 6490
diff changeset
    19
uses uLandGraphics, uDebug, uVariables, uLandTemplates, uRandom, uUtils;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    20
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    21
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    22
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    23
var Stack: record
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    24
           Count: Longword;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    25
           points: array[0..8192] of record
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    26
                                     xl, xr, y, dir: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    27
                                     end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    28
           end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    29
8145
6408c0ba4ba1 Move global variables to units that use them
Joe Doyle (Ginto8) <ginto8@gmail.com>
parents: 6990
diff changeset
    30
const
6408c0ba4ba1 Move global variables to units that use them
Joe Doyle (Ginto8) <ginto8@gmail.com>
parents: 6990
diff changeset
    31
    cMaxEdgePoints = 16384;
6408c0ba4ba1 Move global variables to units that use them
Joe Doyle (Ginto8) <ginto8@gmail.com>
parents: 6990
diff changeset
    32
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    33
procedure Push(_xl, _xr, _y, _dir: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    34
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    35
    TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    36
    _y:= _y + _dir;
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    37
    if (_y < 0) or (_y >= LAND_HEIGHT) then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    38
        exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    39
    with Stack.points[Stack.Count] do
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    40
        begin
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    41
        xl:= _xl;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    42
        xr:= _xr;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    43
        y:= _y;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    44
        dir:= _dir
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    45
        end;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    46
    inc(Stack.Count)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    47
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    48
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    49
procedure Pop(var _xl, _xr, _y, _dir: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    50
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    51
    dec(Stack.Count);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    52
    with Stack.points[Stack.Count] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    53
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    54
        _xl:= xl;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    55
        _xr:= xr;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    56
        _y:= y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    57
        _dir:= dir
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    58
        end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    59
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    60
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    61
procedure FillLand(x, y: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    62
var xl, xr, dir: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    63
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    64
    Stack.Count:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    65
    xl:= x - 1;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    66
    xr:= x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    67
    Push(xl, xr, y, -1);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    68
    Push(xl, xr, y,  1);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    69
    dir:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    70
    while Stack.Count > 0 do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    71
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    72
        Pop(xl, xr, y, dir);
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    73
        while (xl > 0) and (Land[y, xl] <> 0) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    74
            dec(xl);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    75
        while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    76
            inc(xr);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    77
        while (xl < xr) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    78
            begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    79
            while (xl <= xr) and (Land[y, xl] = 0) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    80
                inc(xl);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    81
            x:= xl;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    82
            while (xl <= xr) and (Land[y, xl] <> 0) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    83
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    84
                Land[y, xl]:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    85
                inc(xl)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    86
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    87
            if x < xl then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    88
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    89
                Push(x, Pred(xl), y, dir);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    90
                Push(x, Pred(xl), y,-dir);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    91
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    92
            end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    93
        end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    94
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    95
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    96
procedure DrawEdge(var pa: TPixAr; Color: Longword);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    97
var i: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    98
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    99
    i:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   100
    with pa do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   101
        while i < LongInt(Count) - 1 do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   102
            if (ar[i + 1].X = NTPX) then 
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   103
                inc(i, 2)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   104
            else 
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   105
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   106
                DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   107
                inc(i)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   108
                end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   109
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   110
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   111
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   112
procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   113
var d1, d2, d: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   114
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   115
    Vx:= int2hwFloat(p1.X - p3.X);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   116
    Vy:= int2hwFloat(p1.Y - p3.Y);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   117
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   118
    d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   119
    d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   120
    d2:= Distance(Vx, Vy);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   121
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   122
    if d1 < d then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   123
        d:= d1;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   124
    if d2 < d then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   125
        d:= d2;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   126
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   127
    d:= d * _1div3;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   128
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   129
    if d2.QWordValue = 0 then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   130
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   131
        Vx:= _0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   132
        Vy:= _0
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   133
        end 
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   134
    else
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   135
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   136
        d2:= _1 / d2;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   137
        Vx:= Vx * d2;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   138
        Vy:= Vy * d2;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   139
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   140
        Vx:= Vx * d;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   141
        Vy:= Vy * d
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   142
        end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   143
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   144
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   145
procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   146
var i, pi, ni: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   147
    NVx, NVy, PVx, PVy: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   148
    x1, x2, y1, y2: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   149
    tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   150
    X, Y: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   151
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   152
pi:= EndI;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   153
i:= StartI;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   154
ni:= Succ(StartI);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   155
{$HINTS OFF}
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   156
Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   157
{$HINTS ON}
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   158
repeat
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   159
    inc(pi);
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   160
    if pi > EndI then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   161
        pi:= StartI;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   162
    inc(i);
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   163
    if i > EndI then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   164
        i:= StartI;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   165
    inc(ni);
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   166
    if ni > EndI then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   167
        ni:= StartI;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   168
    PVx:= NVx;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   169
    PVy:= NVy;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   170
    Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   171
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   172
    x1:= opa.ar[pi].x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   173
    y1:= opa.ar[pi].y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   174
    x2:= opa.ar[i].x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   175
    y2:= opa.ar[i].y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   176
    cx1:= int2hwFloat(x1) - PVx;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   177
    cy1:= int2hwFloat(y1) - PVy;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   178
    cx2:= int2hwFloat(x2) + NVx;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   179
    cy2:= int2hwFloat(y2) + NVy;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   180
    t:= _0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   181
    while t.Round = 0 do
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   182
        begin
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   183
        tsq:= t * t;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   184
        tcb:= tsq * t;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   185
        r1:= (_1 - t*3 + tsq*3 - tcb);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   186
        r2:= (     t*3 - tsq*6 + tcb*3);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   187
        r3:= (           tsq*3 - tcb*3);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   188
        X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   189
        Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   190
        t:= t + Delta;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   191
        pa.ar[pa.Count].x:= X;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   192
        pa.ar[pa.Count].y:= Y;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   193
        inc(pa.Count);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   194
        TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   195
        end;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   196
until i = StartI;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   197
pa.ar[pa.Count].x:= opa.ar[StartI].X;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   198
pa.ar[pa.Count].y:= opa.ar[StartI].Y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   199
inc(pa.Count)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   200
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   201
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   202
procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   203
var i, StartLoop: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   204
    opa: TPixAr;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   205
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   206
opa:= pa;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   207
pa.Count:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   208
i:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   209
StartLoop:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   210
while i < LongInt(opa.Count) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   211
    if (opa.ar[i + 1].X = NTPX) then
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   212
        begin
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   213
        AddLoopPoints(pa, opa, StartLoop, i, Delta);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   214
        inc(i, 2);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   215
        StartLoop:= i;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   216
        pa.ar[pa.Count].X:= NTPX;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   217
        pa.ar[pa.Count].Y:= 0;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   218
        inc(pa.Count);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   219
        end else inc(i)
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   220
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   221
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   222
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   223
function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   224
var c1, c2, dm: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   225
begin
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   226
    CheckIntersect:= false;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   227
    dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   228
    c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x);
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   229
    if dm = 0 then
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   230
        exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   231
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   232
    CheckIntersect:= true;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   233
    c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   234
    if dm > 0 then
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   235
    begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   236
        if (c1 < 0) or (c1 > dm) then
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   237
            CheckIntersect:= false
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   238
        else if (c2 < 0) or (c2 > dm) then
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   239
            CheckIntersect:= false;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   240
    end 
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   241
    else
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   242
    begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   243
        if (c1 > 0) or (c1 < dm) then
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   244
            CheckIntersect:= false
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   245
        else if (c2 > 0) or (c2 < dm) then
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   246
            CheckIntersect:= false;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   247
    end;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   248
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   249
    //AddFileLog('1  (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')');
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   250
    //AddFileLog('2  (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')');
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   251
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   252
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   253
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   254
function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   255
var i: Longword;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   256
begin
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   257
    CheckSelfIntersect:= false;
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   258
    if (ind <= 0) or (ind >= Pred(pa.Count)) then
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   259
        exit;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   260
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   261
    CheckSelfIntersect:= true;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   262
    for i:= 1 to pa.Count - 3 do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   263
        if (i <= ind - 1) or (i >= ind + 2) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   264
        begin
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   265
            if (i <> ind - 1) and CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   266
                exit;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   267
            if (i <> ind + 2) and CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6580
diff changeset
   268
                exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   269
        end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   270
    CheckSelfIntersect:= false
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   271
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   272
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   273
procedure RandomizePoints(var pa: TPixAr);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   274
const cEdge = 55;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   275
      cMinDist = 8;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   276
var radz: array[0..Pred(cMaxEdgePoints)] of LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   277
    i, k, dist, px, py: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   278
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   279
    for i:= 0 to Pred(pa.Count) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   280
    begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   281
    radz[i]:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   282
        with pa.ar[i] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   283
            if x <> NTPX then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   284
            begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   285
            radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   286
            radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0)));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   287
            if radz[i] > 0 then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   288
                for k:= 0 to Pred(i) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   289
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   290
                dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   291
                radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k]));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   292
                radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i]))
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   293
                end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   294
            end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   295
    end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   296
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   297
    for i:= 0 to Pred(pa.Count) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   298
        with pa.ar[i] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   299
            if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   300
            begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   301
            px:= x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   302
            py:= y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   303
            x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   304
            y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   305
            if CheckSelfIntersect(pa, i) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   306
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   307
                x:= px;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   308
                y:= py
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   309
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   310
            end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   311
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   312
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   313
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   314
end.