hedgewars/uMisc.pas
changeset 4375 ae5507ddb989
parent 4374 bcefeeabaa33
child 4376 9654205a9424
equal deleted inserted replaced
4374:bcefeeabaa33 4375:ae5507ddb989
    29 procedure AdjustColor(var Color: Longword);
    29 procedure AdjustColor(var Color: Longword);
    30 procedure SetKB(n: Longword);
    30 procedure SetKB(n: Longword);
    31 *)
    31 *)
    32 procedure SendKB;
    32 procedure SendKB;
    33 procedure SendStat(sit: TStatInfoType; s: shortstring);
    33 procedure SendStat(sit: TStatInfoType; s: shortstring);
    34 function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
       
    35 function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
       
    36 procedure FreeTexture(tex: PTexture);
       
    37 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
    34 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
    38 procedure OutError(Msg: shortstring; isFatalError: boolean);
    35 procedure OutError(Msg: shortstring; isFatalError: boolean);
    39 procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean); inline;
    36 procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean); inline;
    40 procedure SDLTry(Assert: boolean; isFatal: boolean);
    37 procedure SDLTry(Assert: boolean; isFatal: boolean);
    41 procedure MakeScreenshot(filename: shortstring);
    38 procedure MakeScreenshot(filename: shortstring);
    95 KBnum:= n
    92 KBnum:= n
    96 end;
    93 end;
    97 *)
    94 *)
    98 
    95 
    99 
    96 
   100 procedure SetTextureParameters(enableClamp: Boolean);
       
   101 begin
       
   102     if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
       
   103     begin
       
   104         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
       
   105         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
       
   106     end;
       
   107     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
       
   108     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
       
   109 end;
       
   110 
       
   111 
       
   112 procedure SendKB;
    97 procedure SendKB;
   113 var s: shortstring;
    98 var s: shortstring;
   114 begin
    99 begin
   115 if KBnum <> 0 then
   100 if KBnum <> 0 then
   116 begin
   101 begin
   123 const stc: array [TStatInfoType] of char = 'rDkKHTPsSB';
   108 const stc: array [TStatInfoType] of char = 'rDkKHTPsSB';
   124 var buf: shortstring;
   109 var buf: shortstring;
   125 begin
   110 begin
   126 buf:= 'i' + stc[sit] + s;
   111 buf:= 'i' + stc[sit] + s;
   127 SendIPCRaw(@buf[0], length(buf) + 1)
   112 SendIPCRaw(@buf[0], length(buf) + 1)
   128 end;
       
   129 
       
   130 
       
   131 procedure ResetVertexArrays(texture: PTexture);
       
   132 begin
       
   133 with texture^ do
       
   134     begin
       
   135     vb[0].X:= 0;
       
   136     vb[0].Y:= 0;
       
   137     vb[1].X:= w;
       
   138     vb[1].Y:= 0;
       
   139     vb[2].X:= w;
       
   140     vb[2].Y:= h;
       
   141     vb[3].X:= 0;
       
   142     vb[3].Y:= h;
       
   143 
       
   144     tb[0].X:= 0;
       
   145     tb[0].Y:= 0;
       
   146     tb[1].X:= rx;
       
   147     tb[1].Y:= 0;
       
   148     tb[2].X:= rx;
       
   149     tb[2].Y:= ry;
       
   150     tb[3].X:= 0;
       
   151     tb[3].Y:= ry
       
   152     end;
       
   153 end;
       
   154 
       
   155 function NewTexture(width, height: Longword; buf: Pointer): PTexture;
       
   156 begin
       
   157 new(NewTexture);
       
   158 NewTexture^.PrevTexture:= nil;
       
   159 NewTexture^.NextTexture:= nil;
       
   160 NewTexture^.Scale:= 1;
       
   161 if TextureList <> nil then
       
   162     begin
       
   163     TextureList^.PrevTexture:= NewTexture;
       
   164     NewTexture^.NextTexture:= TextureList
       
   165     end;
       
   166 TextureList:= NewTexture;
       
   167 
       
   168 NewTexture^.w:= width;
       
   169 NewTexture^.h:= height;
       
   170 NewTexture^.rx:= 1.0;
       
   171 NewTexture^.ry:= 1.0;
       
   172 
       
   173 ResetVertexArrays(NewTexture);
       
   174 
       
   175 glGenTextures(1, @NewTexture^.id);
       
   176 
       
   177 glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
       
   178 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
       
   179 
       
   180 SetTextureParameters(true);
       
   181 end;
       
   182 
       
   183 function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
       
   184 var tw, th, x, y: Longword;
       
   185     tmpp: pointer;
       
   186     fromP4, toP4: PLongWordArray;
       
   187 begin
       
   188 new(Surface2Tex);
       
   189 Surface2Tex^.PrevTexture:= nil;
       
   190 Surface2Tex^.NextTexture:= nil;
       
   191 if TextureList <> nil then
       
   192     begin
       
   193     TextureList^.PrevTexture:= Surface2Tex;
       
   194     Surface2Tex^.NextTexture:= TextureList
       
   195     end;
       
   196 TextureList:= Surface2Tex;
       
   197 
       
   198 Surface2Tex^.w:= surf^.w;
       
   199 Surface2Tex^.h:= surf^.h;
       
   200 
       
   201 if (surf^.format^.BytesPerPixel <> 4) then
       
   202     begin
       
   203     TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
       
   204     Surface2Tex^.id:= 0;
       
   205     exit
       
   206     end;
       
   207 
       
   208 
       
   209 glGenTextures(1, @Surface2Tex^.id);
       
   210 
       
   211 glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
       
   212 
       
   213 if SDL_MustLock(surf) then
       
   214     SDLTry(SDL_LockSurface(surf) >= 0, true);
       
   215 
       
   216 if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
       
   217     begin
       
   218     tw:= toPowerOf2(Surf^.w);
       
   219     th:= toPowerOf2(Surf^.h);
       
   220 
       
   221     Surface2Tex^.rx:= Surf^.w / tw;
       
   222     Surface2Tex^.ry:= Surf^.h / th;
       
   223 
       
   224     GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel);
       
   225 
       
   226     fromP4:= Surf^.pixels;
       
   227     toP4:= tmpp;
       
   228 
       
   229     for y:= 0 to Pred(Surf^.h) do
       
   230         begin
       
   231         for x:= 0 to Pred(Surf^.w) do toP4^[x]:= fromP4^[x];
       
   232         for x:= Surf^.w to Pred(tw) do toP4^[x]:= 0;
       
   233         toP4:= @(toP4^[tw]);
       
   234         fromP4:= @(fromP4^[Surf^.pitch div 4])
       
   235         end;
       
   236 
       
   237     for y:= Surf^.h to Pred(th) do
       
   238         begin
       
   239         for x:= 0 to Pred(tw) do toP4^[x]:= 0;
       
   240         toP4:= @(toP4^[tw])
       
   241         end;
       
   242 
       
   243     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
       
   244 
       
   245     FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
       
   246     end
       
   247 else
       
   248     begin
       
   249     Surface2Tex^.rx:= 1.0;
       
   250     Surface2Tex^.ry:= 1.0;
       
   251     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, surf^.w, surf^.h, 0, GL_RGBA, GL_UNSIGNED_BYTE, surf^.pixels);
       
   252     end;
       
   253 
       
   254 ResetVertexArrays(Surface2Tex);
       
   255 
       
   256 if SDL_MustLock(surf) then
       
   257     SDL_UnlockSurface(surf);
       
   258 
       
   259 SetTextureParameters(enableClamp);
       
   260 end;
       
   261 
       
   262 procedure FreeTexture(tex: PTexture);
       
   263 begin
       
   264     if tex <> nil then
       
   265     begin
       
   266         if tex^.NextTexture <> nil then
       
   267             tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
       
   268         if tex^.PrevTexture <> nil then
       
   269             tex^.PrevTexture^.NextTexture:= tex^.NextTexture
       
   270         else
       
   271             TextureList:= tex^.NextTexture;
       
   272         glDeleteTextures(1, @tex^.id);
       
   273         Dispose(tex);
       
   274     end
       
   275 end;
   113 end;
   276 
   114 
   277 
   115 
   278 procedure MakeScreenshot(filename: shortstring);
   116 procedure MakeScreenshot(filename: shortstring);
   279 var p: Pointer;
   117 var p: Pointer;
   366 end;
   204 end;
   367 
   205 
   368 procedure freeModule;
   206 procedure freeModule;
   369 begin
   207 begin
   370     recordFileName:= '';
   208     recordFileName:= '';
   371     while TextureList <> nil do FreeTexture(TextureList);
       
   372 end;
   209 end;
   373 
   210 
   374 end.
   211 end.