io Programmo 23/IOPROG_23.ISO/SOFT/DELPHIX.ZIP/Source/DXSprite.pas

Pascal/Delphi Source File | 1998-10-06 | 27.1 KB | 1,059 lines

unit DXSprite;

interface

{$INCLUDE DelphiXcfg.inc}

uses
  Windows, SysUtils, Classes, DXClass, DXDraws, DirectX;

type

  {  ESpriteError  }

  ESpriteError = class(Exception);

  {  TSprite  }

  TSpriteEngine = class;

  TSprite = class
  private
    FEngine: TSpriteEngine;
    FParent: TSprite;
    FList: TList;
    FDeaded: Boolean;
    FDrawList: TList;
    FCollisioned: Boolean;
    FMoved: Boolean;
    FVisible: Boolean;
    FX: Double;
    FY: Double;
    FZ: Integer;
    FWidth: Integer;
    FHeight: Integer;
    procedure Add(Sprite: TSprite);
    procedure Remove(Sprite: TSprite);
    procedure AddDrawList(Sprite: TSprite);
    procedure Collision2;
    procedure Draw;
    function GetClientRect: TRect;
    function GetCount: Integer;
    function GetItem(Index: Integer): TSprite;
    function GetWorldX: Double;
    function GetWorldY: Double;
    procedure SetZ(Value: Integer);
  protected
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual;
    procedure DoDraw; virtual;
    procedure DoMove(MoveCount: Integer); virtual;
    function GetBoundsRect: TRect; virtual;
    function TestCollision(Sprite: TSprite): Boolean; virtual;
  public
    constructor Create(AParent: TSprite); virtual;
    destructor Destroy; override;
    procedure Clear;
    function Collision: Integer;
    procedure Dead;
    procedure Move(MoveCount: Integer);
    property BoundsRect: TRect read GetBoundsRect;
    property ClientRect: TRect read GetClientRect;
    property Collisioned: Boolean read FCollisioned write FCollisioned;
    property Count: Integer read GetCount;
    property Engine: TSpriteEngine read FEngine;
    property Items[Index: Integer]: TSprite read GetItem; default;
    property Moved: Boolean read FMoved write FMoved;
    property Parent: TSprite read FParent;
    property Visible: Boolean read FVisible write FVisible;
    property X: Double read FX write FX;
    property Y: Double read FY write FY;
    property Z: Integer read FZ write SetZ;
    property Width: Integer read FWidth write FWidth;
    property WorldX: Double read GetWorldX;
    property WorldY: Double read GetWorldY;
    property Height: Integer read FHeight write FHeight;
  end;

  {  TImageSprite  }

  TImageSprite = class(TSprite)
  private
    FAnimCount: Integer;
    FAnimLooped: Boolean;
    FAnimPos: Double;
    FAnimSpeed: Double;
    FAnimStart: Integer;
    FImage: TPictureCollectionItem;
    FPixelCheck: Boolean;
    FTile: Boolean;
    FTransparent: Boolean;
    function GetDrawImageIndex: Integer;
    function GetDrawRect: TRect;
  protected
    procedure DoDraw; override;
    procedure DoMove(MoveCount: Integer); override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): Boolean; override;
  public
    constructor Create(AParent: TSprite); override;
    property AnimCount: Integer read FAnimCount write FAnimCount;
    property AnimLooped: Boolean read FAnimLooped write FAnimLooped;
    property AnimPos: Double read FAnimPos write FAnimPos;
    property AnimSpeed: Double read FAnimSpeed write FAnimSpeed;
    property AnimStart: Integer read FAnimStart write FAnimStart;
    property PixelCheck: Boolean read FPixelCheck write FPixelCheck;
    property Image: TPictureCollectionItem read FImage write FImage;
    property Tile: Boolean read FTile write FTile;
  end;

  {  TImageSpriteEx  }

  TImageSpriteEx = class(TImageSprite)
  private
    FAngle: Integer;
    FAlpha: Integer;
  protected
    procedure DoDraw; override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): Boolean; override;
  public
    constructor Create(AParent: TSprite); override;
    property Angle: Integer read FAngle write FAngle;
    property Alpha: Integer read FAlpha write FAlpha;
  end;

  {  TBackgroundSprite  }

  TBackgroundSprite = class(TSprite)
  private
    FImage: TPictureCollectionItem;
    FCollisionMap: Pointer;
    FMap: Pointer;
    FMapWidth: Integer;
    FMapHeight: Integer;
    FTile: Boolean;
    function GetCollisionMapItem(X, Y: Integer): Boolean;
    function GetChip(X, Y: Integer): Integer;
    procedure SetChip(X, Y: Integer; Value: Integer);
    procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean);
    procedure SetMapHeight(Value: Integer);
    procedure SetMapWidth(Value: Integer);
  protected
    procedure DoDraw; override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): Boolean; override;
  public
    constructor Create(AParent: TSprite); override;
    destructor Destroy; override;
    procedure SetMapSize(AMapWidth, AMapHeight: Integer);
    property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
    property Chips[X, Y: Integer]: Integer read GetChip write SetChip;
    property Image: TPictureCollectionItem read FImage write FImage;
    property MapHeight: Integer read FMapHeight write SetMapHeight;
    property MapWidth: Integer read FMapWidth write SetMapWidth;
    property Tile: Boolean read FTile write FTile;
  end;

  {  TSpriteEngine  }

  TSpriteEngine = class(TSprite)
  private
    FAllCount: Integer;
    FCollisionCount: Integer;
    FCollisionDone: Boolean;
    FCollisionRect: TRect;
    FCollisionSprite: TSprite;
    FDeadList: TList;
    FDrawCount: Integer;
    FSurface: TDirectDrawSurface;
    FSurfaceRect: TRect;
    procedure SetSurface(Value: TDirectDrawSurface);
  public
    constructor Create(AParent: TSprite); override;
    destructor Destroy; override;
    procedure Dead;
    procedure Draw;
    property AllCount: Integer read FAllCount;
    property DrawCount: Integer read FDrawCount;
    property Surface: TDirectDrawSurface read FSurface write SetSurface;
    property SurfaceRect: TRect read FSurfaceRect;
  end;

  {  EDXSpriteEngineError  }

  EDXSpriteEngineError = class(Exception);

  {  TCustomDXSpriteEngine  }

  TCustomDXSpriteEngine = class(TComponent)
  private
    FDXDraw: TCustomDXDraw;
    FEngine: TSpriteEngine;
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
    procedure SetDXDraw(Value: TCustomDXDraw);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOnwer: TComponent); override;
    destructor Destroy; override;
    procedure Dead;
    procedure Draw;
    procedure Move(MoveCount: Integer);
    property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
    property Engine: TSpriteEngine read FEngine;
  end;

  {  TDXSpriteEngine  }

  TDXSpriteEngine = class(TCustomDXSpriteEngine)
  published
    property DXDraw;
  end;

