gl_rmain.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): gl_rmain.c                                                        }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 17-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 :                                                               }
{ Updated by :                                                               }
{                                                                            }
{----------------------------------------------------------------------------}
// (r_main.c) gl_rmain.c
{ 28.06.2003 Juha: Proofreaded }
{$I ..\Jedi.inc}
unit gl_rmain;

interface

uses
  SysUtils,
  DelphiTypes,
  OpenGL,
  gl_model_h,
  gl_local,
  q_shared,
  q_shared_add,
  ref;

function R_CullBox(var mins, maxs: vec3_t): qboolean;
procedure R_RotateForEntity(e: entity_p);

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

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

procedure MYgluPerspective(fovy, aspect, zNear, zFar: TGLdouble);


var
  vid: viddef_t;
  ri: refimport_t;
  GL_TEXTURE0,
    GL_TEXTURE1: Integer;
  r_worldmodel: model_p;

  gldepthmin, gldepthmax: Single;

  gl_config: glconfig_t;
  gl_state: glstate_t;

  r_notexture: image_p; // use for bad textures
  r_particletexture: image_p; // little dot for particles

  currententity: entity_p;
  currentmodel: model_p;

  frustum: array[0..3] of cplane_t;

  r_visframecount: Integer; // bumped when going to a new PVS
  r_framecount: Integer; // used for dlight push checking

  c_brush_polys,
    c_alias_polys: Integer;

  v_blend: array[0..3] of single; // final blending color

//
// view origin
//
  vup: vec3_t;
  vpn: vec3_t;
  vright: vec3_t;
  r_origin: vec3_t;

  r_world_matrix: array[0..16 - 1] of Single;
  r_base_world_matrix: array[0..16 - 1] of Single;

//
// screen size info
//
  r_newrefdef: refdef_t;

  r_viewcluster,
    r_viewcluster2,
    r_oldviewcluster,
    r_oldviewcluster2: Integer;


  r_norefresh,
    r_drawentities,
    r_drawworld_,
    r_speeds,
    r_fullbright,
    r_novis,
    r_nocull,
    r_lerpmodels,
    r_lefthand,

  r_lightlevel, // FIXME: This is a HACK to get the client's light level

  gl_nosubimage,
    gl_allow_software,

  gl_vertex_arrays,

  gl_particle_min_size,
    gl_particle_max_size,
    gl_particle_size,
    gl_particle_att_a,
    gl_particle_att_b,
    gl_particle_att_c,

  gl_ext_swapinterval,
    gl_ext_palettedtexture,
    gl_ext_multitexture,
    gl_ext_pointparameters,
    gl_ext_compiled_vertex_array,

  gl_log,
    gl_bitdepth,
    gl_drawbuffer,
    gl_driver,
    gl_lightmap,
    gl_shadows,
    gl_mode,
    gl_dynamic,
    gl_monolightmap,
    gl_modulate_,
    gl_nobind,
    gl_round_down,
    gl_picmip,
    gl_skymip,
    gl_showtris,
    gl_ztrick,
    gl_finish,
    gl_clear_,
    gl_cull,
    gl_polyblend,
    gl_flashblend,
    gl_playermip,
    gl_saturatelighting,
    gl_swapinterval,
    gl_texturemode_,
    gl_texturealphamode_,
    gl_texturesolidmode_,
    gl_lockpvs,

  gl_3dlabs_broken,

  vid_fullscreen,
    vid_gamma,
    vid_ref: cvar_p;

  r_rawpalette: array[0..256 - 1] of Cardinal;


implementation

uses
  glw_win,
  glw_imp,
  qgl_h,
  qgl_win,
  gl_model,
  gl_image,
  gl_rmisc,
  gl_light,
  qfiles,
  gl_warp,
  gl_rsurf,
  gl_draw,
  gl_mesh,
  Math,
  CPas;

procedure R_DrawBeam(e: entity_p); forward;


{*
=================
R_CullBox

Returns true if the box is completely outside the frustom
=================
*}
function R_CullBox(var mins, maxs: vec3_t): qboolean;
var
  i: integer;
begin
  if (r_nocull.value <> 0) then
  begin
    Result := false;
    Exit;
  end;

  for i := 0 to 3 do
    if (BOX_ON_PLANE_SIDE(mins, maxs, @frustum[i]) = 2) then
    begin
      Result := true;
      Exit;
    end;

  Result := false;
end;

procedure R_RotateForEntity(e: entity_p);
begin
  qglTranslatef(e.origin[0], e.origin[1], e.origin[2]);

  qglRotatef(e.angles[1], 0, 0, 1);
  qglRotatef(-e.angles[0], 0, 1, 0);
  qglRotatef(-e.angles[2], 1, 0, 0);
end;

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

  SPRITE MODELS

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

