cmodel.pas

delphi编的不错的贪吃蛇

{$ALIGN ON}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): CModel                                                            }
{ Content: Quake2\QCommon\ model loading                                     }
{                                                                            }
{ Initial conversion by : Clootie (Alexey Barkovoy) - [e-mail]     }
{ Initial conversion on : 03-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:                                                                 }
{ 06-jun-2002 Juha Hartikainen ([e-mail])                         }
{ - Changed file handling to use SysUtils style of file handling             }
{----------------------------------------------------------------------------}
// cmodel.c -- model loading

{$IFDEF WIN32}
{$INCLUDE ..\Jedi.inc}
{$ELSE}
{$INCLUDE ../Jedi.inc}
{$ENDIF}

unit CModel;

interface

uses
  DelphiTypes,
  qfiles,
  {$IFDEF WIN32}
  Windows,
  {$ENDIF}
  q_shared,
  SysUtils;


function CM_LoadMap(name: PChar; clientload: qboolean; var checksum: Cardinal): cmodel_p;
function CM_InlineModel(name: PChar): cmodel_p; // *1, *2, etc

function CM_NumClusters: Integer;
function CM_NumInlineModels: Integer;
function CM_EntityString: PChar;

// creates a clipping hull for an arbitrary box
function CM_HeadnodeForBox(const mins, maxs: vec3_t): Integer;

// returns an ORed contents mask
function CM_PointContents(const p: vec3_t; headnode: Integer): Integer;
function CM_TransformedPointContents(const p: vec3_t; headnode: Integer;
  const origin, angles: vec3_t): Integer;

function CM_BoxTrace(const start, _end, mins, maxs: vec3_t;
  headnode, brushmask: Integer): trace_t;
function CM_TransformedBoxTrace(const start, _end, mins, maxs: vec3_t;
  headnode, brushmask: Integer; const origin, angles: vec3_t): trace_t;

function CM_ClusterPVS(cluster: Integer): PByte;
function CM_ClusterPHS(cluster: Integer): PByte;

function CM_PointLeafnum(const p: vec3_t): Integer;

// call with topnode set to the headnode, returns with topnode
// set to the first node that splits the box
function CM_BoxLeafnums(var mins, maxs: vec3_t; list: PInteger;
  listsize: Integer; topnode: PInteger): Integer;

function CM_LeafContents(leafnum: Integer): Integer;
function CM_LeafCluster(leafnum: Integer): Integer;
function CM_LeafArea(leafnum: Integer): Integer;

procedure CM_SetAreaPortalState(portalnum: Integer; open: qboolean); cdecl;
function CM_AreasConnected(area1, area2: Integer): qboolean; cdecl;

function CM_WriteAreaBits(buffer: PByte; area: Integer): Integer;
function CM_HeadnodeVisible(nodenum: Integer; visbits: PByteArray): qboolean;

procedure CM_WritePortalState(var file_: integer);
procedure CM_ReadPortalState(var file_: integer);

var
  numtexinfo: Integer;
  map_surfaces: array[0..MAX_MAP_TEXINFO - 1] of mapsurface_t;
  c_pointcontents: Integer;
  c_traces, c_brush_traces: Integer;

implementation

uses
  Common,
  CPas,
  CVar,
  Files,
  MD4;

type
  cnode_p = ^cnode_t;
  cnode_t = record
    plane: cplane_p;
    children: array[0..1] of Integer;   // negative numbers are leafs
  end;

  cbrushside_p = ^cbrushside_t;
  cbrushside_t = record
    plane: cplane_p;
    surface: mapsurface_p;
  end;

  cleaf_p = ^cleaf_t;
  cleaf_t = record
    contents: Integer;
    cluster: Integer;
    area: Integer;
    firstleafbrush: Word;
    numleafbrushes: Word;
  end;

  cbrush_p = ^cbrush_t;
  cbrush_t = record
    contents: Integer;
    numsides: Integer;
    firstbrushside: Integer;
    checkcount: Integer;                // to avoid repeated testings
  end;

  carea_p = ^carea_t;
  carea_t = record
    numareaportals: Integer;
    firstareaportal: Integer;
    floodnum: Integer;                  // if two areas have equal floodnums, they are connected
    floodvalid: Integer;
  end;

