r_image.pas

delphi编的不错的贪吃蛇

{$ALIGN 8}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): r_image.c                                                          }
{                                                                            }
{ Initial conversion by : Michael Skovslund ([e-mail])               }
{ Initial conversion on : 24-Mar-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.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on :                                                               }
{ Updated by :                                                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ Fix all the bugs                                                           }
{ 1)                                                                         }
{ 2)                                                                         }
{----------------------------------------------------------------------------}

// r_image.c
unit r_image;

interface

uses
  r_local;

procedure R_ImageList_f; cdecl;
procedure LoadPCX(const filename: PChar; pic: PPointer; palette: PPointer; width: PInteger; height: PInteger);
procedure LoadTGA(const name: PChar; pic: PPointer; width, height: PInteger);
function R_FindFreeImage: image_p;
function GL_LoadPic(name: PChar; pic: PByte; width, height: Integer; _type: imagetype_t): image_p;
function R_LoadWal(const name: PChar): image_p;
function R_FindImage(const name: PChar; _type: imagetype_t): image_p;
function R_RegisterSkin(name: PChar): Pointer; cdecl; //image_p;
procedure R_FreeUnusedImages;
procedure R_InitImages;
procedure R_ShutdownImages;

implementation

uses
  r_main,
  QFiles,
  q_shared,
  r_model,
  SysUtils;

const
  CrLf = #13 + #10;
const
  MAX_RIMAGES = 1024;

type
//PPByte = ^PByte;
  TargaHeader = record
    id_length: Byte;
    colormap_type: Byte;
    image_type: Byte;
    colormap_index: Word;
    colormap_length: Word;
    colormap_size: Byte;
    x_origin: Word;
    y_origin: Word;
    width: Word;
    height: Word;
    pixel_size: Byte;
    attributes: Byte;
  end;

var
  r_images: array[0..MAX_RIMAGES - 1] of image_t;
  numr_images: Integer;

(*
===============
R_ImageList_f
===============
*)

procedure R_ImageList_f; cdecl;
var
  i: Integer;
  image: image_p;
  texels: Integer;
begin
	ri.Con_Printf(PRINT_ALL,'------------------');
	texels := 0;
  for i := 0 to numr_images - 1 do
  begin
    image := @r_images[i];
    if (image^.registration_sequence <= 0) then
    begin
      continue;
    end;
		inc(texels, image^.width*image^.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,' %d %d : %s', image^.width, image^.height, image^.name);
	end;
	ri.Con_Printf(PRINT_ALL,'Total texel count: %d', texels);
end;

(*
=================================================================
PCX LOADING
=================================================================
*)

(*
==============
LoadPCX
==============
*)

procedure LoadPCX(const filename: PChar; pic: PPointer; palette: PPointer; width: PInteger; height: PInteger);
var
  raw       : PByte;
  pcx       : pcx_p;
  x,y       : Integer;
  len       : Integer;
  dataByte  : Integer;
  runLength : Integer;
  _out,pix  : PByte;
