gl_warp.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): gl_warp.c -- sky and water polygons                               }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 16-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) warpsin.inc                                                             }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) Do more tests                                                           }
{                                                                            }
{----------------------------------------------------------------------------}
{ 28.06.2003 Juha: Proofreaded}
// gl_warp.c -- sky and water polygons

unit gl_warp;

interface

uses
  q_shared,
  gl_model_h;

procedure GL_SubdivideSurface(fa: msurface_p);
procedure R_SetSky(name: PChar; rotate: Single; axis: vec3_p); cdecl
procedure R_DrawSkyBox;
procedure R_ClearSkyBox;
procedure R_AddSkySurface(fa: msurface_p);
procedure EmitWaterPolys(fa: msurface_p);

var
  // speed up sin calculations - Ed
  r_turbsin: array[0..32 * 8 - 1] of Single =
  (
{$I warpsin.inc}
    );


implementation

uses
  DelphiTypes,
  CPas,
  q_shwin,
  Ref,
  gl_local_add,
  gl_local,
  OpenGL,
  qgl_win,
  gl_model,
  gl_rmain,
  gl_image;



var
  skyname: array[0..MAX_QPATH - 1] of char;
  skyrotate: Single;
  skyaxis: vec3_t;
  sky_images: array[0..5] of image_p;

  warpface: msurface_p;

const
  SUBDIVIDE_SIZE = 64;
//id: #define	SUBDIVIDE_SIZE	1024


procedure BoundPoly(numverts: integer; verts: PSingle; var mins, maxs: vec3_t);
var
  i, j: integer;
  v: PSingle;
begin
  mins[0] := 9999;
  mins[1] := mins[0];
  mins[2] := mins[0];
  maxs[0] := -9999;
  maxs[1] := maxs[0];
  maxs[2] := maxs[0];
  v := verts;
  for i := 0 to numverts - 1 do
    for j := 0 to 2 do
    begin
      if (v^ < mins[j]) then
        mins[j] := v^;
      if (v^ > maxs[j]) then
        maxs[j] := v^;
      Inc(v);
    end;
end;

procedure SubdividePolygon(numverts: integer; verts: PSingle);
var
  i, j, k: integer;
  mins,
  maxs: vec3_t;
  m: Single;
  v: PSingle;

  front,
  back: array[0..63] of vec3_t;
  f, b: integer;
  dist: array[0..63] of Single;
  frac: Single;

  poly: glpoly_p;

  total: vec3_t;
  s, t,
  total_s,
  total_t: Single;
label
  continue_;
begin
  if (numverts > 60) then
    ri.Sys_Error(ERR_DROP, 'numverts = %i', [numverts]);

  BoundPoly(numverts, verts, mins, maxs);

  for i := 0 to 2 do
  begin
    m := (mins[i] + maxs[i]) * 0.5;
    m := SUBDIVIDE_SIZE * Floor(m / SUBDIVIDE_SIZE + 0.5);
    if (maxs[i] - m < 8) then
      Continue;
    if (m - mins[i] < 8) then
      Continue;

    // cut it
    v := verts;
    Inc(v, i);
    j := 0;
    while (j < numverts) do
    begin
      dist[j] := v^ - m;
      Inc(v, 3);
      Inc(j);
    end;

    // wrap cases
    dist[j] := dist[0];
    Dec(v, i);
    VectorCopy(vec3_p(verts)^, vec3_p(v)^);

    f := 0;
    b := 0;
    v := verts;
    for j := 0 to numverts - 1 do
    begin
      if (dist[j] >= 0) then
      begin
        VectorCopy(vec3_p(v)^, front[f]);
        Inc(f);
      end;
      if (dist[j] <= 0) then
      begin
        VectorCopy(vec3_p(v)^, back[b]);
        Inc(b);
      end;
      if (dist[j] = 0) or (dist[j + 1] = 0) then
        goto continue_;
      if ((dist[j] > 0) <> (dist[j + 1] > 0)) then
      begin
        // clip point
        frac := dist[j] / (dist[j] - dist[j + 1]);
        for k := 0 to 2 do
        begin
          back[b][k] := PSingleArray(v)^[k] + frac * (PSingleArray(v)^[3 + k] - PSingleArray(v)^[k]);
          front[f][k] := back[b][k];
        end;
        Inc(f);
        Inc(b);
      end;

      continue_:
      Inc(v, 3);
    end;

    SubdividePolygon(f, @front[0]);
    SubdividePolygon(b, @back[0]);
    Exit;
  end;

  // add a point in the center to help keep warp valid
  poly := Hunk_Alloc(sizeof(glpoly_t) + ((numverts - 4) + 2) * VERTEXSIZE * sizeof(Single));
  poly.next := warpface.polys;
  warpface.polys := poly;
  poly.numverts := numverts + 2;
  VectorClear(total);
  total_s := 0;
  total_t := 0;
  i := 0;
  while (i < numverts) do
  begin
    VectorCopy(vec3_p(verts)^, vec3_p(@poly.verts[i + 1])^);
    s := DotProduct(vec3_p(verts)^, vec3_p(@warpface.texinfo.vecs[0])^);
    t := DotProduct(vec3_p(verts)^, vec3_p(@warpface.texinfo.vecs[1])^);

    total_s := total_s + s;
    total_t := total_t + t;
    VectorAdd(total, vec3_p(verts)^, total);

    poly.verts[i + 1][3] := s;
    poly.verts[i + 1][4] := t;

    Inc(i);
    Inc(verts, 3);
  end;

  VectorScale(total, (1.0 / numverts), vec3_p(@poly.verts[0])^);
  poly.verts[0][3] := total_s / numverts;
  poly.verts[0][4] := total_t / numverts;

  // copy first vertex to last
  memcpy(@poly.verts[i + 1], @poly.verts[1], sizeof(poly.verts[0]));
