hedgewars/uLand.pas
changeset 371 731ad6d27bd1
parent 368 fe71e55d2d7b
child 393 db01cc79f278
equal deleted inserted replaced
370:c75410fe3133 371:731ad6d27bd1
    66    digest:= s
    66    digest:= s
    67 else
    67 else
    68    TryDo(s = digest, 'Different maps generated, sorry', true)
    68    TryDo(s = digest, 'Different maps generated, sorry', true)
    69 end;
    69 end;
    70 
    70 
    71 procedure DrawLine(X1, Y1, X2, Y2: integer; Color: Longword);
    71 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    72 var
    72 var
    73   eX, eY, dX, dY: integer;
    73   eX, eY, dX, dY: LongInt;
    74   i, sX, sY, x, y, d: integer;
    74   i, sX, sY, x, y, d: LongInt;
    75 begin
    75 begin
    76 eX:= 0;
    76 eX:= 0;
    77 eY:= 0;
    77 eY:= 0;
    78 dX:= X2 - X1;
    78 dX:= X2 - X1;
    79 dY:= Y2 - Y1;
    79 dY:= Y2 - Y1;
   119        Land[y, x]:= Color;
   119        Land[y, x]:= Color;
   120     end
   120     end
   121 end;
   121 end;
   122 
   122 
   123 procedure DrawEdge(var pa: TPixAr; Color: Longword);
   123 procedure DrawEdge(var pa: TPixAr; Color: Longword);
   124 var i: integer;
   124 var i: LongInt;
   125 begin
   125 begin
   126 i:= 0;
   126 i:= 0;
   127 with pa do
   127 with pa do
   128 while i < integer(Count) - 1 do
   128 while i < LongInt(Count) - 1 do
   129     if (ar[i + 1].X = NTPX) then inc(i, 2)
   129     if (ar[i + 1].X = NTPX) then inc(i, 2)
   130        else begin
   130        else begin
   131        DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color);
   131        DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color);
   132        inc(i)
   132        inc(i)
   133        end
   133        end
   157    Vx:= Vx * d;
   157    Vx:= Vx * d;
   158    Vy:= Vy * d
   158    Vy:= Vy * d
   159    end
   159    end
   160 end;
   160 end;
   161 
   161 
   162 procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: integer; Delta: hwFloat);
   162 procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat);
   163 var i, pi, ni: integer;
   163 var i, pi, ni: LongInt;
   164     NVx, NVy, PVx, PVy: hwFloat;
   164     NVx, NVy, PVx, PVy: hwFloat;
   165     x1, x2, y1, y2, cx1, cx2, cy1, cy2: hwFloat;
   165     x1, x2, y1, y2, cx1, cx2, cy1, cy2: hwFloat;
   166     tsq, tcb, t, r1, r2, r3, r4: hwFloat;
   166     tsq, tcb, t, r1, r2, r3, r4: hwFloat;
   167     X, Y: integer;
   167     X, Y: LongInt;
   168 begin
   168 begin
   169 pi:= EndI;
   169 pi:= EndI;
   170 i:= StartI;
   170 i:= StartI;
   171 ni:= Succ(StartI);
   171 ni:= Succ(StartI);
   172 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   172 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
   215 pa.ar[pa.Count].y:= opa.ar[StartI].Y;
   215 pa.ar[pa.Count].y:= opa.ar[StartI].Y;
   216 inc(pa.Count)
   216 inc(pa.Count)
   217 end;
   217 end;
   218 
   218 
   219 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
   219 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat);
   220 var x, y, i, StartLoop: integer;
   220 var x, y, i, StartLoop: LongInt;
   221     opa: TPixAr;
   221     opa: TPixAr;
   222 begin
   222 begin
   223 opa:= pa;
   223 opa:= pa;
   224 pa.Count:= 0;
   224 pa.Count:= 0;
   225 i:= 0;
   225 i:= 0;
   226 StartLoop:= 0;
   226 StartLoop:= 0;
   227 while i < integer(opa.Count) do
   227 while i < LongInt(opa.Count) do
   228     if (opa.ar[i + 1].X = NTPX) then
   228     if (opa.ar[i + 1].X = NTPX) then
   229        begin
   229        begin
   230        AddLoopPoints(pa, opa, StartLoop, i, Delta);
   230        AddLoopPoints(pa, opa, StartLoop, i, Delta);
   231        inc(i, 2);
   231        inc(i, 2);
   232        StartLoop:= i;
   232        StartLoop:= i;
   233        pa.ar[pa.Count].X:= NTPX;
   233        pa.ar[pa.Count].X:= NTPX;
   234        inc(pa.Count);
   234        inc(pa.Count);
   235        end else inc(i)
   235        end else inc(i)
   236 end;
   236 end;
   237 
   237 
   238 procedure FillLand(x, y: integer);
   238 procedure FillLand(x, y: LongInt);
   239 var Stack: record
   239 var Stack: record
   240            Count: Longword;
   240            Count: Longword;
   241            points: array[0..8192] of record
   241            points: array[0..8192] of record
   242                                      xl, xr, y, dir: integer;
   242                                      xl, xr, y, dir: LongInt;
   243                                      end
   243                                      end
   244            end;
   244            end;
   245 
   245 
   246     procedure Push(_xl, _xr, _y, _dir: integer);
   246     procedure Push(_xl, _xr, _y, _dir: LongInt);
   247     begin
   247     begin
   248     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
   248     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
   249     _y:= _y + _dir;
   249     _y:= _y + _dir;
   250     if (_y < 0) or (_y > 1023) then exit;
   250     if (_y < 0) or (_y > 1023) then exit;
   251     with Stack.points[Stack.Count] do
   251     with Stack.points[Stack.Count] do
   256          dir:= _dir
   256          dir:= _dir
   257          end;
   257          end;
   258     inc(Stack.Count)
   258     inc(Stack.Count)
   259     end;
   259     end;
   260 
   260 
   261     procedure Pop(var _xl, _xr, _y, _dir: integer);
   261     procedure Pop(var _xl, _xr, _y, _dir: LongInt);
   262     begin
   262     begin
   263     dec(Stack.Count);
   263     dec(Stack.Count);
   264     with Stack.points[Stack.Count] do
   264     with Stack.points[Stack.Count] do
   265          begin
   265          begin
   266          _xl:= xl;
   266          _xl:= xl;
   268          _y:= y;
   268          _y:= y;
   269          _dir:= dir
   269          _dir:= dir
   270          end
   270          end
   271     end;
   271     end;
   272 
   272 
   273 var xl, xr, dir: integer;
   273 var xl, xr, dir: LongInt;
   274 begin
   274 begin
   275 Stack.Count:= 0;
   275 Stack.Count:= 0;
   276 xl:= x - 1;
   276 xl:= x - 1;
   277 xr:= x;
   277 xr:= x;
   278 Push(xl, xr, y, -1);
   278 Push(xl, xr, y, -1);
   326 end;
   326 end;
   327 
   327 
   328 procedure AddBorder(Surface: PSDL_Surface);
   328 procedure AddBorder(Surface: PSDL_Surface);
   329 var tmpsurf: PSDL_Surface;
   329 var tmpsurf: PSDL_Surface;
   330     r, rr: TSDL_Rect;
   330     r, rr: TSDL_Rect;
   331     x, yd, yu: integer;
   331     x, yd, yu: LongInt;
   332 begin
   332 begin
   333 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true);
   333 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true);
   334 for x:= 0 to 2047 do
   334 for x:= 0 to 2047 do
   335     begin
   335     begin
   336     yd:= 1023;
   336     yd:= 1023;
   366     until yd < 0;
   366     until yd < 0;
   367     end;
   367     end;
   368 end;
   368 end;
   369 
   369 
   370 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
   370 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
   371 var i: integer;
   371 var i: LongInt;
   372 begin
   372 begin
   373 with Template do
   373 with Template do
   374      begin
   374      begin
   375      pa.Count:= BasePointsCount;
   375      pa.Count:= BasePointsCount;
   376      for i:= 0 to pred(pa.Count) do
   376      for i:= 0 to pred(pa.Count) do
   377          begin
   377          begin
   378          pa.ar[i].x:= BasePoints^[i].x + integer(GetRandom(BasePoints^[i].w));
   378          pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
   379          pa.ar[i].y:= BasePoints^[i].y + integer(GetRandom(BasePoints^[i].h))
   379          pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h))
   380          end;
   380          end;
   381          
   381          
   382      if canMirror then
   382      if canMirror then
   383         if getrandom(2) = 0 then
   383         if getrandom(2) = 0 then
   384            begin
   384            begin
   398                FillPoints^[i].y:= 1023 - FillPoints^[i].y;
   398                FillPoints^[i].y:= 1023 - FillPoints^[i].y;
   399            end;
   399            end;
   400      end
   400      end
   401 end;
   401 end;
   402 
   402 
   403 procedure RandomizePoints(var pa: TPixAr; MaxRad: integer);
   403 procedure RandomizePoints(var pa: TPixAr; MaxRad: LongInt);
   404 const cEdge = 55;
   404 const cEdge = 55;
   405       cMinDist = 0;
   405       cMinDist = 0;
   406 var radz: array[0..Pred(cMaxEdgePoints)] of integer;
   406 var radz: array[0..Pred(cMaxEdgePoints)] of LongInt;
   407     i, k, dist: integer;
   407     i, k, dist: LongInt;
   408 begin
   408 begin
   409 radz[0]:= 0;
   409 radz[0]:= 0;
   410 for i:= 0 to Pred(pa.Count) do
   410 for i:= 0 to Pred(pa.Count) do
   411   with pa.ar[i] do
   411   with pa.ar[i] do
   412     if x <> NTPX then
   412     if x <> NTPX then
   424 
   424 
   425 for i:= 0 to Pred(pa.Count) do
   425 for i:= 0 to Pred(pa.Count) do
   426   with pa.ar[i] do
   426   with pa.ar[i] do
   427     if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
   427     if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
   428       begin
   428       begin
   429       x:= x + integer(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
   429       x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3;
   430       y:= y + integer(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3
   430       y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3
   431       end
   431       end
   432 end;
   432 end;
   433 
   433 
   434 
   434 
   435 procedure GenBlank(var Template: TEdgeTemplate);
   435 procedure GenBlank(var Template: TEdgeTemplate);
   456               FillLand(x, y);
   456               FillLand(x, y);
   457 
   457 
   458 DrawEdge(pa, COLOR_LAND)
   458 DrawEdge(pa, COLOR_LAND)
   459 end;
   459 end;
   460 
   460 
   461 function SelectTemplate: integer;
   461 function SelectTemplate: LongInt;
   462 begin
   462 begin
   463 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))
   463 SelectTemplate:= getrandom(Succ(High(EdgeTemplates)))
   464 end;
   464 end;
   465 
   465 
   466 procedure GenLandSurface;
   466 procedure GenLandSurface;
   562 AddProgress;
   562 AddProgress;
   563 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   563 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   564 end;
   564 end;
   565 
   565 
   566 procedure GenPreview;
   566 procedure GenPreview;
   567 var x, y, xx, yy, t, bit: integer;
   567 var x, y, xx, yy, t, bit: LongInt;
   568 begin
   568 begin
   569 WriteLnToConsole('Generating preview...');
   569 WriteLnToConsole('Generating preview...');
   570 GenBlank(EdgeTemplates[SelectTemplate]);
   570 GenBlank(EdgeTemplates[SelectTemplate]);
   571 
   571 
   572 for y:= 0 to 127 do
   572 for y:= 0 to 127 do