hedgewars/uLand.pas
changeset 8010 195677b0d06b
parent 8003 7d8bce524daf
child 8011 ffd5eba8f7c2
equal deleted inserted replaced
8009:22d3f053dd9b 8010:195677b0d06b
   325 
   325 
   326 procedure GenLandSurface;
   326 procedure GenLandSurface;
   327 var tmpsurf: PSDL_Surface;
   327 var tmpsurf: PSDL_Surface;
   328     x,y: Longword;
   328     x,y: Longword;
   329 begin
   329 begin
   330     WriteLnToConsole('Generating land...');
       
   331     case cMapGen of
       
   332         0: GenBlank(EdgeTemplates[SelectTemplate]);
       
   333         1: begin ResizeLand(4096,2048); GenMaze; end;
       
   334         2: GenDrawnMap;
       
   335     else
       
   336         OutError('Unknown mapgen', true);
       
   337     end;
       
   338     AddProgress();
   330     AddProgress();
   339 
   331 
   340     tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
   332     tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
   341 
   333 
   342     TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   334     TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   428 tmpsurf:= LoadDataImage(ptForts, ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   420 tmpsurf:= LoadDataImage(ptForts, ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   429 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
   421 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
   430 SDL_FreeSurface(tmpsurf);
   422 SDL_FreeSurface(tmpsurf);
   431 end;
   423 end;
   432 
   424 
       
   425 procedure LoadMapConfig;
       
   426 var f: textfile;
       
   427     s: shortstring;
       
   428 begin
       
   429 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
       
   430 s:= UserPathz[ptMapCurrent] + '/map.cfg';
       
   431 if not FileExists(s) then
       
   432     s:= Pathz[ptMapCurrent] + '/map.cfg';
       
   433 WriteLnToConsole('Fetching map HH limit');
       
   434 {$I-}
       
   435 Assign(f, s);
       
   436 filemode:= 0; // readonly
       
   437 Reset(f);
       
   438 if IOResult <> 0 then
       
   439     begin
       
   440     s:= Pathz[ptMissionMaps] + '/' + ExtractFileName(Pathz[ptMapCurrent]) + '/map.cfg';
       
   441     Assign(f, s);
       
   442     Reset(f);
       
   443     end;
       
   444 Readln(f);
       
   445 if not eof(f) then
       
   446     Readln(f, MaxHedgehogs);
       
   447 {$I+}
       
   448 if (MaxHedgehogs = 0) then
       
   449     MaxHedgehogs:= 18;
       
   450 end;
       
   451 
   433 // Loads Land[] from an image, allowing overriding standard collision
   452 // Loads Land[] from an image, allowing overriding standard collision
   434 procedure LoadMask(mapName: shortstring);
   453 procedure LoadMask;
   435 var tmpsurf: PSDL_Surface;
   454 var tmpsurf: PSDL_Surface;
   436     p: PLongwordArray;
   455     p: PLongwordArray;
   437     x, y, cpX, cpY: Longword;
   456     x, y, cpX, cpY: Longword;
       
   457     mapName: shortstring;
   438 begin
   458 begin
   439 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   459 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   440 if tmpsurf = nil then
   460 if tmpsurf = nil then
   441     begin
   461     begin
   442     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
   462     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
   443     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   463     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   444     end;
   464     end;
   445 
   465 
   446 
   466 
   447 if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then
   467 if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then
   448     begin
   468     begin
       
   469     if LAND_WIDTH = 0 then
       
   470         begin
       
   471         LoadMapConfig;
       
   472         ResizeLand(tmpsurf^.w, tmpsurf^.h);
       
   473         playHeight:= tmpsurf^.h;
       
   474         playWidth:= tmpsurf^.w;
       
   475         leftX:= (LAND_WIDTH - playWidth) div 2;
       
   476         rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
       
   477         topY:= LAND_HEIGHT - playHeight;
       
   478         end;
   449     disableLandBack:= true;
   479     disableLandBack:= true;
   450 
   480 
   451     cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   481     cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   452     cpY:= LAND_HEIGHT - tmpsurf^.h;
   482     cpY:= LAND_HEIGHT - tmpsurf^.h;
   453     if SDL_MustLock(tmpsurf) then
   483     if SDL_MustLock(tmpsurf) then
   494 end;
   524 end;
   495 
   525 
   496 procedure LoadMap;
   526 procedure LoadMap;
   497 var tmpsurf: PSDL_Surface;
   527 var tmpsurf: PSDL_Surface;
   498     s: shortstring;
   528     s: shortstring;
   499     f: textfile;
       
   500     mapName: shortstring = '';
   529     mapName: shortstring = '';
   501 begin
   530 begin
   502 WriteLnToConsole('Loading land from file...');
   531 WriteLnToConsole('Loading land from file...');
   503 AddProgress;
   532 AddProgress;
   504 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   533 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   509     end;
   538     end;
   510 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   539 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   511 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
   540 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
   512 
   541 
   513 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   542 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   514 
   543 LoadMapConfig;
   515 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
       
   516 s:= UserPathz[ptMapCurrent] + '/map.cfg';
       
   517 if not FileExists(s) then
       
   518     s:= Pathz[ptMapCurrent] + '/map.cfg';
       
   519 WriteLnToConsole('Fetching map HH limit');
       
   520 {$I-}
       
   521 Assign(f, s);
       
   522 filemode:= 0; // readonly
       
   523 Reset(f);
       
   524 if IOResult <> 0 then
       
   525     begin
       
   526     s:= Pathz[ptMissionMaps] + '/' + mapName + '/map.cfg';
       
   527     Assign(f, s);
       
   528     Reset(f);
       
   529     end;
       
   530 Readln(f);
       
   531 if not eof(f) then
       
   532     Readln(f, MaxHedgehogs);
       
   533 {$I+}
       
   534 if (MaxHedgehogs = 0) then
       
   535     MaxHedgehogs:= 18;
       
   536 
   544 
   537 playHeight:= tmpsurf^.h;
   545 playHeight:= tmpsurf^.h;
   538 playWidth:= tmpsurf^.w;
   546 playWidth:= tmpsurf^.w;
   539 leftX:= (LAND_WIDTH - playWidth) div 2;
   547 leftX:= (LAND_WIDTH - playWidth) div 2;
   540 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   548 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   547     LAND_HEIGHT - tmpsurf^.h,
   555     LAND_HEIGHT - tmpsurf^.h,
   548     tmpsurf^.w,
   556     tmpsurf^.w,
   549     tmpsurf);
   557     tmpsurf);
   550 SDL_FreeSurface(tmpsurf);
   558 SDL_FreeSurface(tmpsurf);
   551 
   559 
   552 LoadMask(mapname);
   560 LoadMask;
   553 end;
   561 end;
   554 
   562 
   555 procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
   563 procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
   556 var x, w, c: Longword;
   564 var x, w, c: Longword;
   557 begin
   565 begin
   571         end
   579         end
   572 end;
   580 end;
   573 
   581 
   574 procedure GenMap;
   582 procedure GenMap;
   575 var x, y, w, c: Longword;
   583 var x, y, w, c: Longword;
       
   584     usermap, usermask, map, mask: shortstring;
   576 begin
   585 begin
   577     hasBorder:= false;
   586     hasBorder:= false;
   578 
   587 
   579     LoadThemeConfig;
   588     LoadThemeConfig;
   580 
   589 
   582     //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
   591     //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
   583     //    FillChar(Land,SizeOf(TCollisionArray),0);*)
   592     //    FillChar(Land,SizeOf(TCollisionArray),0);*)
   584 
   593 
   585     if (GameFlags and gfForts) = 0 then
   594     if (GameFlags and gfForts) = 0 then
   586         if Pathz[ptMapCurrent] <> '' then
   595         if Pathz[ptMapCurrent] <> '' then
   587             LoadMap
   596             begin
       
   597             usermap:= UserPathz[ptMapCurrent] + '/map.png';
       
   598             usermask:= UserPathz[ptMapCurrent] + '/mask.png';
       
   599             map:= Pathz[ptMapCurrent] + '/map.png';
       
   600             mask:= Pathz[ptMapCurrent] + '/mask.png';
       
   601             if (not(FileExists(usermap)) and FileExists(usermask)) or
       
   602                (not(FileExists(map)) and FileExists(mask)) then
       
   603                 begin
       
   604                 LoadMask;
       
   605                 GenLandSurface
       
   606                 end
       
   607             else LoadMap;
       
   608             end
   588         else
   609         else
       
   610             begin
       
   611             WriteLnToConsole('Generating land...');
       
   612             case cMapGen of
       
   613                 0: GenBlank(EdgeTemplates[SelectTemplate]);
       
   614                 1: begin ResizeLand(4096,2048); GenMaze; end;
       
   615                 2: GenDrawnMap;
       
   616             else
       
   617                 OutError('Unknown mapgen', true);
       
   618             end;
   589             GenLandSurface
   619             GenLandSurface
       
   620             end
   590     else
   621     else
   591         MakeFortsMap;
   622         MakeFortsMap;
   592 
   623 
   593     AddProgress;
   624     AddProgress;
   594 
   625