implementation

uses DXConsts;

function Mod2(i, i2: Integer): Integer;
begin
  Result := i mod i2;
  if Result<0 then
    Result := i2+Result;
end;

function Mod2f(i: Double; i2: Integer): Double;
begin
  if i2=0 then
    Result := i
  else
  begin
    Result := i-(Trunc(i) div i2*i2);
    if Result<0 then
      Result := i2+Result;
  end;
end;

{  TSprite  }

constructor TSprite.Create(AParent: TSprite);
begin
  inherited Create;
  FParent := AParent;
  if FParent<>nil then
  begin
    FParent.Add(Self);
    if FParent is TSpriteEngine then
      FEngine := TSpriteEngine(FParent)
    else
      FEngine := FParent.Engine;
    Inc(FEngine.FAllCount);
  end;

  FCollisioned := True;
  FMoved := True;
  FVisible := True;
end;

destructor TSprite.Destroy;
begin
  Clear;
  if FParent<>nil then
  begin
    Dec(FEngine.FAllCount);
    FParent.Remove(Self);
    FEngine.FDeadList.Remove(Self);
  end;
  FList.Free;
  FDrawList.Free;
  inherited Destroy;
end;

procedure TSprite.Add(Sprite: TSprite);
begin
  if FList=nil then
  begin
    FList := TList.Create;
    FDrawList := TList.Create;
  end;
  FList.Add(Sprite);
  AddDrawList(Sprite);
