hedgewars/uLandOutline.pas
author nemo
Mon, 08 Dec 2014 10:14:47 -0500
changeset 10635 8e8b320eefad
parent 10560 9f09196d92a6
child 11532 bf86c6cb9341
permissions -rw-r--r--
nil out CurrentHedgehog in FreeModule, add a test for nil'd CurrentHedgehog in DelCI since I'd still like to use DeleteGear for the other stuff it does. Move some variable initialiasations in AI Misc to hopefully avoid some uninit val errors.
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
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    12
procedure DrawEdge(var pa: TPixAr; value: Word);
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    13
procedure FillLand(x, y: LongInt; border, value: Word);
6490
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
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    31
procedure Push(_xl, _xr, _y, _dir: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    32
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    33
    TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    34
    _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
    35
    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
    36
        exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    37
    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
    38
        begin
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    39
        xl:= _xl;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    40
        xr:= _xr;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    41
        y:= _y;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    42
        dir:= _dir
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    43
        end;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    44
    inc(Stack.Count)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    45
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    46
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    47
procedure Pop(var _xl, _xr, _y, _dir: LongInt);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    48
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    49
    dec(Stack.Count);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    50
    with Stack.points[Stack.Count] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    51
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    52
        _xl:= xl;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    53
        _xr:= xr;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    54
        _y:= y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    55
        _dir:= dir
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    56
        end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    57
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    58
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    59
procedure FillLand(x, y: LongInt; border, value: Word);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    60
var xl, xr, dir: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    61
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    62
    Stack.Count:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    63
    xl:= x - 1;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    64
    xr:= x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    65
    Push(xl, xr, y, -1);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    66
    Push(xl, xr, y,  1);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    67
    dir:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    68
    while Stack.Count > 0 do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    69
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    70
        Pop(xl, xr, y, dir);
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    71
        while (xl > 0) and (Land[y, xl] <> border) and (Land[y, xl] <> value) do
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    72
            dec(xl);
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    73
        while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> border) and (Land[y, xr] <> value) do
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    74
            inc(xr);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    75
        while (xl < xr) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    76
            begin
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    77
            while (xl <= xr) and ((Land[y, xl] = border) or (Land[y, xl] = value)) do
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
    78
                inc(xl);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    79
            x:= xl;
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    80
            while (xl <= xr) and (Land[y, xl] <> border) and (Land[y, xl] <> value) do
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    81
                begin
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    82
                Land[y, xl]:= value;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    83
                inc(xl)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    84
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    85
            if x < xl then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    86
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    87
                Push(x, Pred(xl), y, dir);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    88
                Push(x, Pred(xl), y,-dir);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    89
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    90
            end;
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
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
    94
procedure DrawEdge(var pa: TPixAr; value: Word);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    95
var i: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    96
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    97
    i:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    98
    with pa do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
    99
        while i < LongInt(Count) - 1 do
8330
aaefa587e277 update branch with default
koda
parents: 8145
diff changeset
   100
            if (ar[i + 1].X = NTPX) then
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   101
                inc(i, 2)
8330
aaefa587e277 update branch with default
koda
parents: 8145
diff changeset
   102
            else
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   103
                begin
10189
875607ce793d - Rework FillLand
unc0rr
parents: 8850
diff changeset
   104
                DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, value);
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   105
                inc(i)
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   106
                end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   107
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   108
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   109
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   110
procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   111
var d1, d2, d: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   112
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   113
    Vx:= int2hwFloat(p1.X - p3.X);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   114
    Vy:= int2hwFloat(p1.Y - p3.Y);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   115
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   116
    d2:= Distance(Vx, Vy);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   117
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   118
    if d2.QWordValue = 0 then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   119
        begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   120
        Vx:= _0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   121
        Vy:= _0
8330
aaefa587e277 update branch with default
koda
parents: 8145
diff changeset
   122
        end
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   123
    else
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   124
        begin
10197
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   125
        d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y);
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   126
        d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y);
10510
9329dab04490 some whitespace fixes
sheepluva
parents: 10485
diff changeset
   127
10197
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   128
        if d1 < d then
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   129
            d:= d1;
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   130
        if d2 < d then
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   131
            d:= d2;
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   132
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   133
        d2:= d * _1div3 / d2;
10510
9329dab04490 some whitespace fixes
sheepluva
parents: 10485
diff changeset
   134
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   135
        Vx:= Vx * d2;
10197
c57798251b55 Some optimizations
unc0rr
parents: 10189
diff changeset
   136
        Vy:= Vy * d2
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   137
        end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   138
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   139
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   140
procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   141
var i, pi, ni: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   142
    NVx, NVy, PVx, PVy: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   143
    x1, x2, y1, y2: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   144
    tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   145
    X, Y: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   146
begin
10485
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   147
    if pa.Count < cMaxEdgePoints - 2 then
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   148
        begin
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   149
        pi:= EndI;
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   150
        i:= StartI;
