|
10198
|
1 |
unit uLandGenTemplateBased;
|
|
|
2 |
interface
|
|
|
3 |
|
|
|
4 |
uses uLandTemplates;
|
|
|
5 |
|
|
|
6 |
procedure GenTemplated(var Template: TEdgeTemplate);
|
|
|
7 |
|
|
|
8 |
implementation
|
|
10199
|
9 |
uses uVariables, uConsts, uFloat, uLandOutline, uLandUtils, uRandom, SDLh;
|
|
10198
|
10 |
|
|
|
11 |
|
|
|
12 |
procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr; fps: PPointArray);
|
|
|
13 |
var i: LongInt;
|
|
|
14 |
begin
|
|
|
15 |
with Template do
|
|
|
16 |
begin
|
|
|
17 |
pa.Count:= BasePointsCount;
|
|
|
18 |
for i:= 0 to pred(pa.Count) do
|
|
|
19 |
begin
|
|
|
20 |
pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
|
|
|
21 |
if pa.ar[i].x <> NTPX then
|
|
10199
|
22 |
pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);
|
|
10198
|
23 |
pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - LongInt(Template.TemplateHeight)
|
|
|
24 |
end;
|
|
|
25 |
|
|
|
26 |
if canMirror then
|
|
|
27 |
if getrandom(2) = 0 then
|
|
|
28 |
begin
|
|
|
29 |
for i:= 0 to pred(BasePointsCount) do
|
|
|
30 |
if pa.ar[i].x <> NTPX then
|
|
|
31 |
pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x;
|
|
|
32 |
for i:= 0 to pred(FillPointsCount) do
|
|
|
33 |
fps^[i].x:= LAND_WIDTH - 1 - fps^[i].x;
|
|
|
34 |
end;
|
|
|
35 |
|
|
|
36 |
(* Experiment in making this option more useful
|
|
|
37 |
if ((not isNegative) and (cTemplateFilter = 4)) or
|
|
|
38 |
(canFlip and (getrandom(2) = 0)) then
|
|
|
39 |
begin
|
|
|
40 |
for i:= 0 to pred(BasePointsCount) do
|
|
|
41 |
begin
|
|
|
42 |
pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
|
|
|
43 |
if pa.ar[i].y > LAND_HEIGHT - 1 then
|
|
|
44 |
pa.ar[i].y:= LAND_HEIGHT - 1;
|
|
|
45 |
end;
|
|
|
46 |
for i:= 0 to pred(FillPointsCount) do
|
|
|
47 |
begin
|
|
|
48 |
FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
|
|
|
49 |
if FillPoints^[i].y > LAND_HEIGHT - 1 then
|
|
|
50 |
FillPoints^[i].y:= LAND_HEIGHT - 1;
|
|
|
51 |
end;
|
|
|
52 |
end;
|
|
|
53 |
end
|
|
|
54 |
*)
|
|
|
55 |
// template recycling. Pull these off the floor a bit
|
|
|
56 |
if (not isNegative) and (cTemplateFilter = 4) then
|
|
|
57 |
begin
|
|
|
58 |
for i:= 0 to pred(BasePointsCount) do
|
|
|
59 |
begin
|
|
|
60 |
dec(pa.ar[i].y, 100);
|
|
|
61 |
if pa.ar[i].y < 0 then
|
|
|
62 |
pa.ar[i].y:= 0;
|
|
|
63 |
end;
|
|
|
64 |
for i:= 0 to pred(FillPointsCount) do
|
|
|
65 |
begin
|
|
|
66 |
dec(fps^[i].y, 100);
|
|
|
67 |
if fps^[i].y < 0 then
|
|
|
68 |
fps^[i].y:= 0;
|
|
|
69 |
end;
|
|
|
70 |
end;
|
|
|
71 |
|
|
|
72 |
if (canFlip and (getrandom(2) = 0)) then
|
|
|
73 |
begin
|
|
|
74 |
for i:= 0 to pred(BasePointsCount) do
|
|
|
75 |
pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y;
|
|
|
76 |
for i:= 0 to pred(FillPointsCount) do
|
|
|
77 |
fps^[i].y:= LAND_HEIGHT - 1 - fps^[i].y;
|
|
|
78 |
end;
|
|
|
79 |
end
|
|
|
80 |
end;
|
|
10199
|
81 |
|
|
|
82 |
|
|
|
83 |
procedure Distort1(var Template: TEdgeTemplate; var pa: TPixAr);
|
|
|
84 |
var i: Longword;
|
|
|
85 |
begin
|
|
|
86 |
for i:= 1 to Template.BezierizeCount do
|
|
|
87 |
begin
|
|
|
88 |
BezierizeEdge(pa, _0_5);
|
|
|
89 |
RandomizePoints(pa);
|
|
|
90 |
RandomizePoints(pa)
|
|
|
91 |
end;
|
|
|
92 |
for i:= 1 to Template.RandPassesCount do
|
|
|
93 |
RandomizePoints(pa);
|
|
|
94 |
BezierizeEdge(pa, _0_1);
|
|
|
95 |
end;
|
|
|
96 |
|
|
|
97 |
|
|
|
98 |
procedure FindLimits(si: LongInt; var pa: TPixAr);
|
|
|
99 |
var p1, p2, mp, ap: TPoint;
|
|
|
100 |
i, t1, t2, a, b, p, q, iy, ix, aqpb: LongInt;
|
|
|
101 |
begin
|
|
|
102 |
// [p1, p2] is segment we're trying to divide
|
|
|
103 |
p1:= pa.ar[si];
|
|
|
104 |
p2:= pa.ar[si + 1];
|
|
|
105 |
|
|
|
106 |
// its middle point
|
|
|
107 |
mp.x:= (p1.x + p2.x) div 2;
|
|
|
108 |
mp.y:= (p1.y + p2.y) div 2;
|
|
|
109 |
// another point on the perpendicular bisector
|
|
|
110 |
ap.x:= mp.x + p2.y - p1.y;
|
|
|
111 |
ap.y:= mp.y + p1.x - p2.x;
|
|
|
112 |
|
|
|
113 |
for i:= 0 to pa.Count - 1 do
|
|
|
114 |
if i <> si then
|
|
|
115 |
begin
|
|
|
116 |
// check if it intersects
|
|
|
117 |
t1:= (mp.x - pa.ar[i].x) * (mp.y - ap.y) - (mp.x - ap.x) * (mp.y - pa.ar[i].y);
|
|
|
118 |
t2:= (mp.x - pa.ar[i + 1].x) * (mp.y - ap.y) - (mp.x - ap.x) * (mp.y - pa.ar[i + 1].y);
|
|
|
119 |
|
|
|
120 |
if (t1 > 0) <> (t2 > 0) then // yes it does, hard arith follows
|
|
|
121 |
begin
|
|
|
122 |
a:= p2.y - p1.y;
|
|
|
123 |
b:= p1.x - p2.x;
|
|
|
124 |
p:= pa.ar[i + 1].x - pa.ar[i].x;
|
|
|
125 |
q:= pa.ar[i + 1].y - pa.ar[i].y;
|
|
|
126 |
aqpb:= a * q - p * b;
|
|
|
127 |
|
|
|
128 |
if (aqpb <> 0) then
|
|
|
129 |
begin
|
|
|
130 |
// (ix; iy) is intersection point
|
|
|
131 |
iy:= (((pa.ar[i].x - mp.x) * b + mp.y * a) * q - pa.ar[i].y * p * b);
|
|
|
132 |
if b <> 0 then
|
|
|
133 |
ix:= (iy - mp.y * aqpb) * a div b div aqpb + mp.x;
|
|
|
134 |
else
|
|
|
135 |
ix:= (iy - pa.ar[i].y * aqpb) * p div q div aqpb + pa.ar[i].x;
|
|
|
136 |
iy:= iy div aqpb;
|
|
|
137 |
|
|
|
138 |
writeln('>>> Intersection <<<');
|
|
|
139 |
writeln(p1.x, '; ', p1.y, ' - ', p2.x, '; ', p2.y);
|
|
|
140 |
writeln(pa.ar[i].x, '; ', pa.ar[i].y, ' - ', pa.ar[i + 1].x, '; ', pa.ar[i + 1].y);
|
|
|
141 |
writeln('== ', ix, '; ', iy);
|
|
|
142 |
end;
|
|
|
143 |
end;
|
|
|
144 |
end;
|
|
|
145 |
end;
|
|
|
146 |
|
|
|
147 |
procedure DivideEdges(var pa: TPixAr);
|
|
|
148 |
var npa: TPixAr;
|
|
|
149 |
i: LongInt;
|
|
|
150 |
begin
|
|
|
151 |
i:= 0;
|
|
|
152 |
npa.Count:= 0;
|
|
|
153 |
while i < pa.Count do
|
|
|
154 |
begin
|
|
|
155 |
if i = 0 then
|
|
|
156 |
begin
|
|
|
157 |
FindLimits(0, pa);
|
|
|
158 |
npa.ar[npa.Count]:= pa.ar[i];
|
|
|
159 |
pa.ar[i].y:= 300;
|
|
|
160 |
npa.ar[npa.Count + 1]:= pa.ar[i];
|
|
|
161 |
inc(npa.Count, 2)
|
|
|
162 |
end else
|
|
|
163 |
begin
|
|
|
164 |
npa.ar[npa.Count]:= pa.ar[i];
|
|
|
165 |
inc(npa.Count)
|
|
|
166 |
end;
|
|
|
167 |
|
|
|
168 |
inc(i)
|
|
|
169 |
end;
|
|
|
170 |
|
|
|
171 |
pa:= npa;
|
|
|
172 |
end;
|
|
|
173 |
|
|
|
174 |
procedure Distort2(var Template: TEdgeTemplate; var pa: TPixAr);
|
|
|
175 |
//var i: Longword;
|
|
|
176 |
begin
|
|
|
177 |
DivideEdges(pa);
|
|
|
178 |
{for i:= 1 to Template.BezierizeCount do
|
|
|
179 |
begin
|
|
|
180 |
BezierizeEdge(pa, _0_5);
|
|
|
181 |
RandomizePoints(pa);
|
|
|
182 |
RandomizePoints(pa)
|
|
|
183 |
end;
|
|
|
184 |
for i:= 1 to Template.RandPassesCount do
|
|
|
185 |
RandomizePoints(pa);}
|
|
|
186 |
BezierizeEdge(pa, _0_9);
|
|
|
187 |
end;
|
|
|
188 |
|
|
|
189 |
|
|
10198
|
190 |
procedure GenTemplated(var Template: TEdgeTemplate);
|
|
|
191 |
var pa: TPixAr;
|
|
|
192 |
i: Longword;
|
|
|
193 |
y, x: Longword;
|
|
|
194 |
fps: TPointArray;
|
|
|
195 |
begin
|
|
|
196 |
fps:=Template.FillPoints^;
|
|
|
197 |
ResizeLand(Template.TemplateWidth, Template.TemplateHeight);
|
|
|
198 |
for y:= 0 to LAND_HEIGHT - 1 do
|
|
|
199 |
for x:= 0 to LAND_WIDTH - 1 do
|
|
|
200 |
Land[y, x]:= lfBasic;
|
|
|
201 |
{$HINTS OFF}
|
|
|
202 |
SetPoints(Template, pa, @fps);
|
|
|
203 |
{$HINTS ON}
|
|
|
204 |
|
|
10199
|
205 |
Distort1(Template, pa);
|
|
10198
|
206 |
|
|
|
207 |
DrawEdge(pa, 0);
|
|
|
208 |
|
|
|
209 |
with Template do
|
|
|
210 |
for i:= 0 to pred(FillPointsCount) do
|
|
|
211 |
with fps[i] do
|
|
|
212 |
FillLand(x, y, 0, 0);
|
|
|
213 |
|
|
|
214 |
DrawEdge(pa, lfBasic);
|
|
|
215 |
|
|
|
216 |
MaxHedgehogs:= Template.MaxHedgehogs;
|
|
|
217 |
hasGirders:= Template.hasGirders;
|
|
|
218 |
playHeight:= Template.TemplateHeight;
|
|
|
219 |
playWidth:= Template.TemplateWidth;
|
|
|
220 |
leftX:= ((LAND_WIDTH - playWidth) div 2);
|
|
|
221 |
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
|
|
|
222 |
topY:= LAND_HEIGHT - playHeight;
|
|
|
223 |
|
|
|
224 |
// HACK: force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ?
|
|
|
225 |
if (cTemplateFilter = 4)
|
|
|
226 |
or (Template.canInvert and (getrandom(2) = 0))
|
|
|
227 |
or (not Template.canInvert and Template.isNegative) then
|
|
|
228 |
begin
|
|
|
229 |
hasBorder:= true;
|
|
|
230 |
for y:= 0 to LAND_HEIGHT - 1 do
|
|
|
231 |
for x:= 0 to LAND_WIDTH - 1 do
|
|
|
232 |
if (y < topY) or (x < leftX) or (x > rightX) then
|
|
|
233 |
Land[y, x]:= 0
|
|
|
234 |
else
|
|
|
235 |
begin
|
|
|
236 |
if Land[y, x] = 0 then
|
|
|
237 |
Land[y, x]:= lfBasic
|
|
|
238 |
else if Land[y, x] = lfBasic then
|
|
|
239 |
Land[y, x]:= 0;
|
|
|
240 |
end;
|
|
|
241 |
end;
|
|
|
242 |
end;
|
|
|
243 |
|
|
|
244 |
|
|
|
245 |
end.
|