mm3d.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]              =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 31.07.98 - 23:35:59 $                                        =}
{========================================================================}
unit MM3D;

{$I COMPILER.INC}

{.$DEFINE _DEBUG}

interface

uses
    Classes,
    SysUtils,
    Windows,
    Graphics,
    MMObj;

type
    FLOAT3D         = Extended;
    {$IFDEF CBUILDER3} {$EXTERNALSYM LONG} {$ENDIF}
    LONG            = LongInt;
    {$IFDEF CBUILDER3} {$EXTERNALSYM PVOID} {$ENDIF}
    PVOID           = Pointer;

    PMM3DColor      = ^TMM3DColor;
    TMM3DColor      = DWORD;
    PMM3DValue      = ^TMM3DValue;
    TMM3DValue      = FLOAT3D;

    PMM3DVector     = ^TMM3DVector;
    TMM3DVector     = record
        case Byte of
            0: (x, y, z: TMM3DValue);
            1: (dvX, dvY, dvZ: TMM3DValue);
            2: (Values: array [0..2] of TMM3DValue);
    end;

    PMM3DVector4D   = ^TMM3DVector4D;
    TMM3DVector4D   = record
        x, y, z, w  : TMM3DValue;
    end;

    PMM3DQuaternion = ^TMM3DQuaternion;
    TMM3DQuaternion = record
        s           : TMM3DValue;
        v           : TMM3DVector;
    end;

    PMM3DMatrix4D   = ^TMM3DMatrix4D;
    TMM3DMatrix4D   = array[0..3,0..3] of TMM3DValue;

    TMM3DProjectionType = (ptPerspective,ptOrthographic);

type
    {-- TMM3DMatrix --------------------------------------------------------------}
    TMMMatrix3D     = class(TMMObject)
    private
        FMatrix     : TMM3DMatrix4D;

        procedure   SetMatrix(const Value: TMM3DMatrix4D);
        procedure   WriteMatrix(Writer: TWriter);
        procedure   ReadMatrix(Reader: TReader);
        function    GetCell(Row, Col: Integer): TMM3DValue;
        procedure   SetCell(Row, Col: Integer; Value: TMM3DValue);
    protected
        procedure   DefineProperties(Filer: TFiler); override;
    public
        function    VectorTransform(const V: TMM3DVector): TMM3DVector4D;
        function    InverseVectorTransform(const V: TMM3DVector): TMM3DVector4D;
        procedure   Assign(Source: TPersistent); override;

        {$IFDEF CBUILDER3} {$EXTERNALSYM TMMMatrix3D.AsMatrix} {$ENDIF}
        property    AsMatrix                : TMM3DMatrix4D read FMatrix write SetMatrix;
        property    Cell[Row,Col: Integer]  : TMM3DValue read GetCell write SetCell; default;
    end;

    {-- TMM3DVector --------------------------------------------------------------}
    TMMVector3D     = class(TMMObject)
    private
        FVector     : TMM3DVector;

        procedure   SetComp(Index: Integer; Value: TMM3DValue);
        function    GetComp(Index: Integer): TMM3DValue;
        procedure   SetAsVector(const Value: TMM3DVector);
    public
        procedure   Assign(Source: TPersistent); override;

        property    AsVector : TMM3DVector read FVector write SetAsVector;
    published
        property    X: TMM3DValue index 0 read GetComp write SetComp;
        property    Y: TMM3DValue index 1 read GetComp write SetComp;
        property    Z: TMM3DValue index 2 read GetComp write SetComp;
    end;

