hedgewars/uLand.pas
branchwebgl
changeset 8096 453917e94e55
parent 8026 4a4f21070479
parent 8060 341fa76d0749
child 8330 aaefa587e277
equal deleted inserted replaced
8053:2e836bebb518 8096:453917e94e55
    29 procedure GenPreview(out Preview: TPreview);
    29 procedure GenPreview(out Preview: TPreview);
    30 
    30 
    31 implementation
    31 implementation
    32 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils,
    32 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils,
    33      uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
    33      uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
    34      uLandGenMaze, uLandOutline;
    34      uLandGenMaze, uLandOutline, uPhysFSLayer;
    35 
    35 
    36 var digest: shortstring;
    36 var digest: shortstring;
    37 
    37 
    38 procedure ResizeLand(width, height: LongWord);
    38 procedure ResizeLand(width, height: LongWord);
    39 var potW, potH: LongInt;
    39 var potW, potH: LongInt;
   422 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
   422 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
   423 SDL_FreeSurface(tmpsurf);
   423 SDL_FreeSurface(tmpsurf);
   424 end;
   424 end;
   425 
   425 
   426 procedure LoadMapConfig;
   426 procedure LoadMapConfig;
   427 var f: textfile;
   427 var f: PFSFile;
   428     s: shortstring;
   428     s: shortstring;
   429 begin
   429 begin
   430 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
   430 s:= cPathz[ptMapCurrent] + '/map.cfg';
   431 s:= UserPathz[ptMapCurrent] + '/map.cfg';
   431 
   432 if not FileExists(s) then
       
   433     s:= Pathz[ptMapCurrent] + '/map.cfg';
       
   434 WriteLnToConsole('Fetching map HH limit');
   432 WriteLnToConsole('Fetching map HH limit');
   435 {$I-}
   433 
   436 Assign(f, s);
   434 f:= pfsOpenRead(s);
   437 filemode:= 0; // readonly
   435 if f <> nil then
   438 Reset(f);
   436     begin
   439 if IOResult <> 0 then
   437     pfsReadLn(f, s);
   440     begin
   438     if not pfsEof(f) then
   441     s:= Pathz[ptMissionMaps] + '/' + ExtractFileName(Pathz[ptMapCurrent]) + '/map.cfg';
   439         begin
   442     Assign(f, s);
   440         pfsReadLn(f, s);
   443     Reset(f);
   441         val(s, MaxHedgehogs)
   444     end;
   442         end;
   445 Readln(f);
   443 
   446 if not eof(f) then
   444     pfsClose(f)
   447     Readln(f, MaxHedgehogs);
   445     end;
   448 {$I+}
   446 
   449 if (MaxHedgehogs = 0) then
   447 if (MaxHedgehogs = 0) then
   450     MaxHedgehogs:= 18;
   448     MaxHedgehogs:= 18;
   451 end;
   449 end;
   452 
   450 
   453 // Loads Land[] from an image, allowing overriding standard collision
   451 // Loads Land[] from an image, allowing overriding standard collision
   457     x, y, cpX, cpY: Longword;
   455     x, y, cpX, cpY: Longword;
   458     mapName: shortstring;
   456     mapName: shortstring;
   459 begin
   457 begin
   460 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   458 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   461 if tmpsurf = nil then
   459 if tmpsurf = nil then
   462     tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   460     begin
   463 if tmpsurf = nil then
   461     mapName:= ExtractFileName(cPathz[ptMapCurrent]);
   464 begin
       
   465     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
       
   466     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   462     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   467     end;
   463     end;
   468 
   464 
   469 
   465 
   470 if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then
   466 if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then
   536 WriteLnToConsole('Loading land from file...');
   532 WriteLnToConsole('Loading land from file...');
   537 AddProgress;
   533 AddProgress;
   538 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   534 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   539 if tmpsurf = nil then
   535 if tmpsurf = nil then
   540     begin
   536     begin
   541     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
   537     mapName:= ExtractFileName(cPathz[ptMapCurrent]);
   542     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   538     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   543     end;
   539     end;
   544 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   540 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   545 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
   541 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
   546 
   542 
   547 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   543 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   548 LoadMapConfig;
   544 LoadMapConfig;
   549 
       
   550 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
       
   551 s:= UserPathz[ptMapCurrent] + '/map.cfg';
       
   552 if not FileExists(s) then
       
   553     s:= Pathz[ptMapCurrent] + '/map.cfg';
       
   554 WriteLnToConsole('Fetching map HH limit');
       
   555 {$I-}
       
   556 Assign(f, s);
       
   557 filemode:= 0; // readonly
       
   558 Reset(f);
       
   559 if IOResult <> 0 then
       
   560     begin
       
   561     s:= Pathz[ptMissionMaps] + '/' + mapName + '/map.cfg';
       
   562     Assign(f, s);
       
   563     Reset(f);
       
   564     end;
       
   565 Readln(f);
       
   566 if not eof(f) then
       
   567     Readln(f, MaxHedgehogs);
       
   568    
       
   569 {$I+}
       
   570 if (MaxHedgehogs = 0) then
       
   571     MaxHedgehogs:= 18;
       
   572 
   545 
   573 playHeight:= tmpsurf^.h;
   546 playHeight:= tmpsurf^.h;
   574 playWidth:= tmpsurf^.w;
   547 playWidth:= tmpsurf^.w;
   575 leftX:= (LAND_WIDTH - playWidth) div 2;
   548 leftX:= (LAND_WIDTH - playWidth) div 2;
   576 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   549 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   608             LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c
   581             LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c
   609         end
   582         end
   610 end;
   583 end;
   611 
   584 
   612 procedure GenMap;
   585 procedure GenMap;
   613 var x, y, w, c : Longword;
   586 var x, y, w, c: Longword;
   614     usermap, usermask, map, mask: shortstring;
   587     map, mask: shortstring;
   615     maskOnly : boolean;
   588     maskOnly: boolean;
   616 begin
   589 begin
   617     hasBorder:= false;
   590     hasBorder:= false;
   618     maskOnly:= false;
   591     maskOnly:= false;
   619 
   592 
   620     LoadThemeConfig;
   593     LoadThemeConfig;
   622     // is this not needed any more? lets hope setlength sets also 0s
   595     // is this not needed any more? lets hope setlength sets also 0s
   623     //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
   596     //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
   624     //    FillChar(Land,SizeOf(TCollisionArray),0);*)
   597     //    FillChar(Land,SizeOf(TCollisionArray),0);*)
   625 
   598 
   626     if (GameFlags and gfForts) = 0 then
   599     if (GameFlags and gfForts) = 0 then
   627         if Pathz[ptMapCurrent] <> '' then
   600         if cPathz[ptMapCurrent] <> '' then
   628             begin
   601             begin
   629             usermap:= UserPathz[ptMapCurrent] + '/map.png';
   602             map:= cPathz[ptMapCurrent] + '/map.png';
   630             usermask:= UserPathz[ptMapCurrent] + '/mask.png';
   603             mask:= cPathz[ptMapCurrent] + '/mask.png';
   631             map:= Pathz[ptMapCurrent] + '/map.png';
   604             if (not(FileExists(map)) and FileExists(mask)) then
   632             mask:= Pathz[ptMapCurrent] + '/mask.png';
       
   633             if (not(FileExists(usermap)) and FileExists(usermask)) or
       
   634                (not(FileExists(map)) and FileExists(mask)) then
       
   635                 begin
   605                 begin
   636                 maskOnly:= true;
   606                 maskOnly:= true;
   637                 LoadMask;
   607                 LoadMask;
   638                 GenLandSurface
   608                 GenLandSurface
   639                 end
   609                 end
   723     DrawBottomBorder;
   693     DrawBottomBorder;
   724 
   694 
   725 if (GameFlags and gfDisableGirders) <> 0 then
   695 if (GameFlags and gfDisableGirders) <> 0 then
   726     hasGirders:= false;
   696     hasGirders:= false;
   727 
   697 
   728 if (GameFlags and gfForts = 0) and (maskOnly or (Pathz[ptMapCurrent] = '')) then
   698 if (GameFlags and gfForts = 0) and (maskOnly or (cPathz[ptMapCurrent] = '')) then
   729     AddObjects
   699     AddObjects
   730     
   700     
   731 else
   701 else
   732     AddProgress();
   702     AddProgress();
   733 
   703 
   803                            and (Land[yy-oy, xx-ox] <> 0) then
   773                            and (Land[yy-oy, xx-ox] <> 0) then
   804                             inc(t);
   774                             inc(t);
   805                 if t > 8 then
   775                 if t > 8 then
   806                     Preview[y, x]:= Preview[y, x] or ($80 shr bit);
   776                     Preview[y, x]:= Preview[y, x] or ($80 shr bit);
   807             end;
   777             end;
   808 	end;
   778         end;
   809 end;
   779 end;
   810 
   780 
   811 
   781 
   812 procedure chLandCheck(var s: shortstring);
   782 procedure chLandCheck(var s: shortstring);
   813 begin
   783 begin
   817     else
   787     else
   818         TryDo(s = digest, 'Different maps generated, sorry', true);
   788         TryDo(s = digest, 'Different maps generated, sorry', true);
   819 end;
   789 end;
   820 
   790 
   821 procedure chSendLandDigest(var s: shortstring);
   791 procedure chSendLandDigest(var s: shortstring);
   822 var adler, i : LongInt;
   792 var adler, i: LongInt;
   823 begin
   793 begin
   824     adler:= 1;
   794     adler:= 1;
   825      for i:= 0 to LAND_HEIGHT-1 do
   795      for i:= 0 to LAND_HEIGHT-1 do
   826        begin
   796        begin
   827         adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH);
   797         adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH);
   852 *)
   822 *)
   853 end;
   823 end;
   854 
   824 
   855 procedure freeModule;
   825 procedure freeModule;
   856 begin
   826 begin
   857 
   827     SetLength(Land, 0, 0);
   858    SetLength(LandPixels, 0, 0);
   828     SetLength(LandPixels, 0, 0);
   859    
   829     SetLength(LandDirty, 0, 0);
   860    SetLength(Land, 0, 0);
       
   861  
       
   862    SetLength(LandDirty, 0, 0);
       
   863 
       
   864 end;
   830 end;
   865 
   831 
   866 end.
   832 end.