Mercurial Mercurial > sheepy-clone / 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 95 1ef5e2c41115
parent 83 207c85fbef51
child 97 e7c1df9cce2c
equal deleted inserted replaced
94:c6eec0bdb630 95:1ef5e2c41115 
    43 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
 
    43 procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
 
    44 procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
 
    44 procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
 
    45 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
 
    45 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
 
    46 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
 
    46 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
 
    47 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
 
    47 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
 
    48 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
 
    48 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
       
    49 procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);
 
    49 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
    50 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
    50 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
    51 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
       
    52 function  RenderString(var s: shortstring; Color: integer; font: THWFont): PSDL_Surface;
 
    51 procedure RenderHealth(var Hedgehog: THedgehog);
 
    53 procedure RenderHealth(var Hedgehog: THedgehog);
 
    52 function  RenderString(var s: shortstring; Color, Pos: integer): PSDL_Surface;
 
       
    53 procedure AddProgress;
 
    54 procedure AddProgress;
 
    54 function  LoadImage(filename: string; hasAlpha: boolean; const critical: boolean = true): PSDL_Surface;
 
    55 function  LoadImage(filename: string; hasAlpha: boolean; const critical: boolean = true): PSDL_Surface;
 
    55 
    56 
    56 var PixelFormat: PSDL_PixelFormat;
 
    57 var PixelFormat: PSDL_PixelFormat;
 
    57  SDLPrimSurface: PSDL_Surface;
 
    58  SDLPrimSurface: PSDL_Surface;
 
    58 
    59 
    59 implementation
 
    60 implementation
 
    60 uses uMisc, uIO, uConsole, uLand, uCollisions;
 
    61 uses uMisc, uIO, uConsole, uLand, uCollisions;
 
    61 
    62 
    62 var StoreSurface,
 
    63 var StoreSurface,
 
    63      TempSurface,
 
       
    64        HHSurface: PSDL_Surface;
 
    64        HHSurface: PSDL_Surface;
 
    65 
    65 
    66 procedure StoreInit;
 
    66 procedure StoreInit;
 
    67 begin
 
    67 begin
 
    68 StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
 
    68 StoreSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
 
    69 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
 
    69 TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
 
    70 SDL_FillRect(StoreSurface, nil, 0);
 
    70 SDL_FillRect(StoreSurface, nil, 0);
 
    71 
    71 
    72 TempSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 724, 900, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
 
       
    73 TryDo(  TempSurface <> nil, errmsgCreateSurface + ': temp'  , true);
 
       
    74 
       
    75 TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
 
    72 TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
 
    76 TryDo(SDL_SetColorKey(  TempSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
 
       
    77 end;
 
    73 end;
 
    78 
    74 
    79 procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);
 
    75 procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);
 
    80 var tmpsurf: PSDL_Surface;
 
    76 var tmpsurf: PSDL_Surface;
 
    81     rr: TSDL_Rect;
 
    77     rr: TSDL_Rect;
 
   153     drY:= cScreenHeight - 4;
 
   149     drY:= cScreenHeight - 4;
 
   154     Team:= TeamsList;
 
   150     Team:= TeamsList;
 
   155     while Team<>nil do
 
   151     while Team<>nil do
 
   156       begin
 
   152       begin
 
   157       r.w:= 104;
 
   153       r.w:= 104;
 
   158       r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);
 
   154       Team.NameTag:= RenderString(Team.TeamName, Team.Color, Font);
 
   159       Team.NameRect:= r;
 
       
   160       inc(r.y, r.h);
 
       
   161       r.w:= cTeamHealthWidth + 5;
 
   155       r.w:= cTeamHealthWidth + 5;
 
       
   156       r.h:= Team.NameTag.h;
 
   162       DrawRoundRect(@r, cWhiteColor, cColorNearBlack, StoreSurface);
 
   157       DrawRoundRect(@r, cWhiteColor, cColorNearBlack, StoreSurface);
 
   163       Team.HealthRect:= r;
 
   158       Team.HealthRect:= r;
 
   164       rr:= r;
 
   159       rr:= r;
 
   165       inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
 
   160       inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
 
   166       DrawRoundRect(@rr, Team.Color, Team.Color, StoreSurface, false);
 
   161       DrawRoundRect(@rr, Team.Color, Team.Color, StoreSurface, false);
 
   167       inc(r.y, r.h);
 
   162       inc(r.y, r.h);
 
   168       dec(drY, r.h + 2);
 
   163       dec(drY, r.h + 2);
 
   169       Team.DrawHealthY:= drY;
 
   164       Team.DrawHealthY:= drY;
 
   170       for i:= 0 to 7 do
 
   165       for i:= 0 to 7 do
 
   171           if Team.Hedgehogs[i].Gear<>nil then
 
   166           with Team.Hedgehogs[i] do
 
   172              begin
 
   167                if Gear <> nil then
 
   173              r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);
 
   168                   NameTag:= RenderString(Name, Team.Color, fnt16);
 
   174              Team.Hedgehogs[i].NameRect:= r;
 
       
   175              inc(r.y, r.h)
 
       
   176              end;
 
       
   177       Team:= Team.Next
 
   169       Team:= Team.Next
 
   178       end;
 
   170       end;
 
   179     end;
 
   171     end;
 
   180 
   172 
   181     procedure MakeCrossHairs;
 
   173     procedure MakeCrossHairs;
 
   207     SDL_FreeSurface(tmpsurf)
 
   199     SDL_FreeSurface(tmpsurf)
 
   208     end;
 
   200     end;
 
   209 
   201 
   210     procedure InitHealth;
 
   202     procedure InitHealth;
 
   211     var p: PTeam;
 
   203     var p: PTeam;
 
   212         i, t: integer;
 
   204         i: integer;
 
   213     begin
 
   205     begin
 
   214     p:= TeamsList;
 
   206     p:= TeamsList;
 
   215     t:= 0;
 
       
   216     while p <> nil do
 
   207     while p <> nil do
 
   217           begin
 
   208           begin
 
   218           for i:= 0 to cMaxHHIndex do
 
   209           for i:= 0 to cMaxHHIndex do
 
   219               if p.Hedgehogs[i].Gear <> nil then
 
   210               if p.Hedgehogs[i].Gear <> nil then
 
   220                  begin
 
       
   221                  p.Hedgehogs[i].HealthRect.y:= t;
 
       
   222                  RenderHealth(p.Hedgehogs[i]);
 
   211                  RenderHealth(p.Hedgehogs[i]);
 
   223                  inc(t, p.Hedgehogs[i].HealthRect.h)
 
       
   224                  end;
 
       
   225           p:= p.Next
 
   212           p:= p.Next
 
   226           end
 
   213           end
 
   227     end;
 
   214     end;
 
   228 
   215 
   229     procedure LoadGraves;
 
   216     procedure LoadGraves;
 
   345 InitHealth;
 
   332 InitHealth;
 
   346 
   333 
   347 {$IFDEF DUMP}
 
   334 {$IFDEF DUMP}
 
   348 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
 
   335 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
 
   349 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
 
   336 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
 
   350 SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.bmp', 'wb'), 1);
 
       
   351 {$ENDIF}
 
   337 {$ENDIF}
 
   352 end;
 
   338 end;
 
   353 
   339 
   354 procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
 
   340 procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
 
   355 var rr: TSDL_Rect;
 
   341 var rr: TSDL_Rect;
 
   419 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
   405 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
 
   420 begin
 
   406 begin
 
   421 DrawFromRect(X, Y, Rect, StoreSurface, Surface)
 
   407 DrawFromRect(X, Y, Rect, StoreSurface, Surface)
 
   422 end;
 
   408 end;
 
   423 
   409 
   424 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
 
   410 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface);
 
   425 begin
 
   411 begin
 
   426 if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface,  Surface)
 
   412 DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
 
   427                 else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
 
   413 end;
 
       
   414 
       
   415 procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);
 
       
   416 var r: TSDL_Rect;
 
       
   417 begin
 
       
   418 r.x:= X - Source.w div 2;
 
       
   419 r.y:= Top;
 
       
   420 r.w:= Source.w;
 
       
   421 r.h:= Source.h;
 
       
   422 SDL_UpperBlit(Source, nil, Surface, @r)
 
   428 end;
 
   423 end;
 
   429 
   424 
   430 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
   425 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
 
   431 var r: TSDL_Rect;
 
   426 var r: TSDL_Rect;
 
   432 begin
 
   427 begin
 
   442 var ii: TSprite;
 
   437 var ii: TSprite;
 
   443 begin
 
   438 begin
 
   444 for ii:= Low(TSprite) to High(TSprite) do
 
   439 for ii:= Low(TSprite) to High(TSprite) do
 
   445     SDL_FreeSurface(SpritesData[ii].Surface);
 
   440     SDL_FreeSurface(SpritesData[ii].Surface);
 
   446 SDL_FreeSurface(  HHSurface  );
 
   441 SDL_FreeSurface(  HHSurface  );
 
   447 SDL_FreeSurface(TempSurface  );
 
       
   448 SDL_FreeSurface(LandSurface  );
 
   442 SDL_FreeSurface(LandSurface  );
 
   449 SDL_FreeSurface(StoreSurface )
 
   443 SDL_FreeSurface(StoreSurface )
 
   450 end;
 
   444 end;
 
   451 
   445 
       
   446 function RenderString(var s: shortstring; Color: integer; font: THWFont): PSDL_Surface;
 
       
   447 var w, h: integer;
 
       
   448 begin
 
       
   449 TTF_SizeUTF8(Fontz[font].Handle, PChar(String(s)), w, h);
 
       
   450 Result:= SDL_CreateRGBSurface(SDL_HWSURFACE, w + 6, h + 2, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
 
       
   451 WriteInRoundRect(Result, 0, 0, Color, font, s);
 
       
   452 TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)
 
       
   453 end;
 
       
   454 
   452 procedure RenderHealth(var Hedgehog: THedgehog);
 
   455 procedure RenderHealth(var Hedgehog: THedgehog);
 
   453 var s: string[15];
 
   456 var s: shortstring;
 
   454 begin
 
   457 begin
 
   455 str(Hedgehog.Gear.Health, s);
 
   458 str(Hedgehog.Gear.Health, s);
 
   456 Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s);
 
   459 if Hedgehog.HealthTag <> nil then SDL_FreeSurface(Hedgehog.HealthTag);
 
   457 if Hedgehog.Gear.Damage > 0 then
 
   460 Hedgehog.HealthTag:= RenderString(s, Hedgehog.Team^.Color, fnt16)
 
   458    begin
 
       
   459    str(Hedgehog.Gear.Damage, s);
 
       
   460    Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s)
 
       
   461    end;
 
       
   462 end;
 
       
   463 
       
   464 function RenderString(var s: shortstring; Color, Pos: integer): PSDL_Surface;
 
       
   465 var w, h: integer;
 
       
   466 begin
 
       
   467 TTF_SizeUTF8(Fontz[fntBig].Handle, PChar(String(s)), w, h);
 
       
   468 Result:= SDL_CreateRGBSurface(SDL_HWSURFACE, w + 6, h + 2, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
 
       
   469 WriteInRoundRect(Result, 0, 0, Color, fntBig, s);
 
       
   470 TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)
 
       
   471 end;
 
   461 end;
 
   472 
   462 
   473 procedure AddProgress;
 
   463 procedure AddProgress;
 
   474 const Step: Longword = 0;
 
   464 const Step: Longword = 0;
 
   475       ProgrSurf: PSDL_Surface = nil;
 
   465       ProgrSurf: PSDL_Surface = nil;
sheepy-clone