hedgewars/uStore.pas
changeset 689 f4ec46c48ed2
parent 620 451cabd49241
child 690 e9d35e319328
equal deleted inserted replaced
688:e4d1fb310a66 689:f4ec46c48ed2
    22 {$INCLUDE options.inc}
    22 {$INCLUDE options.inc}
    23 
    23 
    24 procedure StoreInit;
    24 procedure StoreInit;
    25 procedure StoreLoad;
    25 procedure StoreLoad;
    26 procedure StoreRelease;
    26 procedure StoreRelease;
    27 procedure DrawGear(Stuff : TStuff; X, Y: LongInt; Surface: PSDL_Surface);
    27 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
    28 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
       
    29 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
    28 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
    30 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
    29 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
    31 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source, Surface: PSDL_Surface);
    30 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source, Surface: PSDL_Surface);
    32 procedure DrawLand (X, Y: LongInt; Surface: PSDL_Surface);
    31 procedure DrawLand (X, Y: LongInt; Surface: PSDL_Surface);
    33 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
    32 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
    56 StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
    55 StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
    57 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
    56 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
    58 SDL_FillRect(StoreSurface, nil, 0);
    57 SDL_FillRect(StoreSurface, nil, 0);
    59 
    58 
    60 TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
    59 TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
    61 end;
       
    62 
       
    63 procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: LongInt);
       
    64 var tmpsurf: PSDL_Surface;
       
    65     rr: TSDL_Rect;
       
    66 begin
       
    67   tmpsurf:= LoadImage(Filename, false, true, false);
       
    68   rr.x:= X;
       
    69   rr.y:= Y;
       
    70   SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
       
    71   SDL_FreeSurface(tmpsurf);
       
    72 end;
    60 end;
    73 
    61 
    74 procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);
    62 procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);
    75 var r: TSDL_Rect;
    63 var r: TSDL_Rect;
    76 begin
    64 begin
   123 Result.h:= h + FontBorder * 2;
   111 Result.h:= h + FontBorder * 2;
   124 WriteInRoundRect:= Result
   112 WriteInRoundRect:= Result
   125 end;
   113 end;
   126 
   114 
   127 procedure StoreLoad;
   115 procedure StoreLoad;
   128 var i: TStuff;
   116 var ii: TSprite;
   129     ii: TSprite;
       
   130     fi: THWFont;
   117     fi: THWFont;
   131     s: string;
   118     s: string;
   132     tmpsurf: PSDL_Surface;
   119     tmpsurf: PSDL_Surface;
   133 
   120 
   134     procedure WriteNames(Font: THWFont);
   121     procedure WriteNames(Font: THWFont);
   195                  RenderHealth(Hedgehogs[i]);
   182                  RenderHealth(Hedgehogs[i]);
   196           end
   183           end
   197     end;
   184     end;
   198 
   185 
   199     procedure LoadGraves;
   186     procedure LoadGraves;
   200     var t, l: LongInt;
   187     var t: LongInt;
   201     begin
   188     begin
   202     l:= 512;
       
   203     for t:= 0 to Pred(TeamsCount) do
   189     for t:= 0 to Pred(TeamsCount) do
   204      if TeamsArray[t] <> nil then
   190      if TeamsArray[t] <> nil then
   205       with TeamsArray[t]^ do
   191       with TeamsArray[t]^ do
   206           begin
   192           begin
   207           dec(l, 32);
       
   208           if GraveName = '' then GraveName:= 'Simple';
   193           if GraveName = '' then GraveName:= 'Simple';
   209           LoadToSurface(Pathz[ptGraves] + '/' + GraveName, StoreSurface, l, 512);
   194           GraveSurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
   210           GraveRect.x:= l;
       
   211           GraveRect.y:= 512;
       
   212           GraveRect.w:= 32;
       
   213           GraveRect.h:= 256;
       
   214           end
   195           end
   215     end;
   196     end;
   216 
   197 
   217     procedure GetSkyColor;
   198     procedure GetSkyColor;
   218     var p: PByteArray;
   199     var p: PByteArray;
   272    end else LandSurface:= tmpsurf;
   253    end else LandSurface:= tmpsurf;
   273 TryDo(SDL_SetColorKey(LandSurface, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
   254 TryDo(SDL_SetColorKey(LandSurface, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
   274 WriteLnToConsole(msgOK);
   255 WriteLnToConsole(msgOK);
   275 
   256 
   276 GetExplosionBorderColor;
   257 GetExplosionBorderColor;
   277 
       
   278 AddProgress;
       
   279 for i:= Low(TStuff) to High(TStuff) do
       
   280     LoadToSurface(Pathz[StuffLoadData[i].Path] + '/' + StuffLoadData[i].FileName, StoreSurface, StuffPoz[i].x, StuffPoz[i].y);
       
   281 
   258 
   282 AddProgress;
   259 AddProgress;
   283 WriteNames(fnt16);
   260 WriteNames(fnt16);
   284 MakeCrossHairs;
   261 MakeCrossHairs;
   285 LoadGraves;
   262 LoadGraves;
   327    OutError('Blit: ' + SDL_GetError, true);
   304    OutError('Blit: ' + SDL_GetError, true);
   328    exit
   305    exit
   329    end;
   306    end;
   330 end;
   307 end;
   331 
   308 
   332 procedure DrawGear(Stuff: TStuff; X, Y: LongInt; Surface: PSDL_Surface);
   309 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
   333 begin
       
   334 DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)
       
   335 end;
       
   336 
       
   337 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
       
   338 begin
   310 begin
   339 r.y:= r.y + Height * Position;
   311 r.y:= r.y + Height * Position;
   340 r.h:= Height;
   312 r.h:= Height;
   341 DrawFromRect(X, Y, @r, StoreSurface, Surface)
   313 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
   342 end;
   314 end;
   343 
   315 
   344 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
   316 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
   345 begin
   317 begin
   346 DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)
   318 DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)