gl_model.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): gl_model.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.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ 28.06.2003 Juha: Proofreaded }
unit gl_model;

interface

uses
  q_shared,
  gl_local_add,
  gl_local,
  gl_model_h,
  ref;

var
  loadmodel: model_p;


function Mod_PointInLeaf(const p: vec3_t; model: model_p): mleaf_p;
function Mod_ClusterPVS(cluster: integer; model: model_p): PByte;
procedure Mod_Modellist_f; cdecl;
procedure Mod_Init;

procedure R_BeginRegistration(model: PChar); cdecl;
function R_RegisterModel(name: PChar): pointer; cdecl;
procedure R_EndRegistration; cdecl;

procedure Mod_FreeAll;

var
  registration_sequence: Integer;

implementation

uses
  DelphiTypes,
  SysUtils,
  q_shwin,
  CPas,
  qfiles,
  gl_rmain,
  gl_image,
  gl_warp,
  gl_rsurf;


procedure Mod_Free(_mod: model_p); forward;


var
  modfilelen: integer;


procedure Mod_LoadBrushModel(_mod: model_p; buffer: pointer); forward;
procedure Mod_LoadAliasModel(_mod: model_p; buffer: pointer); forward;
procedure Mod_LoadSpriteModel(_mod: model_p; buffer: pointer); forward;

const
  MAX_MOD_KNOWN = 512;


var
  mod_novis: array[0..MAX_MAP_LEAFS div 8 - 1] of byte;
  mod_known: array[0..MAX_MOD_KNOWN - 1] of model_t;
  mod_numknown: integer;
  // the inline * models from the current map are kept seperate
  mod_inline: array[0..MAX_MOD_KNOWN - 1] of model_t;

{*
===============
Mod_PointInLeaf
===============
*}

function Mod_PointInLeaf(const p: vec3_t; model: model_p): mleaf_p;
var
  node: mnode_p;
  d: Single;
  plane: cplane_p;
begin
  if (model = nil) or (model^.nodes = nil) then
    ri.Sys_Error(ERR_DROP, 'Mod_PointInLeaf: bad model');

  node := model^.nodes;
  while (True) do
  begin
    if (node^.contents <> -1) then
    begin
      Result := mleaf_p(node);
      Exit;
    end;
    plane := node^.plane;
    d := DotProduct(p, plane^.normal) - plane^.dist;
    if (d > 0) then
      node := node^.children[0]
    else
      node := node^.children[1];
  end;

  Result := nil; // never reached
end;

{*
===================
Mod_DecompressVis
===================
*}
var
  decompressed: array[0..(MAX_MAP_LEAFS div 8) - 1] of Byte;

function Mod_DecompressVis(_in: PByte; model: model_p): PByte;
var
  c: Integer;
  _out: PByte;
  row: Integer;
begin
  row := (model^.vis^.numclusters + 7) shr 3;
  _out := @decompressed;

  if _in = nil then
  begin // no vis info, so make all visible
    while row <> 0 do
    begin
      _out^ := $FF;
      inc(_out);
      dec(row, 1);
    end;
    Result := @decompressed;
    exit;
  end;

  repeat
    if (_in^ <> 0) then
    begin
      _out^ := _in^;
      inc(_out);
      inc(_in);
      continue;
    end;
    c := PByteArray(_in)^[1];
    inc(_in, 2);
    while (c <> 0) do
    begin
      _out^ := 0;
      inc(_out);
      dec(c);
    end;
  until (Integer(_out) - Integer(@decompressed)) >= row;
  Result := @decompressed;
end;

{*
==============
Mod_ClusterPVS
==============
*}

function Mod_ClusterPVS(cluster: integer; model: model_p): PByte;
begin
  if (cluster = -1) or (model.vis = nil) then
  begin
    Result := @mod_novis;
    Exit;
  end;

  Result := Mod_DecompressVis(PByte(Integer(model^.vis) + model^.vis^.bitofs[cluster][DVIS_PVS]), model);
end;

{*
================
Mod_Modellist_f
================
*}

procedure Mod_Modellist_f;
var
  i, total: integer;
  _mod: model_p;
label
  continue_;
