hgenurbs.pas

完整的Delphi游戏开发控件

unit HGENURBS;
(*
** HGE NURBS helper class
** Extension to the HGE engine
** Extension added by DraculaLin
** This extension is NOT part of the original HGE engine.
*)

interface

uses
  HGE, SysUtils,  Math, HGEDef;

type
  TFittingCurveType = (fcConstantParameter, fcConstantSpeed);
  TNDrawMode = (dmNone, dmCurve, dmCurveCP, dmCurveCPHull);

  PEditPoint2 = ^TEdiTPoint2;
  TEditPoint2 = record
    X, Y: Integer;
    Radius: Integer;
    Active: Boolean;
  end;

  TNURBSCurve = class
  private
    FCPCount: Integer;
    FKnotsCount: Integer;
    FOrderOfCurve: Integer;
    FParameterStart: Single;
    FParameterEnd: Single;
    FSegments: Integer;
    FFittingCurveType: TFittingCurveType;
    FFittingCurveReady: Boolean;
    function BSFunction(KnotIndex: Integer; OrderOfCurve: Integer;
        Parameter: Single): Single;
    function CalcXY(Parameter: Single): TPoint2;
    function GetSegmentLength(Index1, Index2: Integer): Single;
    function GetCurveLength: Single;
    procedure SetSegments(const Value: Integer);
    procedure SetFittingCurveType(const Value: TFittingCurveType);
  public
    ControlPoints: array of TPoint2;
    KnotsVector: array of Single;
    FittingCurve: array of TPoint2;
    property Segments: Integer read FSegments write SetSegments;
    property FittingCurveType: TFittingCurveType read FFittingCurveType write SetFittingCurveType;
    property FittingCurveReady: Boolean read FFittingCurveReady write FFittingCurveReady;
    property CurveLength: Single read GetCurveLength;
    property CPCount: Integer read FCPCount write FCPCount;
    property KnotsCount: Integer read FKnotsCount write FKnotsCount;
    property OrderOfCurve: Integer read FOrderOfCurve write FOrderOfCurve;
    property ParameterStart: Single read FParameterStart write FParameterStart;
    property ParameterEnd: Single read FParameterEnd write FParameterEnd;
    procedure SetFittingCurve;
    function GetXY(Parameter: Single): TPoint2; {Parameter = [0,1]}
    function GetTangent(Parameter: Single): Single; {Parameter = [0,1]}
    procedure UpdateKnots;
    constructor Create(var AControlPoints: array of TPoint2); overload;
    constructor Create; overload;
    destructor Destroy; override;
  end;

  TNURBSCurveEx = class(TNURBSCurve)
  private
    FColor: Cardinal;
    FCPRadius: Integer;
    FCPColor: Cardinal;
    FCPIndex: Integer;
    FHullColor: Cardinal;
    FDragMode: Boolean;
    FDrawMode: TNDrawMode;
  public
    property CPIndex: Integer read FCPIndex write FCPIndex;
    property CPRadius: Integer read FCPRadius write FCPRadius;
    property CPColor : Cardinal read FCPColor write FCPColor;
    property HullColor : Cardinal read FHullColor write FHullColor;
    property DragMode: Boolean read FDragMode write FDragMode;
    property DrawMode: TNDrawMode read FDrawMode write FDrawMode;
    property Color: Cardinal read FColor write FColor;
    function CreateCP(X, Y: Integer): Integer;
    function GetCP(X, Y: Integer): Integer;
    procedure DeleteCP;
    procedure Draw;
    procedure SwitchDrawMode;
    procedure LoadCurve(Filename: String);
    procedure SaveCurve(Filename: String);
    procedure LoadBakeCurve(Filename: String);
    procedure SaveBakeCurve(Filename: String);
    procedure Update;
    constructor Create; overload;
    constructor Create(var AControlPoints: array of TPoint2); overload;
    destructor Destroy; override;
  end;


{ TNURBSCurves = class(TCollection)       ..... anyone? ))
  private
    NURBSCurves: array of TNURBSCurveEx;
    Archive: TASDb;
    function GetItem(Index: Integer): TNURBSCurve;
    function GetNURBS(const Name: string): TNURBSCurve;
    procedure SetItem(Index: Integer; const Value: TNURBSCurve);
    function GetItemCount(): Integer;
  public
    property Items[Index: Integer]: TNURBSCurve read GetItem; default;
    property ItemCount: Integer read GetItemCount;
    property NURBS[const Name: string]: TNURBSCurve read GetNURBS;
    function IndexOf(Element: TNURBSCurve): Integer; overload;
    function IndexOf(const Name: string): Integer; overload;
    function Include(Element: TNURBSCurve): Integer;
    procedure Remove(Index: Integer);
    procedure RemoveAll();
    procedure LoadFromASDb(Key: string; Archive: TASDb);
    procedure SaveToASDb(Key: string; Archive: TASDb);
    function LoadFromFile(const FileName: string): Integer;
    function SaveToFile(const FileName: string): Integer;
    destructor Destroy; override;
    constructor Create(); override;
  end;

var
  nurbs: TNURBSCurves = nil;}
 //function Point2(x, y: Single): TPoint2;

const
  BAKE_EXT = '.bake';


implementation

var
  FHGE: IHGE=nil;

{TNURBSCurve}

// ==========================================================================
constructor TNURBSCurve.Create(var AControlPoints: array of TPoint2);
var
  i: Integer;
begin
  OrderOfCurve := 4;  // OrderOfCurve + 1 actually, so 4 means 'cubic'
  CPCount := Length(AControlPoints);
  SetLength(ControlPoints, CPCount);
  for i:= 0 to CPCount-1 do
    begin
      ControlPoints[i].x := AControlPoints[i].x;
      ControlPoints[i].y := AControlPoints[i].y;
    end;
  Segments := 200;
  FittingCurveType := fcConstantParameter;  //fcConstantSpeed;
  FittingCurveReady := false;
  UpdateKnots;
