geometry.pas

一个用Delphi编写的很好的屏保程序

begin
  Result := Degrees * (PI / 180);
end;

//----------------------------------------------------------------------------------------------------------------------

function RadToDeg(Radians: Extended): Extended;

begin
  Result := Radians * (180 / PI);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure SinCos(Theta: Extended; var Sin, Cos: Extended); assembler; register;

// calculates sine and cosine from the given angle Theta
// EAX contains address of Sin
// EDX contains address of Cos
// Theta is passed over the stack

asm
              FLD  Theta
              FSINCOS
              FSTP TBYTE PTR [EDX]    // cosine
              FSTP TBYTE PTR [EAX]    // sine
              FWAIT
end;

//----------------------------------------------------------------------------------------------------------------------

function ArcCos(X: Extended): Extended;

begin
  Result := ArcTan2(Sqrt(1 - X * X), X);
end;

//----------------------------------------------------------------------------------------------------------------------

function ArcSin(X: Extended): Extended;

begin
  Result := ArcTan2(X, Sqrt(1 - X * X))
end;

//----------------------------------------------------------------------------------------------------------------------

function ArcTan2(Y, X: Extended): Extended;

asm
              FLD  Y
              FLD  X
              FPATAN
              FWAIT
end;

//----------------------------------------------------------------------------------------------------------------------

function Tan(X: Extended): Extended;

asm
              FLD  X
              FPTAN
              FSTP ST(0)      // FPTAN pushes 1.0 after result
              FWAIT
end;

//----------------------------------------------------------------------------------------------------------------------

function CoTan(X: Extended): Extended;

asm
              FLD  X
              FPTAN
              FDIVRP
              FWAIT
end;

//----------------- miscellaneous vector functions ---------------------------------------------------------------------

function MakeAffineDblVector(V: array of Double): TAffineDblVector; assembler;

// creates a vector from given values
// EAX contains address of V
// ECX contains address to result vector
// EDX contains highest index of V

asm
              PUSH EDI
              PUSH ESI
              MOV EDI, ECX
              MOV ESI, EAX
              MOV ECX, EDX
              ADD ECX, 2
              REP MOVSD
              POP ESI
              POP EDI
end;

//----------------------------------------------------------------------------------------------------------------------

function MakeDblVector(V: array of Double): THomogeneousDblVector; assembler;

// creates a vector from given values
// EAX contains address of V
// ECX contains address to result vector
// EDX contains highest index of V

asm
              PUSH EDI
              PUSH ESI
              MOV EDI, ECX
              MOV ESI, EAX
              MOV ECX, EDX
              ADD ECX, 2
              REP MOVSD
              POP ESI
              POP EDI
end;

//----------------------------------------------------------------------------------------------------------------------

function MakeAffineVector(V: array of Single): TAffineVector; assembler;

// creates a vector from given values
// EAX contains address of V
// ECX contains address to result vector
// EDX contains highest index of V

asm
              PUSH EDI
              PUSH ESI
              MOV EDI, ECX
              MOV ESI, EAX
              MOV ECX, EDX
              INC ECX
              CMP ECX, 3
              JB  @@1
              MOV ECX, 3
@@1:          REP MOVSD                     // copy given values
              MOV ECX, 2
              SUB ECX, EDX                   // determine missing entries
              JS  @@Finish
              XOR EAX, EAX
              REP STOSD                     // set remaining fields to 0
@@Finish:     POP ESI
              POP EDI
end;

//----------------------------------------------------------------------------------------------------------------------

function MakeQuaternion(Imag: array of Single; Real: Single): TQuaternion; assembler;

// creates a quaternion from the given values
// EAX contains address of Imag
// ECX contains address to result vector
// EDX contains highest index of Imag
// Real part is passed on the stack

asm
              PUSH EDI
              PUSH ESI
              MOV EDI, ECX
              MOV ESI, EAX
              MOV ECX, EDX
              INC ECX
              REP MOVSD
              MOV EAX, [Real]
              MOV [EDI], EAX
              POP ESI
              POP EDI
end;

//----------------------------------------------------------------------------------------------------------------------

function MakeVector(V: array of Single): TVector; assembler;

// creates a vector from given values
// EAX contains address of V
// ECX contains address to result vector
// EDX contains highest index of V

asm
              PUSH EDI
              PUSH ESI
              MOV EDI, ECX
              MOV ESI, EAX
              MOV ECX, EDX
              INC ECX
              CMP ECX, 4
              JB  @@1
              MOV ECX, 4
@@1:          REP MOVSD                     // copy given values
              MOV ECX, 3
              SUB ECX, EDX                   // determine missing entries
              JS  @@Finish
              XOR EAX, EAX
              REP STOSD                     // set remaining fields to 0
@@Finish:     POP ESI
              POP EDI
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorLength(V: array of Single): Single; assembler;

// calculates the length of a vector following the equation: sqrt(x * x + y * y + ...)
// Note: The parameter of this function is declared as open array. Thus
// there's no restriction about the number of the components of the vector.
//
// EAX contains address of V
// EDX contains the highest index of V
// the result is returned in ST(0)

asm
              FLDZ                           // initialize sum
@@Loop:       FLD  DWORD PTR [EAX  +  4 * EDX] // load a component
              FMUL ST, ST
              FADDP
              SUB  EDX, 1
              JNL  @@Loop
              FSQRT
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorAngle(V1, V2: TAffineVector): Single; assembler;

// calculates the cosine of the angle between Vector1 and Vector2
// Result = DotProduct(V1, V2) / (Length(V1) * Length(V2))
//
// EAX contains address of Vector1
// EDX contains address of Vector2

