Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uStore.pas
changeset 371 731ad6d27bd1
parent 355 40c68869899e
child 393 db01cc79f278
equal deleted inserted replaced
370:c75410fe3133 371:731ad6d27bd1 
    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: integer; Surface: PSDL_Surface);
 
    27 procedure DrawGear(Stuff : TStuff; X, Y: LongInt; Surface: PSDL_Surface);
 
    28 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; 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: integer; Surface: PSDL_Surface);
 
    29 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
 
    30 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
 
    30 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
 
    31 procedure DrawSurfSprite(X, Y, Height, Frame: integer; Source, Surface: PSDL_Surface);
 
    31 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source, Surface: PSDL_Surface);
 
    32 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
 
    32 procedure DrawLand (X, Y: LongInt; Surface: PSDL_Surface);
 
    33 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
 
    33 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
 
    34 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
    34 procedure DrawCaption(X, Y: LongInt; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
    35 procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);
 
    35 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
 
    36 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
    36 procedure DrawFromStoreRect(X, Y: LongInt; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
    37 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
    37 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
 
    38 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
 
    38 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
 
    39 procedure RenderHealth(var Hedgehog: THedgehog);
 
    39 procedure RenderHealth(var Hedgehog: THedgehog);
 
    40 procedure AddProgress;
 
    40 procedure AddProgress;
 
    41 function  LoadImage(filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
 
    41 function  LoadImage(filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
 
    42 
    42 
    57 SDL_FillRect(StoreSurface, nil, 0);
 
    57 SDL_FillRect(StoreSurface, nil, 0);
 
    58 
    58 
    59 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);
 
    60 end;
 
    60 end;
 
    61 
    61 
    62 procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);
 
    62 procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: LongInt);
 
    63 var tmpsurf: PSDL_Surface;
 
    63 var tmpsurf: PSDL_Surface;
 
    64     rr: TSDL_Rect;
 
    64     rr: TSDL_Rect;
 
    65 begin
 
    65 begin
 
    66   tmpsurf:= LoadImage(Filename, false, true, false);
 
    66   tmpsurf:= LoadImage(Filename, false, true, false);
 
    67   rr.x:= X;
 
    67   rr.x:= X;
 
    93 r.w:= rect^.w - 2;
 
    93 r.w:= rect^.w - 2;
 
    94 r.h:= rect^.h - 4;
 
    94 r.h:= rect^.h - 4;
 
    95 SDL_FillRect(Surface, @r, FillColor)
 
    95 SDL_FillRect(Surface, @r, FillColor)
 
    96 end;
 
    96 end;
 
    97 
    97 
    98 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
 
    98 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
 
    99 var w, h: LongInt;
 
    99 var w, h: LongInt;
 
   100     tmpsurf: PSDL_Surface;
 
   100     tmpsurf: PSDL_Surface;
 
   101     clr: TSDL_Color;
 
   101     clr: TSDL_Color;
 
   102     Result: TSDL_Rect;
 
   102     Result: TSDL_Rect;
 
   103 begin
 
   103 begin
 
   130     s: string;
 
   130     s: string;
 
   131     tmpsurf: PSDL_Surface;
 
   131     tmpsurf: PSDL_Surface;
 
   132 
   132 
   133     procedure WriteNames(Font: THWFont);
 
   133     procedure WriteNames(Font: THWFont);
 
   134     var Team: PTeam;
 
   134     var Team: PTeam;
 
   135         i: integer;
 
   135         i: LongInt;
 
   136         r, rr: TSDL_Rect;
 
   136         r, rr: TSDL_Rect;
 
   137         drY: integer;
 
   137         drY: LongInt;
 
   138     begin
 
   138     begin
 
   139     r.x:= 0;
 
   139     r.x:= 0;
 
   140     r.y:= 272;
 
   140     r.y:= 272;
 
   141     drY:= cScreenHeight - 4;
 
   141     drY:= cScreenHeight - 4;
 
   142     Team:= TeamsList;
 
   142     Team:= TeamsList;
 
   184     SDL_FreeSurface(tmpsurf)
 
   184     SDL_FreeSurface(tmpsurf)
 
   185     end;
 
   185     end;
 
   186 
   186 
   187     procedure InitHealth;
 
   187     procedure InitHealth;
 
   188     var p: PTeam;
 
   188     var p: PTeam;
 
   189         i: integer;
 
   189         i: LongInt;
 
   190     begin
 
   190     begin
 
   191     p:= TeamsList;
 
   191     p:= TeamsList;
 
   192     while p <> nil do
 
   192     while p <> nil do
 
   193           begin
 
   193           begin
 
   194           for i:= 0 to cMaxHHIndex do
 
   194           for i:= 0 to cMaxHHIndex do
 
   198           end
 
   198           end
 
   199     end;
 
   199     end;
 
   200 
   200 
   201     procedure LoadGraves;
 
   201     procedure LoadGraves;
 
   202     var p: PTeam;
 
   202     var p: PTeam;
 
   203         l: integer;
 
   203         l: LongInt;
 
   204     begin
 
   204     begin
 
   205     p:= TeamsList;
 
   205     p:= TeamsList;
 
   206     l:= 512;
 
   206     l:= 512;
 
   207     while p <> nil do
 
   207     while p <> nil do
 
   208           begin
 
   208           begin
 
   233        SDL_UnlockSurface(SpritesData[sprSky].Surface)
 
   233        SDL_UnlockSurface(SpritesData[sprSky].Surface)
 
   234     end;
 
   234     end;
 
   235 
   235 
   236     procedure GetExplosionBorderColor;
 
   236     procedure GetExplosionBorderColor;
 
   237     var f: textfile;
 
   237     var f: textfile;
 
   238         c: integer;
 
   238         c: LongInt;
 
   239     begin
 
   239     begin
 
   240     s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
 
   240     s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
 
   241     WriteToConsole(msgLoading + s + ' ');
 
   241     WriteToConsole(msgLoading + s + ' ');
 
   242     Assign(f, s);
 
   242     Assign(f, s);
 
   243     {$I-}
 
   243     {$I-}
 
   317 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
 
   317 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
 
   318 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
 
   318 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
 
   319 {$ENDIF}
 
   319 {$ENDIF}
 
   320 end;
 
   320 end;
 
   321 
   321 
   322 procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
 
   322 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
 
   323 var rr: TSDL_Rect;
 
   323 var rr: TSDL_Rect;
 
   324 begin
 
   324 begin
 
   325 rr.x:= X;
 
   325 rr.x:= X;
 
   326 rr.y:= Y;
 
   326 rr.y:= Y;
 
   327 rr.w:= r^.w;
 
   327 rr.w:= r^.w;
 
   331    OutError('Blit: ' + SDL_GetError, true);
 
   331    OutError('Blit: ' + SDL_GetError, true);
 
   332    exit
 
   332    exit
 
   333    end;
 
   333    end;
 
   334 end;
 
   334 end;
 
   335 
   335 
   336 procedure DrawGear(Stuff: TStuff; X, Y: integer; Surface: PSDL_Surface);
 
   336 procedure DrawGear(Stuff: TStuff; X, Y: LongInt; Surface: PSDL_Surface);
 
   337 begin
 
   337 begin
 
   338 DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)
 
   338 DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)
 
   339 end;
 
   339 end;
 
   340 
   340 
   341 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
 
   341 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
 
   342 begin
 
   342 begin
 
   343 r.y:= r.y + Height * Position;
 
   343 r.y:= r.y + Height * Position;
 
   344 r.h:= Height;
 
   344 r.h:= Height;
 
   345 DrawFromRect(X, Y, @r, StoreSurface, Surface)
 
   345 DrawFromRect(X, Y, @r, StoreSurface, Surface)
 
   346 end;
 
   346 end;
 
   347 
   347 
   348 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: integer; Surface: PSDL_Surface);
 
   348 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
 
   349 begin
 
   349 begin
 
   350 DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)
 
   350 DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)
 
   351 end;
 
   351 end;
 
   352 
   352 
   353 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
 
   353 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
 
   354 var r: TSDL_Rect;
 
   354 var r: TSDL_Rect;
 
   355 begin
 
   355 begin
 
   356 r.x:= FrameX * SpritesData[Sprite].Width;
 
   356 r.x:= FrameX * SpritesData[Sprite].Width;
 
   357 r.w:= SpritesData[Sprite].Width;
 
   357 r.w:= SpritesData[Sprite].Width;
 
   358 r.y:= FrameY * SpritesData[Sprite].Height;
 
   358 r.y:= FrameY * SpritesData[Sprite].Height;
 
   359 r.h:= SpritesData[Sprite].Height;
 
   359 r.h:= SpritesData[Sprite].Height;
 
   360 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
 
   360 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
 
   361 end;
 
   361 end;
 
   362 
   362 
   363 procedure DrawSurfSprite(X, Y, Height, Frame: integer; Source, Surface: PSDL_Surface);
 
   363 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source, Surface: PSDL_Surface);
 
   364 var r: TSDL_Rect;
 
   364 var r: TSDL_Rect;
 
   365 begin
 
   365 begin
 
   366 r.x:= 0;
 
   366 r.x:= 0;
 
   367 r.w:= Source^.w;
 
   367 r.w:= Source^.w;
 
   368 r.y:= Frame * Height;
 
   368 r.y:= Frame * Height;
 
   369 r.h:= Height;
 
   369 r.h:= Height;
 
   370 DrawFromRect(X, Y, @r, Source, Surface)
 
   370 DrawFromRect(X, Y, @r, Source, Surface)
 
   371 end;
 
   371 end;
 
   372 
   372 
   373 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
 
   373 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
 
   374 var clr: TSDL_Color;
 
   374 var clr: TSDL_Color;
 
   375     tmpsurf: PSDL_Surface;
 
   375     tmpsurf: PSDL_Surface;
 
   376     r: TSDL_Rect;
 
   376     r: TSDL_Rect;
 
   377 begin
 
   377 begin
 
   378 r.x:= X;
 
   378 r.x:= X;
 
   388    end;
 
   388    end;
 
   389 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
 
   389 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
 
   390 SDL_FreeSurface(tmpsurf)
 
   390 SDL_FreeSurface(tmpsurf)
 
   391 end;
 
   391 end;
 
   392 
   392 
   393 procedure DrawLand(X, Y: integer; Surface: PSDL_Surface);
 
   393 procedure DrawLand(X, Y: LongInt; Surface: PSDL_Surface);
 
   394 const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
 
   394 const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
 
   395 begin
 
   395 begin
 
   396 DrawFromRect(X, Y, @r, LandSurface, Surface)
 
   396 DrawFromRect(X, Y, @r, LandSurface, Surface)
 
   397 end;
 
   397 end;
 
   398 
   398 
   399 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
   399 procedure DrawFromStoreRect(X, Y: LongInt; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
   400 begin
 
   400 begin
 
   401 DrawFromRect(X, Y, Rect, StoreSurface, Surface)
 
   401 DrawFromRect(X, Y, Rect, StoreSurface, Surface)
 
   402 end;
 
   402 end;
 
   403 
   403 
   404 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
   404 procedure DrawCaption(X, Y: LongInt; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
   405 begin
 
   405 begin
 
   406 DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
 
   406 DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
 
   407 end;
 
   407 end;
 
   408 
   408 
   409 procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);
 
   409 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
 
   410 var r: TSDL_Rect;
 
   410 var r: TSDL_Rect;
 
   411 begin
 
   411 begin
 
   412 r.x:= X - Source^.w div 2;
 
   412 r.x:= X - Source^.w div 2;
 
   413 r.y:= Top;
 
   413 r.y:= Top;
 
   414 r.w:= Source^.w;
 
   414 r.w:= Source^.w;
 
   415 r.h:= Source^.h;
 
   415 r.h:= Source^.h;
 
   416 SDL_UpperBlit(Source, nil, Surface, @r)
 
   416 SDL_UpperBlit(Source, nil, Surface, @r)
 
   417 end;
 
   417 end;
 
   418 
   418 
   419 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
   419 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
 
   420 var r: TSDL_Rect;
 
   420 var r: TSDL_Rect;
 
   421 begin
 
   421 begin
 
   422 r.x:= Step * 32;
 
   422 r.x:= Step * 32;
 
   423 r.y:= Pos * 32;
 
   423 r.y:= Pos * 32;
 
   424 if Dir = -1 then r.x:= HHSurface^.w - 32 - r.x;
 
   424 if Dir = -1 then r.x:= HHSurface^.w - 32 - r.x;
hedgewars