{ *********************************************************************** }
{                                                                         }
{ Copular Chat Client v3.0 Source Code                                    }
{ Sprite Libary Unit                                                      }
{                                                                         }
{ Copyright (c) 1998-2002 SAF Studio                                      }
{                                                                         }
{ Author  : Niu Yu Ping                                                   }
{ Nickname: DecimalOX                                                     }
{ Address : Jilin City China                                              }
{                                                                         }
{ QICQ    : 103106262                                                     }
{ Homepage: www.safree.com                                                }
{ EMail   : decimalox@sohu.com                                            }
{                                                                         }
{ *********************************************************************** }

unit Sprite;

interface

uses
  DXSprite, DXPath, Tools, DXMap, Graphics, Classes, SysUtils;

type
  //Sprite's position
  TPathPoint = record
    X, Y: Double;
  end;

  //Sprite's talk structor
  TTalk = record
    Items,Send, Rece: array[0..9] of string; //sentence, sender, reseiver
    Life, Face: array[0..9] of Integer; //display time, face index
    OnlyOne: array [0..9] of Boolean; //is alone
    Count: Integer; //counter of sentences
  end;

  //TPlayerSprite structor is designed for sprite on the map
  TPlayerSprite = class(TImageSprite)
  private
    FNewY: Double;
    FNewX: Double;
    FMoved: Boolean;
    FCaption: string;
    FDegree: Integer;
    FHeadID: Integer;
    FAnchorY: Integer;
    FAnchorX: Integer;
    FIsMe: Boolean;
    //obstacle map for every sprite is used to find path
    OrgObstacle: array [-MapW div 2..MapW div 2, -MapH div 2..MapH div 2] of Boolean;

    //check for obstacle on the appointed area
    function HasObstacle(StartX, StartY: Integer): Boolean;

    procedure SetNewX(const Value: Double);
    procedure SetNewY(const Value: Double);
    procedure SetMoved(const Value: Boolean);
    procedure SetCaption(const Value: string);
    procedure SetDegree(const Value: Integer);
    procedure SetHeadID(const Value: Integer);
    procedure SetAnchorX(const Value: Integer);
    procedure SetAnchorY(const Value: Integer);
    procedure SetIsMe(const Value: Boolean);
  protected
    //process collision event
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); override;
    //process move event
    procedure DoMove(MoveCount: Integer); override;
  public
    PathCala: Boolean;
    PathInf: TDXPath;
    PathIndex: Integer;
    PathCount: Integer;
    Path: array [0..100] of TPathPoint;
    Talk: TTalk;
    property AnchorX: Integer read FAnchorX write SetAnchorX;
    property AnchorY: Integer read FAnchorY write SetAnchorY;
    property NewX: Double read FNewX write SetNewX;
    property NewY: Double read FNewY write SetNewY;
    property Moved: Boolean read FMoved write SetMoved;
    property Caption: string read FCaption write SetCaption;
    property HeadID: Integer read FHeadID write SetHeadID;
    property Degree: Integer read FDegree write SetDegree;
    property IsMe: Boolean read FIsMe write SetIsMe;
    constructor Create(Aparent: TSprite); override;
    destructor Destroy; override;

    //buile obstacle map
    procedure MakeMap(MapEngine: TDXMap);

    //move to appointed position
    procedure Go(EndX, EndY:Double);

    //fill the TTalk items for drawwing
    procedure Speak(ASend, ARece, AText: string; AFace: Integer; AOnlyOne: Boolean);

    //drop the TTalk item which was timeout
    procedure RollTalk;
  end;

  //TPlayers structor is designed for Online List of Client
  TPlayers = class(TComponent)
  private
    FCount: Integer;
    procedure SetCount(const Value: Integer);
  public
    Items: array [0..200] of TPlayerSprite;
    property Count: Integer read FCount write SetCount;
    constructor Create(AOwner: TObject); reintroduce;

    //Add a new sprite to the online list of client
    function Add(ASprite: TSprite; ACaption: string;ADegree: Integer): Integer;

    //drop a sprite from the online list of client
    procedure Delete(Index: Integer);

    //search sprite by caption from online list of client
    function FindByCaption(ACaption: string): Integer;

    //clear the online list of client
    procedure Clear;

    //get the caption of the sprite which at the appointed area
    function GetSpriteAt(X, Y: Double): string;
  end;

implementation

{ TPlayerSprite }

