hedgewars/uStore.pas
changeset 755 edf26e9554ac
parent 754 94ac14829085
child 756 2b307457fd68
equal deleted inserted replaced
754:94ac14829085 755:edf26e9554ac
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
    17  *)
    17  *)
    18 
    18 
    19 unit uStore;
    19 unit uStore;
    20 interface
    20 interface
    21 uses uConsts, uTeams, SDLh, uFloat;
    21 uses uConsts, uTeams, SDLh, uFloat, GL;
    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 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, 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; Surface: PSDL_Surface);
    32 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);
    33 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
    33 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
    34 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
    34 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);
    35 procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
    36 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
    36 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
    37 procedure RenderHealth(var Hedgehog: THedgehog);
    37 procedure RenderHealth(var Hedgehog: THedgehog);
    38 procedure AddProgress;
    38 procedure AddProgress;
    39 procedure FinishProgress;
    39 procedure FinishProgress;
    43 var PixelFormat: PSDL_PixelFormat;
    43 var PixelFormat: PSDL_PixelFormat;
    44  SDLPrimSurface: PSDL_Surface;
    44  SDLPrimSurface: PSDL_Surface;
    45    PauseSurface: PSDL_Surface;
    45    PauseSurface: PSDL_Surface;
    46 
    46 
    47 implementation
    47 implementation
    48 uses uMisc, uConsole, uLand, uLocale, GL, GLU;
    48 uses uMisc, uConsole, uLand, uLocale, GLU;
    49 
    49 
    50 var
    50 var
    51     HHSurface: PSDL_Surface;
    51     HHSurface: PSDL_Surface;
    52 
    52 
    53 procedure StoreInit;
    53 procedure StoreInit;
   194           GraveSurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
   194           GraveSurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
   195           end
   195           end
   196     end;
   196     end;
   197 
   197 
   198     procedure GetSkyColor;
   198     procedure GetSkyColor;
   199     var p: PByteArray;
   199 //    var p: PByteArray;
   200     begin
   200     begin
   201     if SDL_MustLock(SpritesData[sprSky].Surface) then
   201 (*    if SDL_MustLock(SpritesData[sprSky].Surface) then
   202        SDLTry(SDL_LockSurface(SpritesData[sprSky].Surface) >= 0, true);
   202        SDLTry(SDL_LockSurface(SpritesData[sprSky].Surface) >= 0, true);
   203     p:= SpritesData[sprSky].Surface^.pixels;
   203     p:= SpritesData[sprSky].Surface^.pixels;
   204     case SpritesData[sprSky].Surface^.format^.BytesPerPixel of
   204     case SpritesData[sprSky].Surface^.format^.BytesPerPixel of
   205          1: cSkyColor:= PByte(p)^;
   205          1: cSkyColor:= PByte(p)^;
   206          2: cSkyColor:= PWord(p)^;
   206          2: cSkyColor:= PWord(p)^;
   207          3: cSkyColor:= (p^[0]) or (p^[1] shl 8) or (p^[2] shl 16);
   207          3: cSkyColor:= (p^[0]) or (p^[1] shl 8) or (p^[2] shl 16);
   208          4: cSkyColor:= PLongword(p)^;
   208          4: cSkyColor:= PLongword(p)^;
   209          end;
   209          end;*)
       
   210     cSkyColor:= $3030A0;
   210     glClearColor((cSkyColor shr 16) / 255, ((cSkyColor shr 8) and $FF) / 255, (cSkyColor and $FF) / 255, 0);
   211     glClearColor((cSkyColor shr 16) / 255, ((cSkyColor shr 8) and $FF) / 255, (cSkyColor and $FF) / 255, 0);
   211 
   212 
   212     if SDL_MustLock(SpritesData[sprSky].Surface) then
   213 //    if SDL_MustLock(SpritesData[sprSky].Surface) then
   213        SDL_UnlockSurface(SpritesData[sprSky].Surface)
   214 //       SDL_UnlockSurface(SpritesData[sprSky].Surface)
   214     end;
   215     end;
   215 
   216 
   216     procedure GetExplosionBorderColor;
   217     procedure GetExplosionBorderColor;
   217     var f: textfile;
   218     var f: textfile;
   218         c: LongInt;
   219         c: LongInt;
   266 AddProgress;
   267 AddProgress;
   267 for ii:= Low(TSprite) to High(TSprite) do
   268 for ii:= Low(TSprite) to High(TSprite) do
   268     with SpritesData[ii] do
   269     with SpritesData[ii] do
   269          begin
   270          begin
   270          if AltPath = ptNone then
   271          if AltPath = ptNone then
   271             Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, true, true)
   272             tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, true, true)
   272          else begin
   273          else begin
   273             Surface:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, false, true);
   274             tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, hasAlpha, false, true);
   274             if Surface = nil then
   275             if tmpsurf = nil then
   275                Surface:= LoadImage(Pathz[AltPath] + '/' + FileName, hasAlpha, true, true)
   276                tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, hasAlpha, true, true)
   276             end;
   277             end;
   277          if Width = 0 then Width:= Surface^.w;
   278          if Width = 0 then Width:= tmpsurf^.w;
   278          if Height = 0 then Height:= Surface^.h
   279          if Height = 0 then Height:= tmpsurf^.h;
       
   280          Texture:= Surface2Tex(tmpsurf)
   279          end;
   281          end;
   280 
   282 
   281 GetSkyColor;
   283 GetSkyColor;
   282 
   284 
   283 AddProgress;
   285 AddProgress;
   292 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
   294 SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
   293 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
   295 SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
   294 {$ENDIF}
   296 {$ENDIF}
   295 end;
   297 end;
   296 
   298 
   297 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
   299 procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture; DestSurface: PSDL_Surface);
   298 var rr: TSDL_Rect;
   300 var rr: TSDL_Rect;
       
   301     t, b: real;
   299 begin
   302 begin
   300 rr.x:= X;
   303 rr.x:= X;
   301 rr.y:= Y;
   304 rr.y:= Y;
   302 rr.w:= r^.w;
   305 rr.w:= r^.w;
   303 rr.h:= r^.h;
   306 rr.h:= r^.h;
   304 if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then
   307 
   305    begin
   308 t:= r^.y / SourceTexture^.h;
   306    OutError('Blit: ' + SDL_GetError, true);
   309 b:= (r^.y + r^.h) / SourceTexture^.h;
   307    exit
   310 
   308    end;
   311 glBindTexture(GL_TEXTURE_2D, SourceTexture^.id);
       
   312 glEnable(GL_TEXTURE_2D);
       
   313 
       
   314 glBegin(GL_QUADS);
       
   315 
       
   316 glTexCoord2f(0, t);
       
   317 glVertex2i(X, Y);
       
   318 
       
   319 glTexCoord2f(1, t);
       
   320 glVertex2i(rr.w + X, Y);
       
   321 
       
   322 glTexCoord2f(1, b);
       
   323 glVertex2i(rr.w + X, rr.h + Y);
       
   324 
       
   325 glTexCoord2f(0, b);
       
   326 glVertex2i(X, rr.h + Y);
       
   327 
       
   328 glEnd();
   309 end;
   329 end;
   310 
   330 
   311 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
   331 procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
   312 begin
   332 begin
   313 r.y:= r.y + Height * Position;
   333 r.y:= r.y + Height * Position;
   314 r.h:= Height;
   334 r.h:= Height;
   315 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
   335 DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
   316 end;
   336 end;
   317 
   337 
   318 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
   338 procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
   319 begin
   339 var r: TSDL_Rect;
   320 DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)
   340 begin
       
   341 r.x:= 0;
       
   342 r.w:= SpritesData[Sprite].Width;
       
   343 r.y:= Frame * SpritesData[Sprite].Height;
       
   344 r.h:= SpritesData[Sprite].Height;
       
   345 DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
   321 end;
   346 end;
   322 
   347 
   323 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
   348 procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
   324 var r: TSDL_Rect;
   349 var r: TSDL_Rect;
   325 begin
   350 begin
   326 r.x:= FrameX * SpritesData[Sprite].Width;
   351 r.x:= FrameX * SpritesData[Sprite].Width;
   327 r.w:= SpritesData[Sprite].Width;
   352 r.w:= SpritesData[Sprite].Width;
   328 r.y:= FrameY * SpritesData[Sprite].Height;
   353 r.y:= FrameY * SpritesData[Sprite].Height;
   329 r.h:= SpritesData[Sprite].Height;
   354 r.h:= SpritesData[Sprite].Height;
   330 DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
   355 DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
   331 end;
   356 end;
   332 
   357 
   333 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source, Surface: PSDL_Surface);
   358 procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: GLuint; Surface: PSDL_Surface);
   334 var r: TSDL_Rect;
   359 //var r: TSDL_Rect;
   335 begin
   360 begin
   336 r.x:= 0;
   361 //r.x:= 0;
   337 r.w:= Source^.w;
   362 //r.w:= Source^.w;
   338 r.y:= Frame * Height;
   363 //r.y:= Frame * Height;
   339 r.h:= Height;
   364 //r.h:= Height;
   340 DrawFromRect(X, Y, @r, Source, Surface)
   365 //DrawFromRect(X, Y, @r, Source, Surface)
   341 end;
   366 end;
   342 
   367 
   343 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
   368 procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
   344 var clr: TSDL_Color;
   369 var clr: TSDL_Color;
   345     tmpsurf: PSDL_Surface;
   370     tmpsurf: PSDL_Surface;
   359 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   384 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   360 SDL_FreeSurface(tmpsurf)
   385 SDL_FreeSurface(tmpsurf)
   361 end;
   386 end;
   362 
   387 
   363 procedure DrawLand(X, Y: LongInt; Surface: PSDL_Surface);
   388 procedure DrawLand(X, Y: LongInt; Surface: PSDL_Surface);
   364 const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
   389 //const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
   365 begin
   390 begin
   366 glBindTexture(GL_TEXTURE_2D, LandTexture);
   391 glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   367 glEnable(GL_TEXTURE_2D);
   392 glEnable(GL_TEXTURE_2D);
   368 
   393 
   369         glBegin(GL_QUADS);
   394 glBegin(GL_QUADS);
   370 
   395 
   371         // top left
   396 glTexCoord2i(0, 0);
   372         glTexCoord2i(0, 0);
   397 glVertex2i(X, Y);
   373         glVertex2i(X, Y);
   398 
   374 
   399 glTexCoord2i(1, 0);
   375         // top right
   400 glVertex2i(2048 + X, Y);
   376         glTexCoord2i(1, 0);
   401 
   377         glVertex2i(2048 + X, Y);
   402 glTexCoord2i(1, 1);
   378 
   403 glVertex2i(2048 + X, 1024 + Y);
   379         // bottom right
   404 
   380         glTexCoord2i(1, 1);
   405 glTexCoord2i(0, 1);
   381         glVertex2i(2048 + X, 1024 + Y);
   406 glVertex2i(X, 1024 + Y);
   382 
   407 
   383         // bottom left
   408 glEnd();
   384         glTexCoord2i(0, 1);
       
   385         glVertex2i(X, 1024 + Y);
       
   386 
       
   387         glEnd();
       
   388 //DrawFromRect(X, Y, @r, LandSurface, Surface)
   409 //DrawFromRect(X, Y, @r, LandSurface, Surface)
   389 end;
   410 end;
   390 
   411 
   391 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
   412 procedure DrawCentered(X, Top: LongInt; Source, Surface: PSDL_Surface);
   392 var r: TSDL_Rect;
   413 var r: TSDL_Rect;
   404 r.x:= Step * 32;
   425 r.x:= Step * 32;
   405 r.y:= Pos * 32;
   426 r.y:= Pos * 32;
   406 if Dir = -1 then r.x:= HHSurface^.w - 32 - r.x;
   427 if Dir = -1 then r.x:= HHSurface^.w - 32 - r.x;
   407 r.w:= 32;
   428 r.w:= 32;
   408 r.h:= 32;
   429 r.h:= 32;
   409 DrawFromRect(X, Y, @r, HHSurface, Surface)
   430 //DrawFromRect(X, Y, @r, HHSurface, Surface)
   410 end;
   431 end;
   411 
   432 
   412 procedure StoreRelease;
   433 procedure StoreRelease;
   413 var ii: TSprite;
   434 var ii: TSprite;
   414 begin
   435 begin
   415 for ii:= Low(TSprite) to High(TSprite) do
   436 for ii:= Low(TSprite) to High(TSprite) do
   416     SDL_FreeSurface(SpritesData[ii].Surface);
   437     glDeleteTextures(1, @SpritesData[ii].Texture);
   417 SDL_FreeSurface(  HHSurface  );
   438 SDL_FreeSurface(  HHSurface  );
   418 SDL_FreeSurface(LandSurface  )
   439 SDL_FreeSurface(LandSurface  )
   419 end;
   440 end;
   420 
   441 
   421 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
   442 function  RenderString(s: string; Color: Longword; font: THWFont): PSDL_Surface;
   500 SDL_FillRect(SDLPrimSurface, nil, 0);
   521 SDL_FillRect(SDLPrimSurface, nil, 0);
   501 r.x:= 0;
   522 r.x:= 0;
   502 r.w:= ProgrSurf^.w;
   523 r.w:= ProgrSurf^.w;
   503 r.h:= ProgrSurf^.w;
   524 r.h:= ProgrSurf^.w;
   504 r.y:= (Step mod (ProgrSurf^.h div ProgrSurf^.w)) * ProgrSurf^.w;
   525 r.y:= (Step mod (ProgrSurf^.h div ProgrSurf^.w)) * ProgrSurf^.w;
   505 DrawFromRect((cScreenWidth - ProgrSurf^.w) div 2,
   526 //DrawFromRect((cScreenWidth - ProgrSurf^.w) div 2,
   506              (cScreenHeight - ProgrSurf^.w) div 2, @r, ProgrSurf, SDLPrimSurface);
   527 //             (cScreenHeight - ProgrSurf^.w) div 2, @r, ProgrSurf, SDLPrimSurface);
   507 SDL_Flip(SDLPrimSurface);
   528 SDL_Flip(SDLPrimSurface);
   508 inc(Step);
   529 inc(Step);
   509 end;
   530 end;
   510 
   531 
   511 procedure FinishProgress;
   532 procedure FinishProgress;