r_edge.pas

delphi编的不错的贪吃蛇

unit r_edge;
{$ALIGN 8}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): r_edge.c                                                          }
{                                                                            }
{ Initial conversion by : CodeFusion ([e-mail])                  }
{ Initial conversion on : 8-July-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:                               }
{ r_bsp_c.pas                                                                }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ Functions has been commented out, so the source will compile.              }
{ What needs to be done is to get the vector math working.                   }
{----------------------------------------------------------------------------}

interface

uses
  r_local,
//  r_main,  // uncomment when r_main is done
//  cvar,
  r_model;

(*
the complex cases add new polys on most lines, so dont optimize for keeping them the same
have multiple free span lists to try to get better coherence?
low depth complexity -- 1 to 3 or so

have a sentinal at both ends?
*)

type
  surf_t_array = array[0..2048] of surf_t;
  surf_p_array = ^surf_t_array;

type
  tdrawfunc = procedure;

// FIXME: should go away
//procedure R_RotateBmodel; external;
//procedure R_TransformFrustum; external;

procedure R_GenerateSpans;
procedure R_GenerateSpansBackward;

procedure R_LeadingEdge(edge: edge_p);
procedure R_LeadingEdgeBackwards(edge: edge_p);
procedure R_TrailingEdge(surf: surf_p; edge: edge_p);

procedure R_BeginEdgeFrame;
procedure R_ScanEdges;

var
  r_currentkey: Integer;

  edge_p_: edge_p;
  r_edges: edge_p;
  edge_max: edge_p;

  surface_p: surf_p;
  surf_max: surf_p;

  newedges: array[0..MAXHEIGHT - 1] of edge_p;
  removeedges: array[0..MAXHEIGHT - 1] of edge_p;
  auxedges: edge_p;

  errorterm: Integer;
  erroradjustup: Integer;
  erroradjustdown: Integer;
  ubasestep: Integer;
  scale_for_mip: Single;

implementation

uses
//  r_alias_c,
  DelphiTypes,
  SysUtils,
  r_surf,
  r_misc,
  r_main,
  q_shared,
  r_scan,
  r_bsp_c,
  r_edgea;

var
// surfaces are generated in back to front order by the bsp, so if a surf
// pointer is greater than another one, it should be drawn in front
// surfaces[1] is the background, and is used as the active surface stack
  max_span_p: espan_p;
  pdrawfunc: tdrawfunc; // static
  edge_sentinel: edge_t;
  miplevel: Integer; // static

procedure D_DrawSurfaces; forward;

{$IFNDEF id386}

procedure R_SurfacePatch;
begin
end;

procedure R_EdgeCodeStart;
begin
end;

procedure R_EdgeCodeEnd;
begin
end;
{$ENDIF}

(*
===============================================================================

EDGE SCANNING

===============================================================================
*)

(*
==============
R_BeginEdgeFrame
==============
*)

procedure R_BeginEdgeFrame;
var
  v: Integer;
  lSurf: surf_p;
begin
  edge_p_ := r_edges;
  edge_max := @PEdge_tArray(r_edges)^[r_numallocatededges];
//	edge_max := edge_p(Integer(r_edges)+(r_numallocatededges*SizeOf(edge_t)));

  surface_p := @PSurf_tArray(surfaces)^[2]; // background is surface 1,
                    //  surface 0 is a dummy
  lSurf := @PSurf_tArray(surfaces)^[1];
  lSurf^.spans := nil; // no background spans yet
  lSurf^.flags := SURF_DRAWBACKGROUND;

// put the background behind everything in the world
  if (sw_draworder^.value <> 0) then
  begin
    pdrawfunc := R_GenerateSpansBackward;
    lSurf^.key := 0;
    r_currentkey := 1;
  end
  else
  begin
    pdrawfunc := R_GenerateSpans;
    lSurf^.key := $7FFFFFFF;
    r_currentkey := 0;
  end;

// FIXME: set with memset
  for v := r_refdef.vrect.y to r_refdef.vrectbottom - 1 do
  begin
    newedges[v] := nil;
    removeedges[v] := nil;
  end;
end;

{$IFNDEF	id386}
(*
==============
R_InsertNewEdges

Adds the edges in the linked list edgestoadd, adding them to the edges in the
linked list edgelist.  edgestoadd is assumed to be sorted on u, and non-empty (
this is actually newedges[v]).  edgelist is assumed to be sorted on u, with a
sentinel at the end (actually, this is the active edge table starting at
edge_head.next).
==============
*)

procedure R_InsertNewEdges(edgestoadd: edge_p; edgelist: edge_p);
label
  edgesearch;
label
  addedge;
var
  next_edge: edge_p;
