hedgewars/uLand.pas
branchqmlfrontend
changeset 11544 b69f5f22a3ba
parent 11539 c22d292e7266
child 11649 1fd1525653d8
equal deleted inserted replaced
11481:caa1e84c3ac2 11544:b69f5f22a3ba
   258 
   258 
   259 procedure LandSurface2LandPixels(Surface: PSDL_Surface);
   259 procedure LandSurface2LandPixels(Surface: PSDL_Surface);
   260 var x, y: LongInt;
   260 var x, y: LongInt;
   261     p: PLongwordArray;
   261     p: PLongwordArray;
   262 begin
   262 begin
   263 TryDo(Surface <> nil, 'Assert (LandSurface <> nil) failed', true);
   263 if checkFails(Surface <> nil, 'Assert (LandSurface <> nil) failed', true) then exit;
   264 
   264 
   265 if SDL_MustLock(Surface) then
   265 if SDL_MustLock(Surface) then
   266     SDLTry(SDL_LockSurface(Surface) >= 0, 'SDL_LockSurface', true);
   266     if SDLCheck(SDL_LockSurface(Surface) >= 0, 'SDL_LockSurface', true) then exit;
   267 
   267 
   268 p:= Surface^.pixels;
   268 p:= Surface^.pixels;
   269 for y:= 0 to LAND_HEIGHT - 1 do
   269 for y:= 0 to LAND_HEIGHT - 1 do
   270     begin
   270     begin
   271     for x:= 0 to LAND_WIDTH - 1 do
   271     for x:= 0 to LAND_WIDTH - 1 do
   289 begin
   289 begin
   290     AddProgress();
   290     AddProgress();
   291 
   291 
   292     tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, AMask);
   292     tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, AMask);
   293 
   293 
   294     TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   294     if checkFails(tmpsurf <> nil, 'Error creating pre-land surface', true) then exit;
   295     ColorizeLand(tmpsurf);
   295     ColorizeLand(tmpsurf);
   296     if gameFlags and gfShoppaBorder = 0 then DrawBorderFromImage(tmpsurf);
   296     if gameFlags and gfShoppaBorder = 0 then DrawBorderFromImage(tmpsurf);
   297     AddOnLandObjects(tmpsurf);
   297     AddOnLandObjects(tmpsurf);
   298 
   298 
   299     LandSurface2LandPixels(tmpsurf);
   299     LandSurface2LandPixels(tmpsurf);
   449     disableLandBack:= true;
   449     disableLandBack:= true;
   450 
   450 
   451     cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   451     cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   452     cpY:= LAND_HEIGHT - tmpsurf^.h;
   452     cpY:= LAND_HEIGHT - tmpsurf^.h;
   453     if SDL_MustLock(tmpsurf) then
   453     if SDL_MustLock(tmpsurf) then
   454         SDLTry(SDL_LockSurface(tmpsurf) >= 0, 'SDL_LockSurface', true);
   454         SDLCheck(SDL_LockSurface(tmpsurf) >= 0, 'SDL_LockSurface', true);
   455 
   455 
       
   456     if allOK then
       
   457     begin
   456         p:= tmpsurf^.pixels;
   458         p:= tmpsurf^.pixels;
   457         for y:= 0 to Pred(tmpsurf^.h) do
   459         for y:= 0 to Pred(tmpsurf^.h) do
   458             begin
   460             begin
   459             for x:= 0 to Pred(tmpsurf^.w) do
   461             for x:= 0 to Pred(tmpsurf^.w) do
   460                 SetLand(Land[cpY + y, cpX + x], p^[x]);
   462                 SetLand(Land[cpY + y, cpX + x], p^[x]);
   461             p:= PLongwordArray(@(p^[tmpsurf^.pitch div 4]));
   463             p:= PLongwordArray(@(p^[tmpsurf^.pitch div 4]));
   462             end;
   464             end;
   463 
   465 
   464     if SDL_MustLock(tmpsurf) then
   466         if SDL_MustLock(tmpsurf) then
   465         SDL_UnlockSurface(tmpsurf);
   467             SDL_UnlockSurface(tmpsurf);
   466     if not disableLandBack then
   468         if not disableLandBack then
   467         begin
   469             begin
   468         // freed in freeModule() below
   470             // freed in freeModule() below
   469         LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifTransparent);
   471             LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifTransparent);
   470         if (LandBackSurface <> nil) and GrayScale then
   472             if (LandBackSurface <> nil) and GrayScale then
   471             Surface2GrayScale(LandBackSurface)
   473                 Surface2GrayScale(LandBackSurface)
   472         end;
   474             end;
       
   475     end;
   473 end;
   476 end;
   474 if (tmpsurf <> nil) then
   477 if (tmpsurf <> nil) then
   475     SDL_FreeSurface(tmpsurf);
   478     SDL_FreeSurface(tmpsurf);
   476 tmpsurf:= nil;
   479 tmpsurf:= nil;
   477 end;
   480 end;
   485 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   488 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps);
   486 if tmpsurf = nil then
   489 if tmpsurf = nil then
   487     begin
   490     begin
   488     mapName:= ExtractFileName(cPathz[ptMapCurrent]);
   491     mapName:= ExtractFileName(cPathz[ptMapCurrent]);
   489     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
   492     tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
       
   493     if not allOK then exit;
   490     end;
   494     end;
   491 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   495 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
   492 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (QWord(tmpsurf^.w) * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true);
   496 if checkFails((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (QWord(tmpsurf^.w) * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true)
       
   497         then exit;
   493 
   498 
   494 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   499 ResizeLand(tmpsurf^.w, tmpsurf^.h);
   495 LoadMapConfig;
   500 LoadMapConfig;
   496 
   501 
   497 playHeight:= tmpsurf^.h;
   502 playHeight:= tmpsurf^.h;
   498 playWidth:= tmpsurf^.w;
   503 playWidth:= tmpsurf^.w;
   499 leftX:= (LAND_WIDTH - playWidth) div 2;
   504 leftX:= (LAND_WIDTH - playWidth) div 2;
   500 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   505 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   501 topY:= LAND_HEIGHT - playHeight;
   506 topY:= LAND_HEIGHT - playHeight;
   502 
   507 
   503 TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);
   508 if not checkFails(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true) then
   504 
   509     BlitImageAndGenerateCollisionInfo(
   505 BlitImageAndGenerateCollisionInfo(
   510         (LAND_WIDTH - tmpsurf^.w) div 2,
   506     (LAND_WIDTH - tmpsurf^.w) div 2,
   511         LAND_HEIGHT - tmpsurf^.h,
   507     LAND_HEIGHT - tmpsurf^.h,
   512         tmpsurf^.w,
   508     tmpsurf^.w,
   513         tmpsurf);
   509     tmpsurf);
   514 
   510 SDL_FreeSurface(tmpsurf);
   515 SDL_FreeSurface(tmpsurf);
   511 
   516 
   512 LoadMask;
   517 if allOK then LoadMask;
   513 end;
   518 end;
   514 
   519 
   515 procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
   520 procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
   516 var x, w, c: Longword;
   521 var x, w, c: Longword;
   517 begin
   522 begin
   660 
   665 
   661 else
   666 else
   662     AddProgress();
   667     AddProgress();
   663 
   668 
   664 FreeLandObjects;
   669 FreeLandObjects;
       
   670 
       
   671 if not allOK then exit;
   665 
   672 
   666 if GrayScale then
   673 if GrayScale then
   667     begin
   674     begin
   668     if (cReducedQuality and rqBlurryLand) = 0 then
   675     if (cReducedQuality and rqBlurryLand) = 0 then
   669         for x:= leftX to rightX do
   676         for x:= leftX to rightX do
   792 begin
   799 begin
   793     AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
   800     AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
   794     if digest = '' then
   801     if digest = '' then
   795         digest:= s
   802         digest:= s
   796     else
   803     else
   797         TryDo(s = digest, 'Different maps generated, sorry', true);
   804         checkFails(s = digest, 'Different maps generated, sorry', true);
   798 end;
   805 end;
   799 
   806 
   800 procedure chSendLandDigest(var s: shortstring);
   807 procedure chSendLandDigest(var s: shortstring);
   801 var adler, i: LongInt;
   808 var adler, i: LongInt;
   802 begin
   809 begin
   806     s:= 'M' + IntToStr(adler) + cScriptName;
   813     s:= 'M' + IntToStr(adler) + cScriptName;
   807 
   814 
   808     ScriptSetString('LandDigest', s);
   815     ScriptSetString('LandDigest', s);
   809 
   816 
   810     chLandCheck(s);
   817     chLandCheck(s);
   811     SendIPCRaw(@s[0], Length(s) + 1)
   818     if allOK then SendIPCRaw(@s[0], Length(s) + 1)
   812 end;
   819 end;
   813 
   820 
   814 procedure initModule;
   821 procedure initModule;
   815 begin
   822 begin
   816     RegisterVariable('landcheck', @chLandCheck, false);
   823     RegisterVariable('landcheck', @chLandCheck, false);