r_model.pas

delphi编的不错的贪吃蛇

  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc((count + 13) * sizeof(_out^)); // extra for skybox

  loadmodel^.edges := _out;
  loadmodel^.numedges := count;

  for i := 0 to count - 1 do
  begin
    _out^.v[0] := Word(LittleShort(_in^.v[0]));
    _out^.v[1] := Word(LittleShort(_in^.v[1]));
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end {next i};
end {procedure};

(*
=================
Mod_LoadTexinfo
=================
*)

procedure Mod_LoadTexinfo(l: lump_p);
var
  _in: texinfo_p;
  _out, step: mtexinfo_p;
  i, j, count: Integer;
  len1, len2: Single;
  name: array[0..MAX_QPATH - 1] of Char;
  next: Integer;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc((count + 6) * sizeof(_out^)); // extra for skybox

  loadmodel^.texinfo := _out;
  loadmodel^.numtexinfo := count;

  for i := 0 to count - 1 do
  begin
    for j := 0 to 7 do
    begin
      _out^.vecs[0][j] := LittleFloat(_in^.vecs[0][j]);
      //_out^.vecs[1][j] := LittleFloat(_in^.vecs[1][j]);
    end;
    len1 := VectorLength(vec3_p(@_out^.vecs[0][0])^);
    len2 := VectorLength(vec3_p(@_out^.vecs[1][0])^);
    len1 := (len1 + len2)/2;
    if len1 < 0.32 then
      _out^.mipadjust := 4
    else
      if len1 < 0.49 then
        _out^.mipadjust := 3
      else
        if len1 < 0.99 then
          _out^.mipadjust := 2
        else
          _out^.mipadjust := 1;
(*
  if (len1 + len2 < 0.001)
   _out.mipadjust := 1;		// don't crash
  else
   _out.mipadjust := 1 / floor( (len1+len2)/2 + 0.1 );
*)

    _out^.flags := LittleLong(_in^.flags);

    next := LittleLong(_in^.nexttexinfo);
    if next > 0 then
      _out^.next := mtexinfo_p(Integer(loadmodel^.texinfo) + (next * SizeOf(loadmodel^.texinfo^)));

    Com_sprintf(name, sizeof(name), 'textures/%s.wal', [_in^.texture]);
    _out^.image := R_FindImage(name, it_wall);
    if _out^.image = nil then
    begin
      _out^.image := r_notexture_mip; // texture not found
      _out^.flags := 0;
    end;
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end;

  // count animation frames
  _out := loadmodel^.texinfo;
  for i := 0 to count - 1 do
  begin
    _out^.numframes := 1;
    step := _out^.next;
    while (step <> nil) and (Integer(step) <> Integer(_out)) do
    begin
      inc(_out^.numframes);
      step := step^.next;
    end;
    Inc(Integer(_out), SizeOf(_out^));
  end;
end;

(*
================
CalcSurfaceExtents

Fills in s->texturemins[] and s->extents[]
================
*)

procedure CalcSurfaceExtents(s: msurface_p);
var
  mins, maxs: array[0..1] of Single;
  val: Single;
  i, j, e: Integer;
  v: mvertex_p;
  tex: mtexinfo_p;
  bmins, bmaxs: array[0..1] of Single;
begin
  mins[0] := 999999;
  mins[1] := 999999;
  maxs[0] := -99999;
  maxs[1] := -99999;

  tex := s^.texinfo;

  for i := 0 to s^.numedges - 1 do
  begin
    e := PIntegerArray(loadmodel^.surfedges)^[s^.firstedge + i];
    if e >= 0 then
      v := @mvertex_arrp(loadmodel^.vertexes)^[medge_arrp(loadmodel^.edges)^[e].v[0]]
    else
      v := @mvertex_arrp(loadmodel^.vertexes)^[medge_arrp(loadmodel^.edges)^[-e].v[1]];

    for j := 0 to 1 do
    begin
      val := v^.position[0] * tex^.vecs[j][0] +
        v^.position[1] * tex^.vecs[j][1] +
        v^.position[2] * tex^.vecs[j][2] +
        tex^.vecs[j][3];
      if val < mins[j] then
        mins[j] := val;
      if val > maxs[j] then
        maxs[j] := val;
    end;
  end;

  for i := 0 to 1 do
  begin
    bmins[i] := floor(mins[i] / 16);
    bmaxs[i] := ceil(maxs[i] / 16);

    s^.texturemins[i] := Trunc(bmins[i] * 16);
    s^.extents[i] := Trunc((bmaxs[i] - bmins[i]) * 16);
    if s^.extents[i] < 16 then
      s^.extents[i] := 16; // take at least one cache block
    if ((tex^.flags and (SURF_WARP or SURF_SKY)) = 0) and (s^.extents[i] > 256) then
      ri.Sys_Error(ERR_DROP, 'Bad surface extents');
  end;