var
  checkcount: Integer;

  map_name: array[0..MAX_QPATH - 1] of Char;

  numbrushsides: Integer;
  map_brushsides: array[0..MAX_MAP_BRUSHSIDES - 1] of cbrushside_t;

  numplanes: Integer;
  map_planes: array[0..MAX_MAP_PLANES + 6 - 1] of cplane_t; // extra for box hull

  numnodes: Integer;
  map_nodes: array[0..MAX_MAP_NODES + 6 - 1] of cnode_t; // extra for box hull

  numleafs: Integer = 1;                // allow leaf funcs to be called without a map
  map_leafs: array[0..MAX_MAP_LEAFS - 1] of cleaf_t;
  emptyleaf, solidleaf: Integer;

  numleafbrushes: Integer;
  map_leafbrushes: array[0..MAX_MAP_LEAFBRUSHES - 1] of Word;

  numcmodels: Integer;
  map_cmodels: array[0..MAX_MAP_MODELS - 1] of cmodel_t;

  numbrushes: Integer;
  map_brushes: array[0..MAX_MAP_BRUSHES - 1] of cbrush_t;

  numvisibility: Integer;
  map_visibility: array[0..MAX_MAP_VISIBILITY - 1] of Byte;
  map_vis: dvis_p = @map_visibility;

  numentitychars: Integer;
  map_entitystring: array[0..MAX_MAP_ENTSTRING - 1] of Char;

  numareas: Integer = 1;
  map_areas: array[0..MAX_MAP_AREAS - 1] of carea_t;

  numareaportals: Integer;

  map_areaportals: array[0..MAX_MAP_AREAPORTALS - 1] of dareaportal_t;

  numclusters: Integer = 1;

  nullsurface: mapsurface_t;

  floodvalid: Integer;

  portalopen: array[0..MAX_MAP_AREAPORTALS - 1] of qboolean;

  map_noareas: cvar_p;

procedure CM_initBoxHull; forward;
procedure FloodAreaConnections; forward;

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

     MAP LOADING

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

var
  cmod_base: PByte;

  (*
  =================
  CMod_LoadSubmodels
  =================
  *)

procedure CMod_LoadSubmodels(l: lump_p);
var
  in_: dmodel_p;
  out_: cmodel_p;
  i, j, count: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l.fileofs);

  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);

  if (count < 1) then
    Com_Error(ERR_DROP, 'Map with no models', []);
  if (count > MAX_MAP_MODELS) then
    Com_Error(ERR_DROP, 'Map has too many models', []);

  numcmodels := count;

  for i := 0 to count - 1 do
  begin
    out_ := @map_cmodels[i];

    for j := 0 to 2 do
    begin                               // spread the mins / maxs by a pixel
      out_^.mins[j] := LittleFloat(in_^.mins[j]) - 1;
      out_^.maxs[j] := LittleFloat(in_^.maxs[j]) + 1;
      out_^.origin[j] := LittleFloat(in_^.origin[j]);
    end;
    out_^.headnode := LittleLong(in_^.headnode);
    Inc(in_);
    // Inc(out_); //Clootie: - never used
  end;
end;

(*
=================
CMod_LoadSurfaces
=================
*)

procedure CMod_LoadSurfaces(l: lump_p);
var
  in_: texinfo_p;
  out_: mapsurface_p;
  i, count: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l.fileofs);

  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);
  if (count < 1) then
    Com_Error(ERR_DROP, 'Map with no surfaces', []);
  if (count > MAX_MAP_TEXINFO) then
    Com_Error(ERR_DROP, 'Map has too many surfaces', []);

  numtexinfo := count;
  out_ := @map_surfaces;

  for i := 0 to count - 1 do
  begin
    strncpy(out_^.c.name, in_^.texture, SizeOf(out_^.c.name) - 1);
    strncpy(out_^.rname, in_^.texture, SizeOf(out_^.rname) - 1);
    out_^.c.flags := LittleLong(in_^.flags);
    out_^.c.value := LittleLong(in_^.value);
    Inc(in_);
    Inc(out_);
  end;
end;

