gl_rmain.pas

雷神之锤2(Quake2)Delphi源码

// PLEASE, don't modify this file
// 81% complete

{----------------------------------------------------------------------------}
{                                                                            }
{ 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 :                                                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ x)                                                                         }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) Do more tests                                                           }
{                                                                            }
{----------------------------------------------------------------------------}

// (r_main.c) gl_rmain.c

unit gl_rmain;

interface

uses q_shared, ref;

function R_CullBox (mins, maxs : vec3_t) : qboolean;  //for gl_rsurf
procedure R_RotateForEntity (e : entity_p);  //for gl_rsurf

function GetRefAPI (rimp : refimport_t) : refexport_t;

implementation

uses gl_local, GL, qgl_win, glw_win, glw_imp,
     gl_model_h, gl_model,
     gl_image,
     qfiles,
     gl_warp, gl_rsurf,
     Math,
     CPas;

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

  
(*void R_Clear (void);
viddef_t	vid;

image_t		* r_notexture;		// use for bad textures
 cplane_t	frustum[4];

void GL_Strings_f( void );
float	r_base_world_matrix[16];*)



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

Returns true if the box is completely outside the frustom
=================
*}
//Y: can optimize (variable Result)!!!
function R_CullBox (mins, maxs : vec3_t) : qboolean; //for gl_rsurf
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  //q_shared
    begin
      Result := true;
      Exit;
    end;

  Result := false;
end;//function

procedure R_RotateForEntity (e : entity_p);  //for gl_rsurf
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;//procedure

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

  SPRITE MODELS

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

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

=================
*}
procedure R_DrawSpriteModel (e : entity_p);
const
  alpha : float = 1.0;
var
  point : vec3_t;
//	dsprframe_t	*frame;

//	float		*up, *right;
up, right : {pfloat; //"OR"} vec3_t;

//  psprite : dsprite_p;
begin
(*  // don't even bother culling, because it's just a single
  // polygon without a surface cache

  psprite := (dsprite_t * )currentmodel.extradata;*)

(*#if 0
	if (e->frame < 0 || e->frame >= psprite->numframes)
	{
		ri.Con_Printf (PRINT_ALL, "no such sprite frame %i\n", e->frame);
		e->frame = 0;
	}
#endif*)
(*Y//	e.frame %= psprite.numframes;
	e.frame := e.frame MOD psprite.numframes;
	frame := &psprite.frames[e.frame];*)

(*#if 0
	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
#endif*)
	//{	// normal sprite
		up := vup;
		right := vright;
	//}

//{Y}  if ( e->flags & RF_TRANSLUCENT )
  if (e.flags AND RF_TRANSLUCENT) <> 0 then
    alpha := e.alpha;

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

  qglColor4f (1, 1, 1, alpha);

//Y  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);
(*Y    VectorMA (e.origin, -frame.origin_y, up,    point);
    VectorMA (point,    -frame.origin_x, right, point);*)
    qglVertex3fv (@point);

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

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

    qglTexCoord2f (1, 1);
(*Y    VectorMA (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;//procedure

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

{*
=============
R_DrawNullModel
=============
*}
procedure R_DrawNullModel;
var
  shadelight : vec3_t;
  i          : integer;
begin
//  if ( currententity->flags & RF_FULLBRIGHT )
{Y}  if (currententity.flags AND RF_FULLBRIGHT) <> 0
  then begin
    shadelight[0] := 1.0;
    shadelight[1] := 1.0;
    shadelight[2] := 1.0;
  end
(*Y  else R_LightPoint (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;//procedure

{*
=============
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 := r_newrefdef.entities[i];
    // if (currententity->flags & RF_TRANSLUCENT)
    if (currententity.flags AND RF_TRANSLUCENT) <> 0 then
      Continue;  // solid

    // if ( currententity->flags & RF_BEAM )
    if (currententity.flags AND RF_BEAM) <> 0
      then (*YR_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;//case*)
      end;//else
  end;//for i

  // draw transparent entities
  // we could sort these if it ever becomes a problem...
  qglDepthMask (0);  // no z writes
  for i:=0 to r_newrefdef.num_entities-1 do
  begin
    currententity := r_newrefdef.entities[i];
//    if (!(currententity.flags & RF_TRANSLUCENT)) then
    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;//case*)
      end;//else
  end;//for i
  qglDepthMask (1);  // back to writing
end;//procedure

{*
** GL_DrawParticles
**
*}
//procedure GL_DrawParticles( int num_particles, const particle_t particles[], const unsigned colortable[768] );
procedure GL_DrawParticles (num_particles : integer; particles : particle_p; colortable : array {[0..767]} of byte);
var
//	const    particle_t *p;
  p : particle_p;

  i         : integer;
  up, right : vec3_t;
  scale     : float;
  color     : array [0..3] of byte;
begin
  GL_Bind (r_particletexture.texnum);
  qglDepthMask (GL_FALSE);   // no z buffering
  qglEnable (GL_BLEND);
  GL_TexEnv (GL_MODULATE);
  qglBegin (GL_TRIANGLES);
    VectorScale (vup,    1.5, up);
    VectorScale (vright, 1.5, right);

//{Y}    for ( p = particles, i=0 ; i < num_particles ; i++,p++)
    p := particles;
    for i:=0 to num_particles-1 do
    begin
          // hack a scale up to keep particles from disapearing
          scale := (p.origin[0] - r_origin[0]) * vpn[0] +
                   (p.origin[1] - r_origin[1]) * vpn[1] +
                   (p.origin[2] - r_origin[2]) * vpn[2];

          if (scale < 20)
          then scale := 1
          else scale := 1 + scale * 0.004;

//          *(int * )color = colortable[p.color];
(*Y          color := colortable[p.color];
          color[3] := p.alpha*255;*)

          qglColor4ubv (@color);

          qglTexCoord2f (0.0625, 0.0625);
          qglVertex3fv (@p.origin);

          qglTexCoord2f (1.0625, 0.0625);
          qglVertex3f (p.origin[0] + up[0]*scale,
                       p.origin[1] + up[1]*scale,
                       p.origin[2] + up[2]*scale);

          qglTexCoord2f (0.0625, 1.0625);
          qglVertex3f (p.origin[0] + right[0]*scale,
                       p.origin[1] + right[1]*scale,
                       p.origin[2] + right[2]*scale);

      Inc(p);
    end;//for???
  qglEnd ();
  qglDisable (GL_BLEND);
  qglColor4f (1,1,1,1);
  qglDepthMask (1);	    // back to normal Z buffering
  GL_TexEnv (GL_REPLACE);
end;//procedure

{*
===============
R_DrawParticles
===============
*}
procedure R_DrawParticles;
var
  i : integer;
{    unsigned char color[4];
    const particle_t *p;}
  color     : array [0..3] of byte;
  p : particle_p;
begin
  if (gl_ext_pointparameters.value <> 0) AND Assigned(qglPointParameterfEXT)