end;

(*
=================
Mod_LoadFaces
=================
*)

procedure Mod_LoadFaces(l: lump_p);
var
  _in: dface_p;
  _out: msurface_p;
  i, count: Integer;
  surfnum: Integer;
  planenum: Integer;
  side: Integer;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc((count + 6) * sizeof(_out^)); // extra for skybox

  loadmodel^.surfaces := _out;
  loadmodel^.numsurfaces := count;

  for surfnum := 0 to count - 1 do
  begin
    _out^.firstedge := LittleLong(_in^.firstedge);
    _out^.numedges := LittleShort(_in^.numedges);
    if _out^.numedges < 3 then
      ri.Sys_Error(ERR_DROP, PChar('Surface with ' + IntToStr(_out^.numedges) + ' edges')); // CAK BUG!!!!! The number of edges was passed to printf as a string instead of an integer
    _out^.flags := 0;

    planenum := LittleShort(_in^.planenum);
    side := LittleShort(_in^.side);
    if side <> 0 then
      _out^.flags := _out^.flags or SURF_PLANEBACK;

    _out^.plane := @mplane_arrp(loadmodel^.planes)^[planenum];

    _out^.texinfo := @mtexinfo_arrp(loadmodel^.texinfo)^[LittleShort(_in^.texinfo)];

    CalcSurfaceExtents(_out);

    // lighting info is converted from 24 bit on disk to 8 bit

    for i := 0 to MAXLIGHTMAPS - 1 do
      _out^.styles[i] := _in^.styles[i];
    i := LittleLong(_in^.lightofs);
    if i = -1 then
      _out^.samples := nil
    else
      _out^.samples := Pointer(Integer(loadmodel.lightdata) + (i div 3));

    // set the drawing flags flag

    if _out^.texinfo.image = nil then
    begin
      inc(Integer(_in), SizeOf(_in^));
      inc(Integer(_out), SizeOf(_out^));
      continue;
    end;
    if (_out^.texinfo.flags and SURF_SKY) <> 0 then
    begin
      _out^.flags := _out^.flags or SURF_DRAWSKY;
      inc(Integer(_in), SizeOf(_in^));
      inc(Integer(_out), SizeOf(_out^));
      continue;
    end;

    if (_out^.texinfo.flags and SURF_WARP) <> 0 then
    begin
      _out^.flags := _out^.flags or SURF_DRAWTURB;
      for i := 0 to 1 do
      begin
        _out^.extents[i] := 16384;
        _out^.texturemins[i] := -8192;
      end;
      inc(Integer(_in), SizeOf(_in^));
      inc(Integer(_out), SizeOf(_out^));
      continue;
    end;
//==============
//PGM
    // this marks flowing surfaces as turbulent, but with the new
    // SURF_FLOW flag.
    if (_out^.texinfo.flags and SURF_FLOWING) <> 0 then
    begin
      _out^.flags := _out^.flags or SURF_DRAWTURB or SURF_FLOW;
      for i := 0 to 1 do
      begin
        _out^.extents[i] := 16384;
        _out^.texturemins[i] := -8192;
      end;
      inc(Integer(_in), SizeOf(_in^));
      inc(Integer(_out), SizeOf(_out^));
      continue;
    end;
//PGM
//==============
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end {next i};
end;

(*
=================
Mod_SetParent
=================
*)

procedure Mod_SetParent(node, parent: mnode_p);
begin
  node^.parent := parent;
  if node^.contents <> -1 then
    exit;
  Mod_SetParent(node^.children[0], node);
  Mod_SetParent(node^.children[1], node);