asm
              FLD DWORD PTR [EAX]           // V1[0]
              FLD ST                        // double V1[0]
              FMUL ST, ST                   // V1[0]^2 (prep. for divisor)
              FLD DWORD PTR [EDX]           // V2[0]
              FMUL ST(2), ST                // ST(2) := V1[0] * V2[0]
              FMUL ST, ST                   // V2[0]^2 (prep. for divisor)
              FLD DWORD PTR [EAX + 4]       // V1[1]
              FLD ST                        // double V1[1]
              FMUL ST, ST                   // ST(0) := V1[1]^2
              FADDP ST(3), ST               // ST(2) := V1[0]^2 + V1[1] *  * 2
              FLD DWORD PTR [EDX + 4]       // V2[1]
              FMUL ST(1), ST                // ST(1) := V1[1] * V2[1]
              FMUL ST, ST                   // ST(0) := V2[1]^2
              FADDP ST(2), ST               // ST(1) := V2[0]^2 + V2[1]^2
              FADDP ST(3), ST               // ST(2) := V1[0] * V2[0] + V1[1] * V2[1]
              FLD DWORD PTR [EAX + 8]       // load V2[1]
              FLD ST                        // same calcs go here
              FMUL ST, ST                   // (compare above)
              FADDP ST(3), ST
              FLD DWORD PTR [EDX + 8]
              FMUL ST(1), ST
              FMUL ST, ST
              FADDP ST(2), ST
              FADDP ST(3), ST
              FMULP                         // ST(0) := (V1[0]^2 + V1[1]^2 + V1[2]) *
                                            //          (V2[0]^2 + V2[1]^2 + V2[2])
              FSQRT                         // sqrt(ST(0))
              FDIVP                         // ST(0) := Result := ST(1) / ST(0)
  // the result is expected in ST(0), if it's invalid, an error is raised
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorNorm(V: array of Single): Single; assembler; register;

// calculates norm of a vector which is defined as norm = x * x + y * y + ...
// EAX contains address of V
// EDX contains highest index in V
// result is passed in ST(0)

asm
              FLDZ                           // initialize sum
@@Loop:       FLD  DWORD PTR [EAX + 4 * EDX] // load a component
              FMUL ST, ST                    // make square
              FADDP                          // add previous calculated sum
              SUB  EDX, 1
              JNL  @@Loop
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorNormalize(V: array of Single): Single; assembler; register;

// transforms a vector to unit length and return length
// EAX contains address of V
// EDX contains the highest index in V
// return former length of V in ST

asm
              PUSH EBX
              MOV ECX, EDX                  // save size of V
              CALL VectorLength             // calculate length of vector
              FTST                          // test if length = 0
              MOV EBX, EAX                  // save parameter address
              FSTSW AX                      // get test result
              TEST AH, C3                   // check the test result
              JNZ @@Finish
              SUB EBX, 4                    // simplyfied address calculation
              INC ECX
              FLD1                          // calculate reciprocal of length
              FDIV ST, ST(1)
@@1:          FLD ST                        // double reciprocal
              FMUL DWORD PTR [EBX + 4 * ECX] // scale component
              WAIT
              FSTP DWORD PTR [EBX + 4 * ECX] // store result
              LOOP @@1
              FSTP ST                       // remove reciprocal from FPU stack
@@Finish:     POP EBX
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorAffineSubtract(V1, V2: TAffineVector): TAffineVector; assembler; register;

// returns v1 minus v2
// EAX contains address of V1
// EDX contains address of V2
// ECX contains address of the result

asm
  {Result[X] := V1[X]-V2[X];
  Result[Y] := V1[Y]-V2[Y];
  Result[Z] := V1[Z]-V2[Z];}

                   FLD DWORD PTR [EAX]
                   FSUB DWORD PTR [EDX]
                   FSTP DWORD PTR [ECX]
                   FLD DWORD PTR [EAX + 4]
                   FSUB DWORD PTR [EDX + 4]
                   FSTP DWORD PTR [ECX + 4]
                   FLD DWORD PTR [EAX + 8]
                   FSUB DWORD PTR [EDX + 8]
                   FSTP DWORD PTR [ECX + 8]
end;

//----------------------------------------------------------------------------------------------------------------------

function VectorReflect(V, N: TAffineVector): TAffineVector; assembler; register;

// reflects vector V against N (assumes N is normalized)
// EAX contains address of V
// EDX contains address of N
// ECX contains address of the result

//var Dot : Single;

asm
   {Dot := VectorAffineDotProduct(V, N);
   Result[X] := V[X]-2 * Dot * N[X];
   Result[Y] := V[Y]-2 * Dot * N[Y];
   Result[Z] := V[Z]-2 * Dot * N[Z];}
   
                   CALL VectorAffineDotProduct   // dot is now in ST(0)
                   FCHS                          // -dot
                   FADD ST, ST                   // -dot * 2
                   FLD DWORD PTR [EDX]           // ST := N[X]
                   FMUL ST, ST(1)                // ST := -2 * dot * N[X]
                   FADD DWORD PTR[EAX]           // ST := V[X] - 2 * dot * N[X]
                   FSTP DWORD PTR [ECX]          // store result
                   FLD DWORD PTR [EDX + 4]       // etc.
                   FMUL ST, ST(1)
                   FADD DWORD PTR[EAX + 4]
                   FSTP DWORD PTR [ECX + 4]
                   FLD DWORD PTR [EDX + 8]
                   FMUL ST, ST(1)
                   FADD DWORD PTR[EAX + 8]
                   FSTP DWORD PTR [ECX + 8]