hedgewars/uStore.pas
changeset 762 5ecf042f6113
parent 761 63ae90011a52
child 764 7513452b1d51
equal deleted inserted replaced
761:63ae90011a52 762:5ecf042f6113
    26 procedure StoreRelease;
    26 procedure StoreRelease;
    27 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
    27 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
    28 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
    28 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
    29 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);
    30 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: GLuint; Surface: PSDL_Surface);
    30 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: GLuint; Surface: PSDL_Surface);
    31 procedure DrawLand (X, Y: LongInt; Surface: PSDL_Surface);
    31 procedure DrawLand (X, Y: LongInt);
       
    32 procedure DrawTexture(X, Y: LongInt; Texture: PTexture);
    32 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
    33 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
    33 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
    34 procedure DrawCentered(X, Top: LongInt; Source: PTexture);
    34 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture; DestSurface: PSDL_Surface);
    35 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture; DestSurface: PSDL_Surface);
    35 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
    36 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
    36 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
    37 function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
    37 procedure RenderHealth(var Hedgehog: THedgehog);
    38 procedure RenderHealth(var Hedgehog: THedgehog);
    38 procedure AddProgress;
    39 procedure AddProgress;
    39 procedure FinishProgress;
    40 procedure FinishProgress;
    40 function  LoadImage(const filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
    41 function  LoadImage(const filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
    41 procedure SetupOpenGL;
    42 procedure SetupOpenGL;
    42 
    43 
    43 var PixelFormat: PSDL_PixelFormat;
    44 var PixelFormat: PSDL_PixelFormat;
    44  SDLPrimSurface: PSDL_Surface;
    45  SDLPrimSurface: PSDL_Surface;
    45    PauseSurface: PSDL_Surface;
    46    PauseTexture: PTexture;
    46 
    47 
    47 implementation
    48 implementation
    48 uses uMisc, uConsole, uLand, uLocale, GLU;
    49 uses uMisc, uConsole, uLand, uLocale, GLU;
    49 
    50 
    50 var
    51 var
   124     r.y:= 0;
   125     r.y:= 0;
   125     drY:= cScreenHeight - 4;
   126     drY:= cScreenHeight - 4;
   126     for t:= 0 to Pred(TeamsCount) do
   127     for t:= 0 to Pred(TeamsCount) do
   127      with TeamsArray[t]^ do
   128      with TeamsArray[t]^ do
   128       begin
   129       begin
   129       NameTag:= RenderString(TeamName, Clan^.Color, Font);
   130       NameTagTex:= RenderStringTex(TeamName, Clan^.Color, Font);
   130 
   131 
   131       r.w:= cTeamHealthWidth + 5;
   132       r.w:= cTeamHealthWidth + 5;
   132       r.h:= NameTag^.h;
   133       r.h:= NameTagTex^.h;
   133 
   134 
   134       HealthSurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, r.w, r.h, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
   135       HealthSurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, r.w, r.h, cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
   135       TryDo(HealthSurf <> nil, errmsgCreateSurface, true);
   136       TryDo(HealthSurf <> nil, errmsgCreateSurface, true);
   136       TryDo(SDL_SetColorKey(HealthSurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
   137       TryDo(SDL_SetColorKey(HealthSurf, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
   137 
   138 
   143       dec(drY, r.h + 2);
   144       dec(drY, r.h + 2);
   144       DrawHealthY:= drY;
   145       DrawHealthY:= drY;
   145       for i:= 0 to 7 do
   146       for i:= 0 to 7 do
   146           with Hedgehogs[i] do
   147           with Hedgehogs[i] do
   147                if Gear <> nil then
   148                if Gear <> nil then
   148                   NameTag:= RenderString(Name, Clan^.Color, fnt16);
   149                   NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);
   149       end;
   150       end;
   150     end;
   151     end;
   151 
   152 
   152     procedure MakeCrossHairs;
   153     procedure MakeCrossHairs;
   153     var t: LongInt;
   154     var t: LongInt;
   289 HHTexture:= Surface2Tex(tmpsurf);
   290 HHTexture:= Surface2Tex(tmpsurf);
   290 SDL_FreeSurface(tmpsurf);
   291 SDL_FreeSurface(tmpsurf);
   291 
   292 
   292 InitHealth;
   293 InitHealth;
   293 
   294 
   294 PauseSurface:= RenderString(trmsg[sidPaused], $FFFF00, fntBig);
   295 PauseTexture:= RenderStringTex(trmsg[sidPaused], $FFFF00, fntBig);
   295 
   296 
   296 {$IFDEF DUMP}
   297 {$IFDEF DUMP}
   297 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
   298 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
   298 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
   299 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
   299 {$ENDIF}
   300 {$ENDIF}
   327 glVertex2i(rr.w + X, rr.h + Y);
   328 glVertex2i(rr.w + X, rr.h + Y);
   328 
   329 
   329 glTexCoord2f(0, b);
   330 glTexCoord2f(0, b);
   330 glVertex2i(X, rr.h + Y);
   331 glVertex2i(X, rr.h + Y);
   331 
   332 
   332 glEnd();
   333 glEnd()
       
   334 end;
       
   335 
       
   336 procedure DrawTexture(X, Y: LongInt; Texture: PTexture);
       
   337 begin
       
   338 glBindTexture(GL_TEXTURE_2D, Texture^.id);
       
   339 glEnable(GL_TEXTURE_2D);
       
   340 
       
   341 glBegin(GL_QUADS);
       
   342 
       
   343 glTexCoord2f(0, 0);
       
   344 glVertex2i(X, Y);
       
   345 
       
   346 glTexCoord2f(1, 0);
       
   347 glVertex2i(Texture^.w + X, Y);
       
   348 
       
   349 glTexCoord2f(1, 1);
       
   350 glVertex2i(Texture^.w + X, Texture^.h + Y);
       
   351 
       
   352 glTexCoord2f(0, 1);
       
   353 glVertex2i(X, Texture^.h + Y);
       
   354 
       
   355 glEnd()
   333 end;
   356 end;
   334 
   357 
   335 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
   358 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
   336 begin
   359 begin
   337 r.y:= r.y + Height * Position;
   360 r.y:= r.y + Height * Position;
   387    end;
   410    end;
   388 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   411 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   389 SDL_FreeSurface(tmpsurf)
   412 SDL_FreeSurface(tmpsurf)
   390 end;
   413 end;
   391 
   414 
   392 procedure DrawLand(X, Y: LongInt; Surface: PSDL_Surface);
   415 procedure DrawLand(X, Y: LongInt);
   393 //const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
   416 begin
   394 begin
   417 DrawTexture(X, Y, LandTexture)
   395 glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   418 end;
   396 glEnable(GL_TEXTURE_2D);
   419 
   397 
   420 procedure DrawCentered(X, Top: LongInt; Source: PTexture);
   398 glBegin(GL_QUADS);
   421 begin
   399 
   422 DrawTexture(X - Source^.w div 2, Top, Source)
   400 glTexCoord2i(0, 0);
       
   401 glVertex2i(X, Y);
       
   402 
       
   403 glTexCoord2i(1, 0);
       
   404 glVertex2i(2048 + X, Y);
       
   405 
       
   406 glTexCoord2i(1, 1);
       
   407 glVertex2i(2048 + X, 1024 + Y);
       
   408 
       
   409 glTexCoord2i(0, 1);
       
   410 glVertex2i(X, 1024 + Y);
       
   411 
       
   412 glEnd();
       
   413 //DrawFromRect(X, Y, @r, LandSurface, Surface)
       
   414 end;
       
   415 
       
   416 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
       
   417 var r: TSDL_Rect;
       
   418 begin
       
   419 r.x:= X - Source^.w div 2;
       
   420 r.y:= Top;
       
   421 r.w:= Source^.w;
       
   422 r.h:= Source^.h;
       
   423 SDL_UpperBlit(Source, nil, Surface, @r)
       
   424 end;
   423 end;
   425 
   424 
   426 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
   425 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
   427 var l, r, t, b: real;
   426 var l, r, t, b: real;
   428 begin
   427 begin
   471 FreeTexture(LandTexture);
   470 FreeTexture(LandTexture);
   472 
   471 
   473 SDL_FreeSurface(LandSurface)
   472 SDL_FreeSurface(LandSurface)
   474 end;
   473 end;
   475 
   474 
   476 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
   475 function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
   477 var w, h: LongInt;
   476 var w, h: LongInt;
   478     Result: PSDL_Surface;
   477     Result: PSDL_Surface;
   479 begin
   478 begin
   480 TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(s), w, h);
   479 TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(s), w, h);
   481 Result:= SDL_CreateRGBSurface(SDL_HWSURFACE, w + FontBorder * 2 + 4, h + FontBorder * 2,
   480 Result:= SDL_CreateRGBSurface(SDL_SWSURFACE, w + FontBorder * 2 + 4, h + FontBorder * 2,
   482          cBits, PixelFormat^.RMask, PixelFormat^.GMask, PixelFormat^.BMask, PixelFormat^.AMask);
   481          32, RMask, GMask, BMask, AMask);
   483 TryDo(Result <> nil, 'RenderString: fail to create surface', true);
   482 TryDo(Result <> nil, 'RenderString: fail to create surface', true);
   484 WriteInRoundRect(Result, 0, 0, Color, font, s);
   483 WriteInRoundRect(Result, 0, 0, Color, font, s);
   485 TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
   484 TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
   486 RenderString:= Result
   485 RenderStringTex:= Surface2Tex(Result);
       
   486 SDL_FreeSurface(Result)
   487 end;
   487 end;
   488 
   488 
   489 procedure RenderHealth(var Hedgehog: THedgehog);
   489 procedure RenderHealth(var Hedgehog: THedgehog);
   490 var s: shortstring;
   490 var s: shortstring;
   491 begin
   491 begin
   492 str(Hedgehog.Gear^.Health, s);
   492 str(Hedgehog.Gear^.Health, s);
   493 if Hedgehog.HealthTag <> nil then SDL_FreeSurface(Hedgehog.HealthTag);
   493 if Hedgehog.HealthTagTex <> nil then FreeTexture(Hedgehog.HealthTagTex);
   494 Hedgehog.HealthTag:= RenderString(s, Hedgehog.Team^.Clan^.Color, fnt16)
   494 Hedgehog.HealthTagTex:= RenderStringTex(s, Hedgehog.Team^.Clan^.Color, fnt16)
   495 end;
   495 end;
   496 
   496 
   497 function  LoadImage(const filename: string; hasAlpha: boolean; critical, setTransparent: boolean): PSDL_Surface;
   497 function  LoadImage(const filename: string; hasAlpha: boolean; critical, setTransparent: boolean): PSDL_Surface;
   498 var tmpsurf: PSDL_Surface;
   498 var tmpsurf: PSDL_Surface;
   499     //Result: PSDL_Surface;
   499     //Result: PSDL_Surface;
   523 WriteLnToConsole(msgOK);
   523 WriteLnToConsole(msgOK);
   524 LoadImage:= tmpsurf//Result
   524 LoadImage:= tmpsurf//Result
   525 end;
   525 end;
   526 
   526 
   527 procedure SetupOpenGL;
   527 procedure SetupOpenGL;
   528 var aspect: real;
   528 //var aspect: real;
   529 begin
   529 begin
   530 aspect:= cScreenWidth / cScreenHeight;
   530 //aspect:= cScreenWidth / cScreenHeight;
   531 
   531 
   532 glLoadIdentity;
   532 glLoadIdentity;
   533 glViewport(0, 0, cScreenWidth, cScreenHeight);
   533 glViewport(0, 0, cScreenWidth, cScreenHeight);
   534 glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
   534 glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
   535 glTranslatef(-cScreenWidth / 2, -cScreenHeight / 2, 0);
   535 glTranslatef(-cScreenWidth / 2, -cScreenHeight / 2, 0);