gl_image.pas

delphi编的不错的贪吃蛇

{$ALIGN 8}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): gl_image.c - model loading and caching                            }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 03-Apr-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ PROOFREADED: 8.03.2003 Juha }
{ PROOFREADED: 28.06.2003 Juha }
unit gl_image;

interface

{$I ..\Jedi.inc}

uses
  DelphiTypes,
  CPas,
  gl_local,
  gl_local_add,
  q_shared,
  OpenGL;

procedure GL_EnableMultitexture(enable: qboolean);
procedure GL_TexEnv(mode: TGLenum);
procedure GL_Bind(texnum: integer);

procedure GL_TextureMode(_string: PChar);
procedure GL_TextureAlphaMode(_string: PChar);
procedure GL_TextureSolidMode(_string: PChar);

procedure GL_ImageList_f; cdecl;

function GL_FindImage(name: PChar; _type: imagetype_t): image_p;
function R_RegisterSkin(name: PChar): pointer; cdecl;
procedure GL_FreeUnusedImages;
function GL_LoadPic(name: PChar; pic: PByte; width, height: integer; _type: imagetype_t; bits: integer): image_p;
procedure GL_SetTexturePalette(palette: PCardinalArray);

function Draw_GetPalette: integer;
procedure GL_InitImages;
procedure GL_ShutdownImages;
procedure GL_MBind(target: TGLenum; texnum: integer);
procedure GL_SelectTexture(texture: TGLenum);
procedure Scrap_Upload;

var
  gltextures: array[0..MAX_GLTEXTURES - 1] of image_t;
  numgltextures: Integer;
  scrap_dirty: qboolean;
  d_8to24table: array[0..256 - 1] of Cardinal;
  gl_solid_format: Integer = 3;
  gl_alpha_format: Integer = 4;

  gl_tex_solid_format: Integer = 3;
  gl_tex_alpha_format: Integer = 4;
  gl_filter_min: integer = GL_LINEAR_MIPMAP_NEAREST;
  gl_filter_max: integer = GL_LINEAR;

implementation

uses
  SysUtils,
  Math,
  QFiles,
  gl_draw,
  gl_rmain,
  gl_model,
  qgl_win,
  ref;

var
  base_textureid: Integer; // gltextures[i] = base_textureid+i

  intensitytable: array[0..256 - 1] of byte;
  gammatable: array[0..256 - 1] of byte;

  intensity: cvar_p;

function GL_Upload8(data: PByteArray; width, height: integer; mipmap, is_sky: qboolean): qboolean; forward;

procedure GL_SetTexturePalette(palette: PCardinalArray);
var
  i: integer;
  temptable: array[0..768 - 1] of byte;
begin
  if (@qglColorTableEXT <> nil) and (gl_ext_palettedtexture^.value <> 0) then
  begin
    for i := 0 to 255 do
    begin
      temptable[i * 3 + 0] := (palette[i] shr 0) and $FF;
      temptable[i * 3 + 1] := (palette[i] shr 8) and $FF;
      temptable[i * 3 + 2] := (palette[i] shr 16) and $FF;
    end;

    qglColorTableEXT(GL_SHARED_TEXTURE_PALETTE_EXT,
      GL_RGB,
      256,
      GL_RGB,
      GL_UNSIGNED_BYTE,
      @temptable);
  end;
end;

procedure GL_EnableMultitexture(enable: qboolean);
begin
  if (@qglSelectTextureSGIS = nil) and (@qglActiveTextureARB = nil) then
    Exit;

  if (enable) then
  begin
    GL_SelectTexture(GL_TEXTURE1);
    qglEnable(GL_TEXTURE_2D);
    GL_TexEnv(GL_REPLACE);
  end
  else
  begin
    GL_SelectTexture(GL_TEXTURE1);
    qglDisable(GL_TEXTURE_2D);
    GL_TexEnv(GL_REPLACE);
  end;
  GL_SelectTexture(GL_TEXTURE0);
  GL_TexEnv(GL_REPLACE);
end;

procedure GL_SelectTexture(texture: TGLenum);
var
  tmu: integer;
begin
  if (@qglSelectTextureSGIS = nil) and (@qglActiveTextureARB = nil) then
    exit;

  if (texture = GL_TEXTURE0) then
    tmu := 0
  else
    tmu := 1;

  if (tmu = gl_state.currenttmu) then
    exit;

  gl_state.currenttmu := tmu;

  if (@qglSelectTextureSGIS <> nil) then
    qglSelectTextureSGIS(texture)
  else
    if (@qglActiveTextureARB <> nil) then
    begin
      qglActiveTextureARB(texture);
      qglClientActiveTextureARB(texture);
    end;