{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateColorRGB} {$ENDIF}
function    MM3DCreateColorRGB(red, green, blue: TMM3DValue): TMM3DColor;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateColorRGBA} {$ENDIF}
function    MM3DCreateColorRGBA(red, green, blue, alpha: TMM3DValue): TMM3DColor;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetRed} {$ENDIF}
function    MM3DColorGetRed(color: TMM3DColor): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetGreen} {$ENDIF}
function    MM3DColorGetGreen(color: TMM3DColor): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetBlue} {$ENDIF}
function    MM3DColorGetBlue(color: TMM3DColor): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetAlpha} {$ENDIF}
function    MM3DColorGetAlpha(color: TMM3DColor): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DBuildRGBColor} {$ENDIF}
function    MM3DBuildRGBColor(color: TMM3DColor): TColor;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorAdd} {$ENDIF}
function    MM3DVectorAdd(const s1, s2: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorSubtract} {$ENDIF}
function    MM3DVectorSubtract(const s1, s2: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorReflect} {$ENDIF}
function    MM3DVectorReflect(const ray, normal: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorCrossProduct} {$ENDIF}
function    MM3DVectorCrossProduct(const s1, s2: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorDotProduct} {$ENDIF}
function    MM3DVectorDotProduct(const s1, s2: TMM3DVector): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorNormalize} {$ENDIF}
function    MM3DVectorNormalize(const v: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorNormalise} {$ENDIF}
function    MM3DVectorNormalise(const v: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorModulus} {$ENDIF}
function    MM3DVectorModulus(const v: TMM3DVector): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRotate} {$ENDIF}
function    MM3DVectorRotate(const v, axis: TMM3DVector; theta: TMM3DValue): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorScale} {$ENDIF}
function    MM3DVectorScale(const s: TMM3DVector; factor: TMM3DValue): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRandom} {$ENDIF}
function    MM3DVectorRandom: TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DQuaternionFromRotation} {$ENDIF}
function    MM3DQuaternionFromRotation(const v: TMM3DVector; theta: TMM3DValue): TMM3DQuaternion;
//function    MM3DQuaternionMultiply(const a, b: TMM3DQuaternion): TMM3DQuaternion;
//function    MM3DQuaternionSlerp(const a, b: TMM3DQuaternion; alpha: TMM3DValue): TMM3DQuaternion;

{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromQuaternion} {$ENDIF}
function    MM3DMatrixFromQuaternion(const q: TMM3DQuaternion): TMM3DMatrix4D;

{ NOTE: Not all functions listed below work properly }

{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVector} {$ENDIF}
function    MM3DVector(x, y, z: TMM3DValue): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRotateQ} {$ENDIF}
function    MM3DVectorRotateQ(const v: TMM3DVector; const q: TMM3DQuaternion): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorTransform} {$ENDIF}
function    MM3DVectorTransform(const v: TMM3DVector; const Mat: TMM3DMatrix4D): TMM3DVector4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVector3D} {$ENDIF}
function    MM3DVector3D(const v: TMM3DVector4D): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateViewportMatrix} {$ENDIF}
function    MM3DCreateViewportMatrix(Front: TMM3DValue; Proj: TMM3DProjectionType): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixMul} {$ENDIF}
function    MM3DMatrixMul(const M1, M2: TMM3DMatrix4D): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromTranslation} {$ENDIF}
function    MM3DMatrixFromTranslation(const T: TMM3DVector): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromScaling} {$ENDIF}
function    MM3DMatrixFromScaling(const T: TMM3DVector): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromRotation} {$ENDIF}
function    MM3DMatrixFromRotation(const Axis: TMM3DVector; Angle: TMM3DValue): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromRotationTo} {$ENDIF}
function    MM3DMatrixFromRotationTo(const Dest: TMM3DVector): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateCameraMatrix} {$ENDIF}
function    MM3DCreateCameraMatrix(const Origin, Front, Top: TMM3DVector): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorInvert} {$ENDIF}
function    MM3DVectorInvert(const V: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixInvert} {$ENDIF}
function    MM3DMatrixInvert(const M: TMM3DMatrix4D): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixDeterminant} {$ENDIF}
function    MM3DMatrixDeterminant(const M: TMM3DMatrix4D): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixCofactor} {$ENDIF}
function    MM3DMatrixCofactor(const M: TMM3DMatrix4D; i, j: Integer): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorDegToRad} {$ENDIF}
function    MM3DVectorDegToRad(const R: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRadToDeg} {$ENDIF}
function    MM3DVectorRadToDeg(const R: TMM3DVector): TMM3DVector;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DDegToRad} {$ENDIF}
function    MM3DDegToRad(D: TMM3DValue): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DRadToDeg} {$ENDIF}
function    MM3DRadToDeg(R: TMM3DValue): TMM3DValue;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromCameraOrientation} {$ENDIF}
function    MM3DMatrixFromCameraOrientation(const Front, Top: TMM3DVector): TMM3DMatrix4D;
{$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorEqual} {$ENDIF}
function    MM3DVectorEqual(const V1, V2: TMM3DVector): Boolean;

