r_main.pas

delphi编的不错的贪吃蛇

unit r_main;
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): r_main.c                                                          }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 23-Jan-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 : 17-July-2002                                                  }
{ Updated by : CodeFusion ([e-mail])                             }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{                                                                            }
{----------------------------------------------------------------------------}

interface

uses
  q_shared,
  ref,
  r_local,
  r_model;

procedure Com_Printf(fmt: PChar; args: array of const); overload;
procedure Com_Printf(fmt: PChar); overload;

function _SAR(AValue: Integer; AShift: Byte): Integer;
function _SAL(AValue: Integer; AShift: Byte): Integer;

var
  vid: viddef_t;
  ri: refimport_t;

  d_8to24table: array[0..256 - 1] of Cardinal;
  r_worldentity: entity_t;

  skyname: array[0..MAX_QPATH - 1] of Char;
  skyrotate: Single;
  skyaxis: vec3_t;
  sky_images: array[0..6 - 1] of image_p;

  r_newrefdef: refdef_t;
  currentmodel: model_p;

  r_worldmodel: model_p;

  r_warpbuffer: array[0..(WARP_WIDTH * WARP_HEIGHT) - 1] of Byte;

  sw_state: swstate_t;

  colormap: Pointer;
  viewlightvec: vec3_t;
//alight_t  r_viewlighting = {128, 192, viewlightvec};
  r_viewlighting: alight_t = (ambientlight: 128; shadelight: 192; plightvec: @viewlightvec);

  r_time1: Single;
  r_numallocatededges: Integer;
  r_aliasuvscale: Single = 1.0;
  r_outofsurfaces: Integer;
  r_outofedges: Integer;

  r_dowarp: qboolean;

  r_pcurrentvertbase: mvertex_p;

  c_surf: Integer;
  r_maxsurfsseen: Integer;
  r_maxedgesseen: Integer;
  r_cnumsurfs: Integer;
  r_surfsonstack: qboolean;
  r_clipflags: Integer;

//
// view origin
//
  vup: vec3_t;
  base_vup: vec3_t;
  vpn: vec3_t;
  base_vpn: vec3_t;
  vright: vec3_t;
  base_vright: vec3_t;
  r_origin: vec3_t;

//
// screen size info
//
  r_refdef: oldrefdef_t;
  xcenter: Single;
  ycenter: Single;
  xscale: Single;
  yscale: Single;
  xscaleinv: Single;
  yscaleinv: Single;
  xscaleshrink: Single;
  yscaleshrink: Single;
  aliasxscale: Single;
  aliasyscale: Single;
  aliasxcenter: Single;
  aliasycenter: Single;

  r_screenwidth: Integer;

  verticalFieldOfView: Single;
  xOrigin: Single;
  yOrigin: Single;

  screenedge: array[0..4 - 1] of mplane_t;

//
// refresh flags
//
  r_framecount: Integer = 1; // so frame counts initialized to 0 don't match
  r_visframecount: Integer;
  d_spanpixcount: Integer;
  r_polycount: Integer;
  r_drawnpolycount: Integer;
  r_wholepolycount: Integer;

  pfrustum_indexes: array[0..4 - 1] of PInteger;
  r_frustum_indexes: array[0..(4 * 6) - 1] of Integer;

  r_viewleaf: mleaf_p;
  r_viewcluster: Integer;
  r_oldviewcluster: Integer;

  r_notexture_mip: image_p;

  da_time1: Single;
  da_time2: Single;
  dp_time1: Single;
  dp_time2: Single;
  db_time1: Single;
  db_time2: Single;
  rw_time1: Single;
  rw_time2: Single;
  se_time1: Single;
  se_time2: Single;
  de_time1: Single;
  de_time2: Single;

  r_lefthand: cvar_p;
  sw_aliasstats: cvar_p;
  sw_allow_modex: cvar_p;
  sw_clearcolor: cvar_p;
  sw_drawflat: cvar_p;
  sw_draworder: cvar_p;
  sw_maxedges: cvar_p;
  sw_maxsurfs: cvar_p;
  sw_mode: cvar_p;
  sw_reportedgeout: cvar_p;
  sw_reportsurfout: cvar_p;
  sw_stipplealpha: cvar_p;
  sw_surfcacheoverride: cvar_p;
  sw_waterwarp: cvar_p;

  r_drawworld: cvar_p;
  r_drawentities: cvar_p;
  r_dspeeds: cvar_p;
  r_fullbright: cvar_p;
  r_lerpmodels: cvar_p;
  r_novis: cvar_p;

  r_speeds: cvar_p;
  r_lightlevel: cvar_p; //FIXME HACK

  vid_fullscreen: cvar_p;
  vid_gamma: cvar_p;

//PGM
  sw_lockpvs: cvar_p;
//PGM

//#define  STRINGER(x) "x"
procedure R_MarkLeaves;
procedure R_GammaCorrectAndSetPalette(const palette: PByte);
procedure R_NewMap;

{$IFNDEF id386}

// r_vars.c

// all global and static refresh variables are collected in a contiguous block
// to avoid cache conflicts.

