游戏引擎

开发平台：
Delphi

BaseTypes.pas：源码内容
							(*
 @Abstract(Base types unit)
 (C) 2007 George "Mirage" Bakhtadze <br>
 The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
 Created: Apr 09, 2007 <br>
 Unit contains most basic types
*)
{$Include GDefines.inc}
unit BaseTypes;
interface
const
  BitsInByte = 8;
  DegToRad   = pi/180;
  RadToDeg   = 180/pi;
  MaxPadeg = 6;
  epsilon = 0.0001;
  MaxFloatValue = 3.4e+38;
  
type
    // Platform independent basic types
  //
  Int32 = Longint;
  Int16 = SmallInt;
  Int8  = ShortInt;
  // Unsinged (natural)
  Nat32 = Longword;
  Nat16 = Word;
  Nat8  = Byte;
const
  // Max and mins for signed
  MaxInt32: Int32 =  $7FFFFFFF;
  MinInt32: Int32 = -$7FFFFFFF-1;  // -$80000000
  MaxInt16: Int16 =  $7FFF;
  MinInt16: Int16 = -$8000;
  MaxInt8:  Int8  =  $7F;
  MinInt8:  Int8  = -$80;
  // Max for unsigned
  MaxNat32: Nat32 = $FFFFFFFF;
  MaxNat16: Nat16 = $FFFF;
  MaxNat8:  Nat8  = $FF;
type
  // 32-bit set
  TSet32 = set of 0..31;
  // Globally unique identifier
  TSGUID12 = string[12];
  // File signature
  TFileSignature = array [0..3] of AnsiChar;
  // Type for time values
  TTimeUnit = Double;
  // Message flag
  TMessageFlag = (// Message has been handled or discarded. No need to handle it anymore.
                  mfInvalid,
                  // Message has a recipient
                  mfRecipient,
                  // Message is a notification message from parent to immediate childs
                  mfChilds,
                  // Message is a broadcasted message from some item down through hierarchy
                  mfBroadcast,
                  // Message's destination is core handle
                  mfCore,
                  // Message is asyncronous
                  mfAsync);
  // Message flag set
  TMessageFlags = set of TMessageFlag;
  // General method pointer
  TDelegate = procedure(Data: Pointer) of object; 
  // Method pointer used by time-consuming routines to report progess in range [0..1]
  TProgressDelegate = procedure(Progress: Single) of object;
  // Pointer to a two-dimensional vector
  PVector2s = ^TVector2s;
  // Two-dimensional vector
  TVector2s = packed record
    case Integer of
      0: (X, Y: Single);
      1: (V: array[0..1] of Single);
  end;
  // Pointer to a three-dimensional vector
  PVector3s = ^TVector3s;
  // Three-dimensional vector
  TVector3s = packed record
    case Integer of
      0: (X, Y, Z: Single);
      1: (V: array[0..2] of Single);
  end;
  // Four-dimensional (homogeneous) vector
  TVector4s = packed record
    case Integer of
      0: (X, Y, Z, W: Single);
      1: (V: array[0..3] of Single);
      2: (xyz: TVector3s);
  end;
  // Pointer to 32-bit color
  PColor = ^TColor;
  // 32-bit color
  TColor = packed record
    case Boolean of
      False: (C: Longword);
      True: (B, G, R, A: Byte);
  end;
  // Color with floating-point components
  TColor4s = packed record
  case Integer of
    0: (R, G, B, A: Single;);
    1: (RGB: TVector3s);
    2: (RGBA: TVector4s);
  end;
  TARGB = packed record B, G, R, A: Byte; end;
  TARGBInt = packed record B, G, R, A: Integer; end;
  // Palette color
  TPaletteItem = TARGB;
  // Image palette for paletted graphics file formats
  TPalette = array[0..255] of TPaletteItem;
  PPalette = ^TPalette;
  PByteBuffer = ^TByteBuffer;
  PWordBuffer = ^TWordBuffer;
  PSmallintBuffer = ^TSmallintBuffer;
  TByteBuffer     = array[0..$6FFFFFFF] of Byte;
  TWordBuffer     = array[0..$0FFFFFFF] of Word;
  TSmallintBuffer = array[0..$0FFFFFFF] of Smallint;
  TDWordBuffer    = array[0..$0FFFFFFF] of Cardinal;
  TColorBuffer    = array[0..$0FFFFFFF] of TColor;
  TSingleBuffer   = array[0..$0FFFFFFF] of Single;
  TRGBArray       = array[0..$0FFFFFFF] of packed record B, G, R: Byte; end;
  TARGBArray      = array[0..$0FFFFFFF] of TARGB;
  TPointerArray    = array of Pointer;
  TAnsiStringArray = array of AnsiString;
  TStringArray     = array of String;
  TIndArray        = array of Integer;
  TSingleArray     = array of Single;
  PImageBuffer  = ^TImageBuffer;
  TImageBuffer  = TColorBuffer;
  PDWordBuffer  = ^TDWordBuffer;
  PAnsiStringArray  = ^TAnsiStringArray;
  PSingleBuffer = ^TSingleBuffer;
  TNameString = AnsiString;
  TShortName = string[31];
  TShortMessage = string[127];
  TFileName = string;
  // Pointer to @Link(TUV)
  PUV = ^TUV;
  // Rectangular area within a bitmap (texture)  
  TUV = packed record U, V, W, H: Single; end;
  TUVArray = array[0..$FFFFFF] of TUV;
  TUVMap = ^TUVArray;
  // Character map
  TCharMapItem = Longword;
  TCharmapArray = array[0..$FFFFFF] of TCharMapItem;
  TCharMap = ^TCharmapArray;
  // Last pixel convention: not include
  TRect = packed record
    case Integer of
      0:(Left, Top, Right, Bottom: Integer);
      1:(X, Y, W, H: Integer);
      2:(a1, a2, Width, Height: Integer);
  end;
  PRect = ^TRect;
  TRect3D = packed record
    case Integer of
      0:(Left, Top, Right, Bottom, Front, Back: Integer);
      1:(X, Y, W, H: Integer);
      2:(a1, a2, Width, Height: Integer);
  end;
  PRect3D = ^TRect3D;
  TArea = record                                   // Last pixel convention: not include
    X1, Y1, X2, Y2: Single;
  end;
  PArea = ^TArea;
