hedgewars/uLand.pas
changeset 358 236bbd12d4d9
parent 351 29bc9c36ad5f
child 359 59fbfc65fbda
equal deleted inserted replaced
357:165a040e4cfa 358:236bbd12d4d9
    53        +inttostr(dig[3])+':'
    53        +inttostr(dig[3])+':'
    54        +inttostr(dig[4])+'}';
    54        +inttostr(dig[4])+'}';
    55 SendIPC('M' + s)
    55 SendIPC('M' + s)
    56 end;
    56 end;
    57 
    57 
       
    58 procedure DrawLine(X1, Y1, X2, Y2: integer; Color: Longword);
       
    59 var
       
    60   eX, eY, dX, dY: integer;
       
    61   i, sX, sY, x, y, d: integer;
       
    62 begin
       
    63 eX:= 0;
       
    64 eY:= 0;
       
    65 dX:= X2 - X1;
       
    66 dY:= Y2 - Y1;
       
    67 
       
    68 if (dX > 0) then sX:= 1
       
    69 else
       
    70   if (dX < 0) then
       
    71      begin
       
    72      sX:= -1;
       
    73      dX:= -dX
       
    74      end else sX:= dX;
       
    75 
       
    76 if (dY > 0) then sY:= 1
       
    77   else
       
    78   if (dY < 0) then
       
    79      begin
       
    80      sY:= -1;
       
    81      dY:= -dY
       
    82      end else sY:= dY;
       
    83 
       
    84 if (dX > dY) then d:= dX
       
    85              else d:= dY;
       
    86 
       
    87 x:= X1;
       
    88 y:= Y1;
       
    89  
       
    90 for i:= 0 to d do
       
    91     begin
       
    92     inc(eX, dX);
       
    93     inc(eY, dY);
       
    94     if (eX > d) then
       
    95        begin
       
    96        dec(eX, d);
       
    97        inc(x, sX);
       
    98        end;
       
    99     if (eY > d) then
       
   100        begin
       
   101        dec(eY, d);
       
   102        inc(y, sY);
       
   103        end;
       
   104        
       
   105     if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
       
   106        Land[y, x]:= Color;
       
   107     end
       
   108 end;
       
   109 
    58 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
   110 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
    59 var x, y, i: integer;
   111 const dT: hwFloat = (isNegative: false; QWordValue: 85899346);
       
   112 var x, y, i, px, py: integer;
    60     tx, ty, vx, vy, vlen, t: hwFloat;
   113     tx, ty, vx, vy, vlen, t: hwFloat;
    61     r1, r2, r3, r4: hwFloat;
   114     r1, r2, r3, r4: hwFloat;
    62     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: hwFloat;
   115     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: hwFloat;
    63 begin
   116 begin
    64 vx:= 0;
   117 vx:= 0;
    94     cy1:= ar[i].y   + hwRound(vy);
   147     cy1:= ar[i].y   + hwRound(vy);
    95     cx2:= ar[i+1].X + hwRound(tx);
   148     cx2:= ar[i+1].X + hwRound(tx);
    96     cy2:= ar[i+1].y + hwRound(ty);
   149     cy2:= ar[i+1].y + hwRound(ty);
    97     vx:= -tx;
   150     vx:= -tx;
    98     vy:= -ty;
   151     vy:= -ty;
    99     t:= 0;
   152     px:= hwRound(x1);
       
   153     py:= hwRound(y1);
       
   154     t:= dT;
   100     while t.Round = 0 do
   155     while t.Round = 0 do
   101           begin
   156           begin
   102           tsq:= t * t;
   157           tsq:= t * t;
   103           tcb:= tsq * t;
   158           tcb:= tsq * t;
   104           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
   159           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
   109           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
   164           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
   110           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
   165           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
   111           r3:= (          3*tsq - 3*tcb) * cy2;
   166           r3:= (          3*tsq - 3*tcb) * cy2;
   112           r4:= (                    tcb) * y2;
   167           r4:= (                    tcb) * y2;
   113           Y:= hwRound(r1 + r2 + r3 + r4);
   168           Y:= hwRound(r1 + r2 + r3 + r4);
   114           t:= t + _1div1024;
   169           t:= t + dT;
   115           if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
   170           DrawLine(px, py, x, y, Color);
   116                 Land[y, x]:= Color;
   171           px:= x;
   117           end;
   172           py:= y
   118     end;
       
   119 end;
       
   120 
       
   121 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
       
   122 var x, y, i: integer;
       
   123     tx, ty, vx, vy, vlen, t: hwFloat;
       
   124     r1, r2, r3, r4: hwFloat;
       
   125     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: hwFloat;
       
   126     opa: TPixAr;
       
   127 begin
       
   128 opa:= pa;
       
   129 pa.Count:= 0;
       
   130 vx:= 0;
       
   131 vy:= 0;
       
   132 with opa do
       
   133 for i:= 0 to Count-2 do
       
   134     begin
       
   135 addfilelog('50');
       
   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');
       
   139     if t<vlen then vlen:= t;
       
   140     vlen:= vlen * _1div3;
       
   141     tx:= ar[i+2].X - ar[i].X;
       
   142     ty:= ar[i+2].y - ar[i].y;
       
   143     t:= Distance(tx, ty);
       
   144     if t.QWordValue = 0 then
       
   145        begin
       
   146        tx:= -tx * 100000;
       
   147        ty:= -ty * 100000;
       
   148        end else
       
   149        begin
       
   150        t:= 1/t;
       
   151        tx:= -tx * t;
       
   152        ty:= -ty * t;
       
   153        end;
       
   154     t:= vlen;
       
   155     tx:= tx*t;
       
   156     ty:= ty*t;
       
   157     x1:= ar[i].x;
       
   158     y1:= ar[i].y;
       
   159     x2:= ar[i + 1].x;
       
   160     y2:= ar[i + 1].y;
       
   161     cx1:= ar[i].X   + hwRound(vx);
       
   162     cy1:= ar[i].y   + hwRound(vy);
       
   163     cx2:= ar[i+1].X + hwRound(tx);
       
   164     cy2:= ar[i+1].y + hwRound(ty);
       
   165     vx:= -tx;
       
   166     vy:= -ty;
       
   167     t:= 0;
       
   168     while t.Round = 0 do
       
   169           begin
       
   170           tsq:= t * t;
       
   171           tcb:= tsq * t;
       
   172           r1:= (1 - 3*t + 3*tsq -   tcb) * x1;
       
   173           r2:= (    3*t - 6*tsq + 3*tcb) * cx1;
       
   174           r3:= (          3*tsq - 3*tcb) * cx2;
       
   175           r4:= (                    tcb) * x2;
       
   176           X:= hwRound(r1 + r2 + r3 + r4);
       
   177           r1:= (1 - 3*t + 3*tsq -   tcb) * y1;
       
   178           r2:= (    3*t - 6*tsq + 3*tcb) * cy1;
       
   179           r3:= (          3*tsq - 3*tcb) * cy2;
       
   180           r4:= (                    tcb) * y2;
       
   181           Y:= hwRound(r1 + r2 + r3 + r4);
       
   182           t:= t + Delta;
       
   183           pa.ar[pa.Count].x:= X;
       
   184           pa.ar[pa.Count].y:= Y;
       
   185           inc(pa.Count);
       
   186           TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true)
       
   187           end;
   173           end;
   188     end;
   174     end;
   189 end;
   175 end;
   190 
   176 
   191 procedure FillLand(x, y: integer);
   177 procedure FillLand(x, y: integer);
   318       yd:= yu - 1;
   304       yd:= yu - 1;
   319     until yd < 0;
   305     until yd < 0;
   320     end;
   306     end;
   321 end;
   307 end;
   322 
   308 
   323 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   309 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
   324 const MAXPASSES = 32;
   310 var i: integer;
   325 var ar: array[0..MAXPASSES, 0..9] of hwFloat;
       
   326     i, k: integer;
       
   327     rx, ry, ox, oy: hwFloat;
       
   328     PassesNum: Longword;
       
   329 begin
   311 begin
   330 with Template do
   312 with Template do
   331      begin
   313      begin
   332      PassesNum:= PassMin + getrandom(PassDelta);
   314      pa.Count:= BasePointsCount;
   333      TryDo(PassesNum < MAXPASSES, 'Passes number too big', true);
   315      for i:= 0 to pred(pa.Count) do
   334      ar[0, 1]:= WaveFreqMin * _1div10000;
       
   335      ar[0, 4]:= WaveFreqMin * _1div10000;
       
   336      for i:= 1 to PassesNum do  // initialize random parameters
       
   337          begin
   316          begin
   338          ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta;
   317          pa.ar[i].x:= BasePoints^[i].x + integer(GetRandom(BasePoints^[i].w));
   339 //         ar[i, 1]:= ar[i - 1, 1] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
   318          pa.ar[i].y:= BasePoints^[i].y + integer(GetRandom(BasePoints^[i].h))
   340          ar[i, 1]:= ar[i - 1, 1] + (getrandom) * WaveFreqDelta;
       
   341          ar[i, 2]:= getrandom * hwPi * 2;
       
   342          ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta;
       
   343 //         ar[i, 4]:= ar[i - 1, 4] + (getrandom * 0.7 + 0.3) * WaveFreqDelta;
       
   344          ar[i, 4]:= ar[i - 1, 4] + (getrandom) * WaveFreqDelta;
       
   345          ar[i, 5]:= getrandom * hwPi * 2;
       
   346          ar[i, 6]:= ar[i, 1] * (getrandom * 2 - 1);
       
   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);
       
   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])));
       
   352          end;
   319          end;
   353      end;
   320          
   354 
   321      if canMirror then
   355 for k:= 0 to Pred(pa.Count) do  // apply transformation
   322         if getrandom(16) < 8 then
   356     begin
   323            begin
   357     rx:= pa.ar[k].x;
   324            for i:= 0 to pred(BasePointsCount) do
   358     ry:= pa.ar[k].y;
   325                BasePoints^[i].x:= 2047 - BasePoints^[i].x;
   359     for i:= 1 to PassesNum do
   326            for i:= 0 to pred(FillPointsCount) do
   360         begin
   327                FillPoints^[i].x:= 2047 - FillPoints^[i].x;
   361         ox:= rx;
   328            end;
   362         oy:= ry;
   329 
   363 //        ry:= ry; + ar[i, 0] * sin(ox * ar[i, 6] + oy * ar[i, 7] + ar[i, 2]);
   330      if canFlip then
   364 //        rx:= rx + ar[i, 3] * sin(ox * ar[i, 8] + oy * ar[i, 9] + ar[i, 5]);
   331         if getrandom(16) < 8 then
   365         end;
   332            begin
   366     pa.ar[k].x:= hwRound(rx);
   333            for i:= 0 to pred(BasePointsCount) do
   367     pa.ar[k].y:= hwRound(ry);
   334                BasePoints^[i].y:= 1023 - BasePoints^[i].y;
   368     end;
   335            for i:= 0 to pred(FillPointsCount) do
       
   336                FillPoints^[i].y:= 1023 - FillPoints^[i].y;
       
   337            end;
       
   338      end
   369 end;
   339 end;
   370 
   340 
   371 procedure NormalizePoints(var pa: TPixAr);
   341 procedure NormalizePoints(var pa: TPixAr);
   372 const brd = 32;
   342 const brd = 32;
   373 var isUP: boolean;  // HACK: transform for Y should be exact as one for X
   343 var isUP: boolean;  // HACK: transform for Y should be exact as one for X
   424 begin
   394 begin
   425 for y:= 0 to 1023 do
   395 for y:= 0 to 1023 do
   426     for x:= 0 to 2047 do
   396     for x:= 0 to 2047 do
   427         Land[y, x]:= COLOR_LAND;
   397         Land[y, x]:= COLOR_LAND;
   428 
   398 
       
   399 SetPoints(Template, pa);
       
   400 NormalizePoints(pa);
       
   401 
       
   402 DrawBezierEdge(pa, 0);
       
   403 
   429 with Template do
   404 with Template do
   430      begin
       
   431      if canMirror then
       
   432         if getrandom(16) < 8 then
       
   433            begin
       
   434            for i:= 0 to pred(BasePointsCount) do
       
   435                BasePoints^[i].x:= 2047 - BasePoints^[i].x;
       
   436            for i:= 0 to pred(FillPointsCount) do
       
   437                FillPoints^[i].x:= 2047 - FillPoints^[i].x;
       
   438            end;
       
   439 
       
   440      if canFlip then
       
   441         if getrandom(16) < 8 then
       
   442            begin
       
   443            for i:= 0 to pred(BasePointsCount) do
       
   444                BasePoints^[i].y:= 1023 - BasePoints^[i].y;
       
   445            for i:= 0 to pred(FillPointsCount) do
       
   446                FillPoints^[i].y:= 1023 - FillPoints^[i].y;
       
   447            end;
       
   448 
       
   449      pa.Count:= BasePointsCount;
       
   450      for i:= 0 to pred(pa.Count) do
       
   451          pa.ar[i]:= BasePoints^[i];
       
   452 
       
   453 //     for i:= 1 to BezPassCnt do
       
   454          BezierizeEdge(pa, _1div3);
       
   455 
       
   456      PointWave(Template, pa);
       
   457      NormalizePoints(pa);
       
   458      DrawBezierEdge(pa, 0);
       
   459 
       
   460      for i:= 0 to pred(FillPointsCount) do
   405      for i:= 0 to pred(FillPointsCount) do
   461          with FillPoints^[i] do
   406          with FillPoints^[i] do
   462               FillLand(x, y);
   407               FillLand(x, y);
   463 
   408 
   464      DrawBezierEdge(pa, COLOR_LAND);
   409 DrawBezierEdge(pa, COLOR_LAND)
   465      end;
       
   466 end;
   410 end;
   467 
   411 
   468 function SelectTemplate: integer;
   412 function SelectTemplate: integer;
   469 begin
   413 begin
   470 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))
   414 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))