end;

// ==========================================================================
constructor TNURBSCurve.Create;
begin
  FHGE := HGECreate(HGE_VERSION);
  OrderOfCurve := 4;
  CPCount := 0;
  SetLength(ControlPoints, CPCount);
  Segments := 100;
  FittingCurveType := fcConstantParameter;
  FittingCurveReady := false;
  UpdateKnots;
end;

// ==========================================================================
destructor TNURBSCurve.Destroy;
begin
  ControlPoints := nil;
  KnotsVector := nil;
  FittingCurve := nil;
  inherited;
end;

// ==========================================================================
function TNURBSCurve.BSFunction(KnotIndex, OrderOfCurve: Integer;
  Parameter: Single): Single;
var FirstItem, SecondItem, denominator, numerator: Single;
begin
  if (Parameter >= KnotsVector[KnotIndex + OrderOfCurve]) or
     (Parameter < KnotsVector[KnotIndex]) then BSFunction := 0
  else
    if OrderOfCurve = 1 then
      if (Parameter <= KnotsVector[KnotIndex + 1]) and
         (Parameter >= KnotsVector[KnotIndex]) then BSFunction := 1
      else Result := 0
    else
      begin
        {FirstItem}
        denominator := KnotsVector[KnotIndex + OrderOfCurve - 1] - KnotsVector[KnotIndex];
        if denominator = 0 then FirstItem := 0
          else
            begin
              numerator := Parameter - KnotsVector[KnotIndex];
              if numerator = 0 then FirstItem := 0
                else FirstItem := (numerator/denominator)*
                  BSFunction(KnotIndex, (OrderOfCurve - 1), Parameter);
            end;
        {SecondItem}
        denominator := KnotsVector[KnotIndex + OrderOfCurve] - KnotsVector[KnotIndex + 1];
        if denominator = 0 then SecondItem := 0
          else
            begin
              numerator := KnotsVector[KnotIndex + OrderOfCurve] - Parameter;
              if numerator = 0 then SecondItem := 0
                else SecondItem := (numerator/denominator)*
                  BSFunction((KnotIndex + 1), (OrderOfCurve - 1), Parameter);
            end;
        BSFunction := FirstItem + SecondItem;
      end;
end;

// ==========================================================================
function TNURBSCurve.CalcXY(Parameter: Single): TPoint2;
var
  i: Integer;
  Value: TPoint2;
  N, CheckSumm: Single;
begin
  Value.x := 0;
  Value.y := 0;
  CheckSumm := 0;
  for i := 0 to CPCount - 1 do
    begin
      N := BSFunction(i, (OrderOfCurve), Parameter);
      Value := Value + ControlPoints[i]*N;
      CheckSumm := CheckSumm + N;
    end;
  Result.X :=  Value.x/CheckSumm;
  Result.Y :=  Value.y/CheckSumm;
  // some bug here: CheckSumm of last element is time to time equal to zero
  // some fix: FittingCurve[Segments - 1].XY :=  ControlPoints[CPCount - 1].XY;
  if Parameter >= ParameterEnd then
    begin
      Result.X :=  ControlPoints[CPCount - 1].X;
      Result.Y :=  ControlPoints[CPCount - 1].Y;
    end;
end;

// ==========================================================================
procedure TNURBSCurve.SetFittingCurve;
var
  i: Integer;
  Parameter: array of Single;
  Parameter2, SegmentLength, Parameter2Delta, temp: Single;
begin
  case FittingCurveType of
    fcConstantParameter:
      begin
        SetLength(Parameter, Segments);
        Parameter[0] := ParameterStart;
        for i := 1 to Segments - 1 do
          Parameter[i] := Parameter[i-1] + (ParameterEnd - ParameterStart)/(Segments-1);
        for i := 0 to Segments - 1 do
          FittingCurve[i] := CalcXY(Parameter[i]);
        FittingCurve[Segments - 1].X :=  ControlPoints[CPCount - 1].X;
        FittingCurve[Segments - 1].Y :=  ControlPoints[CPCount - 1].Y;
      end;
    fcConstantSpeed:
      begin
        Parameter2 := ParameterStart;
        // getting CurveLength
        FittingCurveType := fcConstantParameter;
        SetFittingCurve;
        FittingCurveType := fcConstantSpeed;
        SegmentLength := CurveLength/(Segments-1);
        Parameter2Delta := SegmentLength/Segments/100;
        FittingCurve[0].X := ControlPoints[0].X;
        FittingCurve[0].Y := ControlPoints[0].Y;
        for i := 0 to Segments - 2 do
          begin
            temp := 0;
            repeat
              FittingCurve[i] := CalcXY(Parameter2);
              Parameter2 := Parameter2 + Parameter2Delta;
              if Parameter2 >= ParameterEnd then break;
            temp := GetSegmentLength(i-1, i);
            until temp >= SegmentLength;;
          end;
        FittingCurve[Segments - 1].X :=  ControlPoints[CPCount - 1].X;
        FittingCurve[Segments - 1].Y :=  ControlPoints[CPCount - 1].Y;
      end;
  end;
  FittingCurveReady := True;
  Parameter := nil;
end;

// ==========================================================================
procedure TNURBSCurve.SetFittingCurveType(const Value: TFittingCurveType);
begin
  FFittingCurveType := Value;
end;

// ==========================================================================
procedure TNURBSCurve.SetSegments(const Value: Integer);
begin
  FSegments := Value;
  SetLength(FittingCurve, Segments);
end;

// ==========================================================================
procedure TNURBSCurve.UpdateKnots;
var
  i: Integer;