const
  NullSignature: TFileSignature = (#0, #0, #0, #0);
  // Default area on image
  DefaultUV: TUV = (U: 0; V: 0; W: 1; H: 1);
  // Floating point color black
  clBlack4s: TColor4s = (R: 0; G: 0; B: 0; A: 0);
  // Floating point color black
  clWhite4s: TColor4s = (R: 1; G: 1; B: 1; A: 1);
  // Returns TColor record
  function GetColor(const R, G, B, A: Byte): TColor; overload;
  // Returns TColor record
  function GetColor(const C: Longword): TColor; overload;
  // Returns TColor4s record
  function GetColor4S(const R, G, B, A: Single): TColor4s;
  // Converts a TColor to TColor4s
  procedure ColorTo4S(var Result: TColor4s; const Color: TColor); overload;
  // Converts a TColor to TColor4s
  function ColorTo4S(const Color: TColor): TColor4s; overload;
  // Converts a TColor to TColor4s
  procedure ColorTo4S(var Result: TColor4s; const Color: Longword); overload;
  // Converts a TColor to TColor4s
  function ColorTo4S(const Color: Longword): TColor4s; overload;
  // Convert time unit to milliseconds
  function TimeUnitToMs(const TimeStamp: TTimeUnit): Int64;
  // Fills the specified rectangle record and returns it in Result
  procedure Rect(ALeft, ATop, ARight, ABottom: Integer; out Result: TRect);
  // Returns the specified by its bounds rectangle record
  function GetRect(ALeft, ATop, ARight, ABottom: Integer): TRect;
  // Returns the specified by width and height rectangle record
  function GetRectWH(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  // Returns the specified by UV coordinates on an image rectangle record
  function GetRectOnImage(UV: TUV; AImageWidth, AImageHeight: Integer): TRect;
  // Returns in Result source rectangle moved by (MoveX, MoveY)
  procedure RectMove(const ARect: TRect; MoveX, MoveY: Integer; out Result: TRect);
  // Returns source rectangle moved by (MoveX, MoveY)
  function GetRectMoved(const ARect: TRect; MoveX, MoveY: Integer): TRect;
  // Returns in Result source rectangle scaled by (SX, SY)
  procedure RectScale(const ARect: TRect; SX, SY: Single; out Result: TRect);
  // Returns source rectangle scaled by (SX, SY)
  function GetRectScaled(const ARect: TRect; SX, SY: Single): TRect;
  // Returns in Result source rectangle expanded by (EX, EY)
  procedure RectExpand(const ARect: TRect; EX, EY: Integer; out Result: TRect);
  // Returns source rectangle expanded by (EX, EY)
  function GetRectExpanded(const ARect: TRect; EX, EY: Integer): TRect;
  function GetArea(AX1, AY1, AX2, AY2: Single): TArea;
implementation
function GetColor(const R, G, B, A: Byte): TColor;
begin
  Result.R := R; Result.G := G; Result.B := B; Result.A := A;
end;
function GetColor(const C: Longword): TColor;
begin
  Result.C := C;
end;
function GetColor4S(const R, G, B, A: Single): TColor4s;
begin
  Result.B := B; Result.G := G; Result.R := R; Result.A := A;
end;
procedure ColorTo4S(var Result: TColor4s; const Color: TColor); overload;
const Norm: Single = 1/255;
begin
  Result.B :=  (Color.C and 255) * Norm;
  Result.G := ((Color.C shr 8)  and 255) * Norm;
  Result.R := ((Color.C shr 16) and 255) * Norm;
  Result.A :=  (Color.C shr 24) * Norm;
end;
function ColorTo4S(const Color: TColor): TColor4s;
begin
  ColorTo4S(Result, Color);
end;
procedure ColorTo4S(var Result: TColor4s; const Color: Longword); overload;
begin
  ColorTo4S(Result, TColor(Color));
end;
function ColorTo4S(const Color: Longword): TColor4s; overload;
begin
  ColorTo4S(Result, TColor(Color));
end;
procedure Rect(ALeft, ATop, ARight, ABottom: Integer; out Result: TRect); overload;
begin
  with Result do begin
    Left := ALeft; Top := ATop;
    Right:= ARight; Bottom := ABottom;
  end;
end;
function TimeUnitToMs(const TimeStamp: TTimeUnit): Int64;
begin
  Result := Round(TimeStamp*1000);
end;
function GetRect(ALeft, ATop, ARight, ABottom: Integer): TRect;
begin
  Rect(ALeft, ATop, ARight, ABottom, Result);
end;
function GetRectWH(ALeft, ATop, AWidth, AHeight: Integer): TRect;
begin
  Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight, Result);
end;
function GetRectOnImage(UV: TUV; AImageWidth, AImageHeight: Integer): TRect;
begin
  with Result do begin
    Left   := Trunc(0.5 + UV.U * AImageWidth);
    Top    := Trunc(0.5 + UV.V * AImageHeight);
    Right  := Left + Trunc(0.5 + UV.W * AImageWidth);
    Bottom := Top  + Trunc(0.5 + UV.H * AImageHeight);
  end;
end;
procedure RectMove(const ARect: TRect; MoveX, MoveY: Integer; out Result: TRect);
begin
  Result.Left   := ARect.Left   + MoveX;
  Result.Top    := ARect.Top    + MoveY;
  Result.Right  := ARect.Right  + MoveX;
  Result.Bottom := ARect.Bottom + MoveY;
end;
function GetRectMoved(const ARect: TRect; MoveX, MoveY: Integer): TRect;
begin
  RectMove(ARect, MoveX, MoveY, Result);
end;
procedure RectScale(const ARect: TRect; SX, SY: Single; out Result: TRect);
begin
  Result.Left   := Round(ARect.Left   * SX);
  Result.Top    := Round(ARect.Top    * SY);
  Result.Right  := Round(ARect.Right  * SX);
  Result.Bottom := Round(ARect.Bottom * SY);
end;
function GetRectScaled(const ARect: TRect; SX, SY: Single): TRect;
begin
  RectScale(ARect, SX, SY, Result);
end;
procedure RectExpand(const ARect: TRect; EX, EY: Integer; out Result: TRect);
begin
  Result.Left   := ARect.Left   - EX;
  Result.Top    := ARect.Top    - EY;
  Result.Right  := ARect.Right  + EX;
  Result.Bottom := ARect.Bottom + EY;
end;
function GetRectExpanded(const ARect: TRect; EX, EY: Integer): TRect;
begin
  RectExpand(ARect, EX, EY, Result);
end;
function GetArea(AX1, AY1, AX2, AY2: Single): TArea;
begin
  with Result do begin
    X1 := AX1; Y1 := AY1;
    X2 := AX2; Y2 := AY2;
  end;
end;
end.

						