end;

procedure TSprite.Remove(Sprite: TSprite);
begin
  FList.Remove(Sprite);
  FDrawList.Remove(Sprite);
  if FList.Count=0 then
  begin
    FList.Free;
    FList := nil;
    FDrawList.Free;
    FDrawList := nil;
  end;
end;

procedure TSprite.AddDrawList(Sprite: TSprite);

  function CompareInt(i1, i2: Integer): Integer;
  begin
    if i1<i2 then
      Result := -1
    else if i1>i2 then
      Result := 1
    else
      Result := 0;
  end;

var
  L, H, I, C: Integer;
begin
  L := 0;
  H := FDrawList.Count - 1;
  while L <= H do
  begin
    I := (L + H) div 2;
    C := CompareInt(TSprite(FDrawList[I]).Z, Sprite.Z);
    if C < 0 then L := I + 1 else
      H := I - 1;
  end;
  FDrawList.Insert(L, Sprite);
end;

procedure TSprite.Clear;
begin
  while Count>0 do
    Items[Count-1].Free;
end;

function TSprite.Collision: Integer;
var
  i: Integer;
begin
  Result := 0;
  if (FEngine<>nil) and (not FDeaded) and (Collisioned) then
  begin
    with FEngine do
    begin
      FCollisionCount := 0;
      FCollisionDone := False;
      FCollisionRect := Self.BoundsRect;
      FCollisionSprite := Self;

      for i:=0 to Count-1 do
        Items[i].Collision2;

      Result := FCollisionCount;
    end;
  end;
end;

procedure TSprite.Collision2;
var
  i: Integer;
begin
  if Collisioned then
  begin
    if (Self<>FEngine.FCollisionSprite) and OverlapRect(BoundsRect, FEngine.FCollisionRect) and
      FEngine.FCollisionSprite.TestCollision(Self) and TestCollision(FEngine.FCollisionSprite) then
    begin
      Inc(FEngine.FCollisionCount);
      FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
      if (not FEngine.FCollisionSprite.Collisioned) or (FEngine.FCollisionSprite.FDeaded) then
      begin
        FEngine.FCollisionDone := True;
      end;
    end;
    if FEngine.FCollisionDone then Exit;
    for i:=0 to Count-1 do
      Items[i].Collision2;
  end;
end;

procedure TSprite.Dead;
begin
  if (FEngine<>nil) and (not FDeaded) then
  begin
    FDeaded := True;
    FEngine.FDeadList.Add(Self);
  end;
end;

procedure TSprite.DoMove;
begin
end;

procedure TSprite.DoDraw;
begin
end;

procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
begin
end;

function TSprite.TestCollision(Sprite: TSprite): Boolean;
begin
  Result := True;
end;

procedure TSprite.Move(MoveCount: Integer);
var
  i: Integer;
begin
  if FMoved then
  begin
    DoMove(MoveCount);
    for i:=0 to Count-1 do
      Items[i].Move(MoveCount);
  end;
end;

procedure TSprite.Draw;
var
  i: Integer;
begin
  if FVisible then
  begin
    if FEngine<>nil then
    begin
      if OverlapRect(FEngine.FSurfaceRect, BoundsRect) then
      begin
        DoDraw;
        Inc(FEngine.FDrawCount);
      end;
    end;

    if FDrawList<>nil then
    begin
      for i:=0 to FDrawList.Count-1 do
        TSprite(FDrawList[i]).Draw;
    end;
  end;
end;

function TSprite.GetBoundsRect: TRect;
begin
  Result := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);
end;

function TSprite.GetClientRect: TRect;
begin
  Result := Bounds(0, 0, Width, Height);
end;

