49 implementation |
49 implementation |
50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO; |
50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO; |
51 |
51 |
52 type TPixAr = record |
52 type TPixAr = record |
53 Count: Longword; |
53 Count: Longword; |
54 ar: array[word] of TPoint; |
54 ar: array[0..Pred(cMaxEdgePoints)] of TPoint; |
55 end; |
55 end; |
56 |
56 |
57 var HHPoints: record |
57 var HHPoints: record |
58 First, Last: word; |
58 First, Last: word; |
59 ar: array[1..Pred(cMaxHHs)] of TPoint |
59 ar: array[1..Pred(cMaxSpawnPoints)] of TPoint |
60 end = (First: 1); |
60 end = (First: 1); |
61 |
61 |
62 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
62 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
63 var i, p: LongWord; |
63 var i, p: LongWord; |
64 x, y: Longword; |
64 x, y: Longword; |
108 if SDL_MustLock(Image) then |
108 if SDL_MustLock(Image) then |
109 SDL_UnlockSurface(Image); |
109 SDL_UnlockSurface(Image); |
110 WriteLnToConsole(msgOK) |
110 WriteLnToConsole(msgOK) |
111 end; |
111 end; |
112 |
112 |
113 procedure GenEdge(out pa: TPixAr); |
113 procedure GenEdge(TemplateType: Longword; out pa: TPixAr); |
114 var angle, r: real; |
114 const Template0: array[0..4] of TPoint = ( |
115 len1: Longword; |
115 (x: 500; y: 1500), |
116 begin |
116 (x: 350; y: 400), |
117 len1:= 0; |
117 (x: 1023; y: 800), |
118 angle:= 5*pi/6; |
118 (x: 1700; y: 400), |
119 r:= 410; |
119 (x: 1550; y: 1500) |
120 repeat |
120 ); |
121 angle:= angle + 0.1 + getrandom * 0.1; |
121 var i: integer; |
122 pa.ar[len1].X:= 544 + trunc(r*cos(angle)); |
122 begin |
123 pa.ar[len1].Y:= 1080 + trunc(1.5*r*sin(angle)); |
123 pa.Count:= Succ(High(Template0)); |
124 if r<380 then r:= r+getrandom*110 |
124 for i:= 0 to High(Template0) do |
125 else r:= r - getrandom*80; |
125 pa.ar[i]:= Template0[i] |
126 inc(len1); |
126 end; |
127 until angle > 7/4*pi; |
127 |
128 |
128 procedure DrawBezierEdge(var pa: TPixAr); |
129 angle:= -pi/6; |
|
130 r:= 510; |
|
131 pa.ar[len1].X:= 644 + trunc(r*cos(angle)); |
|
132 pa.ar[len1].Y:= 1080 + trunc(r*sin(angle)); |
|
133 angle:= -pi; |
|
134 |
|
135 repeat |
|
136 angle:= angle + 0.1 + getrandom*0.1; |
|
137 pa.ar[len1].X:= 1504 + trunc(r*cos(angle)); |
|
138 pa.ar[len1].Y:= 880 + trunc(1.5*r*sin(angle)); |
|
139 if r<410 then r:= r + getrandom*80 |
|
140 else r:= r - getrandom*110; |
|
141 inc(len1); |
|
142 until angle > 1/4*pi; |
|
143 pa.ar[len1]:= pa.ar[0]; |
|
144 pa.Count:= Succ(len1) |
|
145 end; |
|
146 |
|
147 procedure DrawBezierBorder(var pa: TPixAr); |
|
148 var x, y, i: integer; |
129 var x, y, i: integer; |
149 tx, ty, vx, vy, vlen, t: real; |
130 tx, ty, vx, vy, vlen, t: real; |
150 r1, r2, r3, r4: real; |
131 r1, r2, r3, r4: real; |
151 x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; |
132 x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; |
152 begin |
133 begin |
204 Land[y, x]:= $FFFFFF; |
185 Land[y, x]:= $FFFFFF; |
205 end; |
186 end; |
206 end; |
187 end; |
207 end; |
188 end; |
208 |
189 |
|
190 procedure BezierizeEdge(var pa: TPixAr; Delta: real); |
|
191 var x, y, i: integer; |
|
192 tx, ty, vx, vy, vlen, t: real; |
|
193 r1, r2, r3, r4: real; |
|
194 x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; |
|
195 opa: TPixAr; |
|
196 begin |
|
197 opa:= pa; |
|
198 pa.Count:= 0; |
|
199 vx:= 0; |
|
200 vy:= 0; |
|
201 with opa do |
|
202 for i:= 0 to Count-2 do |
|
203 begin |
|
204 vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); |
|
205 t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); |
|
206 if t<vlen then vlen:= t; |
|
207 vlen:= vlen/3; |
|
208 tx:= ar[i+2].X - ar[i].X; |
|
209 ty:= ar[i+2].y - ar[i].y; |
|
210 t:= sqrt(sqr(tx)+sqr(ty)); |
|
211 if t = 0 then |
|
212 begin |
|
213 tx:= -tx * 100000; |
|
214 ty:= -ty * 100000; |
|
215 end else |
|
216 begin |
|
217 tx:= -tx/t; |
|
218 ty:= -ty/t; |
|
219 end; |
|
220 t:= 1.0*vlen; |
|
221 tx:= tx*t; |
|
222 ty:= ty*t; |
|
223 x1:= ar[i].x; |
|
224 y1:= ar[i].y; |
|
225 x2:= ar[i + 1].x; |
|
226 y2:= ar[i + 1].y; |
|
227 cx1:= ar[i].X + trunc(vx); |
|
228 cy1:= ar[i].y + trunc(vy); |
|
229 cx2:= ar[i+1].X + trunc(tx); |
|
230 cy2:= ar[i+1].y + trunc(ty); |
|
231 vx:= -tx; |
|
232 vy:= -ty; |
|
233 t:= 0; |
|
234 while t <= 1.0 do |
|
235 begin |
|
236 tsq:= sqr(t); |
|
237 tcb:= tsq * t; |
|
238 r1:= (1 - 3*t + 3*tsq - tcb) * x1; |
|
239 r2:= ( 3*t - 6*tsq + 3*tcb) * cx1; |
|
240 r3:= ( 3*tsq - 3*tcb) * cx2; |
|
241 r4:= ( tcb) * x2; |
|
242 X:= round(r1 + r2 + r3 + r4); |
|
243 r1:= (1 - 3*t + 3*tsq - tcb) * y1; |
|
244 r2:= ( 3*t - 6*tsq + 3*tcb) * cy1; |
|
245 r3:= ( 3*tsq - 3*tcb) * cy2; |
|
246 r4:= ( tcb) * y2; |
|
247 Y:= round(r1 + r2 + r3 + r4); |
|
248 t:= t + Delta; |
|
249 pa.ar[pa.Count].x:= X; |
|
250 pa.ar[pa.Count].y:= Y; |
|
251 inc(pa.Count); |
|
252 TryDo(pa.Count < cMaxEdgePoints, 'Edge points overflow', true) |
|
253 end; |
|
254 end; |
|
255 end; |
|
256 |
209 procedure FillLand(x, y: integer); |
257 procedure FillLand(x, y: integer); |
210 var Stack: record |
258 var Stack: record |
211 Count: Longword; |
259 Count: Longword; |
212 points: array[0..8192] of record |
260 points: array[0..8192] of record |
213 xl, xr, y, dir: integer; |
261 xl, xr, y, dir: integer; |
259 while (xl <= xr) and (Land[y, xl] = 0) do |
307 while (xl <= xr) and (Land[y, xl] = 0) do |
260 begin |
308 begin |
261 Land[y, xl]:= $FFFFFF; |
309 Land[y, xl]:= $FFFFFF; |
262 inc(xl) |
310 inc(xl) |
263 end; |
311 end; |
264 if x < xl then Push(x, Pred(xl), y, dir) |
312 if x < xl then |
|
313 begin |
|
314 Push(x, Pred(xl), y, dir); |
|
315 Push(x, Pred(xl), y,-dir); |
|
316 end; |
265 end; |
317 end; |
266 end; |
318 end; |
267 end; |
319 end; |
268 |
320 |
269 procedure ColorizeLand(Surface: PSDL_Surface); |
321 procedure ColorizeLand(Surface: PSDL_Surface); |
285 SDL_FreeSurface(tmpsurf); |
337 SDL_FreeSurface(tmpsurf); |
286 |
338 |
287 tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0); |
339 tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0); |
288 SDLTry(tmpsurf <> nil, true); |
340 SDLTry(tmpsurf <> nil, true); |
289 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF)); |
341 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF)); |
290 SDL_UpperBlit(tmpsurf, nil, Surface, nil) |
342 SDL_UpperBlit(tmpsurf, nil, Surface, nil); |
|
343 SDL_FreeSurface(tmpsurf) |
291 end; |
344 end; |
292 |
345 |
293 procedure AddBorder(Surface: PSDL_Surface); |
346 procedure AddBorder(Surface: PSDL_Surface); |
294 var tmpsurf: PSDL_Surface; |
347 var tmpsurf: PSDL_Surface; |
295 r, rr: TSDL_Rect; |
348 r, rr: TSDL_Rect; |
419 inc(t, 2) |
472 inc(t, 2) |
420 until (y > 1023) or (CountNonZeroz(x, y) <> 0); |
473 until (y > 1023) or (CountNonZeroz(x, y) <> 0); |
421 if (t > 22) and (y < 1023) then AddHHPoint(x, y - 12); |
474 if (t > 22) and (y < 1023) then AddHHPoint(x, y - 12); |
422 inc(y, 100) |
475 inc(y, 100) |
423 end; |
476 end; |
424 inc(x, 160) |
477 inc(x, 120) |
425 end; |
478 end; |
|
479 |
|
480 if HHPoints.Last < cMaxHHs then |
|
481 begin |
|
482 AddHHPoint(300, 800); |
|
483 AddHHPoint(400, 800); |
|
484 AddHHPoint(500, 800); |
|
485 AddHHPoint(600, 800); |
|
486 AddHHPoint(700, 800); |
|
487 AddHHPoint(800, 800); |
|
488 AddHHPoint(900, 800); |
|
489 AddHHPoint(1000, 800); |
|
490 AddHHPoint(1100, 800); |
|
491 AddHHPoint(1200, 800); |
|
492 AddHHPoint(1300, 800); |
|
493 AddHHPoint(1400, 800); |
|
494 end; |
|
495 end; |
|
496 |
|
497 procedure PointWave(var pa: TPixAr; PassesNum: Longword); |
|
498 const MAXPASSES = 8; |
|
499 var ar: array[0..Pred(MAXPASSES) - 1, 0..5] of real; |
|
500 i, k: integer; |
|
501 rx, ry, oy: real; |
|
502 begin |
|
503 TryDo(PassesNum < MAXPASSES, 'Passes number too big', true); |
|
504 for i:= 0 to Pred(PassesNum) do // initialize random parameters |
|
505 begin |
|
506 ar[i, 0]:= 20 + getrandom(45); |
|
507 ar[i, 1]:= 0.005 + getrandom * 0.015; |
|
508 ar[i, 2]:= getrandom * pi * 2; |
|
509 ar[i, 3]:= 20 + getrandom(45); |
|
510 ar[i, 4]:= 0.005 + getrandom * 0.015; |
|
511 ar[i, 5]:= getrandom * pi * 2; |
|
512 end; |
|
513 |
|
514 for k:= 0 to Pred(pa.Count) do // apply transformation |
|
515 begin |
|
516 rx:= pa.ar[k].x; |
|
517 ry:= pa.ar[k].y; |
|
518 for i:= 0 to Pred(PassesNum) do |
|
519 begin |
|
520 oy:= ry; |
|
521 ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]); |
|
522 rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]); |
|
523 end; |
|
524 pa.ar[k].x:= round(rx); |
|
525 pa.ar[k].y:= round(ry); |
|
526 end; |
426 end; |
527 end; |
427 |
528 |
428 procedure GenLandSurface; |
529 procedure GenLandSurface; |
429 var pa: TPixAr; |
530 var pa: TPixAr; |
430 tmpsurf: PSDL_Surface; |
531 tmpsurf: PSDL_Surface; |
431 begin |
532 begin |
432 GenEdge(pa); |
533 GenEdge(0, pa); |
433 DrawBezierBorder(pa); |
534 BezierizeEdge(pa, 0.33334); |
|
535 BezierizeEdge(pa, 0.33334); |
|
536 BezierizeEdge(pa, 0.33334); |
|
537 PointWave(pa, 3); |
|
538 DrawBezierEdge(pa); |
434 FillLand(1023, 1023); |
539 FillLand(1023, 1023); |
|
540 |
435 AddProgress; |
541 AddProgress; |
436 with PixelFormat^ do |
542 with PixelFormat^ do |
437 tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); |
543 tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); |
438 ColorizeLand(tmpsurf); |
544 ColorizeLand(tmpsurf); |
439 AddProgress; |
545 AddProgress; |