begin
	pic^ := nil;

	//
	// load the file
	//
	len := ri.FS_LoadFile(filename,@raw);
	if (raw = nil) then
	begin
		ri.Con_Printf(PRINT_DEVELOPER,'Bad pcx file %s', filename);
		Exit;
	end;

	//
	// parse the PCX file
	//
	pcx := pcx_p(raw);
  pcx^.xmin := LittleShort(pcx^.xmin);
  pcx^.ymin := LittleShort(pcx^.ymin);
  pcx^.xmax := LittleShort(pcx^.xmax);
  pcx^.ymax := LittleShort(pcx^.ymax);
  pcx^.hres := LittleShort(pcx^.hres);
  pcx^.vres := LittleShort(pcx^.vres);
  pcx^.bytes_per_line := LittleShort(pcx^.bytes_per_line);
  pcx^.palette_type := LittleShort(pcx^.palette_type);

  raw := @pcx^.data;

  if (pcx^.manufacturer <> #$0A) or (pcx^.version <> #5) or (pcx^.encoding <> #1) or
    (pcx^.bits_per_pixel <> #8) or (pcx^.xmax >= 640) or (pcx^.ymax >= 480) then
  begin
    ri.Con_Printf(PRINT_ALL, PChar('Bad pcx file ' + filename + CrLf));
    Exit;
  end;

  _out := AllocMem((pcx^.ymax + 1) * (pcx^.xmax + 1));
  pic^ := _out;
  pix := _out;

  if (palette <> nil) then
  begin
    palette^ := AllocMem(768);
    Move(Pointer(Integer(pcx) + len - 768)^, palette^^, 768);
  end;

	if (pcx^.manufacturer <> #$0a) or (pcx^.version <> #5) or (pcx^.encoding <> #1) or
		 (pcx^.bits_per_pixel <> #8) or (pcx^.xmax >= 640) or (pcx^.ymax >= 480) then
	begin
		ri.Con_Printf(PRINT_ALL,'Bad pcx file %s', filename);
		Exit;
	end;

	_out := AllocMem((pcx^.ymax+1)*(pcx^.xmax+1));
	pic^ := _out;
	pix := _out;

	if (palette <> nil) then
	begin
		palette^ := AllocMem(768);
    Move(Pointer(Integer(pcx)+len-768)^,palette^^,768);
	end;

	if (width <> nil) then
		width^ := pcx^.xmax+1;
	if (height <> nil) then
		height^ := pcx^.ymax+1;

  for y := 0 to pcx^.ymax do
  begin
    x := 0;
    while (x <= pcx^.xmax) do
    begin
      dataByte := raw^;
      Inc(Cardinal(raw), 1);
      if ((dataByte and $C0) = $C0) then
      begin
        runLength := dataByte and $3F;
        dataByte := raw^;
        Inc(Cardinal(raw), 1);
      end
      else
        runLength := 1;
      while (runLength > 0) do
      begin
        PByteArray(pix)^[x] := dataByte;
        inc(x);
        dec(runLength);
      end;
    end;
    pix := PByte(Cardinal(pix) + pcx^.xmax + 1);
  end;
	if (Integer(raw) - Integer(pcx) > len) then
	begin
		ri.Con_Printf(PRINT_DEVELOPER,'PCX file %s was malformed', filename);
		FreeMem(pic^);
		pic^ := nil;
	end;
	ri.FS_FreeFile(pcx);
end;

(*
=========================================================

TARGA LOADING

=========================================================
*)

(*
=============
LoadTGA
=============
*)

procedure LoadTGA(const name: PChar; pic: PPointer; width, height: PInteger);
var
  columns: Integer;
  rows: Integer;
  numPixels: Integer;
  pixbuf: PByte;
  row: Integer;
  column: Integer;
  buf_p: PByte;
  buffer: PByte;
//	length          : Integer;
  targa_header: TargaHeader;
  targa_rgba: PByte;
  red, green: Byte;
  blue, alphabyte: Byte;
  packetHeader: Byte;
  packetSize, j: Byte;

label
  breakOut;
begin
  pic^ := nil;

 //
 // load the file
 //
//	length :=
  ri.FS_LoadFile(name,@buffer);
	if (buffer = nil) then
	begin
		ri.Con_Printf(PRINT_DEVELOPER,'Bad tga file %s', name);
		Exit;
	end;

  buf_p := buffer;

  targa_header.id_length := buf_p^;
  inc(Cardinal(buf_p));
  targa_header.colormap_type := buf_p^;
  inc(Cardinal(buf_p));
  targa_header.image_type := buf_p^;
  inc(Cardinal(buf_p));

  targa_header.colormap_index := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.colormap_length := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.colormap_size := buf_p^;
  inc(Cardinal(buf_p));
  targa_header.x_origin := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.y_origin := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.width := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.height := LittleShort(buf_p^);
  inc(Cardinal(buf_p), 2);
  targa_header.pixel_size := buf_p^;
  inc(Cardinal(buf_p));
  targa_header.attributes := buf_p^;
  inc(Cardinal(buf_p));

  if (targa_header.image_type <> 2) and (targa_header.image_type <> 10) then
    ri.Sys_Error(ERR_DROP, PChar('LoadTGA: Only type 2 and 10 targa RGB images supported' + CrLf));

  if (targa_header.colormap_type <> 0) or ((targa_header.pixel_size <> 32) and (targa_header.pixel_size <> 24)) then
    ri.Sys_Error(ERR_DROP, PChar('LoadTGA: Only 32 or 24 bit images supported (no colormaps)' + CrLf));

  columns := targa_header.width;
  rows := targa_header.height;
  numPixels := columns * rows;

  if (width <> nil) then
    width^ := columns;
  if (height <> nil) then
    height^ := rows;

  targa_rgba := AllocMem(numPixels * 4);
  pic^ := targa_rgba;

  if (targa_header.id_length <> 0) then
    Inc(Cardinal(buf_p), targa_header.id_length); // skip TARGA image comment

  if (targa_header.image_type = 2) then
  begin // Uncompressed, RGB images
    for row := rows - 1 downto 0 do
    begin
      pixbuf := Pointer(Integer(targa_rgba) + row * columns * 4);
      column := 0;
      while (column <= columns - 1) do
      begin
        case (targa_header.pixel_size) of
          24:
            begin
              blue := buf_p^;
              inc(Cardinal(buf_p));
              green := buf_p^;
              inc(Cardinal(buf_p));
              red := buf_p^;
              inc(Cardinal(buf_p));
              pixbuf^ := red;
              inc(Cardinal(pixbuf));
              pixbuf^ := green;
              inc(Cardinal(pixbuf));
              pixbuf^ := blue;
              inc(Cardinal(pixbuf));
              pixbuf^ := 255;
              inc(Cardinal(pixbuf));
            end;
          32:
            begin
              blue := buf_p^;
              inc(Cardinal(buf_p));
              green := buf_p^;
              inc(Cardinal(buf_p));
              red := buf_p^;
              inc(Cardinal(buf_p));
              alphabyte := buf_p^;
              inc(Cardinal(buf_p));
              pixbuf^ := red;
              inc(Cardinal(pixbuf));
              pixbuf^ := green;
              inc(Cardinal(pixbuf));
              pixbuf^ := blue;
              inc(Cardinal(pixbuf));
              pixbuf^ := alphabyte;
              inc(Cardinal(pixbuf));
            end;
        end;