(*
=================
CMod_LoadNodes

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

procedure CMod_LoadNodes(l: lump_p);
var
  in_: dnode_p;
  child: Integer;
  out_: cnode_p;
  i, j, count: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);

  if (count < 1) then
    Com_Error(ERR_DROP, 'Map has no nodes', []);
  if (count > MAX_MAP_NODES) then
    Com_Error(ERR_DROP, 'Map has too many nodes', []);

  out_ := @map_nodes;

  numnodes := count;

  for i := 0 to count - 1 do
  begin
    out_^.plane := @map_planes[LittleLong(in_^.planenum)];
    for j := 0 to 1 do
    begin
      child := LittleLong(in_^.children[j]);
      out_^.children[j] := child;
    end;
    Inc(in_);
    Inc(out_);
  end;
end;

(*
=================
CMod_LoadBrushes

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

procedure CMod_LoadBrushes(l: lump_p);
var
  in_: dbrush_p;
  out_: cbrush_p;
  i, count: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);

  if (count > MAX_MAP_BRUSHES) then
    Com_Error(ERR_DROP, 'Map has too many brushes', []);

  out_ := @map_brushes;

  numbrushes := count;

  for i := 0 to count - 1 do
  begin
    out_^.firstbrushside := LittleLong(in_^.firstside);
    out_^.numsides := LittleLong(in_^.numsides);
    out_^.contents := LittleLong(in_^.contents);
    Inc(in_);
    Inc(out_);
  end;

end;

(*
=================
CMod_LoadLeafs
=================
*)

procedure CMod_LoadLeafs(l: lump_p);
var
  i: Integer;
  out_: cleaf_p;
  in_: dleaf_p;
  count: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);

  if (count < 1) then
    Com_Error(ERR_DROP, 'Map with no leafs', []);
  // need to save space for box planes
  if (count > MAX_MAP_PLANES) then
    Com_Error(ERR_DROP, 'Map has too many planes', []);

  out_ := @map_leafs;
  numleafs := count;
  numclusters := 0;

  for i := 0 to count - 1 do
  begin
    out_^.contents := LittleLong(in_^.contents);
    out_^.cluster := LittleShort(in_^.cluster);
    out_^.area := LittleShort(in_^.area);
    out_^.firstleafbrush := LittleShort(in_^.firstleafbrush);
    out_^.numleafbrushes := LittleShort(in_^.numleafbrushes);

    if (out_^.cluster >= numclusters) then
      numclusters := out_^.cluster + 1;
    Inc(in_);
    Inc(out_);
  end;

  if (map_leafs[0].contents <> CONTENTS_SOLID) then
    Com_Error(ERR_DROP, 'Map leaf 0 is not CONTENTS_SOLID', []);
  solidleaf := 0;
  emptyleaf := -1;
  for i := 1 to numleafs - 1 do
  begin
    if (map_leafs[i].contents = 0) then
    begin
      emptyleaf := i;
      Break;
    end;
  end;
  if (emptyleaf = -1) then
    Com_Error(ERR_DROP, 'Map does not have an empty leaf', []);
end;

(*
=================
CMod_LoadPlanes
=================
*)

procedure CMod_LoadPlanes(l: lump_p);
var
  i, j: Integer;
  out_: cplane_p;
  in_: dplane_p;
  count: Integer;
  bits: Integer;
begin
  in_ := Pointer(Integer(cmod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(in_^)) <> 0 then
    Com_Error(ERR_DROP, 'MOD_LoadBmodel: funny lump size', []);
  count := l^.filelen div SizeOf(in_^);

  if (count < 1) then
    Com_Error(ERR_DROP, 'Map with no planes', []);
  // need to save space for box planes
  if (count > MAX_MAP_PLANES) then
    Com_Error(ERR_DROP, 'Map has too many planes', []);

  out_ := @map_planes;
  numplanes := count;

  for i := 0 to count - 1 do
  begin
    bits := 0;
    for j := 0 to 2 do
    begin
      out_^.normal[j] := LittleFloat(in_^.normal[j]);
      if (out_^.normal[j] < 0) then
        bits := bits or (1 shl j);
    end;

    out_^.dist := LittleFloat(in_^.dist);
    out_^._type := LittleLong(in_^._type);
    out_^.signbits := bits;
    Inc(in_);
    Inc(out_);
  end;
end;

(*
=================
CMod_LoadLeafBrushes
=================
*)

procedure CMod_LoadLeafBrushes(l: lump_p);
var
  i: Integer;
  out_: PWord;
  in_: PWord;
  count: Integer;