function TSprite.GetCount: Integer;
begin
  if FList<>nil then
    Result := FList.Count
  else
    Result := 0;
end;

function TSprite.GetItem(Index: Integer): TSprite;
begin
  if FList<>nil then
    Result := FList[Index]
  else
    raise ESpriteError.CreateFmt(SListIndexError, [Index]);
end;

function TSprite.GetWorldX: Double;
begin
  if Parent<>nil then
    Result := Parent.WorldX+FX
  else
    Result := FX;
end;

function TSprite.GetWorldY: Double;
begin
  if Parent<>nil then
    Result := Parent.WorldY+FY
  else
    Result := FY;
end;

procedure TSprite.SetZ(Value: Integer);
begin
  if FZ<>Value then
  begin
    FZ := Value;
    if Parent<>nil then
    begin
      Parent.FDrawList.Remove(Self);
      Parent.AddDrawList(Self);
    end;
  end;
end;

{  TImageSprite  }

constructor TImageSprite.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FTransparent := True;
end;

function TImageSprite.GetBoundsRect: TRect;
var
  dx, dy: Integer;
begin
  dx := Trunc(WorldX);
  dy := Trunc(WorldY);
  if FTile then
  begin
    dx := Mod2(dx, FEngine.SurfaceRect.Right+Width);
    dy := Mod2(dy, FEngine.SurfaceRect.Bottom+Height);

    if dx>FEngine.SurfaceRect.Right then
      dx := (dx-FEngine.SurfaceRect.Right)-Width;

    if dy>FEngine.SurfaceRect.Bottom then
      dy := (dy-FEngine.SurfaceRect.Bottom)-Height;
  end;

  Result := Bounds(dx, dy, Width, Height);
end;

procedure TImageSprite.DoMove(MoveCount: Integer);
begin
  FAnimPos := FAnimPos + FAnimSpeed*MoveCount;

  if FAnimLooped then
  begin
    if FAnimCount>0 then
      FAnimPos := Mod2f(FAnimPos, FAnimCount)
    else
      FAnimPos := 0;
  end else
  begin
    if FAnimPos>=FAnimCount then
    begin
      FAnimPos := FAnimCount-1;
      FAnimSpeed := 0;
    end;
    if FAnimPos<0 then
    begin
      FAnimPos := 0;
      FAnimSpeed := 0;
    end;
  end;
end;

function TImageSprite.GetDrawImageIndex: Integer;
begin
  Result := FAnimStart+Trunc(FAnimPos);
end;

function TImageSprite.GetDrawRect: TRect;
begin
  Result := BoundsRect;
  OffsetRect(Result, (Width-Image.Width) div 2, (Height-Image.Height) div 2);
end;

procedure TImageSprite.DoDraw;
var
  ImageIndex: Integer;
  r: TRect;
begin
  ImageIndex := GetDrawImageIndex;
  r := GetDrawRect;
  Image.Draw(FEngine.Surface, r.Left, r.Top, ImageIndex);
end;

function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect;
  x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean;

  function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
  begin
    with DestRect do
    begin
      Left := Max(Left, DestRect2.Left);
      Right := Min(Right, DestRect2.Right);
      Top := Max(Top, DestRect2.Top);
      Bottom := Min(Bottom, DestRect2.Bottom);

      Result := (Left < Right) and (Top < Bottom);
    end;
  end;

type
  PRGB = ^TRGB;
  TRGB = packed record
    R, G, B: Byte;
  end;
var
  ddsd1, ddsd2: DDSURFACEDESC;
  r1, r2: TRect;
  tc1, tc2: DWORD;
  x, y, w, h: Integer;
  P1, P2: Pointer;