//-------------------------------------------------------
// global refresh variables
//-------------------------------------------------------

// FIXME: make into one big structure, like cl or sv
// FIXME: do separately for refresh engine and driver

// d_vars.c

// all global and static refresh variables are collected in a contiguous block
// to avoid cache conflicts.

//-------------------------------------------------------
// global refresh variables
//-------------------------------------------------------

// FIXME: make into one big structure, like cl or sv
// FIXME: do separately for refresh engine and driver
var
  d_sdivzstepu: Single;
  d_tdivzstepu: Single;
  d_zistepu: Single;
  d_sdivzstepv: Single;
  d_tdivzstepv: Single;
  d_zistepv: Single;
  d_sdivzorigin: Single;
  d_tdivzorigin: Single;
  d_ziorigin: Single;

  sadjust: fixed16_t;
  tadjust: fixed16_t;
  bbextents: fixed16_t;
  bbextentt: fixed16_t;

  cacheblock: pixel_p;
  cachewidth: Integer;
  d_viewbuffer: pixel_P;
  d_pzbuffer: PSmallInt;
  d_zrowbytes: Cardinal;
  d_zwidth: Cardinal;

{$ENDIF} // !id386

var
  r_notexture_buffer: array[0..1024 - 1] of Byte;

function GetRefAPI(rimp: refimport_t): refexport_t; cdecl;

implementation

uses
  SysUtils,
  Math,
  r_misc,
  r_surf,
  r_image,
  r_draw,
  r_rast,
  r_light,
  rw_imp,
  r_bsp_c,
  r_edge,
  r_edgea,
  r_part,
  r_poly,
  r_scan,
  r_sprite,
  r_alias_c,
  DelphiTypes,
  q_shwin;

const
  NUM_BEAM_SEGS = 6;

var
  modified: qboolean; (*was static*)
// 3dstudio environment map names
  suf: array[0..5] of PChar = ('rt', 'bk', 'lf', 'ft', 'up', 'dn');
  r_skysideimage: array[0..5] of Integer = (5, 2, 4, 1, 0, 3);

procedure Draw_GetPalette; forward;

procedure R_BeginFrame(camera_separation: Single); cdecl; forward;

procedure Draw_BuildGammaTable; cdecl; forward;

procedure R_DrawBeam(e: entity_p); cdecl; forward;

function _SAR(AValue: Integer; AShift: Byte): Integer;
asm
  mov eax,AValue
  mov cl,AShift
  sar eax,cl
end;

function _SAL(AValue: Integer; AShift: Byte): Integer;
asm
  mov eax,AValue
  mov cl,AShift
  sal eax,cl
end;

(*
==================
R_InitTextures
==================
*)

procedure R_InitTextures;
var
  x, y, m: Integer;
  dest: PByte;
begin
// create a simple checkerboard texture for the default
  r_notexture_mip := image_p(@r_notexture_buffer);

  r_notexture_mip^.height := 16;
  r_notexture_mip^.width := 16;
  r_notexture_mip^.pixels[0] := PByte(@r_notexture_buffer[sizeof(image_t)]);
  r_notexture_mip^.pixels[1] := PByte(Cardinal(r_notexture_mip^.pixels[0]) + 16 * 16);
  r_notexture_mip^.pixels[2] := PByte(Cardinal(r_notexture_mip^.pixels[1]) + 8 * 8);
  r_notexture_mip^.pixels[3] := PByte(Cardinal(r_notexture_mip^.pixels[2]) + 4 * 4);

  for m := 0 to 3 do
  begin
    dest := r_notexture_mip^.pixels[m];
    for y := 0 to (16 shr m) - 1 do
    begin
      for x := 0 to (16 shr m) - 1 do
      begin
        if ((y < (8 shr m)) xor (x < (8 shr m))) then
          dest^ := 0
        else
          dest^ := $FF;
        dest := PByte(Cardinal(dest) + 1);
      end;
    end;
  end;
end;

(*
================
R_InitTurb
================
*)

procedure R_InitTurb;
var
  i: Integer;
begin
  for i := 0 to 1280 - 1 do
  begin
    sintable[i] := Trunc(AMP + sin(i * 3.14159 * 2 / CYCLE) * AMP);
    intsintable[i] := Trunc(AMP2 + sin(i * 3.14159 * 2 / CYCLE) * AMP2); // AMP2, not 20
    blanktable[i] := 0; //PGM
  end;
end;

