oxnewtonmousecontrol.pas

Newton Game Dynamic 1.52 Delphi下基于GLScene的OpenGL游戏开发控件。功能非常强大和易于使用。 Advanced physics engine for re

begin
  inherited Create(aOwner);
  FOrionX3D:= 100;
  FActived:= false;
  FColor:= TGLColor.CreateInitialized(Self, clrGray20);
  if ( VirtualMouseControler = nil ) then VirtualMouseControler:= self;
  FPickedParam:= 1.1;
  FOXVisual:= True;
  FPParam:= FPickedParam;
  FForce:= 100;
  FDampForce:= 10;
  FRotFix:= 1.1;
  FDx:= 0;
  FDy:= 1;
  FRadius:= 0.25;
  FSlices:= 8;
  FStacks:= 8;
  FPickedForce:= oxV4Make( 0, 0, 0 );
  FAttachmentPointVec:= oxV3Make( 0, 0, 0 );
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.SetColor( val: TGLColor );
begin
  if FColor <> val then FColor:= val;
  NotifyChange(Self);  
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation=opRemove) and (AComponent=GLSceneViewer) then GLSceneViewer:=nil;
  if (Operation=opRemove) and (AComponent=Manager) then Manager:=nil;
  inherited;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.SetObject( val: TGLBaseSceneObject );
begin
  if FPointerObject <> val then
  begin
    FPointerObject:= val;
    FPointerObject.Visible:= False;
  end;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.BuildList(Sender: TObject; var rci: TRenderContextInfo);
var
  m: TOXMatrix;
begin
  if not FActived then exit;
  if ( not FOXVisual ) and Assigned( FPickedBody ) then begin
    NewtonBodyGetMatrix( FPickedBody, @M[0, 0] );
    if oxDebugLine = 1 then begin
      glMultMatrixf( @M[0, 0] );
      glTranslatef( FAttachmentPointVec[0], FAttachmentPointVec[1], FAttachmentPointVec[2] );
    end else
    if oxDebugLine = 2 then begin
      glMultMatrixd( @M[0, 0] );
      glTranslated( FAttachmentPointVec[0], FAttachmentPointVec[1], FAttachmentPointVec[2] );
    end;
    if Assigned( PointerObject ) then
      if PointerObject.Count > 0 then
        PointerObject.DoRender( rci, True, True ) else PointerObject.DoRender( rci, True, False );
  end else
  if ( FMousePickMode ) and Assigned( FPickedBody ) then begin
    glPushMatrix;
      glColor4fv( FColor.AsAddress );
      glDisable( GL_LIGHTING );
      glPolygonMode( GL_FRONT_AND_BACK, GL_LINE );
      NewtonBodyGetMatrix( FPickedBody, @M[0, 0] );
      if oxDebugLine = 1 then begin
        glMultMatrixf( @M[0, 0] );
        glTranslatef
        ( FAttachmentPointVec[0], FAttachmentPointVec[1], FAttachmentPointVec[2] );
      end else
      if oxDebugLine = 2 then begin
        glMultMatrixd( @M[0, 0] );
        glTranslated
        ( FAttachmentPointVec[0], FAttachmentPointVec[1], FAttachmentPointVec[2] );
      end;
      gluSphere( FQ, FRadius, FSlices, FStacks );
      glPolygonMode( GL_FRONT_AND_BACK, GL_FILL );
      glEnable( GL_LIGHTING );
    glPopMatrix;
  end;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.SetViewer( val: TGLSceneViewer );
begin
  if ( val <> FViewer ) then FViewer:= val;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.SetManager( val: TOXNewtonManager );
begin
  if ( val <> FManager ) then FManager:= val;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.MouseMove( X, Y: Integer );
var
  p2: TOXVector4;
  p, p0, p1: TOXVector4;
  yh: integer;
  obj: TGLBaseSceneObject;
  tMat: TOXMatrix;