begin
  r1 := rect1;
  with rect2 do r2 := Bounds(x2-x1, y2-y1, Right-Left, Bottom-Top);

  Result := OverlapRect(r1, r2);

  if (suf1=nil) or (suf2=nil) then Exit;

  if DoPixelCheck and Result then
  begin
    {  Get Overlapping rectangle  }
    with r1 do r1 := Bounds(Max(x2-x1, 0), Max(y2-y1, 0), Right-Left, Bottom-Top);
    with r2 do r2 := Bounds(Max(x1-x2, 0), Max(y1-y2, 0), Right-Left, Bottom-Top);

    ClipRect(r1, rect1);
    ClipRect(r2, rect2);

    w := Min(r1.Right-r1.Left, r2.Right-r2.Left);
    h := Min(r1.Bottom-r1.Top, r2.Bottom-r2.Top);

    ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
    ClipRect(r2, bounds(r2.Left, r2.Top, w, h));

    {  Pixel check !!!  }
    ddsd1.dwSize := SizeOf(ddsd1);
    if suf1.Lock(r1, ddsd1) then
    begin
      try
        ddsd2.dwSize := SizeOf(ddsd2);
        if (suf1=suf2) or suf2.Lock(r2, ddsd2) then
        begin
          try
            if suf1=suf2 then ddsd2 := ddsd1;
            if ddsd1.ddpfPixelFormat.dwRGBBitCount<>ddsd2.ddpfPixelFormat.dwRGBBitCount then Exit;

            {  Get transparent color  }
            tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
            tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;

            case ddsd1.ddpfPixelFormat.dwRGBBitCount of
              8 : begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PByte(P1)^<>tc1) and (PByte(P2)^<>tc2) then Exit;
                        Inc(PByte(P1));
                        Inc(PByte(P2));
                      end;
                    end;
                  end;
              16: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PWord(P1)^<>tc1) and (PWord(P2)^<>tc2) then Exit;
                        Inc(PWord(P1));
                        Inc(PWord(P2));
                      end;
                    end;
                  end;
              24: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        with PRGB(P1)^ do if (R shl 16) or (G shl 8) or B<>tc1 then Exit;
                        with PRGB(P2)^ do if (R shl 16) or (G shl 8) or B<>tc2 then Exit;
                        Inc(PRGB(P1));
                        Inc(PRGB(P2));
                      end;
                    end;
                  end;
              32: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PDWORD(P1)^<>tc1) and (PDWORD(P2)^<>tc2) then Exit;
                        Inc(PDWORD(P1));
                        Inc(PDWORD(P2));
                      end;
                    end;
                  end;
            end;
          finally
            if suf1<>suf2 then suf2.UnLock(ddsd2.lpSurface);
          end;
        end;
      finally
        suf1.UnLock(ddsd1.lpSurface);
      end;
    end;

    Result := False;
  end;
end;

function TImageSprite.TestCollision(Sprite: TSprite): Boolean;
var
  img1, img2: Integer;
  b1, b2: TRect;
begin
  if (Sprite is TImageSprite) and FPixelCheck then
  begin
    b1 := GetDrawRect;
    b2 := TImageSprite(Sprite).GetDrawRect;

    img1 := GetDrawImageIndex;
    img2 := TImageSprite(Sprite).GetDrawImageIndex;

    Result := ImageCollisionTest(Image.PatternSurfaces[img1], TImageSprite(Sprite).Image.PatternSurfaces[img2],
      Image.PatternRects[img1], TImageSprite(Sprite).Image.PatternRects[img2],
      b1.Left, b1.Top, b2.Left, b2.Top, True);
  end else
    Result := inherited TestCollision(Sprite);
end;

{  TImageSpriteEx  }

constructor TImageSpriteEx.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FAlpha := 255;
end;

procedure TImageSpriteEx.DoDraw;
var
  r: TRect;