end;

procedure GL_TexEnv(mode: TGLenum);
{$IFDEF COMPILER6_UP}{$WRITEABLECONST ON}{$ENDIF}
const
  lastmodes: array[0..1] of integer = (-1, -1);
{$IFDEF COMPILER6_UP}{$WRITEABLECONST OFF}{$ENDIF}
begin
  if (mode <> lastmodes[gl_state.currenttmu]) then
  begin
    qglTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, mode);
    lastmodes[gl_state.currenttmu] := mode;
  end;
end;

procedure GL_Bind(texnum: integer);
begin
  if (gl_nobind^.value <> 0) and (draw_chars <> nil) then // performance evaluation option
    texnum := draw_chars^.texnum;

  if (gl_state.currenttextures[gl_state.currenttmu] = texnum) then
    Exit;
  gl_state.currenttextures[gl_state.currenttmu] := texnum;
  qglBindTexture(GL_TEXTURE_2D, texnum);
end;

procedure GL_MBind(target: TGLenum; texnum: integer);
begin
  GL_SelectTexture(target);
  if (target = GL_TEXTURE0) then
  begin
    if (gl_state.currenttextures[0] = texnum) then
      exit;
  end
  else
  begin
    if (gl_state.currenttextures[1] = texnum) then
      exit;
  end;
  GL_Bind(texnum);
end;

type
  glmode_t = record
    name: PChar;
    minimize,
      maximize: integer;
  end;

var
  modes: array[0..5] of glmode_t = (
    (name: 'GL_NEAREST'; minimize: GL_NEAREST; maximize: GL_NEAREST),
    (name: 'GL_LINEAR'; minimize: GL_LINEAR; maximize: GL_LINEAR),
    (name: 'GL_NEAREST_MIPMAP_NEAREST'; minimize: GL_NEAREST_MIPMAP_NEAREST; maximize: GL_NEAREST),
    (name: 'GL_LINEAR_MIPMAP_NEAREST'; minimize: GL_LINEAR_MIPMAP_NEAREST; maximize: GL_LINEAR),
    (name: 'GL_NEAREST_MIPMAP_LINEAR'; minimize: GL_NEAREST_MIPMAP_LINEAR; maximize: GL_NEAREST),
    (name: 'GL_LINEAR_MIPMAP_LINEAR'; minimize: GL_LINEAR_MIPMAP_LINEAR; maximize: GL_LINEAR));

const
  NUM_GL_MODES = sizeof(modes) div sizeof(glmode_t);

type
  gltmode_t = record
    name: PChar;
    mode: integer;
  end;
var
  gl_alpha_modes: array[0..5] of gltmode_t = (
    (name: 'default'; mode: 4),
    (name: 'GL_RGBA'; mode: GL_RGBA),
    (name: 'GL_RGBA8'; mode: GL_RGBA8),
    (name: 'GL_RGB5_A1'; mode: GL_RGB5_A1),
    (name: 'GL_RGBA4'; mode: GL_RGBA4),
    (name: 'GL_RGBA2'; mode: GL_RGBA2));

const
  NUM_GL_ALPHA_MODES = sizeof(gl_alpha_modes) div sizeof(gltmode_t);

var
  gl_solid_modes: array[0..5 {6}] of gltmode_t = (
    (name: 'default'; mode: 3),
    (name: 'GL_RGB'; mode: GL_RGB),
    (name: 'GL_RGB8'; mode: GL_RGB8),
    (name: 'GL_RGB5'; mode: GL_RGB5),
    (name: 'GL_RGB4'; mode: GL_RGB4),
    (name: 'GL_R3_G3_B2'; mode: GL_R3_G3_B2));
{*
#ifdef GL_RGB2_EXT
 ("GL_RGB2", GL_RGB2_EXT),
#endif
*}

const
  NUM_GL_SOLID_MODES = sizeof(gl_solid_modes) div sizeof(gltmode_t);

{*
===============
GL_TextureMode
===============
*}
procedure GL_TextureMode(_string: PChar);
var
  i: integer;
  glt: image_p;