type
    {-- EMM3DError ---------------------------------------------------------------}
    EMM3DError  = class(Exception)
    end;

const
    XUnit       : TMM3DVector   = (x:1;y:0;z:0);
    YUnit       : TMM3DVector   = (x:0;y:1;z:0);
    ZUnit       : TMM3DVector   = (x:0;y:0;z:1);
    ZeroVector  : TMM3DVector   = (x:0;y:0;z:0);
    Identity    : TMM3DMatrix4D = (
                                    (1, 0, 0, 0),
                                    (0, 1, 0, 0),
                                    (0, 0, 1, 0),
                                    (0, 0, 0, 1)
                                  );

var
    White       : TMM3DColor;
    Red         : TMM3DColor;
    Blue        : TMM3DColor;
    Green       : TMM3DColor;
    LightRed    : TMM3DColor;
    LightBlue   : TMM3DColor;
    LightGreen  : TMM3DColor;
    Yellow      : TMM3DColor;
    Black       : TMM3DColor;

implementation

uses
    MMMath,
    MMUtils
{$IFDEF _DEBUG}
    ,MMDebug
{$ENDIF}
    ;

{-----------------------------------------------------------------------------}
function    MM3DCreateColorRGB(red, green, blue: TMM3DValue): TMM3DColor;
begin
    Result  := $ff000000 or (Trunc(red * 255) shl 16) or (Trunc(green * 255) shl 8) or Trunc(blue * 255);
end;

{-----------------------------------------------------------------------------}
function    MM3DCreateColorRGBA(red, green, blue, alpha: TMM3DValue): TMM3DColor;
begin
    Result  := (Trunc(alpha * 255) shl 24) or (Trunc(red * 255) shl 16) or (Trunc(green * 255) shl 8) or Trunc(blue * 255);
end;

{-----------------------------------------------------------------------------}
function    MM3DColorGetRed(color: TMM3DColor): TMM3DValue;
begin
    Result  := ((color shr 16) and $ff)/255;
end;

{-----------------------------------------------------------------------------}
function    MM3DColorGetGreen(color: TMM3DColor): TMM3DValue;
begin
    Result  := ((color shr 8) and $ff)/255;
end;

{-----------------------------------------------------------------------------}
function    MM3DColorGetBlue(color: TMM3DColor): TMM3DValue;
begin
    Result  := (color and $ff)/255;
end;

{-----------------------------------------------------------------------------}
function    MM3DColorGetAlpha(color: TMM3DColor): TMM3DValue;
begin
    Result  := (color shr 24)/255;
end;

{-----------------------------------------------------------------------------}
function    MM3DBuildRGBColor(color: TMM3DColor): TColor;
type
    TBytes = record
        case Byte of
            0: (C: TMM3DColor);
            1: (B, G, R, A: Byte);
    end;
begin
    with TBytes(color) do
        Result := RGB(R,G,B);
end;

{-----------------------------------------------------------------------------}
function    MM3DVectorAdd(const s1, s2: TMM3DVector): TMM3DVector;
begin
    with Result do