end; //procedure

{*
================
GL_SubdivideSurface

Breaks a polygon up along axial 64 unit
boundaries so that turbulent and sky warps
can be done reasonably.
================
*}
procedure GL_SubdivideSurface(fa: msurface_p); //for gl_model
var
  verts: array[0..63] of vec3_t;
  numverts,
    i,
    lindex: integer;
  vec: vec3_p;
begin
  warpface := fa;
  //
  // convert edges back to a normal polygon
  //
  numverts := 0;
  for i := 0 to fa.numedges - 1 do
  begin
    lindex := PIntegerArray(loadmodel.surfedges)^[fa^.firstedge + i];

    if (lindex > 0) then
      vec := @loadmodel.vertexes^[loadmodel.edges[lindex].v[0]].position
    else
      vec := @loadmodel.vertexes[loadmodel.edges[-lindex].v[1]].position;
    VectorCopy(vec^, verts[numverts]);
    Inc(numverts);
  end;

  SubdividePolygon(numverts, @verts[0]);
end;

const
  TURBSCALE = 256.0 / (2 * M_PI);

{*
=============
EmitWaterPolys

Does a water warp on the pre-fragmented glpoly_t chain
=============
*}
procedure EmitWaterPolys(fa: msurface_p);
var
  bp, p: glpoly_p;
  v: psinglearray;
  i: integer;
  s, t,
    os, ot,
    scroll,
    rdt: Single;
begin
  rdt := r_newrefdef.time;

  if ((fa.texinfo.flags and SURF_FLOWING) <> 0) then
    scroll := -64 * ( (r_newrefdef.time*0.5) - Trunc(r_newrefdef.time*0.5) )
  else
    scroll := 0;


  bp := fa.polys;
  while (bp <> nil) do
  begin
    p := bp;

    qglBegin(GL_TRIANGLE_FAN);
    v := @p.verts[0];
    for i:= 0 to p.numverts - 1 do
    begin
      os := v[3];
      ot := v[4];

{$ifndef id386}
      s := os + r_turbsin[trunc(((ot*0.125+r_newrefdef.time) * TURBSCALE)) and 255];
{$else}
      s := os + r_turbsin[Q_ftol( ((ot*0.125+rdt) * TURBSCALE) ) and 255];
{$endif}
      s := s +scroll;
      s := s *(1.0/64);
{$ifndef id386}
      t := ot + r_turbsin[trunc((os*0.125+rdt) * TURBSCALE) and 255];
{$else}
      t := ot + r_turbsin[Q_ftol( ((os*0.125+rdt) * TURBSCALE)) and 255];
{$endif}
      t := t *(1.0/64);

      qglTexCoord2f (s, t);
      qglVertex3fv (@v[0]);
      v := PSingleArray(Cardinal(v) + VERTEXSIZE * SizeOf(Single));
    end;
    qglEnd();
    bp := bp.next;
  end;
end;

const
  skyclip: array[0..5] of vec3_t =
  ((1, 1, 0),
    (1, -1, 0),
    (0, -1, 1),
    (0, 1, 1),
    (1, 0, 1),
    (-1, 0, 1));
var
  c_sky: integer;

const
  // 1 = s, 2 = t, 3 = 2048
  st_to_vec: array[0..5, 0..2] of integer =
  ((3, -1, 2),
    (-3, 1, 2),

    (1, 3, 2),
    (-1, -3, 2),

    (-2, -1, 3), // 0 degrees yaw, look straight up
    (2, -1, -3) // look straight down

//	{-1,2,3},
//	{1,2,-3}
    );

  // s = [0]/[2], t = [1]/[2]
  vec_to_st: array[0..5, 0..2] of integer =
  ((-2, 3, 1),
    (2, 3, -1),

    (1, 3, 2),
    (-1, 3, -2),

    (-2, -1, 3),
    (-2, 1, -3)

//	{-1,2,3},
//	{1,2,-3}
    );

var
  skymins, skymaxs: array[0..1, 0..5] of Single;
  sky_min, sky_max: Single;

procedure DrawSkyPolygon(nump: integer; vecs: vec3_p);
var
  i, j,
    axis: integer;
  v, av: vec3_t;
  s, t, dv: Single;
  vp: vec3_p;
label
  continue_;
begin
  Inc(c_sky);