procedure TPlayerSprite.Go(EndX, EndY:Double);
var
  I: Integer;

  //transform the default coordinate format to custom coordinate format
  //the map with new coordinate is most smaller than normal
  //so can process the map more faster include all of it's operation
  function WorldToMapX(WX: Double): Integer;
  begin
    Result:=(Trunc(WX) +(MapW div 2)) div DL;
    if Result>MapW then
      Result:=MapW;
    if Result<0 then
      Result:=0;
  end;

  function WorldToMapY(WY: Double): Integer;
  begin
    Result:=(Trunc(WY)+MapH div 2) div dl;
    if Result>MapH then
      Result:=MapH;
    if Result<0 then
      Result:=0;
  end;

  function MapToWorldX(MX: Integer): Integer;
  begin
    Result:=MX*DL-MapW div 2+DL div 2;
    if Result>MapW div 2 then
      Result:=MapW div 2;
    if Result<-MapW div 2 then
      Result:=-MapW div 2;
  end;

  function MapToWorldY(MY: Integer):Integer;
  begin
    Result:=MY*DL-MapH div 2 + DL div 2;
    if Result>MapH div 2 then
      Result:=MapH div 2;
    if Result<-MapH div 2 then
      Result:=-MapH div 2;
  end;

begin
  //create new coordinate of start position and end position
  PathInf.FStartPos.x:=WorldToMapX(X);
  PathInf.FStartPos.y:=WorldToMapY(Y);
  PathInf.FEndPos.x:=WorldToMapX(EndX);
  PathInf.FEndPos.y:=WorldToMapY(EndY);

  //find path
  //DXPath is a third party unit,i have modified a few part in it
  if not PathInf.FindPath then
    Exit;

  PathIndex:=0;
  PathCount:=PathInf.DirChangedPointsCount-1;

  //copy the path points to temp value
  //and DoMove function will move the sprite to end position along the points
  for I:=1 to PathCount do
  begin
    Path[I-1].X:=MapToWorldX(PathInf.DirChangedPointsArr[I].Point.X);
    Path[I-1].Y:=MapToWorldY(PathInf.DirChangedPointsArr[I].Point.Y);
  end;
end;

destructor TPlayerSprite.Destroy;
begin
  PathInf.Free;
  PathInf:=nil;
  inherited Destroy;
end;

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

procedure TPlayerSprite.DoMove(MoveCount: Integer);
var
  EngX, EngY: Double;
begin
  inherited DoMove(MoveCount);

  //animate speed
  AnimSpeed := 8/1000;

  if PathIndex>=PathCount then
    Exit;

  NewX:=Path[PathIndex].X;
  NewY:=Path[PathIndex].Y;

  Moved:=False;

  if (X >NewX) then
  begin
    //calculate the length
    X := X - (120/1000)*MoveCount;

    //if length less then zero then don't move
    if X<NewX then
      X:=NewX;

    //if new position is enough far from old position then let sprite turn about
    if X - NewX >AVAILABLE_AREA then
    begin
      AnimStart := 6;
      AnimCount := 2;
    end;

    Moved:=True;
  end;

  if (X<NewX) then
  begin
    X := X + (120/1000)*MoveCount;

    if X>NewX then
      X:=NewX;
    if NewX-X>AVAILABLE_AREA then
    begin
      AnimStart := 2;
      AnimCount := 2;
    end;
    Moved:=True;
  end;

  if Y > NewY then
  begin
    Y := Y - (120/1000)*MoveCount;

    if Y<NewY then
      Y:=NewY;

    if (Y-NewY)>AVAILABLE_AREA then
    begin
      AnimStart := 0;
      AnimCount := 2;
    end;
    Moved:=True;
  end;

  if Y < NewY then
  begin
    Y := Y + (120/1000)*MoveCount;

    if Y>NewY then
      Y:=NewY;
    if NewY-Y>AVAILABLE_AREA then
    begin
      AnimStart := 4;
      AnimCount := 2;
    end;
    Moved:=True;
  end;

  //if sprite has moved then animate can be played
  AnimLooped:=Moved;

  //if sprite has already move to new position then go to next postion
  if not Moved then
    Inc(PathIndex);

  //process collision
  Collision;

  if not FIsMe then
    Exit;

  //scroll the window and insure self sprite is in the window
  EngX := -X+Engine.Width div 2-Width div 2;
  EngY := -Y+Engine.Height div 2-Height div 2;

  if EngX>MapW div 2 then
    Engine.X:=MapW div 2
  else
    if EngX<-MapW div 2 +Engine.Width then
      Engine.X:=-MapW div 2+Engine.Width
    else
      Engine.X:=EngX;

  if EngY>MapH div 2 then
    Engine.Y:=MapH div 2
  else
    if EngY<-MapH div 2 + Engine.Height then
      Engine.Y:=-MapH div 2+Engine.Height
    else
      Engine.Y:=EngY;
end;

procedure TPlayerSprite.SetCaption(const Value: string);
begin
  FCaption := Value;
end;

procedure TPlayerSprite.SetMoved(const Value: Boolean);
begin
  FMoved := Value;
end;

procedure TPlayerSprite.SetNewX(const Value: Double);
begin
  FNewX := Value;
end;

procedure TPlayerSprite.SetNewY(const Value: Double);
begin
  FNewY := Value;
end;

