Basic test implementation of an ice flag. Allows for slick parts of terrain. Intended for ice gun, or "ice" mask on portions of land objects.
In this test variant it is triggered on girders/objects/bridges of the snow/christmas theme, or on a map that uses blue as a mask colour. Probably needs sheepluva's slope detection to make slopes more slippery to climb.
(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2011 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, 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;
procedure GenMap;
function GenPreview: TPreview;
implementation
uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils,
uVariables, uUtils, uCommands, Adler32, uDebug, uLandPainted;
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;
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;
r, rr: TSDL_Rect;
x, yd, yu: LongInt;
begin
tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/LandTex', ifIgnoreCaps);
if tmpsurf = nil then 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(UserPathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
if LandBackSurface = nil then LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/Border', ifIgnoreCaps or ifTransparent);
if tmpsurf = nil then 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 - LongInt(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
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;
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]:= lfBasic;
{$HINTS OFF}
SetPoints(Template, pa);
{$HINTS ON}
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, lfBasic);
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;
// HACK: 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]:= lfBasic
else if Land[y, x] = lfBasic then
Land[y, x]:= 0;
end;
end;
end;
procedure GenDrawnMap;
begin
uLandPainted.Draw;
MaxHedgehogs:= 48;
hasGirders:= true;
playHeight:= 2048;
playWidth:= 4096;
leftX:= ((LAND_WIDTH - playWidth) div 2);
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
topY:= LAND_HEIGHT - playHeight;
end;
function SelectTemplate: LongInt;
begin
if (cReducedQuality and rqLowRes) <> 0 then
SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))]
else
case cTemplateFilter of
0: SelectTemplate:= getrandom(Succ(High(EdgeTemplates)));
1: SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))];
2: SelectTemplate:= MediumTemplates[getrandom(Succ(High(MediumTemplates)))];
3: SelectTemplate:= LargeTemplates[getrandom(Succ(High(LargeTemplates)))];
4: SelectTemplate:= CavernTemplates[getrandom(Succ(High(CavernTemplates)))];
5: SelectTemplate:= WackyTemplates[getrandom(Succ(High(WackyTemplates)))];
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
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[y, x]:= p^[x] or AMask
else
LandPixels[y div 2, x div 2]:= 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;
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 cMazeSize 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;
x,y: Longword;
begin
WriteLnToConsole('Generating land...');
case cMapGen of
0: GenBlank(EdgeTemplates[SelectTemplate]);
1: GenMaze;
2: GenDrawnMap;
else
OutError('Unknown mapgen', true);
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);
for x:= leftX+2 to rightX-2 do
for y:= topY+2 to LAND_HEIGHT-3 do
if (Land[y, x] = 0) and
(((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
begin
if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x]
else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x];
if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (128 shl AShift)
end;
Land[y,x]:= lfObject
end
else if (Land[y, x] = 0) and
(((Land[y, x-1] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
((Land[y, x-1] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y-2,x] = lfBasic)) or
((Land[y, x+1] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
((Land[y, x+1] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y-2,x] = lfBasic)) or
((Land[y+1, x] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
((Land[y-1, x] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
begin
if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x]
else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x];
if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (64 shl AShift)
end;
Land[y,x]:= lfObject
end;
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(UserPathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then 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(UserPathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then 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;
// Loads Land[] from an image, allowing overriding standard collision
procedure LoadMask(mapName: shortstring);
var tmpsurf: PSDL_Surface;
p: PLongwordArray;
x, y, cpX, cpY: Longword;
begin
tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then
begin
mapName:= ExtractFileName(Pathz[ptMapCurrent]);
tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
end;
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]:= lfIndestructible
else if p^[x] = (AMask or BMask) then
Land[cpY + y, cpX + x]:= lfIce
else if p^[x] = $FFFFFFFF then
Land[cpY + y, cpX + x]:= lfBasic;
end;
p:= @(p^[tmpsurf^.pitch div 4]);
end;
if SDL_MustLock(tmpsurf) then
SDL_UnlockSurface(tmpsurf);
end;
if (tmpsurf <> nil) then
SDL_FreeSurface(tmpsurf);
tmpsurf:= nil;
end;
procedure LoadMap;
var tmpsurf: PSDL_Surface;
s: shortstring;
f: textfile;
mapName: shortstring = '';
begin
isMap:= true;
WriteLnToConsole('Loading land from file...');
AddProgress;
tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then
begin
mapName:= ExtractFileName(Pathz[ptMapCurrent]);
tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
end;
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:= UserPathz[ptMapCurrent] + '/map.cfg';
if not FileExists(s) then s:= Pathz[ptMapCurrent] + '/map.cfg';
WriteLnToConsole('Fetching map HH limit');
{$I-}
Assign(f, s);
filemode:= 0; // readonly
Reset(f);
if IOResult <> 0 then
begin
s:= Pathz[ptMissionMaps] + '/' + mapName + '/map.cfg';
Assign(f, s);
Reset(f);
end;
Readln(f);
if not eof(f) then Readln(f, MaxHedgehogs);
{$I+}
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(mapname);
end;
procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
var x, w, c: Longword;
begin
for w:= 0 to 23 do
for x:= leftX to rightX do
begin
Land[Longword(cWaterLine) - 1 - w, x]:= lfIndestructible;
if (x + w) mod 32 < 16 then
c:= AMask
else
c:= AMask or RMask or GMask; // FF00FFFF
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[Longword(cWaterLine) - 1 - w, x]:= c
else
LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c
end
end;
procedure GenMap;
var x, y, w, c: Longword;
begin
hasBorder:= false;
LoadThemeConfig;
isMap:= false;
// is this not needed any more? lets hope setlength sets also 0s
//if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
// FillChar(Land,SizeOf(TCollisionArray),0);*)
if (GameFlags and gfForts) = 0 then
if Pathz[ptMapCurrent] <> '' then
LoadMap
else
GenLandSurface
else
MakeFortsMap;
AddProgress;
// 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]:= lfIndestructible;
// 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]:= lfIndestructible;
Land[y, rightX - w]:= lfIndestructible;
if (y + w) mod 32 < 16 then
c:= AMask
else
c:= AMask or RMask or GMask; // FF00FFFF
if (cReducedQuality and rqBlurryLand) = 0 then
begin
LandPixels[y, leftX + w]:= c;
LandPixels[y, rightX - w]:= c;
end
else
begin
LandPixels[y div 2, (leftX + w) div 2]:= c;
LandPixels[y div 2, (rightX - w) div 2]:= c;
end;
end;
for x:= leftX to rightX do
begin
Land[topY + w, x]:= lfIndestructible;
if (x + w) mod 32 < 16 then
c:= AMask
else
c:= AMask or RMask or GMask; // FF00FFFF
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[topY + w, x]:= c
else
LandPixels[(topY + w) div 2, x div 2]:= c;
end;
end;
end;
if (GameFlags and gfBottomBorder) <> 0 then DrawBottomBorder;
if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false;
if ((GameFlags and gfForts) = 0)
and (Pathz[ptMapCurrent] = '')
then AddObjects
else AddProgress();
FreeLandObjects;
if cGrayScale then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
for x:= leftX to rightX do
for y:= topY to LAND_HEIGHT-1 do
begin
w:= LandPixels[y,x];
w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED +
(w shr BShift and $FF) * RGB_LUMINANCE_GREEN +
(w shr GShift and $FF) * RGB_LUMINANCE_BLUE));
if w > 255 then w:= 255;
w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y,x] and AMask);
LandPixels[y,x]:= w or (LandPixels[y, x] and AMask)
end
else
for x:= leftX div 2 to rightX div 2 do
for y:= topY div 2 to LAND_HEIGHT-1 div 2 do
begin
w:= LandPixels[y div 2,x div 2];
w:= ((w shr RShift and $FF) + (w shr BShift and $FF) + (w shr GShift and $FF)) div 3;
if w > 255 then w:= 255;
w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y div 2,x div 2] and AMask);
LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
end
end;
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT);
end;
function GenPreview: TPreview;
var x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
Preview: TPreview;
begin
WriteLnToConsole('Generating preview...');
case cMapGen of
0: GenBlank(EdgeTemplates[SelectTemplate]);
1: GenMaze;
2: GenDrawnMap;
else
OutError('Unknown mapgen', true);
end;
lh:= LAND_HEIGHT div 128;
lw:= LAND_WIDTH div 32;
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;
cbit:= bit * 8;
for yy:= y * lh to y * lh + 7 do
for xx:= x * lw + cbit to x * lw + cbit + 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 chLandCheck(var s: shortstring);
begin
AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
if digest = '' then
digest:= s
else
TryDo(s = digest, 'Different maps generated, sorry', true);
end;
procedure chSendLandDigest(var s: shortstring);
var adler, i: LongInt;
begin
adler:= 1;
for i:= 0 to LAND_HEIGHT-1 do
Adler32Update(adler, @Land[i,0], LAND_WIDTH);
s:= 'M' + IntToStr(adler);
chLandCheck(s);
SendIPCRaw(@s[0], Length(s) + 1)
end;
procedure initModule;
begin
RegisterVariable('landcheck', vtCommand, @chLandCheck, false);
RegisterVariable('sendlanddigest', vtCommand, @chSendLandDigest, false);
LandBackSurface:= nil;
digest:= '';
if (cReducedQuality and rqBlurryLand) = 0 then
SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
else
SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2);
SetLength(Land, LAND_HEIGHT, LAND_WIDTH);
SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32));
end;
procedure freeModule;
begin
Land:= nil;
LandPixels:= nil;
LandDirty:= nil;
end;
end.