← Back to branch summary

~ubuntu-branches/ubuntu/wily/hedgewars/wily

« back to all changes in this revision

Viewing changes to hedgewars/uLand.pas

  • Committer: Package Import Robot
  • Author(s): Dmitry E. Oboukhov
  • Date: 2011-09-23 10:16:55 UTC
  • mfrom: (1.2.11 upstream)
  • Revision ID: package-import@ubuntu.com-20110923101655-3977th2gc5n0a3pv
Tags: 0.9.16-1
* New upstream version.
 + Downloadable content! Simply click to install any content.
   New voices, hats, maps, themes, translations, music, scripts...
   Hedgewars is now more customisable than ever before! As time goes
   by we will be soliciting community content to feature on this page,
   so remember to check it from time to time. If you decide you want
   to go back to standard Hedgewars, just remove the Data directory
   from your Hedgewars config directory.
 + 3-D rendering! Diorama-like rendering of the game in a variety
   of 3D modes. Let us know which ones work best for you, we didn't
   really have the equipment to test them all.
 + Resizable game window.
 + New utilities! The Time Box will remove one of your hedgehogs
   from the game for a while, protecting from attack until it returns,
   somewhere else on the map. Land spray will allow you to build bridges,
   seal up holes, or just make life unpleasant for your enemies.
 + New single player: Bamboo Thicket, That Sinking Feeling, Newton and
   the Tree and multi-player: The Specialists, Space Invaders,
   Racer - scripts! And a ton more script hooks for scripters
 + New twists on old weapons. Drill strike, seduction and fire have
   been adjusted. Defective mines have been added, rope can attach to
   hogs/crates/barrels again, grenades now have variable bounce (use
   precise key + 1-5). Portal gun is now more usable in flight and
   all game actions are a lot faster.
 + New theme - Golf, dozens of new community hats and a new
   localised Default voice, Ukranian.

Show diffs side-by-side

added added

removed removed

Lines of Context:
hedgewars/uLand.pas
1
1
(*
2
2
 * Hedgewars, a free turn based strategy game
3
 
 * Copyright (c) 2005-2010 Andrey Korotaev <unC0Rr@gmail.com>
 
3
 * Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
4
4
 *
5
5
 * This program is free software; you can redistribute it and/or modify
6
6
 * it under the terms of the GNU General Public License as published by
30
30
 
31
31
procedure initModule;
32
32
procedure freeModule;
 
33
procedure DrawBottomBorder;
33
34
procedure GenMap;
34
35
function  GenPreview: TPreview;
35
36
 
283
284
    r, rr: TSDL_Rect;
284
285
    x, yd, yu: LongInt;
285
286
begin
286
 
    tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);
 
287
    tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/LandTex', ifIgnoreCaps);
 
288
    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);
287
289
    r.y:= 0;
288
290
    while r.y < LAND_HEIGHT do
289
291
    begin
298
300
    SDL_FreeSurface(tmpsurf);
299
301
 
300
302
    // freed in freeModule() below
301
 
    LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
 
303
    LandBackSurface:= LoadImage(UserPathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
 
304
    if LandBackSurface = nil then LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
302
305
 
303
 
    tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);
 
306
    tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/Border', ifIgnoreCaps or ifTransparent);
 
307
    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);
304
308
    for x:= 0 to LAND_WIDTH - 1 do
305
309
    begin
306
310
        yd:= LAND_HEIGHT - 1;
1039
1043
 
1040
1044
procedure GenLandSurface;
1041
1045
var tmpsurf: PSDL_Surface;
 
1046
    x,y: Longword;
1042
1047
begin
1043
1048
    WriteLnToConsole('Generating land...');
1044
1049
    case cMapGen of
1058
1063
 
1059
1064
    LandSurface2LandPixels(tmpsurf);
1060
1065
    SDL_FreeSurface(tmpsurf);
 
1066
    for x:= leftX+2 to rightX-2 do
 
1067
        for y:= topY+2 to LAND_HEIGHT-3 do
 
1068
            if (Land[y, x] = 0) and 
 
