This map has always been broken. This variant makes it slightly less broken (although something changed on the ceiling might prevent hiding on pixels on the slope). What will finally fix it is either moving nets closer together or adding angle bounce to hedgehogs or some other layout that prevents hiding.
(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2005-2008 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
*)
{$INCLUDE "options.inc"}
unit uLand;
interface
uses SDLh, uLandTemplates, uFloat, uConsts, GLunit;
type TLandArray = packed array[0 .. LAND_HEIGHT - 1, 0 .. LAND_WIDTH - 1] of LongWord;
TCollisionArray = packed array[0 .. LAND_HEIGHT - 1, 0 .. LAND_WIDTH - 1] of Word;
TPreview = packed array[0..127, 0..31] of byte;
TDirtyTag = packed array[0 .. LAND_HEIGHT div 32 - 1, 0 .. LAND_WIDTH div 32 - 1] of byte;
var Land: TCollisionArray;
LandPixels: TLandArray;
LandDirty: TDirtyTag;
hasBorder: boolean;
hasGirders: boolean;
isMap: boolean;
playHeight, playWidth, leftX, rightX, topY, MaxHedgehogs: Longword; // idea is that a template can specify height/width. Or, a map, a height/width by the dimensions of the image. If the map has pixels near top of image, it triggers border.
LandBackSurface: PSDL_Surface;
type direction = record x, y: integer; end;
var DIR_N: direction = (x: 0; y: -1);
var DIR_E: direction = (x: 1; y: 0);
var DIR_S: direction = (x: 0; y: 1);
var DIR_W: direction = (x: -1; y: 0);
var DIR_NONE: direction = (x: 0; y: 0);
procedure initModule;
procedure freeModule;
procedure GenMap;
function GenPreview: TPreview;
procedure CheckLandDigest(s: shortstring);
function LandBackPixel(x, y: LongInt): LongWord;
implementation
uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO, uAmmos, uLandTexture;
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 LogLandDigest;
var ctx: TSHA1Context;
dig: TSHA1Digest;
s: shortstring;
begin
SHA1Init(ctx);
SHA1UpdateLongwords(ctx, @Land, sizeof(Land) div 4);
dig:= SHA1Final(ctx);
s:='M{'+inttostr(dig[0])+':'
+inttostr(dig[1])+':'
+inttostr(dig[2])+':'
+inttostr(dig[3])+':'
+inttostr(dig[4])+'}';
CheckLandDigest(s);
SendIPCRaw(@s[0], Length(s) + 1)
end;
procedure CheckLandDigest(s: shortstring);
const digest: shortstring = '';
begin
{$IFDEF DEBUGFILE}
AddFileLog('CheckLandDigest: ' + s);
{$ENDIF}
if digest = '' then
digest:= s
else
TryDo(s = digest, 'Different maps generated, sorry', true)
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;
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);
Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy);
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;
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);
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;
function LandBackPixel(x, y: LongInt): LongWord;
var p: PLongWordArray;
begin
if LandBackSurface = nil then LandBackPixel:= 0
else
begin
p:= LandBackSurface^.pixels;
LandBackPixel:= p^[LandBackSurface^.w * (y mod LandBackSurface^.h) + (x mod LandBackSurface^.w)];// or $FF000000;
end
end;
procedure ColorizeLand(Surface: PSDL_Surface);
var tmpsurf: PSDL_Surface;
r, rr: TSDL_Rect;
x, yd, yu: LongInt;
begin
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);
r.y:= 0;
while r.y < LAND_HEIGHT do
begin
r.x:= 0;
while r.x < LAND_WIDTH do
begin
SDL_UpperBlit(tmpsurf, nil, Surface, @r);
inc(r.x, tmpsurf^.w)
end;
inc(r.y, tmpsurf^.h)
end;
SDL_FreeSurface(tmpsurf);
// freed in freeModule() below
LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);
for x:= 0 to LAND_WIDTH - 1 do
begin
yd:= LAND_HEIGHT - 1;
repeat
while (yd > 0) and (Land[yd, x] = 0) do dec(yd);
if (yd < 0) then yd:= 0;
while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);
dec(yd);
yu:= yd;
while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu);
while (yu < yd ) and (Land[yu, x] = 0) do inc(yu);
if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
begin
rr.x:= x;
rr.y:= yd - 15;
r.x:= x mod tmpsurf^.w;
r.y:= 16;
r.w:= 1;
r.h:= 16;
SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
end;
if (yu > 0) then
begin
rr.x:= x;
rr.y:= yu;
r.x:= x mod tmpsurf^.w;
r.y:= 0;
r.w:= 1;
r.h:= min(16, yd - yu + 1);
SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
end;
yd:= yu - 1;
until yd < 0;
end;
SDL_FreeSurface(tmpsurf);
end;
procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
var i: LongInt;
begin
with Template do
begin
pa.Count:= BasePointsCount;
for i:= 0 to pred(pa.Count) do
begin
pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
if pa.ar[i].x <> NTPX then
pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);
pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - Template.TemplateHeight
end;
if canMirror then
if getrandom(2) = 0 then
begin
for i:= 0 to pred(BasePointsCount) do
if pa.ar[i].x <> NTPX then
pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x;
for i:= 0 to pred(FillPointsCount) do
FillPoints^[i].x:= LAND_WIDTH - 1 - FillPoints^[i].x;
end;
(* Experiment in making this option more useful
if ((not isNegative) and (cTemplateFilter = 4)) or
(canFlip and (getrandom(2) = 0)) then
begin
for i:= 0 to pred(BasePointsCount) do
begin
pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
if pa.ar[i].y > LAND_HEIGHT - 1 then
pa.ar[i].y:= LAND_HEIGHT - 1;
end;
for i:= 0 to pred(FillPointsCount) do
begin
FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
if FillPoints^[i].y > LAND_HEIGHT - 1 then
FillPoints^[i].y:= LAND_HEIGHT - 1;
end;
end;
end
*)
// template recycling. Pull these off the floor a bit
if (not isNegative) and (cTemplateFilter = 4) then
begin
for i:= 0 to pred(BasePointsCount) do
begin
dec(pa.ar[i].y, 100);
if pa.ar[i].y < 0 then
pa.ar[i].y:= 0;
end;
for i:= 0 to pred(FillPointsCount) do
begin
dec(FillPoints^[i].y, 100);
if FillPoints^[i].y < 0 then
FillPoints^[i].y:= 0;
end;
end;
if (canFlip and (getrandom(2) = 0)) then
begin
for i:= 0 to pred(BasePointsCount) do
pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y;
for i:= 0 to pred(FillPointsCount) do
FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y;
end;
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
radz[0]:= 0;
for i:= 0 to Pred(pa.Count) do
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;
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;
i: Longword;
y, x: Longword;
begin
for y:= 0 to LAND_HEIGHT - 1 do
for x:= 0 to LAND_WIDTH - 1 do
Land[y, x]:= COLOR_LAND;
SetPoints(Template, pa);
for i:= 1 to Template.BezierizeCount do
begin
BezierizeEdge(pa, _0_5);
RandomizePoints(pa);
RandomizePoints(pa)
end;
for i:= 1 to Template.RandPassesCount do RandomizePoints(pa);
BezierizeEdge(pa, _0_1);
DrawEdge(pa, 0);
with Template do
for i:= 0 to pred(FillPointsCount) do
with FillPoints^[i] do
FillLand(x, y);
DrawEdge(pa, COLOR_LAND);
MaxHedgehogs:= Template.MaxHedgehogs;
hasGirders:= Template.hasGirders;
playHeight:= Template.TemplateHeight;
playWidth:= Template.TemplateWidth;
leftX:= ((LAND_WIDTH - playWidth) div 2);
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
topY:= LAND_HEIGHT - playHeight;
// force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ?
if (cTemplateFilter = 4) or
(Template.canInvert and (getrandom(2) = 0)) or
(not Template.canInvert and Template.isNegative) then
begin
hasBorder:= true;
for y:= 0 to LAND_HEIGHT - 1 do
for x:= 0 to LAND_WIDTH - 1 do
if (y < topY) or (x < leftX) or (x > rightX) then
Land[y, x]:= 0
else
begin
if Land[y, x] = 0 then
Land[y, x]:= COLOR_LAND
else if Land[y, x] = COLOR_LAND then
Land[y, x]:= 0;
end;
end;
end;
function SelectTemplate: LongInt;
begin
case cTemplateFilter of
0: begin
SelectTemplate:= getrandom(Succ(High(EdgeTemplates)));
end;
1: begin
SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))];
end;
2: begin
SelectTemplate:= MediumTemplates[getrandom(Succ(High(MediumTemplates)))];
end;
3: begin
SelectTemplate:= LargeTemplates[getrandom(Succ(High(LargeTemplates)))];
end;
4: begin
SelectTemplate:= CavernTemplates[getrandom(Succ(High(CavernTemplates)))];
end;
5: begin
SelectTemplate:= WackyTemplates[getrandom(Succ(High(WackyTemplates)))];
end;
end;
WriteLnToConsole('Selected template #'+inttostr(SelectTemplate)+' using filter #'+inttostr(cTemplateFilter));
end;
procedure LandSurface2LandPixels(Surface: PSDL_Surface);
var x, y: LongInt;
p: PLongwordArray;
begin
TryDo(Surface <> nil, 'Assert (LandSurface <> nil) failed', true);
if SDL_MustLock(Surface) then
SDLTry(SDL_LockSurface(Surface) >= 0, true);
p:= Surface^.pixels;
for y:= 0 to LAND_HEIGHT - 1 do
begin
for x:= 0 to LAND_WIDTH - 1 do
if Land[y, x] <> 0 then LandPixels[y, x]:= p^[x] or AMask;
p:= @(p^[Surface^.pitch div 4]);
end;
if SDL_MustLock(Surface) then
SDL_UnlockSurface(Surface);
end;
procedure GenMaze;
const small_cell_size = 128;
medium_cell_size = 192;
large_cell_size = 256;
braidness = 10;
maze_inverted = false; //false makes more sense for now
var x, y: Longint;
bg_color, fg_color: 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
start_x, start_y: Longint; //first visited cell, must be between 0 and seen_cells_x/y - 1 inclusive
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 Boolean;
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;
function is_cell_seen(x: Longint; y: Longint): Boolean;
begin
if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then
is_cell_seen := true
else
is_cell_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(x: Longint; y: Longint);
var dir: direction;
tries: Longint;
begin
seen_list[x, y] := true;
case GetRandom(4) of
0: dir := DIR_N;
1: dir := DIR_E;
2: dir := DIR_S;
3: dir := DIR_W;
end;
tries := 0;
while (tries < 5) do
begin
if is_cell_seen(x + dir.x, y + dir.y) then
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're not doing that right now)
if not maze_inverted and (GetRandom(braidness) = 0) then
//or just warn that inverted+braid+indestructable 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 dir = DIR_N then //TODO might want to randomize that
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 //cell wasn't 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;
see_cell(x + dir.x, y + dir.y);
end;
tries := tries + 1;
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 x mod 2 = 0 then tmp_x := cellsize
else tmp_x := cellsize * 2 div 3;
if 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: integer;
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 cMazeSize of
0: cellsize := small_cell_size;
1: cellsize := medium_cell_size;
2: cellsize := large_cell_size;
end;
num_cells_x := LAND_WIDTH div cellsize;
if num_cells_x mod 2 = 0 then num_cells_x := num_cells_x - 1; //needs to be odd
num_cells_y := LAND_HEIGHT div cellsize;
if num_cells_y mod 2 = 0 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;
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;
(*
TODO - Inverted maze
if maze_inverted then
begin
bg_color := 0;
fg_color := COLOR_LAND;
end
else
begin*)
bg_color := COLOR_LAND;
fg_color := 0;
//end;
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] := fg_color;
for x := 0 to playWidth do
for y := off_y to LAND_HEIGHT - 1 do
Land[y, x] := bg_color;
for y := 0 to num_cells_y - 1 do
for x := 0 to num_cells_x - 1 do
maze[x, y] := false;
start_x := GetRandom(seen_cells_x);
start_y := GetRandom(seen_cells_y);
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] := false;
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;
see_cell(start_x, start_y);
for x := 0 to seen_cells_x - 1 do
for y := 0 to seen_cells_y - 1 do
if seen_list[x, y] 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);
x := 0;
while Land[cellsize div 2 + cellsize + off_y, x] = bg_color do
x := x + 1;
while Land[cellsize div 2 + cellsize + off_y, x] = fg_color do
x := x + 1;
FillLand(x+1, cellsize div 2 + cellsize + off_y);
MaxHedgehogs:= 32;
if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false
else hasGirders := true;
leftX:= 0;
rightX:= playWidth;
topY:= off_y;
hasBorder := true;
end;
procedure GenLandSurface;
var tmpsurf: PSDL_Surface;
begin
WriteLnToConsole('Generating land...');
case cMapGen of
0: GenBlank(EdgeTemplates[SelectTemplate]);
1: GenMaze;
end;
AddProgress();
tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
ColorizeLand(tmpsurf);
AddOnLandObjects(tmpsurf);
LandSurface2LandPixels(tmpsurf);
SDL_FreeSurface(tmpsurf);
AddProgress();
end;
procedure MakeFortsMap;
var tmpsurf: PSDL_Surface;
begin
MaxHedgehogs:= 32;
// For now, defining a fort is playable area as 3072x1200 - there are no tall forts. The extra height is to avoid triggering border with current code, also if user turns on a border, it will give a bit more maneuvering room.
playHeight:= 1200;
playWidth:= 2560;
leftX:= (LAND_WIDTH - playWidth) div 2;
rightX:= ((playWidth + (LAND_WIDTH - playWidth) div 2) - 1);
topY:= LAND_HEIGHT - playHeight;
WriteLnToConsole('Generating forts land...');
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
BlitImageAndGenerateCollisionInfo(leftX+150, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
SDL_FreeSurface(tmpsurf);
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
SDL_FreeSurface(tmpsurf);
end;
// Hi unC0Rr.
// This is a function that Tiy assures me would not be good for gameplay.
// It allows the setting of arbitrary portions of landscape as indestructible, or regular, or even blank.
// He said I could add it here only when I swore it would not impact gameplay. Which, as far as I can tell, is true.
// I would just like to play with it with my friends if you do not mind.
// Can allow for amusing maps.
procedure LoadMask;
var tmpsurf: PSDL_Surface;
p: PLongwordArray;
x, y, cpX, cpY: Longword;
begin
tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then
begin
cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
cpY:= LAND_HEIGHT - tmpsurf^.h;
if SDL_MustLock(tmpsurf) then
SDLTry(SDL_LockSurface(tmpsurf) >= 0, true);
p:= tmpsurf^.pixels;
for y:= 0 to Pred(tmpsurf^.h) do
begin
for x:= 0 to Pred(tmpsurf^.w) do
begin
if ((AMask and p^[x]) = 0) then // Tiy was having trouble generating transparent black
Land[cpY + y, cpX + x]:= 0
else if p^[x] = (AMask or RMask) then
Land[cpY + y, cpX + x]:= COLOR_INDESTRUCTIBLE
else if p^[x] = $FFFFFFFF then
Land[cpY + y, cpX + x]:= COLOR_LAND;
end;
p:= @(p^[tmpsurf^.pitch div 4]);
end;
if SDL_MustLock(tmpsurf) then
SDL_UnlockSurface(tmpsurf);
end;
if (tmpsurf <> nil) then
SDL_FreeSurface(tmpsurf);
end;
procedure LoadMap;
var tmpsurf: PSDL_Surface;
s: shortstring;
f: textfile;
begin
isMap:= true;
WriteLnToConsole('Loading land from file...');
AddProgress;
tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true);
// unC0Rr - should this be passed from the GUI? I am not sure which layer does what
s:= Pathz[ptMapCurrent] + '/map.cfg';
WriteLnToConsole('Fetching map HH limit');
Assign(f, s);
filemode:= 0; // readonly
Reset(f);
Readln(f);
if not eof(f) then Readln(f, MaxHedgehogs);
if (MaxHedgehogs = 0) then MaxHedgehogs:= 18;
playHeight:= tmpsurf^.h;
playWidth:= tmpsurf^.w;
leftX:= (LAND_WIDTH - playWidth) div 2;
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
topY:= LAND_HEIGHT - playHeight;
TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);
BlitImageAndGenerateCollisionInfo(
(LAND_WIDTH - tmpsurf^.w) div 2,
LAND_HEIGHT - tmpsurf^.h,
tmpsurf^.w,
tmpsurf);
SDL_FreeSurface(tmpsurf);
LoadMask;
end;
procedure GenMap;
var x, y, w, c: Longword;
begin
hasBorder:= false;
LoadThemeConfig;
isMap:= false;
if (GameFlags and gfForts) = 0 then
if Pathz[ptMapCurrent] <> '' then LoadMap
else GenLandSurface
else MakeFortsMap;
AddProgress;
{$IFDEF DEBUGFILE}LogLandDigest;{$ENDIF}
// check for land near top
c:= 0;
if (GameFlags and gfBorder) <> 0 then
hasBorder:= true
else
for y:= topY to topY + 5 do
for x:= leftX to rightX do
if Land[y, x] <> 0 then
begin
inc(c);
if c > 200 then // avoid accidental triggering
begin
hasBorder:= true;
break;
end;
end;
if hasBorder then
begin
for y:= 0 to LAND_HEIGHT - 1 do
for x:= 0 to LAND_WIDTH - 1 do
if (y < topY) or (x < leftX) or (x > rightX) then
Land[y, x]:= COLOR_INDESTRUCTIBLE;
// experiment hardcoding cave
// also try basing cave dimensions on map/template dimensions, if they exist
for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
begin
for y:= topY to LAND_HEIGHT - 1 do
begin
Land[y, leftX + w]:= COLOR_INDESTRUCTIBLE;
Land[y, rightX - w]:= COLOR_INDESTRUCTIBLE;
if (y + w) mod 32 < 16 then
c:= AMask
else
c:= AMask or RMask or GMask; // FF00FFFF
LandPixels[y, leftX + w]:= c;
LandPixels[y, rightX - w]:= c;
end;
for x:= leftX to rightX do
begin
Land[topY + w, x]:= COLOR_INDESTRUCTIBLE;
if (x + w) mod 32 < 16 then
c:= AMask
else
c:= AMask or RMask or GMask; // FF00FFFF
LandPixels[topY + w, x]:= c;
end;
end;
end;
if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false;
if ((GameFlags and gfForts) = 0) and (Pathz[ptMapCurrent] = '') then AddObjects;
FreeLandObjects;
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT);
end;
function GenPreview: TPreview;
var x, y, xx, yy, t, bit: LongInt;
Preview: TPreview;
begin
WriteLnToConsole('Generating preview...');
case cMapGen of
0: GenBlank(EdgeTemplates[SelectTemplate]);
1: GenMaze;
end;
for y:= 0 to 127 do
for x:= 0 to 31 do
begin
Preview[y, x]:= 0;
for bit:= 0 to 7 do
begin
t:= 0;
for yy:= y * (LAND_HEIGHT div 128) to y * (LAND_HEIGHT div 128) + 7 do
for xx:= x * (LAND_WIDTH div 32) + bit * 8 to x * (LAND_WIDTH div 32) + bit * 8 + 7 do
if Land[yy, xx] <> 0 then inc(t);
if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit)
end
end;
GenPreview:= Preview
end;
procedure initModule;
begin
LandBackSurface:= nil;
FillChar(LandPixels, sizeof(TLandArray), 0);
end;
procedure freeModule;
begin
end;
end.