r_misc.pas

delphi编的不错的贪吃蛇

//100%
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): r_misc.c                                                          }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 13-Feb-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 : 22-July-2002                                                  }
{ Updated by : CodeFusion ([e-mail])                             }
{ Updated on : 21-May-2003                                                   }
{ Updated by : Scott Price ([e-mail])                      }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ None.                                                                      }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ - Still some outstanding questions as to why some code is commented out    }
{----------------------------------------------------------------------------}

unit r_misc;

interface

uses
  q_shared,
  r_model,
  r_local;

const
  NUM_MIPS = 4;

var
  sw_mipcap: cvar_p;
  sw_mipscale: cvar_p;

  d_initial_rover: surfcache_p;
  d_roverwrapped: qboolean;
  d_minmip: Integer;
  d_scalemip: array[0..NUM_MIPS - 1 - 1] of Single;

{ extern int			d_aflatcolor; }

  d_vrectx: Integer;
  d_vrecty: Integer;
  d_vrectright_particle: Integer;
  d_vrectbottom_particle: Integer;

  d_pix_min: Integer;
  d_pix_max: Integer;
  d_pix_shift: Integer;

  d_scantable: array[0..MAXHEIGHT - 1] of Integer;
  zspantable: array[0..MAXHEIGHT - 1] of PSmallInt;

  alias_colormap: PByte;

procedure D_Patch;
procedure D_ViewChanged;
procedure R_PrintTimes;
procedure R_PrintDSpeeds;
procedure R_PrintAliasStats;
procedure R_TransformFrustum;
procedure TransformVector(_in: vec3_t; var _out: vec3_t);
//procedure TransformVector(_in, _out : vec3_t);
procedure R_TransformPlane(p: mplane_p; normal: PSingle; dist: PSingle);
procedure R_SetUpFrustumIndexes;
procedure R_ViewChanged(vr: vrect_p);
procedure R_SetupFrame;
procedure R_SurfacePatch;
procedure WritePCXfile(filename: PChar; data: PByte; width, height, rowbytes: Integer; palette: PByte);
procedure R_ScreenShot_f; cdecl;

implementation

uses
  { Borland Standard Units }
  Math,
  SysUtils,

  { Game Units }
  CPas,
  r_bsp_c,
  r_alias_c,
  r_edge,
  r_main,
  r_draw,
  q_shwin,
  r_rast,
  qfiles,
  r_surf,
  r_polyse;

var
  basemip: array[0..NUM_MIPS - 1 - 1] of Single = (1.0, 0.5 * 0.8, 0.25 * 0.8);
{$IFDEF id386}
  protectset8: qboolean = false;
{$ENDIF}

(*
================
D_Patch
================
*)

procedure D_Patch;
begin
{$IFDEF id386}
  if (not protectset8) then
  begin
// Asm code has been changed so it will not be self-modifying.
// As Delphi inline assembler cannot handle self-modifying code.
// Ask CodeFusion (see contacts above) if more information is required.
//============================================================================
//		Sys_MakeCodeWriteable((int)D_PolysetAff8Start,(int)D_Aff8Patch -
//                          (int)D_PolysetAff8Start);
//		Sys_MakeCodeWriteable ((long)R_Surf8Start,(long)R_Surf8End -
//                           (long)R_Surf8Start);
    protectset8 := true;
  end;
  colormap := vid.colormap;

  R_Surf8Patch;
  D_Aff8Patch;
{$ENDIF}
end;

(*
================
D_ViewChanged
================
*)

procedure D_ViewChanged;
var
  I: Integer;
begin
  scale_for_mip := xscale;
  if (yscale > xscale) then
    scale_for_mip := yscale;

  d_zrowbytes := vid.width * 2;
  d_zwidth := vid.width;

  d_pix_min := r_refdef.vrect.width div 320;
  if (d_pix_min < 1) then
    d_pix_min := 1;

  d_pix_max := Trunc(r_refdef.vrect.width / (320.0 / 4.0) + 0.5);
  d_pix_shift := 8 - Trunc(r_refdef.vrect.width / 320.0 + 0.5);
  if (d_pix_max < 1) then
    d_pix_max := 1;

  d_vrectx := r_refdef.vrect.x;
  d_vrecty := r_refdef.vrect.y;
  d_vrectright_particle := r_refdef.vrectright - d_pix_max;
  d_vrectbottom_particle := r_refdef.vrectbottom - d_pix_max;

  for I := 0 to vid.height - 1 do
  begin
    d_scantable[i] := i * r_screenwidth;
    zspantable[i] := PSmallInt(Integer(d_pzbuffer) + ((i * Integer(d_zwidth)) * SizeOf(SmallInt)));
  end;

  (*
  ** clear Z-buffer and color-buffers if we're doing the gallery
  *)
  if (r_newrefdef.rdflags and RDF_NOWORLDMODEL) <> 0 then
  begin
    memset(d_pzbuffer, vid.width * vid.height * SizeOf(SmallInt), $FF);
    Draw_Fill(r_newrefdef.x, r_newrefdef.y, r_newrefdef.width, r_newrefdef.height, Trunc(sw_clearcolor^.value) and $FF);
  end;
  alias_colormap := vid.colormap;
  D_Patch;