begin
  i := 0;
  while (i < NUM_GL_MODES) do
  begin
    if (Q_stricmp(modes[i].name, _string) = 0) then
      Break;
    Inc(i);
  end;

  if (i = NUM_GL_MODES) then
  begin
    ri.Con_Printf(PRINT_ALL, 'bad filter name'#10, []);
    Exit;
  end;

  gl_filter_min := modes[i].minimize;
  gl_filter_max := modes[i].maximize;

  // change all the existing mipmap texture objects
  i := 0;
  glt := @gltextures;
  while (i < numgltextures) do
  begin
    if (glt.type_ <> it_pic) and (glt.type_ <> it_sky) then
    begin
      GL_Bind(glt.texnum);
      qglTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, gl_filter_min);
      qglTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, gl_filter_max);
    end;
    Inc(i);
    Inc(glt);
  end;
end;

{*
===============
GL_TextureAlphaMode
===============
*}
procedure GL_TextureAlphaMode(_string: PChar);
var
  i: integer;
begin
  i := 0;
  while (i < NUM_GL_ALPHA_MODES) do
  begin
    if (Q_stricmp(gl_alpha_modes[i].name, _string) = 0) then
      break;
    Inc(i);
  end;

  if (i = NUM_GL_ALPHA_MODES) then
  begin
    ri.Con_Printf(PRINT_ALL, 'bad alpha texture mode name'#10, []);
    Exit;
  end;

  gl_tex_alpha_format := gl_alpha_modes[i].mode;
end;

{*
===============
GL_TextureSolidMode
===============
*}
procedure GL_TextureSolidMode(_string: PChar);
var
  i: integer;
begin
  i := 0;
  while (i < NUM_GL_SOLID_MODES) do
  begin
    if (Q_stricmp(gl_solid_modes[i].name, _string) = 0) then
      Break;
    Inc(i);
  end;

  if (i = NUM_GL_SOLID_MODES) then
  begin
    ri.Con_Printf(PRINT_ALL, 'bad solid texture mode name'#10, []);
    Exit;
  end;

  gl_tex_solid_format := gl_solid_modes[i].mode;
end;

{*
===============
GL_ImageList_f
===============
*}
procedure GL_ImageList_f;
var
  i: integer;
  image: image_p;
  texels: integer;
const // Changed to Boolean since integer(true) = -1
  palstrings: array[Boolean] of PChar =
  ('RGB',
    'PAL');
label
  Continue_;
begin
  ri.Con_Printf(PRINT_ALL, '------------------'#10, []);
  texels := 0;

  i := 0;
  image := @gltextures;
  while (i < numgltextures) do
  begin
    if (image.texnum <= 0) then
      goto Continue_;
    Inc(texels, image.upload_width * image.upload_height);
    case (image.type_) of
      it_skin: ri.Con_Printf(PRINT_ALL, 'M', []);
      it_sprite: ri.Con_Printf(PRINT_ALL, 'S', []);
      it_wall: ri.Con_Printf(PRINT_ALL, 'W', []);
      it_pic: ri.Con_Printf(PRINT_ALL, 'P', []);
    else
      ri.Con_Printf(PRINT_ALL, ' ', []);
    end;

    ri.Con_Printf(PRINT_ALL, ' %3i %3i %s: %s'#10,
      image.upload_width, image.upload_height, palstrings[image.paletted], image.name);
    Continue_:
    Inc(i);
    Inc(image);
  end;
  ri.Con_Printf(PRINT_ALL, 'Total texel count (not counting mipmaps): %i'#10, [texels]);
end;

{*
=============================================================================

  scrap allocation

  Allocate all the little status bar obejcts into a single texture
  to crutch up inefficient hardware / drivers

=============================================================================
*}
const
  MAX_SCRAPS = 1;
  BLOCK_WIDTH = 256;
  BLOCK_HEIGHT = 256;
var
  scrap_allocated: array[0..MAX_SCRAPS - 1, 0..BLOCK_WIDTH - 1] of integer;
  scrap_texels: array[0..MAX_SCRAPS - 1, 0..BLOCK_WIDTH * BLOCK_HEIGHT - 1] of byte;

// returns a texture number and the position inside it
function Scrap_AllocBlock(w, h: integer;
  var x, y: integer): integer;
var
  i, j,
    best, best2,
    texnum: integer;
begin
  for texnum := 0 to MAX_SCRAPS - 1 do
  begin
    best := BLOCK_HEIGHT;

    for i := 0 to BLOCK_WIDTH - w - 1 do
    begin
      best2 := 0;

      j := 0;
      while (j < w) do