hedgewars/uStore.pas
changeset 47 8daf1ee0b9a3
parent 43 e297fea1a2f3
child 49 3afe33c1cf06
equal deleted inserted replaced
46:c99140d2355a 47:8daf1ee0b9a3
     1 (*
     1 (*
     2  * Hedgewars, a worms-like game
     2  * Hedgewars, a worms-like game
     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
     3  * Copyright (c) 2004, 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com>
     4  *
     4  *
     5  * Distributed under the terms of the BSD-modified licence:
     5  * Distributed under the terms of the BSD-modified licence:
     6  *
     6  *
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
     8  * of this software and associated documentation files (the "Software"), to deal
     8  * of this software and associated documentation files (the "Software"), to deal
    49 procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
    49 procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
    50 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
    50 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);
    51 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    51 procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
    52 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    52 procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
    53 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
    53 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
       
    54 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
    54 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    55 procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
    55 procedure DrawExplosion(X, Y, Radius: integer);
    56 procedure DrawExplosion(X, Y, Radius: integer);
    56 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
    57 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
    57 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
    58 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);
    58 procedure RenderHealth(var Hedgehog: THedgehog);
    59 procedure RenderHealth(var Hedgehog: THedgehog);
   281   rr.y:= Y;
   282   rr.y:= Y;
   282   SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
   283   SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
   283   SDL_FreeSurface(tmpsurf);
   284   SDL_FreeSurface(tmpsurf);
   284 end;
   285 end;
   285 
   286 
       
   287 procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface);
       
   288 var r: TSDL_Rect;
       
   289 begin
       
   290 r:= rect^;
       
   291 SDL_FillRect(Surface, @r, 0);
       
   292 r.y:= rect.y + 1;
       
   293 r.h:= rect.h - 2;
       
   294 SDL_FillRect(Surface, @r, BorderColor);
       
   295 r.x:= rect.x + 1;
       
   296 r.w:= rect.w - 2;
       
   297 r.y:= rect.y;
       
   298 r.h:= rect.h;
       
   299 SDL_FillRect(Surface, @r, BorderColor);
       
   300 r.x:= rect.x + 2;
       
   301 r.y:= rect.y + 1;
       
   302 r.w:= rect.w - 4;
       
   303 r.h:= rect.h - 2;
       
   304 SDL_FillRect(Surface, @r, FillColor);
       
   305 r.x:= rect.x + 1;
       
   306 r.y:= rect.y + 2;
       
   307 r.w:= rect.w - 2;
       
   308 r.h:= rect.h - 4;
       
   309 SDL_FillRect(Surface, @r, FillColor)
       
   310 end;
       
   311 
   286 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
   312 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
   287 var w, h: integer;
   313 var w, h: integer;
   288     tmpsurf: PSDL_Surface;
   314     tmpsurf: PSDL_Surface;
   289     clr: TSDL_Color;
   315     clr: TSDL_Color;
   290 begin
   316 begin
   291 TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h);
   317 TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h);
   292 Result.x:= X;
   318 Result.x:= X;
   293 Result.y:= Y;
   319 Result.y:= Y;
   294 Result.w:= w + 6;
   320 Result.w:= w + 6;
   295 Result.h:= h + 6;
   321 Result.h:= h + 6;
   296 SDL_FillRect(Surface, @Result, 0);
   322 DrawRoundRect(@Result, cWhiteColor, cColorNearBlack, Surface);
   297 Result.w:= 1;
       
   298 Result.y:= Y + 1;
       
   299 Result.h:= h + 4;
       
   300 SDL_FillRect(Surface, @Result, cWhiteColor);
       
   301 Result.x:= X + w + 5;
       
   302 SDL_FillRect(Surface, @Result, cWhiteColor);
       
   303 Result.x:= X + 1;
       
   304 Result.w:= w + 4;
       
   305 Result.y:= Y;
       
   306 Result.h:= 1;
       
   307 SDL_FillRect(Surface, @Result, cWhiteColor);
       
   308 Result.y:= Y + h + 5;
       
   309 SDL_FillRect(Surface, @Result, cWhiteColor);
       
   310 Result.x:= X + 1;
       
   311 Result.y:= Y + 1;
       
   312 Result.h:= h + 4;
       
   313 SDL_FillRect(Surface, @Result, cColorNearBlack);
       
   314 SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b);
   323 SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b);
   315 tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr);
   324 tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr);
   316 Result.x:= X + 3;
   325 Result.x:= X + 3;
   317 Result.y:= Y + 3;
   326 Result.y:= Y + 3;
   318 SDL_UpperBlit(tmpsurf, nil, Surface, @Result);
   327 SDL_UpperBlit(tmpsurf, nil, Surface, @Result);
   331     tmpsurf: PSDL_Surface;
   340     tmpsurf: PSDL_Surface;
   332 
   341 
   333     procedure WriteNames(Font: THWFont);
   342     procedure WriteNames(Font: THWFont);
   334     var Team: PTeam;
   343     var Team: PTeam;
   335         i: integer;
   344         i: integer;
   336         r: TSDL_Rect;
   345         r, rr: TSDL_Rect;
   337     begin
   346     begin
   338     r.x:= 0;
   347     r.x:= 0;
   339     r.y:= 272;
   348     r.y:= 272;
   340     Team:= TeamsList;
   349     Team:= TeamsList;
   341     while Team<>nil do
   350     while Team<>nil do
   342       begin
   351       begin
   343       r.w:= 1968;
   352       r.w:= 104;
   344       r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);
   353       r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);
   345       Team.NameRect:= r;
   354       Team.NameRect:= r;
       
   355       inc(r.y, r.h);
       
   356       r.w:= cTeamHealthWidth + 5;
       
   357       DrawRoundRect(@r, cWhiteColor, cColorNearBlack, StoreSurface);
       
   358       Team.HealthRect:= r;
       
   359       rr:= r;
       
   360       inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
       
   361       DrawRoundRect(@rr, Team.Color, Team.Color, StoreSurface);
   346       inc(r.y, r.h);
   362       inc(r.y, r.h);
   347       for i:= 0 to 7 do
   363       for i:= 0 to 7 do
   348           if Team.Hedgehogs[i].Gear<>nil then
   364           if Team.Hedgehogs[i].Gear<>nil then
   349              begin
   365              begin
   350              r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);
   366              r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);
   586 const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
   602 const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
   587 begin
   603 begin
   588 DrawFromRect(X, Y, @r, LandSurface, Surface)
   604 DrawFromRect(X, Y, @r, LandSurface, Surface)
   589 end;
   605 end;
   590 
   606 
       
   607 procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);
       
   608 begin
       
   609 DrawFromRect(X, Y, Rect, StoreSurface, Surface)
       
   610 end;
       
   611 
   591 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
   612 procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
   592 begin
   613 begin
   593 if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface,  Surface)
   614 if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface,  Surface)
   594                 else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
   615                 else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
   595 end;
   616 end;