Mercurial Mercurial > sheepy-clone / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLand.pas
changeset 351 29bc9c36ad5f
parent 316 57d50189ad86
child 358 236bbd12d4d9
equal deleted inserted replaced
350:c3ccec3834e8 351:29bc9c36ad5f 
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 
    17  *)
 
    17  *)
 
    18 
    18 
    19 unit uLand;
 
    19 unit uLand;
 
    20 interface
 
    20 interface
 
    21 uses SDLh, uLandTemplates;
 
    21 uses SDLh, uLandTemplates, uFloat;
 
    22 {$include options.inc}
 
    22 {$include options.inc}
 
    23 type TLandArray = packed array[0..1023, 0..2047] of LongWord;
 
    23 type TLandArray = packed array[0..1023, 0..2047] of LongWord;
 
    24      TPreview = packed array[0..127, 0..31] of byte;
 
    24      TPreview = packed array[0..127, 0..31] of byte;
 
    25 
    25 
    26 var  Land: TLandArray;
 
    26 var  Land: TLandArray;
 
    55 SendIPC('M' + s)
 
    55 SendIPC('M' + s)
 
    56 end;
 
    56 end;
 
    57 
    57 
    58 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
 
    58 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
 
    59 var x, y, i: integer;
 
    59 var x, y, i: integer;
 
    60     tx, ty, vx, vy, vlen, t: Double;
 
    60     tx, ty, vx, vy, vlen, t: hwFloat;
 
    61     r1, r2, r3, r4: Double;
 
    61     r1, r2, r3, r4: hwFloat;
 
    62     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double;
 
    62     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: hwFloat;
 
    63 begin
 
    63 begin
 
    64 vx:= 0;
 
    64 vx:= 0;
 
    65 vy:= 0;
 
    65 vy:= 0;
 
    66 with pa do
 
    66 with pa do
 
    67 for i:= 0 to Count-2 do
 
    67 for i:= 0 to Count-2 do
 
    68     begin
 
    68     begin
 
    69     vlen:= sqrt(sqr(ar[i + 1].x - ar[i    ].X) + sqr(ar[i + 1].y - ar[i    ].y));
 
    69     vlen:= Distance(ar[i + 1].x - ar[i].X, ar[i + 1].y - ar[i].y);
 
    70     t:=    sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y));
 
    70     t:=    Distance(ar[i + 1].x - ar[i + 2].X,ar[i + 1].y - ar[i + 2].y);
 
    71     if t<vlen then vlen:= t;
 
    71     if t<vlen then vlen:= t;
 
    72     vlen:= vlen/3;
 
    72     vlen:= vlen * _1div3;
 
    73     tx:= ar[i+2].X - ar[i].X;
 
    73     tx:= ar[i+2].X - ar[i].X;
 
    74     ty:= ar[i+2].y - ar[i].y;
 
    74     ty:= ar[i+2].y - ar[i].y;
 
    75     t:= sqrt(sqr(tx)+sqr(ty));
 
    75     t:= Distance(tx, ty);
 
    76     if t = 0 then
 
    76     if t.QWordValue = 0 then
 
    77        begin
 
    77        begin
 
    78        tx:= -tx * 100000;
 
    78        tx:= -tx * 10000;
 
    79        ty:= -ty * 100000;
 
    79        ty:= -ty * 10000;
 
    80        end else
 
    80        end else
 
    81        begin
 
    81        begin
 
    82        tx:= -tx/t;
 
    82        t:= 1/t;
 
    83        ty:= -ty/t;
 
    83        tx:= -tx * t;
 
       
    84        ty:= -ty * t;
 
    84        end;
 
    85        end;
 
    85     t:= 1.0*vlen;
 
    86     t:= vlen;
 
    86     tx:= tx*t;
 
    87     tx:= tx * t;
 
    87     ty:= ty*t;
 
    88     ty:= ty * t;
 
    88     x1:= ar[i].x;
 
    89     x1:= ar[i].x;
 
    89     y1:= ar[i].y;
 
    90     y1:= ar[i].y;
 
    90     x2:= ar[i + 1].x;
 
    91     x2:= ar[i + 1].x;
 
    91     y2:= ar[i + 1].y;
 
    92     y2:= ar[i + 1].y;
 
    92     cx1:= ar[i].X   + trunc(vx);
 
    93     cx1:= ar[i].X   + hwRound(vx);
 
    93     cy1:= ar[i].y   + trunc(vy);
 
    94     cy1:= ar[i].y   + hwRound(vy);
 
    94     cx2:= ar[i+1].X + trunc(tx);
 
    95     cx2:= ar[i+1].X + hwRound(tx);
 
    95     cy2:= ar[i+1].y + trunc(ty);
 
    96     cy2:= ar[i+1].y + hwRound(ty);
 
    96     vx:= -tx;
 
    97     vx:= -tx;
 
    97     vy:= -ty;
 
    98     vy:= -ty;
 
    98     t:= 0;
 
    99     t:= 0;
 
    99     while t <= 1.0 do
 
   100     while t.Round = 0 do
 
   100           begin
 
   101           begin
 
   101           tsq:= sqr(t);
 
   102           tsq:= t * t;
 
   102           tcb:= tsq * t;
 
   103           tcb:= tsq * t;
 
   103           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
 
   104           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
 
   104           r2:= (    3*t - 6*tsq + 3*tcb) * cx1;
 
   105           r2:= (    3*t - 6*tsq + 3*tcb) * cx1;
 
   105           r3:= (          3*tsq - 3*tcb) * cx2;
 
   106           r3:= (          3*tsq - 3*tcb) * cx2;
 
   106           r4:= (                    tcb) * x2;
 
   107           r4:= (                    tcb) * x2;
 
   107           X:= round(r1 + r2 + r3 + r4);
 
   108           X:= hwRound(r1 + r2 + r3 + r4);
 
   108           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
 
   109           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
 
   109           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
 
   110           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
 
   110           r3:= (          3*tsq - 3*tcb) * cy2;
 
   111           r3:= (          3*tsq - 3*tcb) * cy2;
 
   111           r4:= (                    tcb) * y2;
 
   112           r4:= (                    tcb) * y2;
 
   112           Y:= round(r1 + r2 + r3 + r4);
 
   113           Y:= hwRound(r1 + r2 + r3 + r4);
 
   113           t:= t + 0.001;
 
   114           t:= t + _1div1024;
 
   114           if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
 
   115           if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
 
   115                 Land[y, x]:= Color;
 
   116                 Land[y, x]:= Color;
 
   116           end;
 
   117           end;
 
   117     end;
 
   118     end;
 
   118 end;
 
   119 end;
 
   119 
   120 
   120 procedure BezierizeEdge(var pa: TPixAr; Delta: Double);
 
   121 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
 
   121 var x, y, i: integer;
 
   122 var x, y, i: integer;
 
   122     tx, ty, vx, vy, vlen, t: Double;
 
   123     tx, ty, vx, vy, vlen, t: hwFloat;
 
   123     r1, r2, r3, r4: Double;
 
   124     r1, r2, r3, r4: hwFloat;
 
   124     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double;
 
   125     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: hwFloat;
 
   125     opa: TPixAr;
 
   126     opa: TPixAr;
 
   126 begin
 
   127 begin
 
   127 opa:= pa;
 
   128 opa:= pa;
 
   128 pa.Count:= 0;
 
   129 pa.Count:= 0;
 
   129 vx:= 0;
 
   130 vx:= 0;
 
   130 vy:= 0;
 
   131 vy:= 0;
 
   131 with opa do
 
   132 with opa do
 
   132 for i:= 0 to Count-2 do
 
   133 for i:= 0 to Count-2 do
 
   133     begin
 
   134     begin
 
   134     vlen:= sqrt(sqr(ar[i + 1].x - ar[i    ].X) + sqr(ar[i + 1].y - ar[i    ].y));
 
   135 addfilelog('50');
 
   135     t:=    sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y));
 
   136     vlen:= Distance(ar[i + 1].x - ar[i].X, ar[i + 1].y - ar[i].y);
 
       
   137     t:=    Distance(ar[i + 1].x - ar[i + 2].X,ar[i + 1].y - ar[i + 2].y);
 
       
   138 addfilelog('51');
 
   136     if t<vlen then vlen:= t;
 
   139     if t<vlen then vlen:= t;
 
   137     vlen:= vlen/3;
 
   140     vlen:= vlen * _1div3;
 
   138     tx:= ar[i+2].X - ar[i].X;
 
   141     tx:= ar[i+2].X - ar[i].X;
 
   139     ty:= ar[i+2].y - ar[i].y;
 
   142     ty:= ar[i+2].y - ar[i].y;
 
   140     t:= sqrt(sqr(tx)+sqr(ty));
 
   143     t:= Distance(tx, ty);
 
   141     if t = 0 then
 
   144     if t.QWordValue = 0 then
 
   142        begin
 
   145        begin
 
   143        tx:= -tx * 100000;
 
   146        tx:= -tx * 100000;
 
   144        ty:= -ty * 100000;
 
   147        ty:= -ty * 100000;
 
   145        end else
 
   148        end else
 
   146        begin
 
   149        begin
 
   147        tx:= -tx/t;
 
   150        t:= 1/t;
 
   148        ty:= -ty/t;
 
   151        tx:= -tx * t;
 
       
   152        ty:= -ty * t;
 
   149        end;
 
   153        end;
 
   150     t:= 1.0*vlen;
 
   154     t:= vlen;
 
   151     tx:= tx*t;
 
   155     tx:= tx*t;
 
   152     ty:= ty*t;
 
   156     ty:= ty*t;
 
   153     x1:= ar[i].x;
 
   157     x1:= ar[i].x;
 
   154     y1:= ar[i].y;
 
   158     y1:= ar[i].y;
 
   155     x2:= ar[i + 1].x;
 
   159     x2:= ar[i + 1].x;
 
   156     y2:= ar[i + 1].y;
 
   160     y2:= ar[i + 1].y;
 
   157     cx1:= ar[i].X   + trunc(vx);
 
   161     cx1:= ar[i].X   + hwRound(vx);
 
   158     cy1:= ar[i].y   + trunc(vy);
 
   162     cy1:= ar[i].y   + hwRound(vy);
 
   159     cx2:= ar[i+1].X + trunc(tx);
 
   163     cx2:= ar[i+1].X + hwRound(tx);
 
   160     cy2:= ar[i+1].y + trunc(ty);
 
   164     cy2:= ar[i+1].y + hwRound(ty);
 
   161     vx:= -tx;
 
   165     vx:= -tx;
 
   162     vy:= -ty;
 
   166     vy:= -ty;
 
   163     t:= 0;
 
   167     t:= 0;
 
   164     while t <= 1.0 do
 
   168     while t.Round = 0 do
 
   165           begin
 
   169           begin
 
   166           tsq:= sqr(t);
 
   170           tsq:= t * t;
 
   167           tcb:= tsq * t;
 
   171           tcb:= tsq * t;
 
   168           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
 
   172           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
 
   169           r2:= (    3*t - 6*tsq + 3*tcb) * cx1;
 
   173           r2:= (    3*t - 6*tsq + 3*tcb) * cx1;
 
   170           r3:= (          3*tsq - 3*tcb) * cx2;
 
   174           r3:= (          3*tsq - 3*tcb) * cx2;
 
   171           r4:= (                    tcb) * x2;
 
   175           r4:= (                    tcb) * x2;
 
   172           X:= round(r1 + r2 + r3 + r4);
 
   176           X:= hwRound(r1 + r2 + r3 + r4);
 
   173           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
 
   177           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
 
   174           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
 
   178           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
 
   175           r3:= (          3*tsq - 3*tcb) * cy2;
 
   179           r3:= (          3*tsq - 3*tcb) * cy2;
 
   176           r4:= (                    tcb) * y2;
 
   180           r4:= (                    tcb) * y2;
 
   177           Y:= round(r1 + r2 + r3 + r4);
 
   181           Y:= hwRound(r1 + r2 + r3 + r4);
 
   178           t:= t + Delta;
 
   182           t:= t + Delta;
 
   179           pa.ar[pa.Count].x:= X;
 
   183           pa.ar[pa.Count].x:= X;
 
   180           pa.ar[pa.Count].y:= Y;
 
   184           pa.ar[pa.Count].y:= Y;
 
   181           inc(pa.Count);
 
   185           inc(pa.Count);
 
   182           TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
 
   186           TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
 
   205          dir:= _dir
 
   209          dir:= _dir
 
   206          end;
 
   210          end;
 
   207     inc(Stack.Count)
 
   211     inc(Stack.Count)
 
   208     end;
 
   212     end;
 
   209 
   213 
   210     procedure Pop(out _xl, _xr, _y, _dir: integer);
 
   214     procedure Pop(var _xl, _xr, _y, _dir: integer);
 
   211     begin
 
   215     begin
 
   212     dec(Stack.Count);
 
   216     dec(Stack.Count);
 
   213     with Stack.points[Stack.Count] do
 
   217     with Stack.points[Stack.Count] do
 
   214          begin
 
   218          begin
 
   215          _xl:= xl;
 
   219          _xl:= xl;
 
   218          _dir:= dir
 
   222          _dir:= dir
 
   219          end
 
   223          end
 
   220     end;
 
   224     end;
 
   221 
   225 
   222 var xl, xr, dir: integer;
 
   226 var xl, xr, dir: integer;
 
   223 begin     
   227 begin
 
   224 Stack.Count:= 0;
 
   228 Stack.Count:= 0;
 
   225 xl:= x - 1;
 
   229 xl:= x - 1;
 
   226 xr:= x;
 
   230 xr:= x;
 
   227 Push(xl, xr, y, -1);
 
   231 Push(xl, xr, y, -1);
 
   228 Push(xl, xr, y,  1);
 
   232 Push(xl, xr, y,  1);
 
   251 
   255 
   252 procedure ColorizeLand(Surface: PSDL_Surface);
 
   256 procedure ColorizeLand(Surface: PSDL_Surface);
 
   253 var tmpsurf: PSDL_Surface;
 
   257 var tmpsurf: PSDL_Surface;
 
   254     r: TSDL_Rect;
 
   258     r: TSDL_Rect;
 
   255 begin
 
   259 begin
 
   256 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false);
 
   260 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, true);
 
   257 r.y:= 0;
 
   261 r.y:= 0;
 
   258 while r.y < 1024 do
 
   262 while r.y < 1024 do
 
   259       begin
 
   263       begin
 
   260       r.x:= 0;
 
   264       r.x:= 0;
 
   261       while r.x < 2048 do
 
   265       while r.x < 2048 do
 
   262             begin
 
   266             begin
 
   263             SDL_UpperBlit(tmpsurf, nil, Surface, @r);
 
   267             SDL_UpperBlit(tmpsurf, nil, Surface, @r);
 
   264             inc(r.x, tmpsurf.w)
 
   268             inc(r.x, tmpsurf^.w)
 
   265             end;
 
   269             end;
 
   266       inc(r.y, tmpsurf.h)
 
   270       inc(r.y, tmpsurf^.h)
 
   267       end;
 
   271       end;
 
   268 SDL_FreeSurface(tmpsurf);
 
   272 SDL_FreeSurface(tmpsurf);
 
   269 
   273 
   270 tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0);
 
   274 tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0);
 
   271 SDLTry(tmpsurf <> nil, true);
 
   275 SDLTry(tmpsurf <> nil, true);
 
   272 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF));
 
   276 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf^.format, $FF, $FF, $FF));
 
   273 SDL_UpperBlit(tmpsurf, nil, Surface, nil);
 
   277 SDL_UpperBlit(tmpsurf, nil, Surface, nil);
 
   274 SDL_FreeSurface(tmpsurf)
 
   278 SDL_FreeSurface(tmpsurf)
 
   275 end;
 
   279 end;
 
   276 
   280 
   277 procedure AddBorder(Surface: PSDL_Surface);
 
   281 procedure AddBorder(Surface: PSDL_Surface);
 
   278 var tmpsurf: PSDL_Surface;
 
   282 var tmpsurf: PSDL_Surface;
 
   279     r, rr: TSDL_Rect;
 
   283     r, rr: TSDL_Rect;
 
   280     x, yd, yu: integer;
 
   284     x, yd, yu: integer;
 
   281 begin
 
   285 begin
 
   282 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false);
 
   286 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true);
 
   283 for x:= 0 to 2047 do
 
   287 for x:= 0 to 2047 do
 
   284     begin
 
   288     begin
 
   285     yd:= 1023;
 
   289     yd:= 1023;
 
   286     repeat
 
   290     repeat
 
   287       while (yd > 0   ) and (Land[yd, x] =  0) do dec(yd);
 
   291       while (yd > 0   ) and (Land[yd, x] =  0) do dec(yd);
 
   293       while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
 
   297       while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
 
   294       if (yd < 1023) and ((yd - yu) >= 16) then
 
   298       if (yd < 1023) and ((yd - yu) >= 16) then
 
   295          begin
 
   299          begin
 
   296          rr.x:= x;
 
   300          rr.x:= x;
 
   297          rr.y:= yd - 15;
 
   301          rr.y:= yd - 15;
 
   298          r.x:= x mod tmpsurf.w;
 
   302          r.x:= x mod tmpsurf^.w;
 
   299          r.y:= 16;
 
   303          r.y:= 16;
 
   300          r.w:= 1;
 
   304          r.w:= 1;
 
   301          r.h:= 16;
 
   305          r.h:= 16;
 
   302          SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   306          SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   303          end;
 
   307          end;
 
   304       if (yu > 0) then
 
   308       if (yu > 0) then
 
   305          begin
 
   309          begin
 
   306          rr.x:= x;
 
   310          rr.x:= x;
 
   307          rr.y:= yu;
 
   311          rr.y:= yu;
 
   308          r.x:= x mod tmpsurf.w;
 
   312          r.x:= x mod tmpsurf^.w;
 
   309          r.y:= 0;
 
   313          r.y:= 0;
 
   310          r.w:= 1;
 
   314          r.w:= 1;
 
   311          r.h:= min(16, yd - yu + 1);
 
   315          r.h:= min(16, yd - yu + 1);
 
   312          SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   316          SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   313          end;
 
   317          end;
 
   314       yd:= yu - 1;
 
   318       yd:= yu - 1;
 
   315     until yd < 0;
 
   319     until yd < 0;
 
   316     end;
 
   320     end;
 
   317 end;
 
   321 end;
 
   318 
   322 
   319 function rndSign(num: Double): Double;
 
       
   320 begin
 
       
   321 if getrandom(2) = 0 then Result:=   num
 
       
   322                     else Result:= - num
 
       
   323 end;
 
       
   324 
       
   325 
       
   326 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
 
   323 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
 
   327 const MAXPASSES = 32;
 
   324 const MAXPASSES = 32;
 
   328 var ar: array[0..MAXPASSES, 0..9] of Double;
 
   325 var ar: array[0..MAXPASSES, 0..9] of hwFloat;
 
   329     i, k: integer;
 
   326     i, k: integer;
 
   330     rx, ry, ox, oy: Double;
 
   327     rx, ry, ox, oy: hwFloat;
 
   331     PassesNum: Longword;
 
   328     PassesNum: Longword;
 
   332 begin
 
   329 begin
 
   333 with Template do
 
   330 with Template do
 
   334      begin
 
   331      begin
 
   335      PassesNum:= PassMin + getrandom(PassDelta);
 
   332      PassesNum:= PassMin + getrandom(PassDelta);
 
   336      TryDo(PassesNum < MAXPASSES, 'Passes number too big', true);
 
   333      TryDo(PassesNum < MAXPASSES, 'Passes number too big', true);
 
   337      ar[0, 1]:= WaveFreqMin;
 
   334      ar[0, 1]:= WaveFreqMin * _1div10000;
 
   338      ar[0, 4]:= WaveFreqMin;
 
   335      ar[0, 4]:= WaveFreqMin * _1div10000;
 
   339      for i:= 1 to PassesNum do  // initialize random parameters
 
   336      for i:= 1 to PassesNum do  // initialize random parameters
 
   340          begin
 
   337          begin
 
   341          ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
   338          ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
   342          ar[i, 1]:= ar[i - 1, 1] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
 
   339 //         ar[i, 1]:= ar[i - 1, 1] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
 
   343          ar[i, 2]:= getrandom * pi * 2;
 
   340          ar[i, 1]:= ar[i - 1, 1] + (getrandom) * WaveFreqDelta;
 
       
   341          ar[i, 2]:= getrandom * hwPi * 2;
 
   344          ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
   342          ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
   345          ar[i, 4]:= ar[i - 1, 4] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
 
   343 //         ar[i, 4]:= ar[i - 1, 4] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
 
   346          ar[i, 5]:= getrandom * pi * 2;
 
   344          ar[i, 4]:= ar[i - 1, 4] + (getrandom) * WaveFreqDelta;
 
       
   345          ar[i, 5]:= getrandom * hwPi * 2;
 
   347          ar[i, 6]:= ar[i, 1] * (getrandom * 2 - 1);
 
   346          ar[i, 6]:= ar[i, 1] * (getrandom * 2 - 1);
 
   348          ar[i, 7]:= ar[i, 1] * rndSign(sqrt(1 - sqr(ar[i, 6])));
 
   347 //         ar[i, 7]:= ar[i, 1] * rndSign(sqrt(1 - sqr(ar[i, 6])));
 
       
   348          ar[i, 7]:= ar[i, 1] * rndSign((1 - (ar[i, 6])));
 
   349          ar[i, 8]:= ar[i, 4] * (getrandom * 2 - 1);
 
   349          ar[i, 8]:= ar[i, 4] * (getrandom * 2 - 1);
 
   350          ar[i, 9]:= ar[i, 4] * rndSign(sqrt(1 - sqr(ar[i, 8])));
 
   350 //         ar[i, 9]:= ar[i, 4] * rndSign(sqrt(1 - sqr(ar[i, 8])));
 
       
   351            ar[i, 9]:= ar[i, 4] * rndSign((1 - (ar[i, 8])));
 
   351          end;
 
   352          end;
 
   352      end;
 
   353      end;
 
   353 
   354 
   354 for k:= 0 to Pred(pa.Count) do  // apply transformation
 
   355 for k:= 0 to Pred(pa.Count) do  // apply transformation
 
   355     begin
 
   356     begin
 
   357     ry:= pa.ar[k].y;
 
   358     ry:= pa.ar[k].y;
 
   358     for i:= 1 to PassesNum do
 
   359     for i:= 1 to PassesNum do
 
   359         begin
 
   360         begin
 
   360         ox:= rx;
 
   361         ox:= rx;
 
   361         oy:= ry;
 
   362         oy:= ry;
 
   362         ry:= ry + ar[i, 0] * sin(ox * ar[i, 6] + oy * ar[i, 7] + ar[i, 2]);
 
   363 //        ry:= ry; + ar[i, 0] * sin(ox * ar[i, 6] + oy * ar[i, 7] + ar[i, 2]);
 
   363         rx:= rx + ar[i, 3] * sin(ox * ar[i, 8] + oy * ar[i, 9] + ar[i, 5]);
 
   364 //        rx:= rx + ar[i, 3] * sin(ox * ar[i, 8] + oy * ar[i, 9] + ar[i, 5]);
 
   364         end;
 
   365         end;
 
   365     pa.ar[k].x:= round(rx);
 
   366     pa.ar[k].x:= hwRound(rx);
 
   366     pa.ar[k].y:= round(ry);
 
   367     pa.ar[k].y:= hwRound(ry);
 
   367     end;
 
   368     end;
 
   368 end;
 
   369 end;
 
   369 
   370 
   370 procedure NormalizePoints(var pa: TPixAr);
 
   371 procedure NormalizePoints(var pa: TPixAr);
 
   371 const brd = 32;
 
   372 const brd = 32;
 
   372 var isUP: boolean;  // HACK: transform for Y should be exact as one for X  
   373 var isUP: boolean;  // HACK: transform for Y should be exact as one for X
 
   373     Left, Right, Top, Bottom,
 
   374     Left, Right, Top, Bottom,
 
   374     OWidth, Width, OHeight, Height,
 
   375     OWidth, Width, OHeight, Height,
 
   375     OLeft: integer;
 
   376     OLeft: integer;
 
   376     i: integer;
 
   377     i: integer;
 
   377 begin
 
   378 begin
 
   447 
   448 
   448      pa.Count:= BasePointsCount;
 
   449      pa.Count:= BasePointsCount;
 
   449      for i:= 0 to pred(pa.Count) do
 
   450      for i:= 0 to pred(pa.Count) do
 
   450          pa.ar[i]:= BasePoints^[i];
 
   451          pa.ar[i]:= BasePoints^[i];
 
   451 
   452 
   452      for i:= 1 to BezPassCnt do
 
   453 //     for i:= 1 to BezPassCnt do
 
   453          BezierizeEdge(pa, 0.33333334);
 
   454          BezierizeEdge(pa, _1div3);
 
   454 
   455 
   455      PointWave(Template, pa);
 
   456      PointWave(Template, pa);
 
   456      NormalizePoints(pa);
 
   457      NormalizePoints(pa);
 
   457      DrawBezierEdge(pa, 0);
 
   458      DrawBezierEdge(pa, 0);
 
   458 
   459 
   464      end;
 
   465      end;
 
   465 end;
 
   466 end;
 
   466 
   467 
   467 function SelectTemplate: integer;
 
   468 function SelectTemplate: integer;
 
   468 begin
 
   469 begin
 
   469 Result:= getrandom(Succ(High(EdgeTemplates)))
 
   470 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))
 
   470 end;
 
   471 end;
 
   471 
   472 
   472 procedure GenLandSurface;
 
   473 procedure GenLandSurface;
 
   473 var tmpsurf: PSDL_Surface;
 
   474 var tmpsurf: PSDL_Surface;
 
   474 begin
 
   475 begin
 
   504 p:= TeamsList;
 
   505 p:= TeamsList;
 
   505 TryDo(p <> nil, 'No teams on map!', true);
 
   506 TryDo(p <> nil, 'No teams on map!', true);
 
   506 with PixelFormat^ do
 
   507 with PixelFormat^ do
 
   507      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, AMask);
 
   508      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, AMask);
 
   508 SDL_FillRect(LandSurface, nil, 0);
 
   509 SDL_FillRect(LandSurface, nil, 0);
 
   509 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'L', false);
 
   510 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p^.FortName + 'L', false, true, true);
 
   510 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
 
   511 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
 
   511 SDL_FreeSurface(tmpsurf);
 
   512 SDL_FreeSurface(tmpsurf);
 
   512 p:= p.Next;
 
   513 p:= p^.Next;
 
   513 TryDo(p <> nil, 'Only one team on map!', true);
 
   514 TryDo(p <> nil, 'Only one team on map!', true);
 
   514 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'R', false);
 
   515 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p^.FortName + 'R', false, true, true);
 
   515 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
 
   516 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
 
   516 SDL_FreeSurface(tmpsurf);
 
   517 SDL_FreeSurface(tmpsurf);
 
   517 p:= p.Next;
 
   518 p:= p^.Next;
 
   518 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
 
   519 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
 
   519 end;
 
   520 end;
 
   520 
   521 
   521 procedure LoadMap;
 
   522 procedure LoadMap;
 
   522 var x, y: Longword;
 
   523 var x, y: Longword;
 
   523     p: PByteArray;
 
   524     p: PByteArray;
 
   524 begin
 
   525 begin
 
   525 WriteLnToConsole('Loading land from file...');
 
   526 WriteLnToConsole('Loading land from file...');
 
   526 AddProgress;
 
   527 AddProgress;
 
   527 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false);
 
   528 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false, true, true);
 
   528 TryDo((LandSurface.w = 2048) and (LandSurface.h = 1024), 'Map dimensions should be 2048x1024!', true);
 
   529 TryDo((LandSurface^.w = 2048) and (LandSurface^.h = 1024), 'Map dimensions should be 2048x1024!', true);
 
   529 
   530 
   530 if SDL_MustLock(LandSurface) then
 
   531 if SDL_MustLock(LandSurface) then
 
   531    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
 
   532    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
 
   532 
   533 
   533 p:= LandSurface.pixels;
 
   534 p:= LandSurface^.pixels;
 
   534 case LandSurface.format.BytesPerPixel of
 
   535 case LandSurface^.format^.BytesPerPixel of
 
   535      1: OutError('We don''t work with 8 bit surfaces', true);
 
   536      1: OutError('We don''t work with 8 bit surfaces', true);
 
   536      2: for y:= 0 to 1023 do
 
   537      2: for y:= 0 to 1023 do
 
   537             begin
 
   538             begin
 
   538             for x:= 0 to 2047 do
 
   539             for x:= 0 to 2047 do
 
   539                 if PWord(@p[x * 2])^ <> 0 then Land[y, x]:= COLOR_LAND;
 
   540                 if PWord(@(p^[x * 2]))^ <> 0 then Land[y, x]:= COLOR_LAND;
 
   540             p:= @p[LandSurface.pitch];
 
   541             p:= @(p^[LandSurface^.pitch]);
 
   541             end;
 
   542             end;
 
   542      3: for y:= 0 to 1023 do
 
   543      3: for y:= 0 to 1023 do
 
   543             begin
 
   544             begin
 
   544             for x:= 0 to 2047 do
 
   545             for x:= 0 to 2047 do
 
   545                 if  (p[x * 3 + 0] <> 0)
 
   546                 if  (p^[x * 3 + 0] <> 0)
 
   546                  or (p[x * 3 + 1] <> 0)
 
   547                  or (p^[x * 3 + 1] <> 0)
 
   547                  or (p[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND;
 
   548                  or (p^[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND;
 
   548             p:= @p[LandSurface.pitch];
 
   549             p:= @(p^[LandSurface^.pitch]);
 
   549             end;
 
   550             end;
 
   550      4: for y:= 0 to 1023 do
 
   551      4: for y:= 0 to 1023 do
 
   551             begin
 
   552             begin
 
   552             for x:= 0 to 2047 do
 
   553             for x:= 0 to 2047 do
 
   553                 if PLongword(@p[x * 4])^ <> 0 then Land[y, x]:= COLOR_LAND;
 
   554                 if PLongword(@(p^[x * 4]))^ <> 0 then Land[y, x]:= COLOR_LAND;
 
   554             p:= @p[LandSurface.pitch];
 
   555             p:= @(p^[LandSurface^.pitch]);
 
   555             end;
 
   556             end;
 
   556      end;
 
   557      end;
 
       
   558 
   557 if SDL_MustLock(LandSurface) then
 
   559 if SDL_MustLock(LandSurface) then
 
   558    SDL_UnlockSurface(LandSurface);
 
   560    SDL_UnlockSurface(LandSurface);
 
   559 end;
 
   561 end;
 
   560 
   562 
   561 procedure GenMap;
 
   563 procedure GenMap;
 
   582             begin
 
   584             begin
 
   583             t:= 0;
 
   585             t:= 0;
 
   584             for yy:= y * 8 to y * 8 + 7 do
 
   586             for yy:= y * 8 to y * 8 + 7 do
 
   585                 for xx:= x * 64 + bit * 8 to x * 64 + bit * 8 + 7 do
 
   587                 for xx:= x * 64 + bit * 8 to x * 64 + bit * 8 + 7 do
 
   586                     if Land[yy, xx] <> 0 then inc(t);
 
   588                     if Land[yy, xx] <> 0 then inc(t);
 
   587             if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit) 
   589             if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit)
 
   588             end
 
   590             end
 
   589         end
 
   591         end
 
   590 end;
 
   592 end;
 
   591 
   593 
   592 initialization
 
   594 initialization
sheepy-clone