gl_image.pas

delphi编的不错的贪吃蛇

   return false;
  i <<= 1;
 }
}
*)

function GL_Upload8(data: PByteArray; width, height: integer; mipmap, is_sky: qboolean): qboolean;
var
  trans: array[0..512 * 256 - 1] of Cardinal;
  i, s, p: integer;
begin
  s := width * height;

  if (s > sizeof(trans) / 4) then
    ri.Sys_Error(ERR_DROP, 'GL_Upload8: too large');

  if Assigned(qglColorTableEXT) and
    (gl_ext_palettedtexture.value <> 0) and (is_sky) then
  begin
    qglTexImage2D(GL_TEXTURE_2D,
      0,
      GL_COLOR_INDEX8_EXT,
      width,
      height,
      0,
      GL_COLOR_INDEX,
      GL_UNSIGNED_BYTE,
      data);

    qglTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, gl_filter_max);
    qglTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, gl_filter_max);
  end
  else
  begin
    for i := 0 to s - 1 do
    begin
      p := data[i];
      trans[i] := d_8to24table[p];

      if (p = 255) then
      begin
        // transparent, so scan around for another color
        // to avoid alpha fringes
        // FIXME: do a full flood fill so mips work...
        if (i > width) and (data[i - width] <> 255) then
          p := data[i - width]
        else
          if (i < s - width) and (data[i + width] <> 255) then
            p := data[i + width]
          else
            if (i > 0) and (data[i - 1] <> 255) then
              p := data[i - 1]
            else
              if (i < s - 1) and (data[i + 1] <> 255) then
                p := data[i + 1]
              else
                p := 0;

        // copy rgb components
        PByteArray(@trans[i])^[0] := PByteArray(@d_8to24table[p])^[0];
        PByteArray(@trans[i])^[1] := PByteArray(@d_8to24table[p])^[1];
        PByteArray(@trans[i])^[2] := PByteArray(@d_8to24table[p])^[2];
      end;
    end;

    Result := GL_Upload32(@trans, width, height, mipmap);
  end;
end;

{*
================
GL_LoadPic

This is also used as an entry point for the generated r_notexture
================
*}
function GL_LoadPic(name: PChar; pic: PByte; width, height: integer; _type: imagetype_t; bits: integer): image_p;
var
  image: image_p;
  i, j, k,
    x, y,
    texnum: integer;
label
  nonscrap;
begin
  // find a free image_t
  image := @gltextures;
  i := 0;
  while (i < numgltextures) do
  begin
    if (image^.texnum = 0) then
      break;
    inc(image);
    inc(i);
  end;
  if (i = numgltextures) then
  begin
    if (numgltextures = MAX_GLTEXTURES) then
      ri.Sys_Error(ERR_DROP, 'MAX_GLTEXTURES');
    Inc(numgltextures);
  end;
  image := @gltextures[i];

  if (strlen(name) >= sizeof(image^.name)) then
    ri.Sys_Error(ERR_DROP, 'Draw_LoadPic: "%s" is too long', name);
  strcpy(image^.name, name);
  image^.registration_sequence := registration_sequence;

  image.width := width;
  image.height := height;
  image.type_ := _type;

  if (_type = it_skin) and (bits = 8) then
    R_FloodFillSkin(pic, width, height);

  // load little pics into the scrap
  if (image.type_ = it_pic) and (bits = 8) and
    (image.width < 64) and (image.height < 64) then
  begin
    texnum := Scrap_AllocBlock(image.width, image.height, x, y);
    if (texnum = -1) then
      goto nonscrap;
    scrap_dirty := true;

    // copy the texels into the scrap block
    k := 0;
    for i := 0 to image.height - 1 do
      for j := 0 to image^.width - 1 do
      begin
        scrap_texels[texnum][(y + i) * BLOCK_WIDTH + x + j] := PByteArray(pic)^[k];
        Inc(k);
      end;
    image.texnum := TEXNUM_SCRAPS + texnum;
    image.scrap := true;
    image.has_alpha := true;
    image.sl := (x + 0.01) / BLOCK_WIDTH;
    image.sh := (x + image.width - 0.01) / BLOCK_WIDTH;
    image.tl := (y + 0.01) / BLOCK_WIDTH;
    image.th := (y + image.height - 0.01) / BLOCK_WIDTH;
  end
  else
  begin
    nonscrap:
    image.scrap := false;
    image.texnum := TEXNUM_IMAGES + ((Integer(image) - Integer(@gltextures)) div sizeof(image_t));
    GL_Bind(image^.texnum);
    if (bits = 8) then
      image.has_alpha := GL_Upload8(PByteArray(pic), width, height, ((image.type_ <> it_pic) and (image.type_ <> it_sky)), (image.type_ = it_sky))
    else
      image.has_alpha := GL_Upload32(PCardinal(pic), width, height, ((image.type_ <> it_pic) and (image.type_ <> it_sky)));
    image.upload_width := upload_width; // after power of 2 and scales
    image.upload_height := upload_height;
    image.paletted := uploaded_paletted;
    image.sl := 0;
    image.sh := 1;
    image.tl := 0;
    image.th := 1;
  end;

  Result := image;
