# HG changeset patch # User unc0rr # Date 1322949167 -10800 # Node ID 531bf083e8db2f460ba60f33ec20a2e263418f84 # Parent e1f0058cfedd9a78148985f0a34ad36a1f184154 - Give uLand more modularity - Get rid of some more nested functions diff -r e1f0058cfedd -r 531bf083e8db hedgewars/GSHandlers.inc --- a/hedgewars/GSHandlers.inc Sat Dec 03 22:21:23 2011 +0300 +++ b/hedgewars/GSHandlers.inc Sun Dec 04 00:52:47 2011 +0300 @@ -2890,24 +2890,23 @@ end; +procedure PrevAngle(Gear: PGear; dA: LongInt); +begin + Gear^.Angle := (LongInt(Gear^.Angle) + 4 - dA) mod 4 +end; + +procedure NextAngle(Gear: PGear; dA: LongInt); +begin + Gear^.Angle := (LongInt(Gear^.Angle) + 4 + dA) mod 4 +end; + procedure doStepCakeWork(Gear: PGear); const dirs: array[0..3] of TPoint = ((x: 0; y: -1), (x: 1; y: 0),(x: 0; y: 1),(x: -1; y: 0)); var xx, yy, xxn, yyn: LongInt; - da: LongInt; + dA: LongInt; tdx, tdy: hwFloat; - -procedure PrevAngle; -begin - Gear^.Angle := (LongInt(Gear^.Angle) + 4 - dA) mod 4 -end; - -procedure NextAngle; -begin - Gear^.Angle := (LongInt(Gear^.Angle) + 4 + dA) mod 4 -end; - begin AllInactive := false; @@ -2922,7 +2921,7 @@ if (xx = 0) then if TestCollisionYwithGear(Gear, yy) <> 0 then - PrevAngle + PrevAngle(Gear, dA) else begin Gear^.Tag := 0; @@ -2930,13 +2929,13 @@ if not TestCollisionXwithGear(Gear, xxn) then begin Gear^.X := Gear^.X + int2hwFloat(xxn); - NextAngle + NextAngle(Gear, dA) end; end; if (yy = 0) then if TestCollisionXwithGear(Gear, xx) then - PrevAngle + PrevAngle(Gear, dA) else begin Gear^.Tag := 0; @@ -2944,7 +2943,7 @@ if not TestCollisionY(Gear, yyn) then begin Gear^.Y := Gear^.Y + int2hwFloat(yyn); - NextAngle + NextAngle(Gear, dA) end; end; @@ -4134,10 +4133,7 @@ end; end; -procedure doStepMovingPortal_real(Gear: PGear); -var - x, y, tx, ty: LongInt; - s: hwFloat; + procedure loadNewPortalBall(oldPortal: PGear; destroyGear: Boolean); var @@ -4165,6 +4161,10 @@ if destroyGear then oldPortal^.Timer:= 0; end; +procedure doStepMovingPortal_real(Gear: PGear); +var + x, y, tx, ty: LongInt; + s: hwFloat; begin x := hwRound(Gear^.X); y := hwRound(Gear^.Y); diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uGearsRender.pas --- a/hedgewars/uGearsRender.pas Sat Dec 03 22:21:23 2011 +0300 +++ b/hedgewars/uGearsRender.pas Sun Dec 04 00:52:47 2011 +0300 @@ -74,20 +74,16 @@ end; -procedure DrawRope(Gear: PGear); -var roplen: LongInt; - i: Longword; - - procedure DrawRopeLine(X1, Y1, X2, Y2: LongInt); - var eX, eY, dX, dY: LongInt; - i, sX, sY, x, y, d: LongInt; - b: boolean; - begin +procedure DrawRopeLine(X1, Y1, X2, Y2, roplen: LongInt); +var eX, eY, dX, dY: LongInt; + i, sX, sY, x, y, d: LongInt; + b: boolean; +begin if (X1 = X2) and (Y1 = Y2) then - begin - //OutError('WARNING: zero length rope line!', false); - exit - end; + begin + //OutError('WARNING: zero length rope line!', false); + exit + end; eX:= 0; eY:= 0; dX:= X2 - X1; @@ -101,44 +97,50 @@ dX:= -dX end else sX:= dX; - if (dY > 0) then sY:= 1 + if (dY > 0) then + sY:= 1 else - if (dY < 0) then - begin - sY:= -1; - dY:= -dY - end else sY:= dY; - - if (dX > dY) then d:= dX - else d:= dY; - - x:= X1; - y:= Y1; - - for i:= 0 to d do + if (dY < 0) then begin - inc(eX, dX); - inc(eY, dY); - b:= false; - if (eX > d) then - begin - dec(eX, d); - inc(x, sX); - b:= true - end; - if (eY > d) then - begin - dec(eY, d); - inc(y, sY); - b:= true - end; - if b then - begin - inc(roplen); - if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x - 2, y - 2, 0) - end - end - end; + sY:= -1; + dY:= -dY + end else + sY:= dY; + + if (dX > dY) then d:= dX + else d:= dY; + + x:= X1; + y:= Y1; + + for i:= 0 to d do + begin + inc(eX, dX); + inc(eY, dY); + b:= false; + if (eX > d) then + begin + dec(eX, d); + inc(x, sX); + b:= true + end; + if (eY > d) then + begin + dec(eY, d); + inc(y, sY); + b:= true + end; + if b then + begin + inc(roplen); + if (roplen mod 4) = 0 then DrawSprite(sprRopeNode, x - 2, y - 2, 0) + end + end +end; + +procedure DrawRope(Gear: PGear); +var roplen: LongInt; + i: Longword; begin if (cReducedQuality and rqSimpleRope) <> 0 then DrawRopeLinesRQ(Gear) @@ -151,17 +153,17 @@ while i < Pred(RopePoints.Count) do begin DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy, - hwRound(RopePoints.ar[Succ(i)].X) + WorldDx, hwRound(RopePoints.ar[Succ(i)].Y) + WorldDy); + hwRound(RopePoints.ar[Succ(i)].X) + WorldDx, hwRound(RopePoints.ar[Succ(i)].Y) + WorldDy, roplen); inc(i) end; DrawRopeLine(hwRound(RopePoints.ar[i].X) + WorldDx, hwRound(RopePoints.ar[i].Y) + WorldDy, - hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy); + hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, roplen); DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, - hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy); + hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy, roplen); end else if Gear^.Elasticity.QWordValue > 0 then DrawRopeLine(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, - hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy); + hwRound(Gear^.Hedgehog^.Gear^.X) + WorldDx, hwRound(Gear^.Hedgehog^.Gear^.Y) + WorldDy, roplen); end; diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uGearsUtils.pas --- a/hedgewars/uGearsUtils.pas Sat Dec 03 22:21:23 2011 +0300 +++ b/hedgewars/uGearsUtils.pas Sun Dec 04 00:52:47 2011 +0300 @@ -422,23 +422,21 @@ RecountTeamHealth(tempTeam); end; +function CountNonZeroz(x, y, r, c: LongInt): LongInt; +var i: LongInt; + count: LongInt = 0; +begin +if (y and LAND_HEIGHT_MASK) = 0 then + for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do + if Land[y, i] <> 0 then + begin + inc(count); + if count = c then exit(count) + end; +CountNonZeroz:= count; +end; procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean); - - function CountNonZeroz(x, y, r, c: LongInt): LongInt; - var i: LongInt; - count: LongInt = 0; - begin - if (y and LAND_HEIGHT_MASK) = 0 then - for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do - if Land[y, i] <> 0 then - begin - inc(count); - if count = c then exit(count) - end; - CountNonZeroz:= count; - end; - var x: LongInt; y, sy: LongInt; ar: array[0..511] of TPoint; diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uLand.pas --- a/hedgewars/uLand.pas Sat Dec 03 22:21:23 2011 +0300 +++ b/hedgewars/uLand.pas Sun Dec 04 00:52:47 2011 +0300 @@ -22,12 +22,6 @@ interface uses SDLh, uLandTemplates, uFloat, uConsts, GLunit, uTypes; -type direction = record x, y: LongInt; end; -const DIR_N: direction = (x: 0; y: -1); - DIR_E: direction = (x: 1; y: 0); - DIR_S: direction = (x: 0; y: 1); - DIR_W: direction = (x: -1; y: 0); - procedure initModule; procedure freeModule; procedure DrawBottomBorder; @@ -36,248 +30,9 @@ implementation uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils, - uVariables, uUtils, uCommands, Adler32, uDebug, uLandPainted, uTextures; - -operator = (const a, b: direction) c: Boolean; -begin - c := (a.x = b.x) and (a.y = b.y); -end; - -type TPixAr = record - Count: Longword; - ar: array[0..Pred(cMaxEdgePoints)] of TPoint; - end; - -procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); -var - eX, eY, dX, dY: LongInt; - i, sX, sY, x, y, d: LongInt; -begin -eX:= 0; -eY:= 0; -dX:= X2 - X1; -dY:= Y2 - Y1; - -if (dX > 0) then sX:= 1 -else - if (dX < 0) then - begin - sX:= -1; - dX:= -dX - end else sX:= dX; - -if (dY > 0) then sY:= 1 - else - if (dY < 0) then - begin - sY:= -1; - dY:= -dY - end else sY:= dY; - -if (dX > dY) then d:= dX - else d:= dY; - -x:= X1; -y:= Y1; - -for i:= 0 to d do - begin - inc(eX, dX); - inc(eY, dY); - if (eX > d) then - begin - dec(eX, d); - inc(x, sX); - end; - if (eY > d) then - begin - dec(eY, d); - inc(y, sY); - end; - - if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then - Land[y, x]:= Color; - end -end; - -procedure DrawEdge(var pa: TPixAr; Color: Longword); -var i: LongInt; -begin -i:= 0; -with pa do -while i < LongInt(Count) - 1 do - if (ar[i + 1].X = NTPX) then inc(i, 2) - else begin - DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color); - inc(i) - end -end; - -procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat); -var d1, d2, d: hwFloat; -begin -Vx:= int2hwFloat(p1.X - p3.X); -Vy:= int2hwFloat(p1.Y - p3.Y); -d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y); -d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y); -d2:= Distance(Vx, Vy); -if d1 < d then d:= d1; -if d2 < d then d:= d2; -d:= d * _1div3; -if d2.QWordValue = 0 then - begin - Vx:= _0; - Vy:= _0 - end else - begin - d2:= _1 / d2; - Vx:= Vx * d2; - Vy:= Vy * d2; - - Vx:= Vx * d; - Vy:= Vy * d - end -end; + uVariables, uUtils, uCommands, Adler32, uDebug, uLandPainted, uTextures, + uLandGraphics, uLandGenMaze, uLandOutline; -procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat); -var i, pi, ni: LongInt; - NVx, NVy, PVx, PVy: hwFloat; - x1, x2, y1, y2: LongInt; - tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat; - X, Y: LongInt; -begin -pi:= EndI; -i:= StartI; -ni:= Succ(StartI); -{$HINTS OFF} -Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); -{$HINTS ON} -repeat - inc(pi); - if pi > EndI then pi:= StartI; - inc(i); - if i > EndI then i:= StartI; - inc(ni); - if ni > EndI then ni:= StartI; - PVx:= NVx; - PVy:= NVy; - Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); - - x1:= opa.ar[pi].x; - y1:= opa.ar[pi].y; - x2:= opa.ar[i].x; - y2:= opa.ar[i].y; - cx1:= int2hwFloat(x1) - PVx; - cy1:= int2hwFloat(y1) - PVy; - cx2:= int2hwFloat(x2) + NVx; - cy2:= int2hwFloat(y2) + NVy; - t:= _0; - while t.Round = 0 do - begin - tsq:= t * t; - tcb:= tsq * t; - r1:= (_1 - t*3 + tsq*3 - tcb); - r2:= ( t*3 - tsq*6 + tcb*3); - r3:= ( tsq*3 - tcb*3); - X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2); - Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2); - t:= t + Delta; - pa.ar[pa.Count].x:= X; - pa.ar[pa.Count].y:= Y; - inc(pa.Count); - TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true) - end; -until i = StartI; -pa.ar[pa.Count].x:= opa.ar[StartI].X; -pa.ar[pa.Count].y:= opa.ar[StartI].Y; -inc(pa.Count) -end; - -procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); -var i, StartLoop: LongInt; - opa: TPixAr; -begin -opa:= pa; -pa.Count:= 0; -i:= 0; -StartLoop:= 0; -while i < LongInt(opa.Count) do - if (opa.ar[i + 1].X = NTPX) then - begin - AddLoopPoints(pa, opa, StartLoop, i, Delta); - inc(i, 2); - StartLoop:= i; - pa.ar[pa.Count].X:= NTPX; - pa.ar[pa.Count].Y:= 0; - inc(pa.Count); - end else inc(i) -end; - -procedure FillLand(x, y: LongInt); -var Stack: record - Count: Longword; - points: array[0..8192] of record - xl, xr, y, dir: LongInt; - end - end; - - procedure Push(_xl, _xr, _y, _dir: LongInt); - begin - TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true); - _y:= _y + _dir; - if (_y < 0) or (_y >= LAND_HEIGHT) then exit; - with Stack.points[Stack.Count] do - begin - xl:= _xl; - xr:= _xr; - y:= _y; - dir:= _dir - end; - inc(Stack.Count) - end; - - procedure Pop(var _xl, _xr, _y, _dir: LongInt); - begin - dec(Stack.Count); - with Stack.points[Stack.Count] do - begin - _xl:= xl; - _xr:= xr; - _y:= y; - _dir:= dir - end - end; - -var xl, xr, dir: LongInt; -begin -Stack.Count:= 0; -xl:= x - 1; -xr:= x; -Push(xl, xr, y, -1); -Push(xl, xr, y, 1); -dir:= 0; -while Stack.Count > 0 do - begin - Pop(xl, xr, y, dir); - while (xl > 0) and (Land[y, xl] <> 0) do dec(xl); - while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr); - while (xl < xr) do - begin - while (xl <= xr) and (Land[y, xl] = 0) do inc(xl); - x:= xl; - while (xl <= xr) and (Land[y, xl] <> 0) do - begin - Land[y, xl]:= 0; - inc(xl) - end; - if x < xl then - begin - Push(x, Pred(xl), y, dir); - Push(x, Pred(xl), y,-dir); - end; - end; - end; -end; procedure ColorizeLand(Surface: PSDL_Surface); var tmpsurf: PSDL_Surface; @@ -417,84 +172,6 @@ end end; -function CheckIntersect(V1, V2, V3, V4: TPoint): boolean; -var c1, c2, dm: LongInt; -begin -dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y); -c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x); -if dm = 0 then exit(false); - -c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x); -if dm > 0 then - begin - if (c1 < 0) or (c1 > dm) then exit(false); - if (c2 < 0) or (c2 > dm) then exit(false) - end else - begin - if (c1 > 0) or (c1 < dm) then exit(false); - if (c2 > 0) or (c2 < dm) then exit(false) - end; - -//AddFileLog('1 (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')'); -//AddFileLog('2 (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')'); -CheckIntersect:= true -end; - -function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean; -var i: Longword; -begin -if (ind <= 0) or (ind >= Pred(pa.Count)) then exit(false); -for i:= 1 to pa.Count - 3 do - if (i <= ind - 1) or (i >= ind + 2) then - begin - if (i <> ind - 1) and - CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then exit(true); - if (i <> ind + 2) and - CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then exit(true); - end; -CheckSelfIntersect:= false -end; - -procedure RandomizePoints(var pa: TPixAr); -const cEdge = 55; - cMinDist = 8; -var radz: array[0..Pred(cMaxEdgePoints)] of LongInt; - i, k, dist, px, py: LongInt; -begin -for i:= 0 to Pred(pa.Count) do - begin - radz[i]:= 0; - with pa.ar[i] do - if x <> NTPX then - begin - radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0)); - radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0))); - if radz[i] > 0 then - for k:= 0 to Pred(i) do - begin - dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y)); - radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k])); - radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i])) - end - end; - end; - -for i:= 0 to Pred(pa.Count) do - with pa.ar[i] do - if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then - begin - px:= x; - py:= y; - x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; - y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; - if CheckSelfIntersect(pa, i) then - begin - x:= px; - y:= py - end; - end -end; - procedure GenBlank(var Template: TEdgeTemplate); var pa: TPixAr; @@ -610,437 +287,6 @@ SDL_UnlockSurface(Surface); end; -procedure GenMaze; -const small_cell_size = 128; - medium_cell_size = 192; - large_cell_size = 256; - braidness = 10; - -var x, y: LongInt; - cellsize: LongInt; //selected by the user in the gui - seen_cells_x, seen_cells_y: LongInt; //number of cells that can be visited by the generator, that is every second cell in x and y direction. the cells between there are walls that will be removed when we move from one cell to another - num_edges_x, num_edges_y: LongInt; //number of resulting edges that need to be vertexificated - num_cells_x, num_cells_y: LongInt; //actual number of cells, depending on cell size - seen_list: array of array of LongInt; - xwalls: array of array of Boolean; - ywalls: array of array of Boolean; - x_edge_list: array of array of Boolean; - y_edge_list: array of array of Boolean; - maze: array of array of Boolean; - pa: TPixAr; - num_vertices: LongInt; - off_y: LongInt; - num_steps: LongInt; - current_step: LongInt; - step_done: array of Boolean; - done: Boolean; - last_cell: array of record x, y: LongInt; end; - came_from: array of array of record x, y: LongInt; end; - came_from_pos: array of LongInt; - maze_inverted: Boolean; - -function when_seen(x: LongInt; y: LongInt): LongInt; -begin -if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then - when_seen := current_step -else - when_seen := seen_list[x, y]; -end; - -function is_x_edge(x, y: LongInt): Boolean; -begin -if (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then - is_x_edge := false -else - is_x_edge := x_edge_list[x, y]; -end; - -function is_y_edge(x, y: LongInt): Boolean; -begin -if (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then - is_y_edge := false -else - is_y_edge := y_edge_list[x, y]; -end; - -procedure see_cell; -var dir: direction; - tries: LongInt; - x, y: LongInt; - found_cell: Boolean; - next_dir_clockwise: Boolean; - -begin -x := last_cell[current_step].x; -y := last_cell[current_step].y; -seen_list[x, y] := current_step; -case GetRandom(4) of - 0: dir := DIR_N; - 1: dir := DIR_E; - 2: dir := DIR_S; - 3: dir := DIR_W; -end; -tries := 0; -found_cell := false; -if getrandom(2) = 1 then next_dir_clockwise := true -else next_dir_clockwise := false; - -while (tries < 5) and (not found_cell) do -begin - if when_seen(x + dir.x, y + dir.y) = current_step then //we are seeing ourselves, try another direction - begin - //we have already seen the target cell, decide if we should remove the wall anyway - //(or put a wall there if maze_inverted, but we are not doing that right now) - if not maze_inverted and (GetRandom(braidness) = 0) then - //or just warn that inverted+braid+indestructible terrain != good idea - begin - case dir.x of - -1: if x > 0 then ywalls[x-1, y] := false; - 1: if x < seen_cells_x - 1 then ywalls[x, y] := false; - end; - case dir.y of - -1: if y > 0 then xwalls[x, y-1] := false; - 1: if y < seen_cells_y - 1 then xwalls[x, y] := false; - end; - end; - if next_dir_clockwise then - begin - if dir = DIR_N then - dir := DIR_E - else if dir = DIR_E then - dir := DIR_S - else if dir = DIR_S then - dir := DIR_W - else - dir := DIR_N; - end - else - begin - if dir = DIR_N then - dir := DIR_W - else if dir = DIR_E then - dir := DIR_N - else if dir = DIR_S then - dir := DIR_E - else - dir := DIR_S; - end - end - else if when_seen(x + dir.x, y + dir.y) = -1 then //cell was not seen yet, go there - begin - case dir.y of - -1: xwalls[x, y-1] := false; - 1: xwalls[x, y] := false; - end; - case dir.x of - -1: ywalls[x-1, y] := false; - 1: ywalls[x, y] := false; - end; - last_cell[current_step].x := x+dir.x; - last_cell[current_step].y := y+dir.y; - came_from_pos[current_step] := came_from_pos[current_step] + 1; - came_from[current_step, came_from_pos[current_step]].x := x; - came_from[current_step, came_from_pos[current_step]].y := y; - found_cell := true; - end - else //we are seeing someone else, quit - begin - step_done[current_step] := true; - found_cell := true; - end; - - tries := tries + 1; -end; -if not found_cell then -begin - last_cell[current_step].x := came_from[current_step, came_from_pos[current_step]].x; - last_cell[current_step].y := came_from[current_step, came_from_pos[current_step]].y; - came_from_pos[current_step] := came_from_pos[current_step] - 1; - if came_from_pos[current_step] >= 0 then see_cell - else step_done[current_step] := true; -end; -end; - -procedure add_vertex(x, y: LongInt); -var tmp_x, tmp_y: LongInt; -begin -if x = NTPX then -begin - if pa.ar[num_vertices - 6].x = NTPX then - begin - num_vertices := num_vertices - 6; - end - else - begin - pa.ar[num_vertices].x := NTPX; - pa.ar[num_vertices].y := 0; - end -end -else -begin - if maze_inverted or (x mod 2 = 0) then tmp_x := cellsize - else tmp_x := cellsize * 2 div 3; - if maze_inverted or (y mod 2 = 0) then tmp_y := cellsize - else tmp_y := cellsize * 2 div 3; - - pa.ar[num_vertices].x := (x-1)*cellsize + tmp_x; - pa.ar[num_vertices].y := (y-1)*cellsize + tmp_y + off_y; -end; -num_vertices := num_vertices + 1; -end; - -procedure add_edge(x, y: LongInt; dir: direction); -var i: LongInt; -begin -if dir = DIR_N then -begin - dir := DIR_W -end -else if dir = DIR_E then -begin - dir := DIR_N -end -else if dir = DIR_S then -begin - dir := DIR_E -end -else -begin - dir := DIR_S; -end; - -for i := 0 to 3 do -begin - if dir = DIR_N then - dir := DIR_E - else if dir = DIR_E then - dir := DIR_S - else if dir = DIR_S then - dir := DIR_W - else - dir := DIR_N; - - if (dir = DIR_N) and is_x_edge(x, y) then - begin - x_edge_list[x, y] := false; - add_vertex(x+1, y); - add_edge(x, y-1, DIR_N); - break; - end; - - if (dir = DIR_E) and is_y_edge(x+1, y) then - begin - y_edge_list[x+1, y] := false; - add_vertex(x+2, y+1); - add_edge(x+1, y, DIR_E); - break; - end; - - if (dir = DIR_S) and is_x_edge(x, y+1) then - begin - x_edge_list[x, y+1] := false; - add_vertex(x+1, y+2); - add_edge(x, y+1, DIR_S); - break; - end; - - if (dir = DIR_W) and is_y_edge(x, y) then - begin - y_edge_list[x, y] := false; - add_vertex(x, y+1); - add_edge(x-1, y, DIR_W); - break; - end; -end; - -end; - -begin -case cTemplateFilter of - 0: begin - cellsize := small_cell_size; - maze_inverted := false; - end; - 1: begin - cellsize := medium_cell_size; - maze_inverted := false; - end; - 2: begin - cellsize := large_cell_size; - maze_inverted := false; - end; - 3: begin - cellsize := small_cell_size; - maze_inverted := true; - end; - 4: begin - cellsize := medium_cell_size; - maze_inverted := true; - end; - 5: begin - cellsize := large_cell_size; - maze_inverted := true; - end; -end; - -num_cells_x := LAND_WIDTH div cellsize; -if not odd(num_cells_x) then num_cells_x := num_cells_x - 1; //needs to be odd -num_cells_y := LAND_HEIGHT div cellsize; -if not odd(num_cells_y) then num_cells_y := num_cells_y - 1; -num_edges_x := num_cells_x - 1; -num_edges_y := num_cells_y - 1; -seen_cells_x := num_cells_x div 2; -seen_cells_y := num_cells_y div 2; - -if maze_inverted then - num_steps := 3 //TODO randomize, between 3 and 5? -else - num_steps := 1; -SetLength(step_done, num_steps); -SetLength(last_cell, num_steps); -SetLength(came_from_pos, num_steps); -SetLength(came_from, num_steps, num_cells_x*num_cells_y); -done := false; -for current_step := 0 to num_steps - 1 do - step_done[current_step] := false; - came_from_pos[current_step] := 0; -current_step := 0; - -SetLength(seen_list, seen_cells_x, seen_cells_y); -SetLength(xwalls, seen_cells_x, seen_cells_y - 1); -SetLength(ywalls, seen_cells_x - 1, seen_cells_y); -SetLength(x_edge_list, num_edges_x, num_cells_y); -SetLength(y_edge_list, num_cells_x, num_edges_y); -SetLength(maze, num_cells_x, num_cells_y); - -num_vertices := 0; - -playHeight := num_cells_y * cellsize; -playWidth := num_cells_x * cellsize; -off_y := LAND_HEIGHT - playHeight; - -for x := 0 to playWidth do - for y := 0 to off_y - 1 do - Land[y, x] := 0; - -for x := 0 to playWidth do - for y := off_y to LAND_HEIGHT - 1 do - Land[y, x] := lfBasic; - -for y := 0 to num_cells_y - 1 do - for x := 0 to num_cells_x - 1 do - maze[x, y] := false; - -for x := 0 to seen_cells_x - 1 do - for y := 0 to seen_cells_y - 2 do - xwalls[x, y] := true; - -for x := 0 to seen_cells_x - 2 do - for y := 0 to seen_cells_y - 1 do - ywalls[x, y] := true; - -for x := 0 to seen_cells_x - 1 do - for y := 0 to seen_cells_y - 1 do - seen_list[x, y] := -1; - -for x := 0 to num_edges_x - 1 do - for y := 0 to num_cells_y - 1 do - x_edge_list[x, y] := false; - -for x := 0 to num_cells_x - 1 do - for y := 0 to num_edges_y - 1 do - y_edge_list[x, y] := false; - -for current_step := 0 to num_steps-1 do -begin - x := GetRandom(seen_cells_x - 1) div LongWord(num_steps); - last_cell[current_step].x := x + current_step * seen_cells_x div num_steps; - last_cell[current_step].y := GetRandom(seen_cells_y); -end; - -while not done do -begin - done := true; - for current_step := 0 to num_steps-1 do - begin - if not step_done[current_step] then - begin - see_cell; - done := false; - end; - end; -end; - -for x := 0 to seen_cells_x - 1 do - for y := 0 to seen_cells_y - 1 do - if seen_list[x, y] > -1 then - maze[(x+1)*2-1, (y+1)*2-1] := true; - -for x := 0 to seen_cells_x - 1 do - for y := 0 to seen_cells_y - 2 do - if not xwalls[x, y] then - maze[x*2 + 1, y*2 + 2] := true; - - -for x := 0 to seen_cells_x - 2 do - for y := 0 to seen_cells_y - 1 do - if not ywalls[x, y] then - maze[x*2 + 2, y*2 + 1] := true; - -for x := 0 to num_edges_x - 1 do - for y := 0 to num_cells_y - 1 do - if maze[x, y] xor maze[x+1, y] then - x_edge_list[x, y] := true - else - x_edge_list[x, y] := false; - -for x := 0 to num_cells_x - 1 do - for y := 0 to num_edges_y - 1 do - if maze[x, y] xor maze[x, y+1] then - y_edge_list[x, y] := true - else - y_edge_list[x, y] := false; - -for x := 0 to num_edges_x - 1 do - for y := 0 to num_cells_y - 1 do - if x_edge_list[x, y] then - begin - x_edge_list[x, y] := false; - add_vertex(x+1, y+1); - add_vertex(x+1, y); - add_edge(x, y-1, DIR_N); - add_vertex(NTPX, 0); - end; - -pa.count := num_vertices; - -RandomizePoints(pa); -BezierizeEdge(pa, _0_25); -RandomizePoints(pa); -BezierizeEdge(pa, _0_25); - -DrawEdge(pa, 0); - -if maze_inverted then - FillLand(1, 1+off_y) -else -begin - x := 0; - while Land[cellsize div 2 + cellsize + off_y, x] = lfBasic do - x := x + 1; - while Land[cellsize div 2 + cellsize + off_y, x] = 0 do - x := x + 1; - FillLand(x+1, cellsize div 2 + cellsize + off_y); -end; - -MaxHedgehogs:= 32; -if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false -else hasGirders := true; -leftX:= 0; -rightX:= playWidth; -topY:= off_y; -hasBorder := false; -end; procedure GenLandSurface; var tmpsurf: PSDL_Surface; diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uLandGenMaze.pas --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hedgewars/uLandGenMaze.pas Sun Dec 04 00:52:47 2011 +0300 @@ -0,0 +1,455 @@ +unit uLandGenMaze; + +interface + +procedure GenMaze; + +implementation + +uses uRandom, uLandOutline, uLandTemplates, uVariables, uFloat, uConsts; + +type direction = record x, y: LongInt; end; +const DIR_N: direction = (x: 0; y: -1); + DIR_E: direction = (x: 1; y: 0); + DIR_S: direction = (x: 0; y: 1); + DIR_W: direction = (x: -1; y: 0); + + +operator = (const a, b: direction) c: Boolean; +begin + c := (a.x = b.x) and (a.y = b.y); +end; + +const small_cell_size = 128; + medium_cell_size = 192; + large_cell_size = 256; + braidness = 10; + +var x, y: LongInt; + cellsize: LongInt; //selected by the user in the gui + seen_cells_x, seen_cells_y: LongInt; //number of cells that can be visited by the generator, that is every second cell in x and y direction. the cells between there are walls that will be removed when we move from one cell to another + num_edges_x, num_edges_y: LongInt; //number of resulting edges that need to be vertexificated + num_cells_x, num_cells_y: LongInt; //actual number of cells, depending on cell size + seen_list: array of array of LongInt; + xwalls: array of array of Boolean; + ywalls: array of array of Boolean; + x_edge_list: array of array of Boolean; + y_edge_list: array of array of Boolean; + maze: array of array of Boolean; + pa: TPixAr; + num_vertices: LongInt; + off_y: LongInt; + num_steps: LongInt; + current_step: LongInt; + step_done: array of Boolean; + done: Boolean; + last_cell: array of record x, y: LongInt; end; + came_from: array of array of record x, y: LongInt; end; + came_from_pos: array of LongInt; + maze_inverted: Boolean; + +function when_seen(x: LongInt; y: LongInt): LongInt; +begin +if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then + when_seen := current_step +else + when_seen := seen_list[x, y]; +end; + +function is_x_edge(x, y: LongInt): Boolean; +begin +if (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then + is_x_edge := false +else + is_x_edge := x_edge_list[x, y]; +end; + +function is_y_edge(x, y: LongInt): Boolean; +begin +if (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then + is_y_edge := false +else + is_y_edge := y_edge_list[x, y]; +end; + +procedure see_cell; +var dir: direction; + tries: LongInt; + x, y: LongInt; + found_cell: Boolean; + next_dir_clockwise: Boolean; + +begin +x := last_cell[current_step].x; +y := last_cell[current_step].y; +seen_list[x, y] := current_step; +case GetRandom(4) of + 0: dir := DIR_N; + 1: dir := DIR_E; + 2: dir := DIR_S; + 3: dir := DIR_W; +end; +tries := 0; +found_cell := false; +if getrandom(2) = 1 then next_dir_clockwise := true +else next_dir_clockwise := false; + +while (tries < 5) and (not found_cell) do +begin + if when_seen(x + dir.x, y + dir.y) = current_step then //we are seeing ourselves, try another direction + begin + //we have already seen the target cell, decide if we should remove the wall anyway + //(or put a wall there if maze_inverted, but we are not doing that right now) + if not maze_inverted and (GetRandom(braidness) = 0) then + //or just warn that inverted+braid+indestructible terrain != good idea + begin + case dir.x of + -1: if x > 0 then ywalls[x-1, y] := false; + 1: if x < seen_cells_x - 1 then ywalls[x, y] := false; + end; + case dir.y of + -1: if y > 0 then xwalls[x, y-1] := false; + 1: if y < seen_cells_y - 1 then xwalls[x, y] := false; + end; + end; + if next_dir_clockwise then + begin + if dir = DIR_N then + dir := DIR_E + else if dir = DIR_E then + dir := DIR_S + else if dir = DIR_S then + dir := DIR_W + else + dir := DIR_N; + end + else + begin + if dir = DIR_N then + dir := DIR_W + else if dir = DIR_E then + dir := DIR_N + else if dir = DIR_S then + dir := DIR_E + else + dir := DIR_S; + end + end + else if when_seen(x + dir.x, y + dir.y) = -1 then //cell was not seen yet, go there + begin + case dir.y of + -1: xwalls[x, y-1] := false; + 1: xwalls[x, y] := false; + end; + case dir.x of + -1: ywalls[x-1, y] := false; + 1: ywalls[x, y] := false; + end; + last_cell[current_step].x := x+dir.x; + last_cell[current_step].y := y+dir.y; + came_from_pos[current_step] := came_from_pos[current_step] + 1; + came_from[current_step, came_from_pos[current_step]].x := x; + came_from[current_step, came_from_pos[current_step]].y := y; + found_cell := true; + end + else //we are seeing someone else, quit + begin + step_done[current_step] := true; + found_cell := true; + end; + + tries := tries + 1; +end; +if not found_cell then +begin + last_cell[current_step].x := came_from[current_step, came_from_pos[current_step]].x; + last_cell[current_step].y := came_from[current_step, came_from_pos[current_step]].y; + came_from_pos[current_step] := came_from_pos[current_step] - 1; + if came_from_pos[current_step] >= 0 then see_cell + else step_done[current_step] := true; +end; +end; + +procedure add_vertex(x, y: LongInt); +var tmp_x, tmp_y: LongInt; +begin +if x = NTPX then +begin + if pa.ar[num_vertices - 6].x = NTPX then + begin + num_vertices := num_vertices - 6; + end + else + begin + pa.ar[num_vertices].x := NTPX; + pa.ar[num_vertices].y := 0; + end +end +else +begin + if maze_inverted or (x mod 2 = 0) then tmp_x := cellsize + else tmp_x := cellsize * 2 div 3; + if maze_inverted or (y mod 2 = 0) then tmp_y := cellsize + else tmp_y := cellsize * 2 div 3; + + pa.ar[num_vertices].x := (x-1)*cellsize + tmp_x; + pa.ar[num_vertices].y := (y-1)*cellsize + tmp_y + off_y; +end; +num_vertices := num_vertices + 1; +end; + +procedure add_edge(x, y: LongInt; dir: direction); +var i: LongInt; +begin +if dir = DIR_N then +begin + dir := DIR_W +end +else if dir = DIR_E then +begin + dir := DIR_N +end +else if dir = DIR_S then +begin + dir := DIR_E +end +else +begin + dir := DIR_S; +end; + +for i := 0 to 3 do +begin + if dir = DIR_N then + dir := DIR_E + else if dir = DIR_E then + dir := DIR_S + else if dir = DIR_S then + dir := DIR_W + else + dir := DIR_N; + + if (dir = DIR_N) and is_x_edge(x, y) then + begin + x_edge_list[x, y] := false; + add_vertex(x+1, y); + add_edge(x, y-1, DIR_N); + break; + end; + + if (dir = DIR_E) and is_y_edge(x+1, y) then + begin + y_edge_list[x+1, y] := false; + add_vertex(x+2, y+1); + add_edge(x+1, y, DIR_E); + break; + end; + + if (dir = DIR_S) and is_x_edge(x, y+1) then + begin + x_edge_list[x, y+1] := false; + add_vertex(x+1, y+2); + add_edge(x, y+1, DIR_S); + break; + end; + + if (dir = DIR_W) and is_y_edge(x, y) then + begin + y_edge_list[x, y] := false; + add_vertex(x, y+1); + add_edge(x-1, y, DIR_W); + break; + end; +end; + +end; + +procedure GenMaze; +begin +case cTemplateFilter of + 0: begin + cellsize := small_cell_size; + maze_inverted := false; + end; + 1: begin + cellsize := medium_cell_size; + maze_inverted := false; + end; + 2: begin + cellsize := large_cell_size; + maze_inverted := false; + end; + 3: begin + cellsize := small_cell_size; + maze_inverted := true; + end; + 4: begin + cellsize := medium_cell_size; + maze_inverted := true; + end; + 5: begin + cellsize := large_cell_size; + maze_inverted := true; + end; +end; + +num_cells_x := LAND_WIDTH div cellsize; +if not odd(num_cells_x) then num_cells_x := num_cells_x - 1; //needs to be odd +num_cells_y := LAND_HEIGHT div cellsize; +if not odd(num_cells_y) then num_cells_y := num_cells_y - 1; +num_edges_x := num_cells_x - 1; +num_edges_y := num_cells_y - 1; +seen_cells_x := num_cells_x div 2; +seen_cells_y := num_cells_y div 2; + +if maze_inverted then + num_steps := 3 //TODO randomize, between 3 and 5? +else + num_steps := 1; +SetLength(step_done, num_steps); +SetLength(last_cell, num_steps); +SetLength(came_from_pos, num_steps); +SetLength(came_from, num_steps, num_cells_x*num_cells_y); +done := false; +for current_step := 0 to num_steps - 1 do + step_done[current_step] := false; + came_from_pos[current_step] := 0; +current_step := 0; + +SetLength(seen_list, seen_cells_x, seen_cells_y); +SetLength(xwalls, seen_cells_x, seen_cells_y - 1); +SetLength(ywalls, seen_cells_x - 1, seen_cells_y); +SetLength(x_edge_list, num_edges_x, num_cells_y); +SetLength(y_edge_list, num_cells_x, num_edges_y); +SetLength(maze, num_cells_x, num_cells_y); + +num_vertices := 0; + +playHeight := num_cells_y * cellsize; +playWidth := num_cells_x * cellsize; +off_y := LAND_HEIGHT - playHeight; + +for x := 0 to playWidth do + for y := 0 to off_y - 1 do + Land[y, x] := 0; + +for x := 0 to playWidth do + for y := off_y to LAND_HEIGHT - 1 do + Land[y, x] := lfBasic; + +for y := 0 to num_cells_y - 1 do + for x := 0 to num_cells_x - 1 do + maze[x, y] := false; + +for x := 0 to seen_cells_x - 1 do + for y := 0 to seen_cells_y - 2 do + xwalls[x, y] := true; + +for x := 0 to seen_cells_x - 2 do + for y := 0 to seen_cells_y - 1 do + ywalls[x, y] := true; + +for x := 0 to seen_cells_x - 1 do + for y := 0 to seen_cells_y - 1 do + seen_list[x, y] := -1; + +for x := 0 to num_edges_x - 1 do + for y := 0 to num_cells_y - 1 do + x_edge_list[x, y] := false; + +for x := 0 to num_cells_x - 1 do + for y := 0 to num_edges_y - 1 do + y_edge_list[x, y] := false; + +for current_step := 0 to num_steps-1 do +begin + x := GetRandom(seen_cells_x - 1) div LongWord(num_steps); + last_cell[current_step].x := x + current_step * seen_cells_x div num_steps; + last_cell[current_step].y := GetRandom(seen_cells_y); +end; + +while not done do +begin + done := true; + for current_step := 0 to num_steps-1 do + begin + if not step_done[current_step] then + begin + see_cell; + done := false; + end; + end; +end; + +for x := 0 to seen_cells_x - 1 do + for y := 0 to seen_cells_y - 1 do + if seen_list[x, y] > -1 then + maze[(x+1)*2-1, (y+1)*2-1] := true; + +for x := 0 to seen_cells_x - 1 do + for y := 0 to seen_cells_y - 2 do + if not xwalls[x, y] then + maze[x*2 + 1, y*2 + 2] := true; + + +for x := 0 to seen_cells_x - 2 do + for y := 0 to seen_cells_y - 1 do + if not ywalls[x, y] then + maze[x*2 + 2, y*2 + 1] := true; + +for x := 0 to num_edges_x - 1 do + for y := 0 to num_cells_y - 1 do + if maze[x, y] xor maze[x+1, y] then + x_edge_list[x, y] := true + else + x_edge_list[x, y] := false; + +for x := 0 to num_cells_x - 1 do + for y := 0 to num_edges_y - 1 do + if maze[x, y] xor maze[x, y+1] then + y_edge_list[x, y] := true + else + y_edge_list[x, y] := false; + +for x := 0 to num_edges_x - 1 do + for y := 0 to num_cells_y - 1 do + if x_edge_list[x, y] then + begin + x_edge_list[x, y] := false; + add_vertex(x+1, y+1); + add_vertex(x+1, y); + add_edge(x, y-1, DIR_N); + add_vertex(NTPX, 0); + end; + +pa.count := num_vertices; + +RandomizePoints(pa); +BezierizeEdge(pa, _0_25); +RandomizePoints(pa); +BezierizeEdge(pa, _0_25); + +DrawEdge(pa, 0); + +if maze_inverted then + FillLand(1, 1+off_y) +else +begin + x := 0; + while Land[cellsize div 2 + cellsize + off_y, x] = lfBasic do + x := x + 1; + while Land[cellsize div 2 + cellsize + off_y, x] = 0 do + x := x + 1; + FillLand(x+1, cellsize div 2 + cellsize + off_y); +end; + +MaxHedgehogs:= 32; +if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false +else hasGirders := true; +leftX:= 0; +rightX:= playWidth; +topY:= off_y; +hasBorder := false; +end; + +end. diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uLandGraphics.pas --- a/hedgewars/uLandGraphics.pas Sat Dec 03 22:21:23 2011 +0300 +++ b/hedgewars/uLandGraphics.pas Sun Dec 04 00:52:47 2011 +0300 @@ -38,6 +38,7 @@ procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean); function LandBackPixel(x, y: LongInt): LongWord; +procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean; @@ -962,4 +963,56 @@ end; +procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); +var + eX, eY, dX, dY: LongInt; + i, sX, sY, x, y, d: LongInt; +begin +eX:= 0; +eY:= 0; +dX:= X2 - X1; +dY:= Y2 - Y1; + +if (dX > 0) then sX:= 1 +else + if (dX < 0) then + begin + sX:= -1; + dX:= -dX + end else sX:= dX; + +if (dY > 0) then sY:= 1 + else + if (dY < 0) then + begin + sY:= -1; + dY:= -dY + end else sY:= dY; + +if (dX > dY) then d:= dX + else d:= dY; + +x:= X1; +y:= Y1; + +for i:= 0 to d do + begin + inc(eX, dX); + inc(eY, dY); + if (eX > d) then + begin + dec(eX, d); + inc(x, sX); + end; + if (eY > d) then + begin + dec(eY, d); + inc(y, sY); + end; + + if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then + Land[y, x]:= Color; + end +end; + end. diff -r e1f0058cfedd -r 531bf083e8db hedgewars/uLandOutline.pas --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hedgewars/uLandOutline.pas Sun Dec 04 00:52:47 2011 +0300 @@ -0,0 +1,292 @@ +unit uLandOutline; + +interface + +uses uConsts, SDLh, uFloat; + +type TPixAr = record + Count: Longword; + ar: array[0..Pred(cMaxEdgePoints)] of TPoint; + end; + +procedure DrawEdge(var pa: TPixAr; Color: Longword); +procedure FillLand(x, y: LongInt); +procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); +procedure RandomizePoints(var pa: TPixAr); + +implementation + +uses uLandGraphics, uDebug, uVariables, uLandTemplates, uMisc, uRandom, uUtils; + + + +var Stack: record + Count: Longword; + points: array[0..8192] of record + xl, xr, y, dir: LongInt; + end + end; + +procedure Push(_xl, _xr, _y, _dir: LongInt); +begin + TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true); + _y:= _y + _dir; + if (_y < 0) or (_y >= LAND_HEIGHT) then exit; + with Stack.points[Stack.Count] do + begin + xl:= _xl; + xr:= _xr; + y:= _y; + dir:= _dir + end; + inc(Stack.Count) +end; + +procedure Pop(var _xl, _xr, _y, _dir: LongInt); +begin + dec(Stack.Count); + with Stack.points[Stack.Count] do + begin + _xl:= xl; + _xr:= xr; + _y:= y; + _dir:= dir + end +end; + +procedure FillLand(x, y: LongInt); +var xl, xr, dir: LongInt; +begin + Stack.Count:= 0; + xl:= x - 1; + xr:= x; + Push(xl, xr, y, -1); + Push(xl, xr, y, 1); + dir:= 0; + while Stack.Count > 0 do + begin + Pop(xl, xr, y, dir); + while (xl > 0) and (Land[y, xl] <> 0) do dec(xl); + while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr); + while (xl < xr) do + begin + while (xl <= xr) and (Land[y, xl] = 0) do inc(xl); + x:= xl; + while (xl <= xr) and (Land[y, xl] <> 0) do + begin + Land[y, xl]:= 0; + inc(xl) + end; + if x < xl then + begin + Push(x, Pred(xl), y, dir); + Push(x, Pred(xl), y,-dir); + end; + end; + end; +end; + +procedure DrawEdge(var pa: TPixAr; Color: Longword); +var i: LongInt; +begin + i:= 0; + with pa do + while i < LongInt(Count) - 1 do + if (ar[i + 1].X = NTPX) then + inc(i, 2) + else + begin + DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color); + inc(i) + end +end; + + +procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat); +var d1, d2, d: hwFloat; +begin + Vx:= int2hwFloat(p1.X - p3.X); + Vy:= int2hwFloat(p1.Y - p3.Y); + + d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y); + d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y); + d2:= Distance(Vx, Vy); + + if d1 < d then d:= d1; + if d2 < d then d:= d2; + + d:= d * _1div3; + + if d2.QWordValue = 0 then + begin + Vx:= _0; + Vy:= _0 + end + else + begin + d2:= _1 / d2; + Vx:= Vx * d2; + Vy:= Vy * d2; + + Vx:= Vx * d; + Vy:= Vy * d + end +end; + +procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat); +var i, pi, ni: LongInt; + NVx, NVy, PVx, PVy: hwFloat; + x1, x2, y1, y2: LongInt; + tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat; + X, Y: LongInt; +begin +pi:= EndI; +i:= StartI; +ni:= Succ(StartI); +{$HINTS OFF} +Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); +{$HINTS ON} +repeat + inc(pi); + if pi > EndI then pi:= StartI; + inc(i); + if i > EndI then i:= StartI; + inc(ni); + if ni > EndI then ni:= StartI; + PVx:= NVx; + PVy:= NVy; + Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); + + x1:= opa.ar[pi].x; + y1:= opa.ar[pi].y; + x2:= opa.ar[i].x; + y2:= opa.ar[i].y; + cx1:= int2hwFloat(x1) - PVx; + cy1:= int2hwFloat(y1) - PVy; + cx2:= int2hwFloat(x2) + NVx; + cy2:= int2hwFloat(y2) + NVy; + t:= _0; + while t.Round = 0 do + begin + tsq:= t * t; + tcb:= tsq * t; + r1:= (_1 - t*3 + tsq*3 - tcb); + r2:= ( t*3 - tsq*6 + tcb*3); + r3:= ( tsq*3 - tcb*3); + X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2); + Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2); + t:= t + Delta; + pa.ar[pa.Count].x:= X; + pa.ar[pa.Count].y:= Y; + inc(pa.Count); + TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true) + end; +until i = StartI; +pa.ar[pa.Count].x:= opa.ar[StartI].X; +pa.ar[pa.Count].y:= opa.ar[StartI].Y; +inc(pa.Count) +end; + +procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); +var i, StartLoop: LongInt; + opa: TPixAr; +begin +opa:= pa; +pa.Count:= 0; +i:= 0; +StartLoop:= 0; +while i < LongInt(opa.Count) do + if (opa.ar[i + 1].X = NTPX) then + begin + AddLoopPoints(pa, opa, StartLoop, i, Delta); + inc(i, 2); + StartLoop:= i; + pa.ar[pa.Count].X:= NTPX; + pa.ar[pa.Count].Y:= 0; + inc(pa.Count); + end else inc(i) +end; + + +function CheckIntersect(V1, V2, V3, V4: TPoint): boolean; +var c1, c2, dm: LongInt; +begin + dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y); + c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x); + if dm = 0 then exit(false); + + c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x); + if dm > 0 then + begin + if (c1 < 0) or (c1 > dm) then exit(false); + if (c2 < 0) or (c2 > dm) then exit(false) + end + else + begin + if (c1 > 0) or (c1 < dm) then exit(false); + if (c2 > 0) or (c2 < dm) then exit(false) + end; + + //AddFileLog('1 (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')'); + //AddFileLog('2 (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')'); + CheckIntersect:= true +end; + + +function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean; +var i: Longword; +begin + if (ind <= 0) or (ind >= Pred(pa.Count)) then exit(false); + for i:= 1 to pa.Count - 3 do + if (i <= ind - 1) or (i >= ind + 2) then + begin + if (i <> ind - 1) and + CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then exit(true); + if (i <> ind + 2) and + CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then exit(true); + end; + CheckSelfIntersect:= false +end; + +procedure RandomizePoints(var pa: TPixAr); +const cEdge = 55; + cMinDist = 8; +var radz: array[0..Pred(cMaxEdgePoints)] of LongInt; + i, k, dist, px, py: LongInt; +begin + for i:= 0 to Pred(pa.Count) do + begin + radz[i]:= 0; + with pa.ar[i] do + if x <> NTPX then + begin + radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0)); + radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0))); + if radz[i] > 0 then + for k:= 0 to Pred(i) do + begin + dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y)); + radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k])); + radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i])) + end + end; + end; + + for i:= 0 to Pred(pa.Count) do + with pa.ar[i] do + if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then + begin + px:= x; + py:= y; + x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; + y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; + if CheckSelfIntersect(pa, i) then + begin + x:= px; + y:= py + end; + end +end; + + +end. \ No newline at end of file