oxnewtonfpscharacter.pas

来自「Newton Game Dynamic 1.52 Delphi下基于GLSce」· PAS 代码 · 共 309 行

// This unit is experimental and unfinished.
// On this unit you can find later 3 or 4 characters type.
// Other characters control is already in construction on my version test.
// This one is only to show how you can use oxNewton object to create custom object.
unit oxNewtonFPSCharacter;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
{===============================================================================

 Version: MPL 1.1

 The contents of this file are subject to the Mozilla Public License Version
 1.1 (the "License"); you may not use this file except in compliance with
 the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/


 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 for the specific language governing rights and limitations under the
 License.

 The Original Code is "oxNewton opengl-Dynamics-delphi-component".

 The Initial Developer of the Original Code is
 Dave Gravel, OrionX3D Opengl & Delphi Programming, [e-mail].
                       http://www.Dave.ServeUsers.com
                       http://www.k00m.sexidude.com

 Portions created by Dave Gravel are Copyright (C) 2004 - 2006.
 Dave Gravel. All Rights Reserved.

 Contributor(s): GLScene (http://www.glscene.org) -
 Julio Jerez and Alain Suero (http://www.newtondynamics.com) -
 Sascha Willems (www.delphigl.de)

================================================================================
 oxNewton v1.55 by Dave Gravel.

PS: I request only one thing from the users of my oxNewton Component,
it is to put on your about or your help a comment saying you using the
oxNewton Component with my name Dave Gravel and my
e-mail: [e-mail]
Don't modify or remove any comment or information on my file
if you do some modification on my code please contact me.
Read the Newton license too, it is realy important.

================================================================================}
interface
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
uses
     // Windows
     Forms, Windows, Classes, Messages, SysUtils, Graphics, Controls, ExtCtrls,
     Dialogs, StdCtrls,
     // GLScene
     GLScene, GLMisc, GLObjects, VectorGeometry, GLVectorFileObjects, VectorLists,
     OpenGL1x, GLTexture, GLMesh, MeshUtils, GLState, XCollection,
     GLGeomObjects, GLVerletClothify, XOpenGL, GLTerrainRenderer, VectorTypes,
     TGA, GLFileSMD, JPEG,
     // Newton
     oxNewtonImport, oxNewtonUtils, oxNewtonManager, oxNewtonJoint,
     oxNewtonDynamicObjects, oxNewtonCustomJoints, oxNewtondll;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
type
  TOXCharacterController = class;
  TOXCharacterBody = class;
  //
  TOXCharacterBody = class( TOXNewtonDynSphere )
    private
      FCharacter: TOXCharacterController;
    public
      property Character: TOXCharacterController read FCharacter write FCharacter;
  end;
  //
  TOXCharacterController = class( TOXNewtonDynSphere )
  private
    FOrionX3D: byte;
    FJumping: boolean;
    FPushDown: Float;
    FSpeed: Float;
    FVSpeed: TOXVector3;
    FStraf: Float;
    FVDir: TOXVector3;
    FVForca: TOXVector3;
    FVDir2: TOXVector3;
    FVForca2: TOXVector3;
    FVPos: TOXVector3;
    FDummy: TOXNewtonDummy;
    FSphere1: TOXCharacterBody;
    FSphere2: TOXCharacterBody;
    FUpVectorJoint: TOXCUpVectorJoint;
    FSlideControl: TOXCCorkScrewJoint;
    FJambeCorpControl: TOXCUniversalControlJoint;
    FTopCorpControl: TOXCUniversalControlJoint;
    FActor: TGLActor;
    procedure InputCommand;
  public
    constructor Create( aOwner: TComponent ); override;
    destructor Destroy; override;
    //
    procedure InitNewton; override;
    procedure Progression( const deltaTime, newTime: Double );
    procedure ForceAndTorque( cBody: PNewtonBody );
    //
    property CPart1: TOXCharacterBody read FSphere1 write FSphere1;
    property CPart2: TOXCharacterBody read FSphere2 write FSphere2;
  protected

  published
    property Actor: TGLActor read FActor write FActor;
end;
implementation
uses GLKeyboard;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
constructor TOXCharacterController.Create( aOwner: TComponent );
begin
  inherited Create( aOwner );
  FOrionX3D:= 100;  
  FJumping:= False;
  AutoFreeze:= False;
  Radius:= 0.3;
  FrictionMotion1:= True;
  FrictionMotion2:= False;
  SetMaterialSurface( True, 0.05, 0.1, 1.0, 1.0 );
  ApplyForceAndTorque:= ForceAndTorque;
end;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
procedure TOXCharacterController.InitNewton;
const
  UpDir: TOXVector3 = ( 0, 0, 1 );
begin
  if Actived then exit;
  Inherited;
  FDummy:= TOXNewtonDummy( Scene.Objects.AddNewChild( TOXNewtonDummy ) );
  //
  FJambeCorpControl:= TOXCUniversalControlJoint( FDummy.AddNewChild( TOXCUniversalControlJoint ) );
  FSphere1:= TOXCharacterBody( FDummy.AddNewChild( TOXCharacterBody ) );
  FSphere1.ExtentScale:= True;
  FSphere1.FCharacter:= self;
  FSphere1.AutoFreeze:= AutoFreeze;
  FSphere1.Mass:= 0.5;
  FSphere1.Position.SetPoint( AbsoluteMatrix[3][0], AbsoluteMatrix[3][1], AbsoluteMatrix[3][2] + ( 0.5 ) );
  FJambeCorpControl.Position.SetPoint( AbsoluteMatrix[3][0], AbsoluteMatrix[3][1], AbsoluteMatrix[3][2] + ( 0.025 ) );
  FSphere1.Scale.SetVector( 0.6, 0.6, 0.85 );
  FSphere1.InitNewton;
  FJambeCorpControl.JointMinPinLength:= 15;
  FJambeCorpControl.JointCollisionState:= 0;
  FJambeCorpControl.JointStiffness:= 1;
  FJambeCorpControl.BendX:= 0;
  FJambeCorpControl.BendY:= 0;
  FJambeCorpControl.Visible:= False;
  FJambeCorpControl.LocalUse:= False;
  FJambeCorpControl.JointChildPin.SetVector( 0, 0, 1 );
  FJambeCorpControl.JointParentPin.SetVector( 0, 1, 0 );
  FJambeCorpControl.InitJoint( Body, FSphere1.Body );
  //
  FTopCorpControl:= TOXCUniversalControlJoint( FDummy.AddNewChild( TOXCUniversalControlJoint ) );
  FSphere2:= TOXCharacterBody( FDummy.AddNewChild( TOXCharacterBody ) );
  FSphere2.ExtentScale:= True;
  FSphere2.FCharacter:= self;
  FSphere2.AutoFreeze:= AutoFreeze;
  FSphere2.Mass:= 0.5;
  FSphere2.Position.SetPoint( AbsoluteMatrix[3][0], AbsoluteMatrix[3][1], AbsoluteMatrix[3][2] + ( 1.1 ) );
  FSphere2.Scale.SetVector( 0.4, 0.4, 0.5 );
  FSphere2.InitNewton;
  FTopCorpControl.Position.SetPoint( AbsoluteMatrix[3][0], AbsoluteMatrix[3][1], AbsoluteMatrix[3][2] + ( 0.6 ) );
  FTopCorpControl.JointCollisionState:= 0;
  FTopCorpControl.Visible:= False;
  FTopCorpControl.LocalUse:= False;
  FTopCorpControl.JointChildPin.SetVector( 0, 0, 1 );
  FTopCorpControl.JointParentPin.SetVector( 0, 1, 0 );
  FTopCorpControl.InitJoint( FSphere1.Body, FSphere2.Body );
  //
  FSlideControl:= TOXCCorkScrewJoint( FDummy.AddNewChild( TOXCCorkScrewJoint ) );
  FSlideControl.Position.SetPoint( AbsoluteMatrix[3][0], AbsoluteMatrix[3][1], AbsoluteMatrix[3][2] + ( 0.5 ) );
  //FJambeCorpControl.OnCallBack:= nil;
  FSlideControl.JointCollisionState:= 0;
  FSlideControl.Visible:= False;
  FSlideControl.LocalUse:= False;
  FSlideControl.JointLimitsOn:= True;
  FSlideControl.JointMinDist:= 0.25;
  FSlideControl.JointMaxDist:= 0.25;
  FSlideControl.JointChildPin.SetVector( 0, 0, 1 );
  FSlideControl.JointParentPin.SetVector( 0, 1, 0 );
  FSlideControl.InitJoint( Body, FSphere1.Body );
  FSlideControl.OnCallBack:= nil;
  //}
  FUpVectorJoint:= TOXCUpVectorJoint( AddNewChild( TOXCUpVectorJoint ) );
  FUpVectorJoint.JointCollisionState:= 0;
  FUpVectorJoint.Visible:= False;
  FUpVectorJoint.LocalUse:= False;
  FUpVectorJoint.JointChildPin.SetVector( 0, 0, 1 );
  FUpVectorJoint.InitJoint( Body, nil );
  FUpVectorJoint.UpdatePinDir;
  //
end;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
// Normaly the keyboard control is place on the form application it is only to test.
procedure TOXCharacterController.InputCommand;
procedure SurfaceMode(cMode: boolean);
begin
  if cMode then begin
    FrictionMotion1:= True;
    FrictionMotion2:= True;
    SetMaterialSurface( True, 0.05, 0.1, 0.0, 0.0 );
  end else begin
    FrictionMotion1:= True;
    FrictionMotion2:= True;
    SetMaterialSurface( True, 0.05, 0.1, 0.75, 0.5 );
  end;
end;
begin
  if Collide then FJumping:= false;
  FSpeed:= 0;
  FStraf:= 0;
  SurfaceMode(false);
  if IsKeyDown( 'w' ) then begin
    SurfaceMode(true);
    FSpeed:= -500;
  end else
  if IsKeyDown( 's' ) then begin
    SurfaceMode(true);
    FSpeed:= 500;
  end;
  if IsKeyDown( 'a' ) then begin
    SurfaceMode(true);
    FStraf:= 500;
  end else
  if IsKeyDown( 'd' ) then begin
    SurfaceMode(true);
    FStraf:= -500;
  end;
  FVDir:= oxV3Make( Children[0].AbsoluteUp[0], Children[0].AbsoluteUp[1], Children[0].AbsoluteUp[2] );
  FVForca:= oxVScale( oxVNegate( FVDir ), FSpeed );
  FVDir2:= oxV3Make( Children[0].AbsoluteRight[0], Children[0].AbsoluteRight[1], Children[0].AbsoluteRight[2] );
  FVForca2:= oxVScale( oxVNegate( FVDir2 ), FStraf );
end;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
procedure TOXCharacterController.Progression( const deltaTime, newTime: Double );
const
  emptvec: TOXVector3 = ( 0, 0, 0 );
var
  vtmpforce: TOXVector3;
begin
  vtmpforce:= oxV3Make( 0, 0, 0 );
  FVDir:= oxV3Make( 0, 0, 0 );
  FVForca:= oxV3Make( 0, 0, 0 );
  FVDir2:= oxV3Make( 0, 0, 0 );
  FVForca2:= oxV3Make( 0, 0, 0 );
  FVPos:= oxV3Make( 0, 0, 0 );
  InputCommand;
end;

procedure TOXCharacterController.ForceAndTorque( cBody: PNewtonBody );
const
  emptvec: TOXVector3 = ( 0, 0, 0 );
var
  vtmpforce: TOXVector3;
begin
  //FDistance:= 5.0;
  vtmpforce:= oxV3Make( 0, 0, 0 );
  NewtonBodySetOmega( cBody, @emptvec[0] );
  NewtonBodySetTorque( cBody, @emptvec[0] );
  NewtonBodySetOmega( FSphere1.Body, @emptvec[0] );
  NewtonBodySetTorque( FSphere1.Body, @emptvec[0] );
  NewtonBodySetOmega( FSphere2.Body, @emptvec[0] );
  NewtonBodySetTorque( FSphere2.Body, @emptvec[0] );
  NewtonBodyGetVelocity( cBody, @FVSpeed[0] );
  {if ( FReadData = 9 ) then FPushDown:= 500 else}
  FPushDown:= 20;
  FVForca:= oxV3Make( FVForca[0], FVForca[1], 0 -FPushDown );
  NewtonBodyAddForce( Body, @FVForca[0] );
  FVForca2:= oxV3Make( FVForca2[0], FVForca2[1], 0 -FPushDown );
  NewtonBodyAddForce( Body, @FVForca2[0] );
  vtmpforce[0]:= FVSpeed[0] / 2;
  vtmpforce[1]:= FVSpeed[1] / 2;
  vtmpforce[2]:= FVSpeed[2];
  NewtonBodySetVelocity( cBody, @vtmpforce[0] );
end;
{******************************************************************************}
// [15-9-2007]: oxNewtonFPSCharacter last change by Dave Gravel.             //
{******************************************************************************}
destructor TOXCharacterController.Destroy;
begin
  FDummy.DeleteChildren;
  FDummy.Free;
  inherited Destroy;
end;
{******************************************************************************}
{$D '[15-9-2007]: TOXNewtonManager v1.55 by Dave Gravel under MPL-1.1 license.'}
{******************************************************************************}
initialization
  RegisterClasses( [ TOXCharacterController ] );

end.