begin
  r := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);

  if FAngle and $FF=0 then
  begin
    if FAlpha<255 then
    begin
      Image.DrawAlpha(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
    end else
    begin
      Image.StretchDraw(FEngine.FSurface, r, GetDrawImageIndex);
    end;
  end else
  begin
    if FAlpha<255 then
    begin
      Image.DrawRotateAlpha(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2,
        Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha)
    end else
    begin
      Image.DrawRotate(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2,
        Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle)
    end;
  end;
end;

function TImageSpriteEx.GetBoundsRect: TRect;
begin
  Result := FEngine.SurfaceRect;
end;

function TImageSpriteEx.TestCollision(Sprite: TSprite): Boolean;
begin
  if Sprite is TImageSpriteEx then
  begin
    Result := OverlapRect(Bounds(Trunc(Sprite.WorldX), Trunc(Sprite.WorldY), Sprite.Width, Sprite.Height),
      Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
  end else
  begin
    Result := OverlapRect(Sprite.BoundsRect, Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
  end;
end;

{  TBackgroundSprite  }

constructor TBackgroundSprite.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  Collisioned := False;
end;

destructor TBackgroundSprite.Destroy;
begin
  SetMapSize(0, 0);
  inherited Destroy;
end;

procedure TBackgroundSprite.DoDraw;
var
  _x, _y, cx, cy, cx2, cy2, c, ChipWidth, ChipHeight: Integer;
  StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer;
  r: TRect;
begin
  if Image=nil then Exit;

  if (FMapWidth<=0) or (FMapHeight<=0) then Exit;

  r := Image.PatternRects[0];
  ChipWidth := r.Right-r.Left;
  ChipHeight := r.Bottom-r.Top;

  dWidth := (FEngine.SurfaceRect.Right+ChipWidth) div ChipWidth+1;
  dHeight := (FEngine.SurfaceRect.Bottom+ChipHeight) div ChipHeight+1;

  _x := Trunc(WorldX);
  _y := Trunc(WorldY);

  OfsX := _x mod ChipWidth;
  OfsY := _y mod ChipHeight;

  StartX := _x div ChipWidth;
  StartX_ := 0;

  if StartX<0 then
  begin
    StartX_ := -StartX;
    StartX := 0;
  end;

  StartY := _y div ChipHeight;
  StartY_ := 0;

  if StartY<0 then
  begin
    StartY_ := -StartY;
    StartY := 0;
  end;

  EndX := Min(StartX+FMapWidth-StartX_, dWidth);
  EndY := Min(StartY+FMapHeight-StartY_, dHeight);

  if FTile then
  begin
    for cy:=-1 to dHeight do
    begin
      cy2 := Mod2((cy-StartY+StartY_), FMapHeight);
      for cx:=-1 to dWidth do
      begin
        cx2 := Mod2((cx-StartX+StartX_), FMapWidth);
        c := Chips[cx2, cy2];
        if c>=0 then
          Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
      end;
    end;
  end else
  begin
    for cy:=StartY to EndY-1 do
      for cx:=StartX to EndX-1 do
      begin
        c := Chips[cx-StartX+StartX_, cy-StartY+StartY_];
        if c>=0 then
          Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
      end;
  end;
end;

function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean;
var
  b, b1, b2: TRect;
  cx, cy, ChipWidth, ChipHeight: Integer;
  r: TRect;
begin
  Result := True;
  if Image=nil then Exit;
  if (FMapWidth<=0) or (FMapHeight<=0) then Exit;

  r := Image.PatternRects[0];
  ChipWidth := r.Right-r.Left;
  ChipHeight := r.Bottom-r.Top;



  b1 := Sprite.BoundsRect;
  b2 := BoundsRect;

  IntersectRect(b, b1, b2);

  OffsetRect(b, -Trunc(WorldX), -Trunc(WorldY));
  OffsetRect(b1, -Trunc(WorldX), -Trunc(WorldY));

  for cy:=(b.Top-ChipHeight+1) div ChipHeight to b.Bottom div ChipHeight do
    for cx:=(b.Left-ChipWidth+1) div ChipWidth to b.Right div ChipWidth do
      if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
      begin
        if OverlapRect(Bounds(cx*ChipWidth, cy*ChipHeight, ChipWidth, ChipHeight), b1) then Exit;
      end;

  Result := False;
end;

function TBackgroundSprite.GetChip(X, Y: Integer): Integer;
begin
  if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
    Result := PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^
  else
    Result := -1;
end;

type
  PBoolean = ^Boolean;

function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean;
begin
  if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
    Result := PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^
  else
    Result := False;
end;

function TBackgroundSprite.GetBoundsRect: TRect;
begin
  if FTile then
    Result := FEngine.SurfaceRect
  else
  begin
    if Image<>nil then
      Result := Bounds(Trunc(WorldX), Trunc(WorldY),
        Image.Width*FMapWidth, Image.Height*FMapHeight)
    else
      Result := Rect(0, 0, 0, 0);
  end;
end;

procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer);
begin
  if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
    PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^ := Value;
end;

procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean);
begin
  if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
    PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^ := Value;
end;

procedure TBackgroundSprite.SetMapHeight(Value: Integer);
begin
  SetMapSize(FMapWidth, Value);
end;

procedure TBackgroundSprite.SetMapWidth(Value: Integer);
begin
  SetMapSize(Value, FMapHeight);
end;

procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer);
begin
  if (FMapWidth<>AMapWidth) or (FMapHeight<>AMapHeight) then
  begin
    if (AMapWidth<=0) or (AMapHeight<=0) then
    begin
      AMapWidth := 0;
      AMapHeight := 0;
    end;
    FMapWidth := AMapWidth;
    FMapHeight := AMapHeight;
    ReAllocMem(FMap, FMapWidth*FMapHeight*SizeOf(Integer));
    FillChar(FMap^, FMapWidth*FMapHeight*SizeOf(Integer), 0);

    ReAllocMem(FCollisionMap, FMapWidth*FMapHeight*SizeOf(Boolean));
    FillChar(FCollisionMap^, FMapWidth*FMapHeight*SizeOf(Boolean), 1);
  end;