begin
  repeat
    next_edge := edgestoadd^.next;
    edgesearch:
    if (edgelist^.u >= edgestoadd^.u) then
      goto addedge;
    edgelist := edgelist^.next;
    if (edgelist^.u >= edgestoadd^.u) then
      goto addedge;
    edgelist := edgelist^.next;
    if (edgelist^.u >= edgestoadd^.u) then
      goto addedge;
    edgelist := edgelist^.next;
    if (edgelist^.u >= edgestoadd^.u) then
      goto addedge;
    edgelist := edgelist^.next;
    goto edgesearch;

 // insert edgestoadd before edgelist
    addedge:
    edgestoadd^.next := edgelist;
    edgestoadd^.prev := edgelist^.prev;
    edgelist^.prev^.next := edgestoadd;
    edgelist^.prev := edgestoadd;

    edgestoadd := next_edge;
  until (edgestoadd = nil);
end;
{$ENDIF} // !id386

{$IFNDEF	id386}
(*
==============
R_RemoveEdges
==============
*)

procedure R_RemoveEdges(pedge: edge_p);
begin
  repeat
    pedge^.next^.prev := pedge^.prev;
    pedge^.prev^.next := pedge^.next;
    pedge := pedge^.nextremove;
  until (pedge = nil);
end;
{$ENDIF} // !id386

{$IFNDEF	id386}
(*
==============
R_StepActiveU
==============
*)

procedure R_StepActiveU(pedge: edge_p);
label
  nextedge;
label
  pushback;
var
  pnext_edge: edge_p;
  pwedge: edge_p;
begin
  while (True) do
  begin
    nextedge:
    pedge^.u := pedge^.u + pedge^.u_step;
    if (pedge^.u < pedge^.prev^.u) then
      goto pushback;
    pedge := pedge^.next;

    pedge^.u := pedge^.u + pedge^.u_step;
    if (pedge^.u < pedge^.prev^.u) then
      goto pushback;
    pedge := pedge^.next;

    pedge^.u := pedge^.u + pedge^.u_step;
    if (pedge^.u < pedge^.prev^.u) then
      goto pushback;
    pedge := pedge^.next;

    pedge^.u := pedge^.u + pedge^.u_step;
    if (pedge^.u < pedge^.prev^.u) then
      goto pushback;
    pedge := pedge^.next;

    goto nextedge;

    pushback:
    if (Integer(pedge) = Integer(@edge_aftertail)) then
      Exit;

 // push it back to keep it sorted
    pnext_edge := pedge^.next;

 // pull the edge out of the edge list
    pedge^.next^.prev := pedge^.prev;
    pedge^.prev^.next := pedge^.next;

 // find out where the edge goes in the edge list
    pwedge := pedge^.prev^.prev;

    while (pwedge^.u > pedge^.u) do
      pwedge := pwedge^.prev;

 // put the edge back into the edge list
    pedge^.next := pwedge^.next;
    pedge^.prev := pwedge;
    pedge^.next^.prev := pedge;
    pwedge^.next := pedge;

    pedge := pnext_edge;
    if (Integer(pedge) = Integer(@edge_tail)) then
      Exit;
  end;
end;
{$ENDIF} // !id386

(*
==============
R_CleanupSpan
==============
*)

procedure R_CleanupSpan;
var
  surf: surf_p;
  iu: Integer;
  span: espan_p;
begin
// now that we've reached the right edge of the screen, we're done with any
// unfinished surfaces, so emit a span for whatever's on top
  surf := PSurf_tArray(surfaces)^[1].next;
  iu := edge_tail_u_shift20;
  if (iu > surf^.last_u) then
  begin
    span := span_p;
    Inc(Integer(span_p), SizeOf(espan_t));
    span^.u := surf^.last_u;
    span^.count := iu - span^.u;
    span^.v := current_iv;
    span^.pnext := surf^.spans;
    surf^.spans := span;
  end;

// reset spanstate for all surfaces in the surface stack
  repeat
    surf^.spanstate := 0;
    surf := surf^.next;
  until (Integer(surf) = Integer(@PSurf_tArray(surfaces)^[1]));
end;

(*
==============
R_LeadingEdgeBackwards
==============
*)

procedure R_LeadingEdgeBackwards(edge: edge_p);
label
  gotposition;
label
  newtop;
label
  continue_search;
var
  span: espan_p;
  surf: surf_p;
  surf2: surf_p;
  iu: Integer;
begin
// it's adding a new surface in, so find the correct place
  surf := @PSurf_tArray(surfaces)^[edge^.surfs[1]];

// don't start a span if this is an inverted span, with the end
// edge preceding the start edge (that is, we've already seen the
// end edge)
  Inc(surf^.spanstate, 1);
  if (surf^.spanstate = 1) then
  begin
    surf2 := PSurf_tArray(surfaces)^[1].next;

    if (surf^.key > surf2^.key) then
      goto newtop;

 // if it's two surfaces on the same plane, the one that's already
 // active is in front, so keep going unless it's a bmodel
    if ((surf^.insubmodel) and (surf^.key = surf2^.key)) then
    begin
  // must be two bmodels in the same leaf; don't care, because they'll
  // never be farthest anyway
      goto newtop;
    end;

    continue_search:

    repeat
      surf2 := surf2^.next;
    until (surf^.key >= surf2^.key);

    if (surf^.key = surf2^.key) then
    begin
  // if it's two surfaces on the same plane, the one that's already
  // active is in front, so keep going unless it's a bmodel
      if not (surf^.insubmodel) then
        goto continue_search;