constructor TPlayerSprite.Create(Aparent: TSprite);
begin
  inherited Create(AParent);

  //create PathInf and create digital map with new custom coordinate
  PathInf:=TDXPath.Create(MapW div DL, MapH div DL);

  Talk.Count:=0;
  PathCala:=False;
  PathIndex:=-1;
  PathCount:=0;
  AnchorX:=0;
  AnchorY:=0;
  x:=0;
  y:=0;
  Z := 8;
end;

function TPlayerSprite.HasObstacle(StartX, StartY: Integer): Boolean;
var
  AX, AY: Integer;
begin
  Result:=False;
  for AX:=1 to DL do
    for AY:=1 to DL do
      Result:=Result or OrgObstacle[StartX-MapW div 2+AX-1, StartY-MapH div 2+AY-1];
end;

procedure TPlayerSprite.MakeMap(MapEngine: TDXMap);
var
  I, J, K: Integer;
begin
  if PathCala then
    Exit;

  for I:=-MapW div 2 to MapW div 2 do
    for J:=-MapH div 2 to MapH div 2 do
      OrgObstacle[I, J]:=False;

  with MapEngine.Engine.Engine do
    for I:=0 to Count-1 do
      if (not (Items[I] is TPlayerSprite)) and (not (Items[I] is TDecAcces)) then
        for J:=0 to Items[I].Width-1 do
          for K:=0 to Items[I].Height-1 do
            OrgObstacle[Trunc(Items[I].X+J), Trunc(Items[I].Y+K)]:=True;

  for I:=0 to MapH div DL-1 do
    for J:=0 to MapW div DL-1 do
      PathInf.FObstacle[I, J]:=HasObstacle(J*DL, I*DL);
  PathCala:=True;
end;

procedure TPlayerSprite.Speak(ASend, ARece, AText: string; AFace: Integer; AOnlyOne: Boolean);
begin
  if Talk.Count>=1 then
    RollTalk;

  with Talk do
  begin
    Items[Count]:=AText;
    Send[Count]:=Asend;
    Rece[Count]:=ARece;
    Face[Count]:=AFace;
    OnlyOne[Count]:=AOnlyOne;
    Life[Count]:=0;
    Inc(Count);
  end;
end;

procedure TPlayerSprite.RollTalk;
var
  I: Integer;
begin
  with Talk do
  begin
    Dec(Count);
    for I:=0 to Count-1 do
    begin
      Items[I]:=Items[I+1];
      Send[I]:=Send[I+1];
      Rece[I]:=Rece[I+1];
      Face[I]:=Face[I+1];
      OnlyOne[I]:=OnlyOne[I+1];
      Life[I]:=Life[I+1];
    end;
  end;
end;

procedure TPlayerSprite.SetDegree(const Value: Integer);
begin
  FDegree := Value;
end;

procedure TPlayerSprite.SetHeadID(const Value: Integer);
begin
  FHeadID := Value;
end;

procedure TPlayerSprite.SetAnchorX(const Value: Integer);
begin
  FAnchorX := Value;
end;

procedure TPlayerSprite.SetAnchorY(const Value: Integer);
begin
  FAnchorY := Value;
end;

procedure TPlayerSprite.SetIsMe(const Value: Boolean);
begin
  FIsMe := Value;
end;

{ TPlayers }

function TPlayers.Add(ASprite: TSprite; ACaption: string; ADegree: Integer): Integer;
begin
  Items[FCount]:=TPlayerSprite.Create(ASprite);
  with Items[FCount] do
  begin
    FCaption:=ACaption;
    FDegree:=ADegree;
  end;
  Result:=FCount;
  Inc(FCount);
end;

constructor TPlayers.Create(AOwner: TObject);
begin
  FCount:=0;
end;

procedure TPlayers.Delete(Index: Integer);
var
  I: Integer;
begin
  Items[Index].Free;
  for I:=Index to FCount-2 do
    Items[Index]:=Items[Index+1];
  Items[FCount-1]:=nil;
  Dec(FCount);
end;

function TPlayers.FindByCaption(ACaption: string): Integer;
var
  I: Integer;
begin
  Result:=-1;
  for I:=0 to FCount-1 do
    if LowerCase(Items[I].Caption)=LowerCase(ACaption) then
    begin
      Result:=I;
      Exit;
    end;
end;

procedure TPlayers.SetCount(const Value: Integer);
begin
  FCount := Value;
end;

procedure TPlayers.Clear;
var
  I: Integer;
begin
  for I:=0 to FCount-1 do
  begin
    Items[I].Free;
    Items[I]:=nil;
  end;
  FCount:=0;
end;
function TPlayers.GetSpriteAt(X, Y: Double): string;
var
  I: Integer;
begin
  Result:='';
  for I:=0 to FCount-1 do
    if ((Items[I].X-Items[I].Image.Width div 2)<X) and ((Items[I].Y-Items[I].Image.Height div 2)<Y)
      and ((Items[I].X+Items[I].Image.Width div 2)>X) and ((Items[I].Y+Items[I].Image.Height div 2)>Y)
    then
    begin
      Result:=Items[I].Caption;
      Exit;
    end;
end;

end.