1069
               (((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
 
1070
               ((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
 
1071
            begin
 
1072
                if (cReducedQuality and rqBlurryLand) = 0 then
 
1073
                    begin
 
1074
                    if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
 
1075
                    else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
 
1076
                    else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x]
 
1077
                    else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x];
 
1078
                    if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (128 shl AShift)
 
1079
                    end;
 
1080
                Land[y,x]:= lfObject
 
1081
            end
 
1082
            else if (Land[y, x] = 0) and
 
1083
                    (((Land[y, x-1] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
 
1084
                    ((Land[y, x-1] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y-2,x] = lfBasic)) or
 
1085
                    ((Land[y, x+1] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
 
1086
                    ((Land[y, x+1] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y-2,x] = lfBasic)) or
 
1087
                    ((Land[y+1, x] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
 
1088
                    ((Land[y-1, x] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
 
1089
                    ((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
 
1090
                    ((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
 
1091
            begin
 
1092
                if (cReducedQuality and rqBlurryLand) = 0 then
 
1093
                    begin
 
1094
                    if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
 
1095
                    else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
 
1096
                    else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x]
 
1097
                    else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x];
 
1098
                    if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (64 shl AShift)
 
1099
                    end;
 
1100
                Land[y,x]:= lfObject
 
1101
            end;
 
1102
 
1061
1103
    AddProgress();
1062
1104
end;
1063
1105
 
1074
1116
 
1075
1117
WriteLnToConsole('Generating forts land...');
1076
1118
 
1077
 
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
 
1119
tmpsurf:= LoadImage(UserPathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1120
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
1078
1121
BlitImageAndGenerateCollisionInfo(leftX+150, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
1079
1122
SDL_FreeSurface(tmpsurf);
1080
1123
 
1081
 
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
 
1124
tmpsurf:= LoadImage(UserPathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1125
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
1082
1126
BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
1083
1127
SDL_FreeSurface(tmpsurf);
1084
1128
end;
1085
1129
 
1086
 
// Hi unC0Rr.
1087
 
// This is a function that Tiy assures me would not be good for gameplay.
1088
 
// It allows the setting of arbitrary portions of landscape as indestructible, or regular, or even blank.
1089
 
// 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.
1090
 
// I would just like to play with it with my friends if you do not mind.
1091
 
// Can allow for amusing maps.
 
1130
// Loads Land[] from an image, allowing overriding standard collision
1092
1131
procedure LoadMask(mapName: shortstring);
1093
1132
var tmpsurf: PSDL_Surface;
1094
1133
    p: PLongwordArray;
1095
1134
    x, y, cpX, cpY: Longword;
1096
1135
begin
1097
 
    tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
1098
 
    if (tmpsurf = nil) and (mapName <> '') then
1099
 
        tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName +'/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1136
tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1137
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1138
if tmpsurf = nil then
 
1139
    begin
 
1140
    mapName:= ExtractFileName(Pathz[ptMapCurrent]);
 
1141
    tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1142
    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1143
    end;
1100
1144
 
1101
1145
    if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then
1102
1146
    begin
1137
1181
isMap:= true;
1138
1182
WriteLnToConsole('Loading land from file...');
1139
1183
AddProgress;
1140
 
tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1184
tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1185
if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
1141
1186
if tmpsurf = nil then
1142
 
begin
 
1187
    begin
1143
1188
    mapName:= ExtractFileName(Pathz[ptMapCurrent]);
1144
 
    tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
1145
 
end;
 
1189
    tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
 
1190
    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
 
1191
    end;
1146
1192
TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true);
1147
1193
 
1148
1194
// unC0Rr - should this be passed from the GUI? I am not sure which layer does what
1149
 
s:= Pathz[ptMapCurrent] + '/map.cfg';
 
1195
s:= UserPathz[ptMapCurrent] + '/map.cfg';
 
1196
if not FileExists(s) then s:= Pathz[ptMapCurrent] + '/map.cfg';
1150
1197
WriteLnToConsole('Fetching map HH limit');
1151
1198
{$I-}
1152
1199
Assign(f, s);
1181
1228
LoadMask(mapname);
1182
1229
end;
1183
1230
 
 
1231
procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
 
1232
var x, w, c: Longword;
 
1233
begin
 
1234
for w:= 0 to 23 do
 
1235
    for x:= leftX to rightX do
 
1236
        begin
 
1237
        Land[cWaterLine-1 - w, x]:= lfIndestructible;
 
1238
        if (x + w) mod 32 < 16 then
 
1239
            c:= AMask
 
1240
        else
 
1241
            c:= AMask or RMask or GMask; // FF00FFFF
 
1242
 
 
1243
        if (cReducedQuality and rqBlurryLand) = 0 then
 
1244
            LandPixels[cWaterLine-1 - w, x]:= c
 
1245
        else
 
1246
            LandPixels[(cWaterLine-1 - w) div 2, x div 2]:= c
 
1247
        end
 
1248
end;
 
1249
 
1184
1250
procedure GenMap;
1185
1251
var x, y, w, c: Longword;
1186
1252
begin
1189
1255
    LoadThemeConfig;
1190
1256
    isMap:= false;
1191
1257
 
1192
 
    // is this not needed any more? let's hope setlength sets also 0s
 
1258
    // is this not needed any more? lets hope setlength sets also 0s
1193
1259
    //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
1194
1260
    //    FillChar(Land,SizeOf(TCollisionArray),0);*)
1195
1261
 
1231
1297
    for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
1232
1298
        begin
1233
1299
        for y:= topY to LAND_HEIGHT - 1 do
1234
 
            begin
 
1300
                begin
1235
1301
                Land[y, leftX + w]:= lfIndestructible;
1236
1302
                Land[y, rightX - w]:= lfIndestructible;
1237
1303
                if (y + w) mod 32 < 16 then
1240
1306
                    c:= AMask or RMask or GMask; // FF00FFFF
1241
1307
 
1242
1308
                if (cReducedQuality and rqBlurryLand) = 0 then
1243
 
                begin
 
1309
                    begin
1244
1310
                    LandPixels[y, leftX + w]:= c;
1245
1311
                    LandPixels[y, rightX - w]:= c;
1246
 
                end
 
1312
                    end
1247
1313
                else
1248
 
                begin
 
1314
                    begin
1249
1315
                    LandPixels[y div 2, (leftX + w) div 2]:= c;
1250
1316
                    LandPixels[y div 2, (rightX - w) div 2]:= c;
 
1317
                    end;
1251
1318
                end;
1252
 
            end;
1253
1319
 
1254
1320
        for x:= leftX to rightX do
1255
1321
            begin
1256
 
                Land[topY + w, x]:= lfIndestructible;
1257
 
                if (x + w) mod 32 < 16 then
1258
 
                    c:= AMask
1259
 
                else
1260
 
                    c:= AMask or RMask or GMask; // FF00FFFF
 
1322
            Land[topY + w, x]:= lfIndestructible;
 
1323
            if (x + w) mod 32 < 16 then
 
1324
                c:= AMask
 
1325
            else
 
1326
                c:= AMask or RMask or GMask; // FF00FFFF
1261
1327
 
1262
 
                if (cReducedQuality and rqBlurryLand) = 0 then
1263
 
                    LandPixels[topY + w, x]:= c
1264
 
                else
1265
 
                    LandPixels[(topY + w) div 2, x div 2]:= c;
 
1328
            if (cReducedQuality and rqBlurryLand) = 0 then
 
1329
                LandPixels[topY + w, x]:= c
 
1330
            else
 
1331
                LandPixels[(topY + w) div 2, x div 2]:= c;
1266
1332
            end;
1267
1333
        end;
1268
1334
    end;
1269
1335
 
 
1336
if (GameFlags and gfBottomBorder) <> 0 then DrawBottomBorder;
 
1337
 
1270
1338
if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false;
1271
1339
 
1272
1340
if ((GameFlags and gfForts) = 0)
1276
1344
 
1277
1345
FreeLandObjects;
1278
1346
 
 
1347
if cGrayScale then
 
1348
    begin
 
1349
    if (cReducedQuality and rqBlurryLand) = 0 then
 
1350
        for x:= leftX to rightX do
 
1351
            for y:= topY to LAND_HEIGHT-1 do
 
1352
                begin
 
1353
                w:= LandPixels[y,x];
 
1354
                w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED +
 
1355
                      (w shr BShift and $FF) * RGB_LUMINANCE_GREEN +
 
1356
                      (w shr GShift and $FF) * RGB_LUMINANCE_BLUE));
 
1357
                if w > 255 then w:= 255;
 
1358
                w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y,x] and AMask);
 
1359
                LandPixels[y,x]:= w or (LandPixels[y, x] and AMask)
 
1360
                end
 
1361
    else
 
1362
        for x:= leftX div 2 to rightX div 2 do
 
1363
            for y:= topY div 2 to LAND_HEIGHT-1 div 2 do
 
1364
                begin
 
1365
                w:= LandPixels[y div 2,x div 2];
 
1366
                w:= ((w shr RShift and $FF) +  (w shr BShift and $FF) + (w shr GShift and $FF)) div 3;
 
1367
                if w > 255 then w:= 255;
 
1368
               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);
 
1369
                LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
 
1370
                end
 
1371
    end;
 
1372
 
1279
1373
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT);
1280
1374
end;
1281
1375
 
1316
1410
 
1317
1411
procedure chLandCheck(var s: shortstring);
1318
1412
begin
1319
 
{$IFDEF DEBUGFILE}
1320
1413
    AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
1321
 
{$ENDIF}
1322
1414
    if digest = '' then
1323
1415
        digest:= s
1324
1416
    else