hedgewars/uLand.pas
changeset 7477 26706bf32ecf
parent 7293 468cf6d561e5
child 7483 d479b98d38f7
equal deleted inserted replaced
7474:bbecb1b4f59b 7477:26706bf32ecf
    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;
    35 
    35 
    36 var digest: shortstring;
    36 var digest: shortstring;
       
    37 
       
    38 procedure ResizeLand(width, height: LongWord);
       
    39 var potW, potH: LongWord;
       
    40 begin 
       
    41 potW:= toPowerOf2(width);
       
    42 potH:= toPowerOf2(height);
       
    43 if (potW <> LAND_WIDTH) or (potH <> LAND_HEIGHT) then
       
    44     begin
       
    45     LAND_WIDTH:= potW;
       
    46     LAND_HEIGHT:= potH;
       
    47     LAND_WIDTH_MASK:= not(LAND_WIDTH-1);
       
    48     LAND_HEIGHT_MASK:= not(LAND_HEIGHT-1);
       
    49     cWaterLine:= LAND_HEIGHT;
       
    50     if (cReducedQuality and rqBlurryLand) = 0 then
       
    51         SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
       
    52     else
       
    53         SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2);
       
    54 
       
    55     SetLength(Land, LAND_HEIGHT, LAND_WIDTH);
       
    56     SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32));
       
    57     uLandTexture.initModule;
       
    58     end;
       
    59 end;
    37 
    60 
    38 procedure ColorizeLand(Surface: PSDL_Surface);
    61 procedure ColorizeLand(Surface: PSDL_Surface);
    39 var tmpsurf: PSDL_Surface;
    62 var tmpsurf: PSDL_Surface;
    40     r, rr: TSDL_Rect;
    63     r, rr: TSDL_Rect;
    41     x, yd, yu: LongInt;
    64     x, yd, yu: LongInt;
   179 procedure GenBlank(var Template: TEdgeTemplate);
   202 procedure GenBlank(var Template: TEdgeTemplate);
   180 var pa: TPixAr;
   203 var pa: TPixAr;
   181     i: Longword;
   204     i: Longword;
   182     y, x: Longword;
   205     y, x: Longword;
   183 begin
   206 begin
       
   207     ResizeLand(Template.TemplateWidth, Template.TemplateHeight);
   184     for y:= 0 to LAND_HEIGHT - 1 do
   208     for y:= 0 to LAND_HEIGHT - 1 do
   185         for x:= 0 to LAND_WIDTH - 1 do
   209         for x:= 0 to LAND_WIDTH - 1 do
   186             Land[y, x]:= lfBasic;
   210             Land[y, x]:= lfBasic;
   187     {$HINTS OFF}
   211     {$HINTS OFF}
   188     SetPoints(Template, pa);
   212     SetPoints(Template, pa);
   235         end;
   259         end;
   236 end;
   260 end;
   237 
   261 
   238 procedure GenDrawnMap;
   262 procedure GenDrawnMap;
   239 begin
   263 begin
       
   264     ResizeLand(4096, 2048);
   240     uLandPainted.Draw;
   265     uLandPainted.Draw;
   241 
   266 
   242     MaxHedgehogs:= 48;
   267     MaxHedgehogs:= 48;
   243     hasGirders:= true;
   268     hasGirders:= true;
   244     playHeight:= 2048;
   269     playHeight:= 2048;
   297     x,y: Longword;
   322     x,y: Longword;
   298 begin
   323 begin
   299     WriteLnToConsole('Generating land...');
   324     WriteLnToConsole('Generating land...');
   300     case cMapGen of
   325     case cMapGen of
   301         0: GenBlank(EdgeTemplates[SelectTemplate]);
   326         0: GenBlank(EdgeTemplates[SelectTemplate]);
   302         1: GenMaze;
   327         1: begin ResizeLand(4096,2048); GenMaze; end;
   303         2: GenDrawnMap;
   328         2: GenDrawnMap;
   304     else
   329     else
   305         OutError('Unknown mapgen', true);
   330         OutError('Unknown mapgen', true);
   306     end;
   331     end;
   307     AddProgress();
   332     AddProgress();
   487     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
   512     mapName:= ExtractFileName(Pathz[ptMapCurrent]);
   488     tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
   513     tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);
   489     if tmpsurf = nil then
   514     if tmpsurf = nil then
   490         tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   515         tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   491     end;
   516     end;
   492 TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true);
   517 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
       
   518 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
       
   519 
       
   520 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   493 
   521 
   494 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
   522 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what
   495 s:= UserPathz[ptMapCurrent] + '/map.cfg';
   523 s:= UserPathz[ptMapCurrent] + '/map.cfg';
   496 if not FileExists(s) then
   524 if not FileExists(s) then
   497     s:= Pathz[ptMapCurrent] + '/map.cfg';
   525     s:= Pathz[ptMapCurrent] + '/map.cfg';
   679 
   707 
   680 UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false);
   708 UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false);
   681 end;
   709 end;
   682 
   710 
   683 procedure GenPreview(out Preview: TPreview);
   711 procedure GenPreview(out Preview: TPreview);
   684 var x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
   712 var rh, rw, ox, oy, x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
   685 begin
   713 begin
   686     WriteLnToConsole('Generating preview...');
   714     WriteLnToConsole('Generating preview...');
   687     case cMapGen of
   715     case cMapGen of
   688         0: GenBlank(EdgeTemplates[SelectTemplate]);
   716         0: GenBlank(EdgeTemplates[SelectTemplate]);
   689         1: GenMaze;
   717         1: GenMaze;
   690         2: GenDrawnMap;
   718         2: GenDrawnMap;
   691     else
   719     else
   692         OutError('Unknown mapgen', true);
   720         OutError('Unknown mapgen', true);
   693     end;
   721     end;
   694 
   722 
   695     lh:= LAND_HEIGHT div 128;
   723     // strict scaling needed here since preview assumes a rectangle
   696     lw:= LAND_WIDTH div 32;
   724     rh:= max(LAND_HEIGHT,2048);
       
   725     rw:= max(LAND_WIDTH,4096);
       
   726     ox:= 0;
       
   727     if rw < rh*2 then
       
   728         begin
       
   729         rw:= rh*2;
       
   730         end;
       
   731     if rh < rw div 2 then rh:= rw * 2;
       
   732     
       
   733     ox:= (rw-LAND_WIDTH) div 2;
       
   734     oy:= rh-LAND_HEIGHT;
       
   735 
       
   736     lh:= rh div 128;
       
   737     lw:= rw div 32;
   697     for y:= 0 to 127 do
   738     for y:= 0 to 127 do
   698         for x:= 0 to 31 do
   739         for x:= 0 to 31 do
   699         begin
   740         begin
   700             Preview[y, x]:= 0;
   741             Preview[y, x]:= 0;
   701             for bit:= 0 to 7 do
   742             for bit:= 0 to 7 do
   702             begin
   743             begin
   703                 t:= 0;
   744                 t:= 0;
   704                 cbit:= bit * 8;
   745                 cbit:= bit * 8;
   705                 for yy:= y * lh to y * lh + 7 do
   746                 for yy:= y * lh to y * lh + 7 do
   706                     for xx:= x * lw + cbit to x * lw + cbit + 7 do
   747                     for xx:= x * lw + cbit to x * lw + cbit + 7 do
   707                         if Land[yy, xx] <> 0 then
   748                         if ((yy-oy) and LAND_HEIGHT_MASK = 0) and ((xx-ox) and LAND_WIDTH_MASK = 0) 
       
   749                            and (Land[yy-oy, xx-ox] <> 0) then
   708                             inc(t);
   750                             inc(t);
   709                 if t > 8 then
   751                 if t > 8 then
   710                     Preview[y, x]:= Preview[y, x] or ($80 shr bit);
   752                     Preview[y, x]:= Preview[y, x] or ($80 shr bit);
   711             end;
   753             end;
   712         end;
   754         end;