{*
=================
R_DrawSpriteModel

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

procedure R_DrawSpriteModel(e: entity_p);
var
  point: vec3_t;
  frame: dsprframe_p;
  up, right: vec3_p;
  psprite: dsprite_p;
  alpha: Single;
  //v_forward, v_right, v_up: vec3_t;
begin
  alpha := 1;
  // don't even bother culling, because it's just a single
  // polygon without a surface cache

  psprite := dsprite_p(currentmodel.extradata);

(*
 if (e->frame < 0 || e->frame >= psprite->numframes)
 {
  ri.Con_Printf (PRINT_ALL, "no such sprite frame %i\n", e->frame);
  e->frame = 0;
 }
*)

  e.frame := e.frame mod psprite.numframes;
  frame := @psprite.frames[e.frame];

(*
 if (psprite->type == SPR_ORIENTED)
 {	// bullet marks on walls
 vec3_t		v_forward, v_right, v_up;

 AngleVectors (currententity->angles, v_forward, v_right, v_up);
  up = v_up;
  right = v_right;
 }
 else
*)
  begin // normal sprite
    up := @vup;
    right := @vright;
  end;

  if (e.flags and RF_TRANSLUCENT) <> 0 then
    alpha := e.alpha;

  if (alpha <> 1.0) then
    qglEnable(GL_BLEND);

  qglColor4f(1, 1, 1, alpha);

  GL_Bind(currentmodel.skins[e.frame].texnum);

  GL_TexEnv(GL_MODULATE);

  if (alpha = 1.0) then
    qglEnable(GL_ALPHA_TEST)
  else
    qglDisable(GL_ALPHA_TEST);

  qglBegin(GL_QUADS);
  qglTexCoord2f(0, 1);
  VectorMA(vec3_t(e.origin), -frame.origin_y, up^, point);
  VectorMA(point, -frame.origin_x, right^, point);
  qglVertex3fv(@point);

  qglTexCoord2f(0, 0);
  VectorMA(vec3_t(e.origin), frame.height - frame.origin_y, up^, point);
  VectorMA(point, -frame.origin_x, right^, point);
  qglVertex3fv(@point);

  qglTexCoord2f(1, 0);
  VectorMA(vec3_t(e.origin), frame.height - frame.origin_y, up^, point);
  VectorMA(point, frame.width - frame.origin_x, right^, point);
  qglVertex3fv(@point);

  qglTexCoord2f(1, 1);
  VectorMA(vec3_t(e.origin), -frame.origin_y, up^, point);
  VectorMA(point, frame.width - frame.origin_x, right^, point);
  qglVertex3fv(@point);
  qglEnd();

  qglDisable(GL_ALPHA_TEST);
  GL_TexEnv(GL_REPLACE);

  if (alpha <> 1.0) then
    qglDisable(GL_BLEND);

  qglColor4f(1, 1, 1, 1);
end;

//==================================================================================

{*
=============
R_DrawNullModel
=============
*}

procedure R_DrawNullModel;
var
  shadelight: vec3_t;
  i: integer;
begin
  if (currententity.flags and RF_FULLBRIGHT) <> 0 then
  begin
    shadelight[0] := 1.0;
    shadelight[1] := 1.0;
    shadelight[2] := 1.0;
  end
  else
    R_LightPoint(vec3_t(currententity.origin), shadelight);

  qglPushMatrix();
  R_RotateForEntity(currententity);

  qglDisable(GL_TEXTURE_2D);
  qglColor3fv(@shadelight);

  qglBegin(GL_TRIANGLE_FAN);
  qglVertex3f(0, 0, -16);
  for i := 0 to 4 do
    qglVertex3f(16 * cos(i * M_PI / 2), 16 * sin(i * M_PI / 2), 0);
  qglEnd();

  qglBegin(GL_TRIANGLE_FAN);
  qglVertex3f(0, 0, 16);
  for i := 4 downto 0 do
    qglVertex3f(16 * cos(i * M_PI / 2), 16 * sin(i * M_PI / 2), 0);
  qglEnd();

  qglColor3f(1, 1, 1);
  qglPopMatrix();
  qglEnable(GL_TEXTURE_2D);
end;

{*
=============
R_DrawEntitiesOnList
=============
*}

procedure R_DrawEntitiesOnList;
var
  i: integer;
begin
  if (r_drawentities.value = 0) then
    Exit;

  // draw non-transparent first
  for i := 0 to r_newrefdef.num_entities - 1 do
  begin
    currententity := @entity_arrp(r_newrefdef.entities)^[i];
    if (currententity.flags and RF_TRANSLUCENT) <> 0 then
      Continue; // solid

    // if ( currententity->flags & RF_BEAM )
    if (currententity.flags and RF_BEAM) <> 0 then
      R_DrawBeam(currententity)
    else
    begin
      currentmodel := currententity.model;
      if (currentmodel = nil) then
      begin
        R_DrawNullModel();
        Continue;
      end;
      case currentmodel._type of
        mod_alias: R_DrawAliasModel(currententity);
        mod_brush: R_DrawBrushModel(currententity);
        mod_sprite: R_DrawSpriteModel(currententity);
      else
        ri.Sys_Error(ERR_DROP, 'Bad modeltype', []);
      end;
    end;
  end;

  // draw transparent entities
  // we could sort these if it ever becomes a problem...
  qglDepthMask(False); // no z writes
  for i := 0 to r_newrefdef.num_entities - 1 do
  begin
    currententity := @entity_arrp(r_newrefdef.entities)[i];
    if ((currententity.flags and RF_TRANSLUCENT) = 0) then
      Continue; // solid

    // if ( currententity->flags & RF_BEAM )
    if (currententity.flags and RF_BEAM) <> 0 then
      R_DrawBeam(currententity)
    else
    begin
      currentmodel := currententity.model;