10485
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   151
        ni:= Succ(StartI);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   152
        {$HINTS OFF}
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   153
        Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   154
        {$HINTS ON}
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   155
        repeat
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   156
            i:= ni;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   157
            inc(pi);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   158
            if pi > EndI then
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   159
                pi:= StartI;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   160
            inc(ni);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   161
            if ni > EndI then
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   162
                ni:= StartI;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   163
            PVx:= NVx;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   164
            PVy:= NVy;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   165
            Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   166
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   167
            x1:= opa.ar[pi].x;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   168
            y1:= opa.ar[pi].y;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   169
            x2:= opa.ar[i].x;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   170
            y2:= opa.ar[i].y;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   171
10485
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   172
            cx1:= int2hwFloat(x1) - PVx;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   173
            cy1:= int2hwFloat(y1) - PVy;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   174
            cx2:= int2hwFloat(x2) + NVx;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   175
            cy2:= int2hwFloat(y2) + NVy;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   176
            t:= _0;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   177
            while (t.Round = 0) and (pa.Count < cMaxEdgePoints-2) do
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   178
                begin
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   179
                tsq:= t * t;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   180
                tcb:= tsq * t;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   181
                r1:= (_1 - t*3 + tsq*3 - tcb);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   182
                r2:= (     t*3 - tsq*6 + tcb*3);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   183
                r3:= (           tsq*3 - tcb*3);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   184
                X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   185
                Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   186
                t:= t + Delta;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   187
                pa.ar[pa.Count].x:= X;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   188
                pa.ar[pa.Count].y:= Y;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   189
                inc(pa.Count);
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   190
                //TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   191
                end;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   192
        until i = StartI;
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   193
        end;
10485
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   194
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   195
    pa.ar[pa.Count].x:= opa.ar[StartI].X;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   196
    pa.ar[pa.Count].y:= opa.ar[StartI].Y;
05b771423b95 You can't just exit function which is supposed to do copy
unc0rr
parents: 10483
diff changeset
   197
    inc(pa.Count)
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   198
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   199
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   200
procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   201
var i, StartLoop: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   202
    opa: TPixAr;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   203
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   204
opa:= pa;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   205
pa.Count:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   206
i:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   207
StartLoop:= 0;
10483
1f58cb4aa773 Since unc0rr is quiet, try to avoid the assert
nemo
parents: 10197
diff changeset
   208
while (i < LongInt(opa.Count)) and (pa.Count < cMaxEdgePoints-1) do
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   209
    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
   210
        begin
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   211
        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
   212
        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
   213
        StartLoop:= i;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   214
        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
   215
        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
   216
        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
   217
        end else inc(i)
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   218
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   219
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   220
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   221
function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   222
var c1, c2, dm: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   223
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
   224
    CheckIntersect:= false;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   225
    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
   226
    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
   227
    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
   228
        exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   229
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
    CheckIntersect:= true;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   231
    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
   232
    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
   233
    begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   234
        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
   235
            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
   236
        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
   237
            CheckIntersect:= false;
8330
aaefa587e277 update branch with default
koda
parents: 8145
diff changeset
   238
    end
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   239
    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
   240
    begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   241
        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
   242
            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
   243
        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
   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
    end;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   246
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   247
    //AddFileLog('1  (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')');
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   248
    //AddFileLog('2  (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')');
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   249
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   250
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   251
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   252
function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   253
var i: Longword;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   254
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
   255
    CheckSelfIntersect:= false;
10560
9f09196d92a6 fix some pas2c related issues
sheepluva
parents: 10510
diff changeset
   256
    if (ind <= 0) or (LongInt(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
   257
        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
   258
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
    CheckSelfIntersect:= true;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   260
    for i:= 1 to pa.Count - 3 do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   261
        if (i <= ind - 1) or (i >= ind + 2) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   262
        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
   263
            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
   264
                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
   265
            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
   266
                exit;
6490
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   267
        end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   268
    CheckSelfIntersect:= false
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   269
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   270
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   271
procedure RandomizePoints(var pa: TPixAr);
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   272
const cEdge = 55;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   273
      cMinDist = 8;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   274
var radz: array[0..Pred(cMaxEdgePoints)] of LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   275
    i, k, dist, px, py: LongInt;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   276
begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   277
    for i:= 0 to Pred(pa.Count) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   278
    begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   279
    radz[i]:= 0;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   280
        with pa.ar[i] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   281
            if x <> NTPX then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   282
            begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   283
            radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   284
            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
   285
            if radz[i] > 0 then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   286
                for k:= 0 to Pred(i) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   287
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   288
                dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   289
                radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k]));
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   290
                radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i]))
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   291
                end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   292
            end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   293
    end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   294
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   295
    for i:= 0 to Pred(pa.Count) do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   296
        with pa.ar[i] do
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   297
            if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   298
            begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   299
            px:= x;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   300
            py:= y;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   301
            x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   302
            y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   303
            if CheckSelfIntersect(pa, i) then
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   304
                begin
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   305
                x:= px;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   306
                y:= py
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   307
                end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   308
            end
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   309
end;
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   310
531bf083e8db - Give uLand more modularity
unc0rr
parents:
diff changeset
   311
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6491
diff changeset
   312
end.