end;

{*
================
GL_LoadWal
================
*}
function GL_LoadWal(name: PChar): image_p;
var
  mt: miptex_p;
  width, height, ofs: Integer;
  image: image_p;
begin
  ri.FS_LoadFile(name, @mt);
  if (mt = nil) then
  begin
    ri.Con_Printf(PRINT_ALL, 'GL_FindImage: can''t load %s'#10, name);
    Result := r_notexture;
    exit;
  end;

  width := LittleLong(mt^.width);
  height := LittleLong(mt^.height);
  ofs := LittleLong(mt^.offsets[0]);

  image := GL_LoadPic(name, Pointer(Cardinal(mt) + ofs), width, height, it_wall, 8);

  ri.FS_FreeFile(mt);

  Result := image;
end;

{*
===============
GL_FindImage

Finds or loads the given image
===============
*}
function GL_FindImage(name: PChar; _type: imagetype_t): image_p;
var
  image: image_p;
  i, len: integer;
  pic, palette: PByte;
  width, height: integer;
begin
  if (name = nil) then
  begin
    result := nil; //ri.Sys_Error (ERR_DROP, "GL_FindImage: NULL name");
    Exit;
  end;
  len := strlen(name);
  if (len < 5) then
  begin
    Result := nil; //ri.Sys_Error (ERR_DROP, "GL_FindImage: bad name: %s", name);
    Exit;
  end;

  // look for it
  image := @gltextures;
  for i := 0 to numgltextures - 1 do
  begin
    if (strcmp(name, image^.name) = 0) then
    begin
      image^.registration_sequence := registration_sequence;
      Result := image;
      exit;
    end;
    inc(image);
  end;

  //
  // load the pic from disk
  //
  pic := nil;
  palette := nil;
  if strcmp(name + len - 4, '.pcx') = 0 then
  begin
    LoadPCX(name, @pic, @palette, @width, @height);
    if (pic = nil) then
    begin
      Result := nil; // ri.Sys_Error (ERR_DROP, "GL_FindImage: can't load %s", name);
      Exit;
    end;
    image := GL_LoadPic(name, pic, width, height, _type, 8);
  end
  else
    if strcmp(name + len - 4, '.wal') = 0 then
      image := GL_LoadWal(name)
    else
      if strcmp(name + len - 4, '.tga') = 0 then
      begin
        LoadTGA(name, @pic, @width, @height);
        if (pic = nil) then
        begin
          Result := nil; // ri.Sys_Error (ERR_DROP, "GL_FindImage: can't load %s", name);
          Exit;
        end;
        image := GL_LoadPic(name, pic, width, height, _type, 32);
      end
      else
      begin
        Result := nil; //ri.Sys_Error (ERR_DROP, "GL_FindImage: bad extension on: %s", name);
        Exit;
      end;

  if Assigned(pic) then
    FreeMem(pic);
  if Assigned(palette) then
    FreeMem(palette);

  Result := image;
end;

{*
===============
R_RegisterSkin
===============
*}
function R_RegisterSkin(name: PChar): pointer; cdecl;
begin
  Result := GL_FindImage(name, it_skin);
end;

{*
================
GL_FreeUnusedImages

Any image that was not touched on this registration sequence
will be freed.
================
*}
procedure GL_FreeUnusedImages;
var
  i: integer;
  image: image_p;
label
  continue_;
begin
  // never free r_notexture or particle texture
  r_notexture.registration_sequence := registration_sequence;
  r_particletexture.registration_sequence := registration_sequence;

  image := @gltextures;
  for i := 0 to numgltextures - 1 do
  begin
    if (image^.registration_sequence = registration_sequence) then
      goto continue_; // used this sequence
    if (image^.registration_sequence = 0) then
      goto continue_; // free image_t slot
    if (image^.type_ = it_pic) then
      goto continue_; // don't free pics
    // free it
    qglDeleteTextures(1, @image.texnum);
    memset(image, 0, sizeof(image^));
    continue_:
    Inc(image);
  end;
end;

{*
===============
Draw_GetPalette
===============
*}
function Draw_GetPalette: integer;
var
  i,
  r, g, b,
  width, height: integer;
  v: Cardinal;
  pic, pal: PByteArray;
begin
  // get the palette

  LoadPCX('pics/colormap.pcx', @pic, @pal, @width, @height);
  if (pal = nil) then
    ri.Sys_Error(ERR_FATAL, 'Couldn''t load pics/colormap.pcx', []);

  for i := 0 to 255 do
  begin
    r := pal[i * 3 + 0];
    g := pal[i * 3 + 1];
    b := pal[i * 3 + 2];

    v := (255 shl 24) + (r shl 0) + (g shl 8) + (b shl 16);
    d_8to24table[i] := LittleLong(v);
  end;

  d_8to24table[255] := d_8to24table[255] and LittleLong($FFFFFF); // 255 is transparent

  FreeMem(pic);
  FreeMem(pal);

  Result := 0;
end;

{*
===============
GL_InitImages
===============
*}
procedure GL_InitImages;
var
  i, j: integer;
  g, inf: Single;
begin
  g := vid_gamma.value;

  registration_sequence := 1;

  // init intensity conversions
  intensity := ri.Cvar_Get('intensity', '2', 0);

  if (intensity.value <= 1) then
    ri.Cvar_Set('intensity', '1');

  gl_state.inverse_intensity := 1 / intensity.value;

  Draw_GetPalette();

  if Assigned(qglColorTableEXT) then
  begin
    ri.FS_LoadFile('pics/16to8.dat', @gl_state.d_16to8table);
    if (gl_state.d_16to8table = nil) then
      ri.Sys_Error(ERR_FATAL, 'Couldn''t load pics/16to8.pcx', []);
  end;

  if (gl_config.renderer and (GL_RENDERER_VOODOO or GL_RENDERER_VOODOO2)) <> 0 then
    g := 1.0;

  for i := 0 to 255 do
    if (g = 1) then
      gammatable[i] := i
    else
    begin
      inf := 255 * power((i + 0.5) / 255.5, g) + 0.5;
      if (inf < 0) then
        inf := 0;
      if (inf > 255) then
        inf := 255;
      gammatable[i] := Trunc(inf);
    end;

  for i := 0 to 255 do
  begin
    j := Trunc(i * intensity.value);
    if (j > 255) then
      j := 255;
    intensitytable[i] := j;
  end;
end;

{*
===============
GL_ShutdownImages
===============
*}
procedure GL_ShutdownImages;
var
  i: integer;
  image: image_p;
begin
  image := @gltextures;
  for i := 0 to numgltextures - 1 do
  begin
    if (image^.registration_sequence = 0) then
    begin
      Inc(image);
      continue; // free image_t slot
    end;
    // free it
    qglDeleteTextures(1, @image.texnum);
    memset(image, 0, sizeof(image^));
    Inc(image);
  end;
end;

end.