begin
  total := 0;
  ri.Con_Printf(PRINT_ALL, 'Loaded models:'#10, []);
  i := 0;
  _mod := @mod_known;
  while (i < mod_numknown) do
  begin
    if (_mod^.name[0] = #0) then
      goto continue_;
    ri.Con_Printf(PRINT_ALL, '%8i : %s'#10, _mod.extradatasize, _mod.name);
    Inc(total, _mod.extradatasize);
    continue_:
    Inc(_mod);
  end;
  ri.Con_Printf(PRINT_ALL, 'Total resident: %i'#10, [total]);
end;

{*
===============
Mod_Init
===============
*}

procedure Mod_Init;
begin
  memset(@mod_novis, $FF, sizeof(mod_novis));
end;

{*
==================
Mod_ForName

Loads in a model for the given name
==================
*}

function Mod_ForName(name: PChar; crash: qboolean): model_p;
var
  mod_: model_p;
  buf: PCardinal;
  i: integer;
label
  continue_;
begin
  if (name[0] = #0) then
    ri.Sys_Error(ERR_DROP, 'Mod_ForName: NULL name', []);

  //
  // inline models are grabbed only from worldmodel
  //
  if (name[0] = '*') then
  begin
    i := atoi(name + 1);
    if (i < 1) or (r_worldmodel = nil) or (i >= r_worldmodel^.numsubmodels) then
      ri.Sys_Error(ERR_DROP, 'bad inline model number', []);
    Result := @mod_inline[i];
    exit;
  end;

  //
  // search the currently loaded models
  //
  mod_ := @mod_known;
  for i := 0 to mod_numknown - 1 do
  begin
    if (mod_^.name[0] = #0) then
      goto continue_;
    if (strcmp(mod_^.name, name) = 0) then
    begin
      Result := mod_;
      exit;
    end;
    continue_:
    Inc(mod_);
  end;

  //
  // find a free model slot spot
  //
  mod_ := @mod_known;
  i := 0;
  while (i < mod_numknown) do
  begin
    if (mod_^.name[0] = #0) then
      break; // free spot
    Inc(mod_);
    Inc(i);
  end;
  if (i = mod_numknown) then
  begin
    if (mod_numknown = MAX_MOD_KNOWN) then
      ri.Sys_Error(ERR_DROP, 'mod_numknown == MAX_MOD_KNOWN');
    Inc(mod_numknown);
  end;
  strcpy(mod_^.name, name);

  //
  // load the file
  //
  modfilelen := ri.FS_LoadFile(mod_^.name, @buf);
  if (buf = nil) then
  begin
    if (crash) then
      ri.Sys_Error(ERR_DROP, 'Mod_NumForName: %s not found', mod_^.name);
    memset(@mod_^.name, 0, sizeof(mod_^.name));
    Result := nil;
    exit;
  end;

  loadmodel := mod_;

  //
  // fill it in
  //


  // call the apropriate loader

//  switch (LittleLong(*(unsigned * )buf))
  case PCardinal(buf)^ of
    IDALIASHEADER:
      begin
        loadmodel^.extradata := Hunk_Begin($200000);
        Mod_LoadAliasModel(mod_, buf);
      end;

    IDSPRITEHEADER:
      begin
        loadmodel^.extradata := Hunk_Begin($10000);
        Mod_LoadSpriteModel(mod_, buf);
      end;

    IDBSPHEADER:
      begin
        loadmodel^.extradata := Hunk_Begin($1000000);
        Mod_LoadBrushModel(mod_, buf);
      end;

  else
    ri.Sys_Error(ERR_DROP, 'Mod_NumForName: unknown fileid for %s', mod_.name);
  end; //case

  loadmodel^.extradatasize := Hunk_End();

  ri.FS_FreeFile(buf);

  Result := mod_;
end;


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

     BRUSHMODEL LOADING

===============================================================================
*}

var
  mod_base: PByte;

{*
=================
Mod_LoadLighting
=================
*}

procedure Mod_LoadLighting(l: lump_p);
begin
  if (l^.filelen = 0) then
  begin
    loadmodel^.lightdata := nil;
    Exit;
  end;
  loadmodel^.lightdata := Hunk_Alloc(l^.filelen);
  memcpy(loadmodel^.lightdata, @PByteArray(mod_base)^[l^.fileofs], l^.filelen);
end;

{*
=================
Mod_LoadVisibility
=================
*}

procedure Mod_LoadVisibility(l: lump_p);
var
  i: integer;
begin
  if (l^.filelen = 0) then
  begin
    loadmodel^.vis := nil;
    Exit;
  end;
  loadmodel^.vis := Hunk_Alloc(l^.filelen);
  memcpy(loadmodel^.vis, @PByteArray(mod_base)[l^.fileofs], l^.filelen);

  loadmodel^.vis^.numclusters := LittleLong(loadmodel^.vis^.numclusters);
  for i := 0 to loadmodel^.vis^.numclusters - 1 do
  begin
    loadmodel^.vis^.bitofs[i][0] := LittleLong(loadmodel^.vis^.bitofs[i][0]);
    loadmodel^.vis^.bitofs[i][1] := LittleLong(loadmodel^.vis^.bitofs[i][1]);
  end;
end;

{*
=================
Mod_LoadVertexes
=================
*}

procedure Mod_LoadVertexes(l: lump_p);
var
  _in: dvertex_p;
  _out: mvertex_p;
  i,
    count: integer;
begin
  _in := Pointer(Cardinal(mod_base) + l^.fileofs);
  if (l.filelen mod sizeof(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size in %s', loadmodel.name);
  count := l^.filelen div sizeof(_in^);
  _out := Hunk_Alloc(count * sizeof(_out^));

  loadmodel^.vertexes := Pointer(_out);
  loadmodel^.numvertexes := count;

  for i := 0 to count - 1 do
  begin
    _out^.position[0] := LittleFloat(_in^.point[0]);
    _out^.position[1] := LittleFloat(_in^.point[1]);
    _out^.position[2] := LittleFloat(_in^.point[2]);
    Inc(_in);
    Inc(_out);
  end;
end;

{*
=================
RadiusFromBounds
=================
*}

function RadiusFromBounds(const mins, maxs: vec3_t): Single;
var
  i: integer;