end;

(*
=================
Mod_LoadNodes
=================
*)

procedure Mod_LoadNodes(l: lump_p);
var
  i, j: Integer;
  count: Integer;
  p: Integer;
  _in: dnode_p;
  _out: mnode_p;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc(count * sizeof(_out^));

  loadmodel^.nodes := _out;
  loadmodel^.numnodes := count;

  for i := 0 to count - 1 do
  begin
    for j := 0 to 2 do
    begin
      _out^.minmaxs[j] := LittleShort(_in^.mins[j]);
      _out^.minmaxs[3 + j] := LittleShort(_in^.maxs[j]);
    end;

    p := LittleLong(_in^.planenum);
    _out^.plane := @mplane_arrp(loadmodel^.planes)^[p];

    _out^.firstsurface := LittleShort(_in^.firstface);
    _out^.numsurfaces := LittleShort(_in^.numfaces);
    _out^.contents := CONTENTS_NODE; // differentiate from leafs

    for j := 0 to 1 do
    begin
      p := LittleLong(_in^.children[j]);
      if p >= 0 then
        _out^.children[j] := @mnode_arrp(loadmodel^.nodes)^[p]
      else
        _out^.children[j] := mnode_p(@mleaf_arrp(loadmodel^.leafs)^[-1 - p]); // CAK - Huh?????
    end;
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end {next i};
  Mod_SetParent(loadmodel^.nodes, nil); // sets nodes and leafs
end;

(*
=================
Mod_LoadLeafs
=================
*)

procedure Mod_LoadLeafs(l: lump_p);
var
  _in: dleaf_p;
  _out: mleaf_p;
  i, j: Integer;
  count: Integer;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc(count * sizeof(_out^));

  loadmodel^.leafs := _out;
  loadmodel^.numleafs := count;

  for i := 0 to count - 1 do
  begin
    for j := 0 to 2 do
    begin
      _out^.minmaxs[j] := LittleShort(_in^.mins[j]);
      _out^.minmaxs[3 + j] := LittleShort(_in^.maxs[j]);
    end;

    _out^.contents := LittleLong(_in^.contents);
    _out^.cluster := LittleShort(_in^.cluster);
    _out^.area := LittleShort(_in^.area);

    _out^.firstmarksurface := Pointer(Integer(loadmodel^.marksurfaces) + (LittleShort(_in^.firstleafface) * Sizeof(msurface_p)));
    _out^.nummarksurfaces := LittleShort(_in^.numleaffaces);
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end;
end;

(*
=================
Mod_LoadMarksurfaces
=================
*)

procedure Mod_LoadMarksurfaces(l: lump_p);
var
  i, j: Integer;
  count: Integer;
  _in: PSmallInt;
  _out: msurface_pp;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc(count * sizeof(_out^));

  loadmodel^.marksurfaces := _out;
  loadmodel^.nummarksurfaces := count;

  for i := 0 to count - 1 do
  begin
    j := LittleShort(_in^);
    if j >= loadmodel^.numsurfaces then
      ri.Sys_Error(ERR_DROP, 'Mod_ParseMarksurfaces: bad surface number');
    _out^ := @(msurface_arrp(loadmodel^.surfaces)^[j]);
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end;
end;

(*
=================
Mod_LoadSurfedges
=================
*)

procedure Mod_LoadSurfedges(l: lump_p);
var
  i, count: Integer;
  _in, _out: PInteger;
begin
  _in := Pointer(Integer(mod_base) + l^.fileofs);
  if (l^.filelen mod SizeOf(_in^)) <> 0 then
    ri.Sys_Error(ERR_DROP, PChar('MOD_LoadBmodel: funny lump size in ' + string(loadmodel^.name)));
  count := Trunc(l^.filelen / sizeof(_in^));
  _out := Hunk_Alloc((count + 24) * sizeof(_out^)); // extra for skybox

  loadmodel^.surfedges := _out;
  loadmodel^.numsurfedges := count;

  for i := 0 to count - 1 do
  begin
    _out^ := LittleLong(_in^);
    inc(Integer(_in), SizeOf(_in^));
    inc(Integer(_out), SizeOf(_out^));
  end;
end;

(*
=================
Mod_LoadPlanes
=================
*)