end;

{  TSpriteEngine  }

constructor TSpriteEngine.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FDeadList := TList.Create;
end;

destructor TSpriteEngine.Destroy;
begin
  FDeadList.Free;
  inherited Destroy;
end;

procedure TSpriteEngine.Dead;
begin
  while FDeadList.Count>0 do
    TSprite(FDeadList[FDeadList.Count-1]).Free;
end;

procedure TSpriteEngine.Draw;
begin
  FDrawCount := 0;
  inherited Draw;
end;

procedure TSpriteEngine.SetSurface(Value: TDirectDrawSurface);
begin
  FSurface := Value;
  if FSurface<>nil then
  begin
    FSurfaceRect := Surface.ClientRect;
    Width := FSurfaceRect.Right-FSurfaceRect.Left;
    Height := FSurfaceRect.Bottom-FSurfaceRect.Top;
  end;
end;

{  TCustomDXSpriteEngine  }

constructor TCustomDXSpriteEngine.Create(AOnwer: TComponent);
begin
  inherited Create(AOnwer);
  FEngine := TSpriteEngine.Create(nil);
end;

destructor TCustomDXSpriteEngine.Destroy;
begin
  FEngine.Free;
  inherited Destroy;
end;

procedure TCustomDXSpriteEngine.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (DXDraw=AComponent) then
    DXDraw := nil;
end;

procedure TCustomDXSpriteEngine.Dead;
begin
  FEngine.Dead;
end;

procedure TCustomDXSpriteEngine.Draw;
begin
  if (FDXDraw<>nil) and (FDXDraw.Initialized) then
    FEngine.Draw;
end;

procedure TCustomDXSpriteEngine.Move(MoveCount: Integer);
begin
  FEngine.Move(MoveCount);
end;

procedure TCustomDXSpriteEngine.DXDrawNotifyEvent(Sender: TCustomDXDraw;
  NotifyType: TDXDrawNotifyType);
begin
  case NotifyType of
    dxntDestroying: DXDraw := nil;
    dxntInitialize: FEngine.Surface := Sender.Surface;
    dxntFinalize  : FEngine.Surface := nil;
  end;
end;

procedure TCustomDXSpriteEngine.SetDXDraw(Value: TCustomDXDraw);
begin
  if FDXDraw<>nil then
    FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);

  FDXDraw := Value;

  if FDXDraw<>nil then
    FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
end;

end.