procedure R_Register;
begin
  sw_aliasstats := ri.Cvar_Get('sw_polymodelstats', '0', 0);
  sw_allow_modex := ri.Cvar_Get('sw_allow_modex', '1', CVAR_ARCHIVE);
  sw_clearcolor := ri.Cvar_Get('sw_clearcolor', '2', 0);
  sw_drawflat := ri.Cvar_Get('sw_drawflat', '0', 0);
  sw_draworder := ri.Cvar_Get('sw_draworder', '0', 0);
  sw_maxedges := ri.Cvar_Get('sw_maxedges', 'MAXSTACKSURFACES', 0);
  sw_maxsurfs := ri.Cvar_Get('sw_maxsurfs', '0', 0);
  sw_mipcap := ri.Cvar_Get('sw_mipcap', '0', 0);
  sw_mipscale := ri.Cvar_Get('sw_mipscale', '1', 0);
  sw_reportedgeout := ri.Cvar_Get('sw_reportedgeout', '0', 0);
  sw_reportsurfout := ri.Cvar_Get('sw_reportsurfout', '0', 0);
  sw_stipplealpha := ri.Cvar_Get('sw_stipplealpha', '0', CVAR_ARCHIVE);
  sw_surfcacheoverride := ri.Cvar_Get('sw_surfcacheoverride', '0', 0);
  sw_waterwarp := ri.Cvar_Get('sw_waterwarp', '1', 0);
  sw_mode := ri.Cvar_Get('sw_mode', '0', CVAR_ARCHIVE);

  r_lefthand := ri.Cvar_Get('hand', '0', CVAR_USERINFO or CVAR_ARCHIVE);
  r_speeds := ri.Cvar_Get('r_speeds', '0', 0);
  r_fullbright := ri.Cvar_Get('r_fullbright', '0', 0);
  r_drawentities := ri.Cvar_Get('r_drawentities', '1', 0);
  r_drawworld := ri.Cvar_Get('r_drawworld', '1', 0);
  r_dspeeds := ri.Cvar_Get('r_dspeeds', '0', 0);
  r_lightlevel := ri.Cvar_Get('r_lightlevel', '0', 0);
  r_lerpmodels := ri.Cvar_Get('r_lerpmodels', '1', 0);
  r_novis := ri.Cvar_Get('r_novis', '0', 0);

  vid_fullscreen := ri.Cvar_Get('vid_fullscreen', '0', CVAR_ARCHIVE);
  vid_gamma := ri.Cvar_Get('vid_gamma', '1.0', CVAR_ARCHIVE);

  ri.Cmd_AddCommand('modellist', Mod_Modellist_f);
  ri.Cmd_AddCommand('screenshot', R_ScreenShot_f);
  ri.Cmd_AddCommand('imagelist', R_ImageList_f);

  sw_mode^.modified := True; // force us to do mode specific stuff later
  vid_gamma^.modified := true; // force us to rebuild the gamma table later

//PGM
  sw_lockpvs := ri.Cvar_Get('sw_lockpvs', '0', 0);
//PGM
end;

procedure R_UnRegister;
begin
  ri.Cmd_RemoveCommand('screenshot');
  ri.Cmd_RemoveCommand('modellist');
  ri.Cmd_RemoveCommand('imagelist');
end;

(*
===============
R_Init
===============
*)

function R_Init(hInstance: Cardinal; wndProc: Pointer): Integer; cdecl;
begin
  try
    R_InitImages;
    Mod_Init;
    Draw_InitLocal;
    R_InitTextures;

    R_InitTurb;

    view_clipplanes[0].leftedge := 1;
    view_clipplanes[1].rightedge := 1;
    view_clipplanes[1].leftedge := 0;
    view_clipplanes[2].leftedge := 0;
    view_clipplanes[3].leftedge := 0;
    view_clipplanes[0].rightedge := 0;
    view_clipplanes[2].rightedge := 0;
    view_clipplanes[3].rightedge := 0;

    r_refdef.xOrigin := XCENTERING;
    r_refdef.yOrigin := YCENTERING;

// TODO: collect 386-specific code in one place
{$IF defined(id386)}

//*****************************************************************************
// This should not be neccessary, as all asm code has been changed so it will
// not change the upcodes directly during runtime.
//*****************************************************************************
//  Sys_MakeCodeWriteable ((long)R_EdgeCodeStart,
//               (long)R_EdgeCodeEnd - (long)R_EdgeCodeStart);
//  Sys_SetFPCW ();    // get bit masks for FPCW  (FIXME: is this id386?)
{$IFEND} // id386

    r_aliasuvscale := 1.0;

    R_Register;
    Draw_GetPalette;
    SWimp_Init(Pointer(hInstance), wndProc);

 // create the window
    R_BeginFrame(0);

    ri.Con_Printf(PRINT_ALL, 'ref_soft version: %s', REF_VERSION);
  except
    ri.Sys_Error(ERR_FATAL,'Unhandled exception in R_Init.')
  end;
  Result := 1;
end;

(*
===============
R_Shutdown
===============
*)

procedure R_Shutdown; cdecl;
begin
 // free z buffer
  if (d_pzbuffer <> nil) then
  begin
    FreeMem(d_pzbuffer);
    d_pzbuffer := nil;
  end;
 // free surface cache
  if (sc_base <> nil) then
  begin
    D_FlushCaches;
    FreeMem(sc_base);
    sc_base := nil;
  end;

 // free colormap
  if (vid.colormap <> nil) then
  begin
    FreeMem(vid.colormap);
    vid.colormap := nil;
  end;
  R_UnRegister;
  Mod_FreeAll;
  R_ShutdownImages;

  SWimp_Shutdown;
end;

(*
===============
R_NewMap
===============
*)

procedure R_NewMap;
begin
  r_viewcluster := -1;