end;

(*
=============
R_PrintTimes
=============
*)

procedure R_PrintTimes;
var
  r_time2: Integer;
  ms: Integer;
begin
  r_time2 := Sys_Milliseconds;

  ms := r_time2 - Trunc(r_time1);
  ri.Con_Printf(PRINT_ALL,'%5d ms %3d/%3d/%3d poly %3d surf', ms, c_faceclip, r_polycount, r_drawnpolycount, c_surf);
  c_surf := 0;
end;

(*
=============
R_PrintDSpeeds
=============
*)

procedure R_PrintDSpeeds;
var
  ms: Integer;
  dp_time: Integer;
  r_time2: Integer;
  rw_time: Integer;
  db_time: Integer;
  se_time: Integer;
  de_time: Integer;
  da_time: Integer;
begin
  r_time2 := Sys_Milliseconds;

  da_time := Trunc(da_time2 - da_time1);
  dp_time := Trunc(dp_time2 - dp_time1);
  rw_time := Trunc(rw_time2 - rw_time1);
  db_time := Trunc(db_time2 - db_time1);
  se_time := Trunc(se_time2 - se_time1);
  de_time := Trunc(de_time2 - de_time1);
  ms := (r_time2 - Trunc(r_time1));

  ri.Con_Printf(PRINT_ALL, '%3d %2dp %2dw %2db %2ds %2de %2da', ms, dp_time, rw_time, db_time, se_time, de_time, da_time);
end;

(*
=============
R_PrintAliasStats
=============
*)

procedure R_PrintAliasStats;
begin
	ri.Con_Printf(PRINT_ALL,'%d polygon model drawn', r_amodels_drawn);
end;

(*
===================
R_TransformFrustum
===================
*)

procedure R_TransformFrustum;
var
  i: Integer;
  v: vec3_t;
  v2: vec3_t;
begin
  for I := 0 to 3 do
  begin
    v[0] := screenedge[i].normal[2];
    v[1] := -screenedge[i].normal[0];
    v[2] := screenedge[i].normal[1];

    v2[0] := v[1] * vright[0] + v[2] * vup[0] + v[0] * vpn[0];
    v2[1] := v[1] * vright[1] + v[2] * vup[1] + v[0] * vpn[1];
    v2[2] := v[1] * vright[2] + v[2] * vup[2] + v[0] * vpn[2];

    VectorCopy(v2, view_clipplanes[i].normal);

    view_clipplanes[i].dist := DotProduct(modelorg, v2);
  end;
end;

(*
================
TransformVector
================
*)
{ #if !(defined __linux__ && defined __i386__)  // <<--  To Convert}

procedure TransformVector(_in: vec3_t; var _out: vec3_t);
{$IFNDEF id386}
begin
  { 2003-05-21 (SP):  Is this a complete conversion replacement? }
  _out[0] := DotProduct(_in, vright);
  _out[1] := DotProduct(_in, vup);
  _out[2] := DotProduct(_in, vpn);
end;
{$ELSE}
{ DELPHI TODO: put asm code here! }
asm
end;
{$ENDIF}

(*
================
R_TransformPlane
================
*)

procedure R_TransformPlane(p: mplane_p; normal: PSingle; dist: PSingle);
var
  d: Single;
begin
  d := DotProduct(r_origin, p^.normal);
  dist^ := p^.dist - d;
// TODO: when we have rotating entities, this will need to use the view matrix
	TransformVector(p^.normal, vec3_p(normal)^);
// OLD line (CodeFusion):  TransformVector(p^.normal, vec3_p(@normal)^);
end;

(*
===============
R_SetUpFrustumIndexes
===============
*)

procedure R_SetUpFrustumIndexes;
var
  i, j: Integer;
  pindex: PInteger;
begin
  pindex := @r_frustum_indexes;

  for I := 0 to 3 do
  begin
    for j := 0 to 2 do
    begin
      { 2003-05-21 (SP):  Not sure about these conversions below }
      if (view_clipplanes[i].normal[j] < 0) then
      begin
        PInteger(Integer(pindex) + (j * SizeOf(Integer)))^ := j;
        PInteger(Integer(pindex) + ((j + 3) * SizeOf(Integer)))^ := j + 3;
      end
      else
      begin
        PInteger(Integer(pindex) + (j * SizeOf(Integer)))^ := j + 3;
        PInteger(Integer(pindex) + ((j + 3) * SizeOf(Integer)))^ := j;
      end;
    end;

  // FIXME: do just once at start
    pfrustum_indexes[i] := pindex;
    { 2003-05-21 (SP):  Not sure about this conversions below }
    Inc(Integer(pindex), 6 * SizeOf(Integer));
  end;
end;

(*
===============
R_ViewChanged