begin
  if not FActived then exit;
  if ( FMousePickMode ) and Assigned( FPickedBody ) then begin
    yh:= FViewer.Height -y;
    p0:= oxV4FToV4D( FViewer.Buffer.ScreenToWorld( VectorMake( x, yh, FDx ) ) );
    p1:= oxV4FToV4D( FViewer.Buffer.ScreenToWorld( VectorMake( x, yh, FDy ) ) );
    obj:= NewtonBodyGetUserData( FPickedBody );
    tMat:= oxMFToMD( obj.Matrix );
    p2:= oxV4Make( oxMTansformV( tMat, FAttachmentPointVec ) );
    p:= oxVAdd( p0, oxVScale( oxVSubtract( p1, p0 ), FPickedParam ) );
    FPickedForce:= oxVSubtract( p, P2 );
  end;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.MouseDown( X, Y: Integer );
var
  p0, p1: TOXVector4;
  p2: TOXVector4;
  yh: integer;
  obj: TGLBaseSceneObject;
  tMat: TOXMatrix;
begin
  if not FActived then exit;
  FMousePickMode:= False;
  yh:= FViewer.Height -y;
  p0:= oxV4FToV4D( FViewer.Buffer.ScreenToWorld( VectorMake( x, yh, FDx ) ) );
  p1:= oxV4FToV4D( FViewer.Buffer.ScreenToWorld( VectorMake( x, yh, FDy ) ) );
  FPickedBody:= nil;
  FPickedParam:= FPParam;
  NewtonWorldRayCast( FManager.World, @p0, @p1, @RayCastPickingFilter, nil, @RayCastPickPrefilter );
  if Assigned( FPickedBody ) then begin
    FMousePickMode:= True;
    p2:= oxVAdd( p0, oxVScale(oxVSubtract( p1, p0 ), FPickedParam ) );
    obj:= NewtonBodyGetUserData(FPickedBody);
    tMat:= oxMFToMD( obj.Matrix );
    FAttachmentPointVec:= oxMUntransformV( tMat, oxV3Make( P2 ) );
    FChainForceCallBack:= NewtonBodyGetForceAndTorqueCallback( FPickedBody );
    NewtonBodySetForceAndTorqueCallback( FPickedBody, @PhysicsApplyPickForce );
    FSaveAutoFreeMode:= NewtonBodyGetAutoFreeze( FPickedBody );
    NewtonBodySetAutoFreeze( FPickedBody, 0 );
    NewtonWorldUnfreezeBody( FManager.World, FPickedBody );
  end;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.MouseUp( X, Y: Integer );
begin
  if not FActived then exit;
  if ( FPickedBody <> nil ) then begin
    FMousePickMode:= False;
    NewtonWorldUnfreezeBody( FManager.World, FPickedBody );
    NewtonBodySetAutoFreeze( FPickedBody, FSaveAutoFreeMode );
    NewtonBodySetForceAndTorqueCallback( FPickedBody, @FChainForceCallBack );
    FPickedBody:= nil;
    FChainForceCallBack:= nil;
    FPickedForce:= oxV4Make( 0, 0, 0 );
  end;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
procedure TOXMouseControler.InitNewton;
begin
  if (VirtualMouseControler<>self) then exit;
  if not assigned(FManager) or not assigned(FViewer) or FActived then exit;
  FRender:= TGLDirectOpenGL(FManager.Objects.AddNewChild(TGLDirectOpenGL));
  FRender.OnRender:= BuildList;
  if assigned(PointerObject) then PointerObject.Visible:= False;
  FQ:= gluNewQuadric;
  FActived:= True;
end;
{******************************************************************************}
// [15-9-2007]: TOXMouseControler last change by Dave Gravel.                //
{******************************************************************************}
destructor TOXMouseControler.Destroy;
begin
  if assigned( FViewer ) and assigned(FManager) and FActived then begin
    gluDeleteQuadric( FQ );
    FRender.Free;
  end;
  if (VirtualMouseControler=self) then VirtualMouseControler:= nil;
  FColor.Free;  
  inherited Destroy;
end;
{******************************************************************************}
{$D '[15-9-2007]: TOXNewtonManager v1.55 by Dave Gravel under MPL-1.1 license.'}
{******************************************************************************}
initialization
  RegisterClasses( [ TOXMouseControler ] );

end.