Mercurial Mercurial > sheepy-clone / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLand.pas
changeset 4436 94c948a92759
parent 4403 0dfe26f48ec1
child 4458 7351e6f1ee28
equal deleted inserted replaced
4366:d19adc635c99 4436:94c948a92759 
    18 
    18 
    19 {$INCLUDE "options.inc"}
 
    19 {$INCLUDE "options.inc"}
 
    20 
    20 
    21 unit uLand;
 
    21 unit uLand;
 
    22 interface
 
    22 interface
 
    23 uses SDLh, uLandTemplates, uFloat, uConsts, GLunit;
 
    23 uses SDLh, uLandTemplates, uFloat, uConsts, GLunit, uTypes;
 
    24 
       
    25 type
 
       
    26     TLandArray = packed array of array of LongWord;
 
       
    27     TCollisionArray = packed array of array of Word;
 
       
    28     TPreview  = packed array[0..127, 0..31] of byte;
 
       
    29     TDirtyTag = packed array of array of byte;
 
       
    30 
       
    31 var Land: TCollisionArray;
 
       
    32     LandPixels: TLandArray;
 
       
    33     LandDirty: TDirtyTag;
 
       
    34     hasBorder: boolean;
 
       
    35     hasGirders: boolean;
 
       
    36     isMap: boolean;
 
       
    37     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.
 
       
    38     LandBackSurface: PSDL_Surface;
 
       
    39     digest: shortstring;
 
       
    40 
    24 
    41 type direction = record x, y: LongInt; end;
 
    25 type direction = record x, y: LongInt; end;
 
    42 const DIR_N: direction = (x: 0; y: -1);
 
    26 const DIR_N: direction = (x: 0; y: -1);
 
    43     DIR_E: direction = (x: 1; y: 0);
 
    27     DIR_E: direction = (x: 1; y: 0);
 
    44     DIR_S: direction = (x: 0; y: 1);
 
    28     DIR_S: direction = (x: 0; y: 1);
 
    46 
    30 
    47 procedure initModule;
 
    31 procedure initModule;
 
    48 procedure freeModule;
 
    32 procedure freeModule;
 
    49 procedure GenMap;
 
    33 procedure GenMap;
 
    50 function  GenPreview: TPreview;
 
    34 function  GenPreview: TPreview;
 
    51 procedure CheckLandDigest(s: shortstring);
 
       
    52 function  LandBackPixel(x, y: LongInt): LongWord;
 
       
    53 
    35 
    54 implementation
 
    36 implementation
 
    55 uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, Adler32, uIO, uLandTexture, sysutils;
 
    37 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils,
 
       
    38      uVariables, uUtils, uCommands, Adler32, uDebug;
 
    56 
    39 
    57 operator=(const a, b: direction) c: Boolean;
 
    40 operator=(const a, b: direction) c: Boolean;
 
    58 begin
 
    41 begin
 
    59     c := (a.x = b.x) and (a.y = b.y);
 
    42     c := (a.x = b.x) and (a.y = b.y);
 
    60 end;
 
    43 end;
 
    61 
    44 
    62 type TPixAr = record
 
    45 type TPixAr = record
 
    63               Count: Longword;
 
    46               Count: Longword;
 
    64               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
 
    47               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
 
    65               end;
 
    48               end;
 
    66 
       
    67 procedure LogLandDigest;
 
       
    68 var s: shortstring;
 
       
    69     adler, i: LongInt;
 
       
    70 begin
 
       
    71 adler:= 1;
 
       
    72 for i:= 0 to LAND_HEIGHT-1 do
 
       
    73     Adler32Update(adler, @Land[i,0], LAND_WIDTH);
 
       
    74 s:= 'M'+inttostr(adler);
 
       
    75 
       
    76 CheckLandDigest(s);
 
       
    77 SendIPCRaw(@s[0], Length(s) + 1)
 
       
    78 end;
 
       
    79 
       
    80 procedure CheckLandDigest(s: shortstring);
 
       
    81 begin
 
       
    82 {$IFDEF DEBUGFILE}
 
       
    83     AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
 
       
    84 {$ENDIF}
 
       
    85     if digest = '' then
 
       
    86         digest:= s
 
       
    87     else
 
       
    88         TryDo(s = digest, 'Different maps generated, sorry', true);
 
       
    89 end;
 
       
    90 
    49 
    91 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
 
    50 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
 
    92 var
 
    51 var
 
    93   eX, eY, dX, dY: LongInt;
 
    52   eX, eY, dX, dY: LongInt;
 
    94   i, sX, sY, x, y, d: LongInt;
 
    53   i, sX, sY, x, y, d: LongInt;
 
   317                end;
 
   276                end;
 
   318             end;
 
   277             end;
 
   319       end;
 
   278       end;
 
   320 end;
 
   279 end;
 
   321 
   280 
   322 function LandBackPixel(x, y: LongInt): LongWord;
 
       
   323 var p: PLongWordArray;
 
       
   324 begin
 
       
   325     if LandBackSurface = nil then LandBackPixel:= 0
 
       
   326     else
 
       
   327     begin
 
       
   328         p:= LandBackSurface^.pixels;
 
       
   329         LandBackPixel:= p^[LandBackSurface^.w * (y mod LandBackSurface^.h) + (x mod LandBackSurface^.w)];// or $FF000000;
 
       
   330     end
 
       
   331 end;
 
       
   332 
       
   333 procedure ColorizeLand(Surface: PSDL_Surface);
 
   281 procedure ColorizeLand(Surface: PSDL_Surface);
 
   334 var tmpsurf: PSDL_Surface;
 
   282 var tmpsurf: PSDL_Surface;
 
   335     r, rr: TSDL_Rect;
 
   283     r, rr: TSDL_Rect;
 
   336     x, yd, yu: LongInt;
 
   284     x, yd, yu: LongInt;
 
   337 begin
 
   285 begin
 
   383                 rr.x:= x;
 
   331                 rr.x:= x;
 
   384                 rr.y:= yu;
 
   332                 rr.y:= yu;
 
   385                 r.x:= x mod tmpsurf^.w;
 
   333                 r.x:= x mod tmpsurf^.w;
 
   386                 r.y:= 0;
 
   334                 r.y:= 0;
 
   387                 r.w:= 1;
 
   335                 r.w:= 1;
 
   388                 r.h:= min(16, yd - yu + 1);
 
   336                 r.h:= Min(16, yd - yu + 1);
 
   389                 SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   337                 SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
 
   390             end;
 
   338             end;
 
   391             yd:= yu - 1;
 
   339             yd:= yu - 1;
 
   392         until yd < 0;
 
   340         until yd < 0;
 
   393     end;
 
   341     end;
 
  1237     else
 
  1185     else
 
  1238         MakeFortsMap;
 
  1186         MakeFortsMap;
 
  1239 
  1187 
  1240     AddProgress;
 
  1188     AddProgress;
 
  1241 
  1189 
  1242 {$IFDEF DEBUGFILE}LogLandDigest;{$ENDIF}
 
       
  1243 
       
  1244 // check for land near top
 
  1190 // check for land near top
 
  1245 c:= 0;
 
  1191 c:= 0;
 
  1246 if (GameFlags and gfBorder) <> 0 then
 
  1192 if (GameFlags and gfBorder) <> 0 then
 
  1247     hasBorder:= true
 
  1193     hasBorder:= true
 
  1248 else
 
  1194 else
 
  1346         end;
 
  1292         end;
 
  1347 
  1293 
  1348     GenPreview:= Preview
 
  1294     GenPreview:= Preview
 
  1349 end;
 
  1295 end;
 
  1350 
  1296 
       
  1297 
       
  1298 procedure chLandCheck(var s: shortstring);
 
       
  1299 begin
 
       
  1300 {$IFDEF DEBUGFILE}
 
       
  1301     AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
 
       
  1302 {$ENDIF}
 
       
  1303     if digest = '' then
 
       
  1304         digest:= s
 
       
  1305     else
 
       
  1306         TryDo(s = digest, 'Different maps generated, sorry', true);
 
       
  1307 end;
 
       
  1308 
       
  1309 procedure chSendLandDigest(var s: shortstring);
 
       
  1310 var adler, i: LongInt;
 
       
  1311 begin
 
       
  1312     adler:= 1;
 
       
  1313     for i:= 0 to LAND_HEIGHT-1 do
 
       
  1314         Adler32Update(adler, @Land[i,0], LAND_WIDTH);
 
       
  1315     s:= 'M' + IntToStr(adler);
 
       
  1316 
       
  1317     chLandCheck(s);
 
       
  1318     SendIPCRaw(@s[0], Length(s) + 1)
 
       
  1319 end;
 
       
  1320 
  1351 procedure initModule;
 
  1321 procedure initModule;
 
  1352 begin
 
  1322 begin
 
       
  1323     RegisterVariable('landcheck', vtCommand, @chLandCheck, false);
 
       
  1324     RegisterVariable('sendlanddigest', vtCommand, @chSendLandDigest, false);
 
       
  1325 
  1353     LandBackSurface:= nil;
 
  1326     LandBackSurface:= nil;
 
  1354     digest:= '';
 
  1327     digest:= '';
 
  1355 
  1328 
  1356     if (cReducedQuality and rqBlurryLand) = 0 then
 
  1329     if (cReducedQuality and rqBlurryLand) = 0 then
 
  1357         SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
 
  1330         SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
sheepy-clone