parsetypes.pas

xlbot directX game plug in

unit ParseTypes;

interface

uses SysUtils, Classes;

const
   SKILL_STUB = 'You have become better at ';
   ENTERZONE_STUB = 'You have entered ';
   PLAYERLIST_BEGIN_STUB1 = 'Players on EverQuest:';
   PLAYERLIST_BEGIN_STUB2 = 'Players in EverQuest:';
   FRIEND_STUB = 'Friends currently on EverQuest:';
   PLAYERLIST_END_STUB = 'There are ';
   GETPRICE_STUB = 'tells you, ''That''ll be';
   BUYITEM_STUB = 'You give ';

type
   TParseList = class(TStringList)
   protected
      function    IsLineType(const Line: string): boolean; virtual; abstract;
      procedure   ProcessKnownLine(const Line: string);  virtual; abstract;
   public
      constructor Create;
      procedure   ProcessLine(const Line: string); virtual;
   end;


   // TSKillItem

   TSkillItem = class
      Name         : string;
      Max          : integer;
      Min          : integer;
      NumIncrease  : integer;
      LastIncrease : TDateTime;
   end;

   TSkillList = class(TParseList)
   protected
      function    IsLineType(const Line: string): boolean; override;
      procedure   ProcessKnownLine(const Line: string);  override;
      procedure   UpdateSkill(const Skill: string; Val: integer; dt: TDateTime);
   end;


   // TZoneItem

   TZoneItem = class
      Name        : string;
      LastEnter   : TDateTime;
      NumEnter    : integer;
   end;

   TZoneList = class(TParseList)
   protected
      function    IsLineType(const Line: string): boolean; override;
      procedure   ProcessKnownLine(const Line: string);  override;
      procedure   UpdateZone(const Zone: string; dt: TDateTime);
   end;


   // TPlayerItem

   TPlayerItem = class
      Name        : string;
      LastSeen    : TDateTime;
      NumSeen     : integer;
      MaxLevel    : integer;
      MinLevel    : integer;
      PlayClass   : string;
      Race        : string;
      Guild       : string;
      Anon        : boolean;
   end;

   TPlayerList = class(TParseList)
   protected
      InPlayerList   : boolean;
      function    IsLineType(const Line: string): boolean; override;
      procedure   ProcessKnownLine(const Line: string);  override;
      procedure   UpdatePlayer(const Player, PlayClass, Race, Guild: string; dt: TDateTime; Level: integer; Anon: boolean);
   end;


   // TBuyItem

   TBuyItem = class
      Item        : string;
      LastBuy     : TDateTime;
      NumBuy      : integer;
      TotCopper   : integer;
      Vendor      : string;
   end;

   TBuyList = class(TParseList)
   protected
      BuyMode     : boolean;
      CurVendor   : string;
      CurItem     : string;
      function    Price(const ts, coin: string):Integer;
      function    IsLineType(const Line: string): boolean; override;
      procedure   ProcessKnownLine(const Line: string);  override;
      procedure   UpdateBuyItem(const Item: string; LastBuy: TDateTime; Copper: Integer);
   end;


implementation

uses Main;


function CurDateTime: TDateTime;
begin
   Result := MainForm.CurDateTime;
end;

{ TParseList }

constructor TParseList.Create;
begin
   inherited;
   Sorted := True;
end;

procedure TParseList.ProcessLine(const Line: string);
begin
   try
      if IsLineType(Line) then
         ProcessKnownLine(Line);
   except
      on e: Exception do begin
         raise Exception.CreateFmt('Error %s on Line %s', [e.Message, Line]);
      end;
   end;
end;


{ TSkillList }

function TSkillList.IsLineType(const Line: string): boolean;
begin
   Result := Pos(SKILL_STUB, Line) <> 0;
end;


procedure TSkillList.ProcessKnownLine(const Line: string);
var
   tmp    : string;
   skill  : string;
   val    : string;
begin
   tmp := Copy(Line, Length(SKILL_STUB) + 1, Length(Line));
   skill := copy(tmp, 1, Pos('!', tmp)-1);

   // get after the !
   tmp := Trim(copy(tmp, Pos('!', tmp)+1, Length(tmp)));
   // Get rid of the parans
   val := Copy(tmp, 2, Length(tmp)-2);

   UpdateSkill(skill, StrToInt(val), CurDateTime);
end;


procedure TSkillList.UpdateSkill(const Skill: string; Val: integer; dt: TDateTime);
var
   i  : integer;
   si : TSkillItem;
begin
   i := IndexOf(Skill);

   if i = -1 then begin
      si := TSkillItem.Create;
      si.Name := Skill;

      i := AddObject(Skill, si);
   end;

   si := Objects[i] as TSkillItem;
   si.NumIncrease := si.NumIncrease + 1;

   if (si.Min = 0) or (Val < si.Min) then si.Min := Val;
   if (si.Max = 0) or (Val > si.Max) then si.Max := Val;

   si.LastIncrease := dt;
end;


{ TZoneList }

function TZoneList.IsLineType(const Line: string): boolean;
begin
   Result := Pos(ENTERZONE_STUB, Line) <> 0;
end;


procedure TZoneList.ProcessKnownLine(const Line: string);
var
   Zone   : string;
begin
   zone := Copy(Line, Length(ENTERZONE_STUB) + 1, Length(Line));
   zone := Copy(zone, 1, Length(zone)-1);

   UpdateZone(Zone, CurDateTime);
end;


procedure TZoneList.UpdateZone(const Zone: string; dt: TDateTime);
var
   i  : integer;
   zi : TZoneItem;
begin
   i := IndexOf(Zone);

   if i = -1 then begin
      zi := TZoneItem.Create;
      zi.Name := Zone;

      i := AddObject(Zone, zi);
   end;

   zi := Objects[i] as TZoneItem;
   zi.NumEnter := zi.NumEnter + 1;

   zi.LastEnter := dt;
end;



{ TPlayerList }

function TPlayerList.IsLineType(const Line: string): boolean;
var
   b : boolean;
begin
   if InPlayerList then begin

      b := Pos(PLAYERLIST_END_STUB, Line) <> 0;
      if b then begin
         InPlayerList := False;
      end;
      if Copy(Line, 1, 4) = '----' then begin
         Result := False;
         exit;
      end;

   end else begin

      b := Pos(PLAYERLIST_BEGIN_STUB1, Line) <> 0;
      b := b or (Pos(PLAYERLIST_BEGIN_STUB2, Line) <> 0);
      b := b or (Pos(FRIEND_STUB, Line) <> 0);
      if b then begin
         InPlayerList := True;
         Result := False;     // We don't want to process the begin stub line
         exit;
      end;
      
   end;

   Result := InPlayerList;
end;

procedure TPlayerList.ProcessKnownLine(const Line: string);
var
   pb, pb2 : integer;
   bs, ls, tmp, Name : string;
   PlayClass, Race, Guild : string;
   Level : integer;
   Anon : boolean;
begin
   pb := Pos(']', Line);
   if pb = 0 then begin
      InPlayerList := False;
      exit;
   end;

   pb2 := Pos('[', Line);
   bs := Copy(Line, pb2+1, pb-2-pb2+1);
   Anon := (bs = 'ANONYMOUS');

   tmp := Copy(Line, pb+2, Length(Line));
   Name := Copy(tmp, 1, Pos(' ', tmp)-1);
   tmp := Copy(tmp, Pos(' ', tmp)+1, Length(tmp));
   Level := 0;

   if not Anon then begin
      ls := Copy(bs, 1, Pos(' ', bs)-1);
      Level := StrToInt(ls);
      PlayClass := Copy(bs, Pos(' ', bs)+1, Length(bs));
   end;

   if Name = '' then exit;

   if Pos('(', tmp) <> 0 then begin
      pb := Pos('(', tmp);
      pb2 := Pos(')', tmp);
      Race := Copy(tmp, pb+1, pb2-pb-1);
   end;

   if Pos('<', tmp) <> 0 then begin
      pb := Pos('<', tmp);
      pb2 := Pos('>', tmp);
      Guild := Copy(tmp, pb+1, pb2-pb-1);
   end;

   UpdatePlayer(Name, PlayClass, Race, Guild, CurDateTime, Level, Anon);
end;

procedure TPlayerList.UpdatePlayer(const Player, PlayClass, Race,
  Guild: string; dt: TDateTime; Level: integer; Anon: boolean);
var
   i  : integer;
   pi : TPlayerItem;
begin
   i := IndexOf(Player);

   if i = -1 then begin
      pi := TPlayerItem.Create;
      pi.Name := Player;

      i := AddObject(Player, pi);
   end;

   pi := Objects[i] as TPlayerItem;
   pi.NumSeen := pi.NumSeen + 1;

   pi.LastSeen := dt;
   pi.Anon := Anon;

   if not Anon then begin
      pi.PlayClass := PlayClass;
      pi.Race := Race;
      pi.Guild := Guild;

      if (pi.MinLevel = 0) or (Level < pi.MinLevel) then pi.MinLevel := Level;
      if (pi.MaxLevel = 0) or (Level > pi.MaxLevel) then pi.MaxLevel := Level;
   end;

end;


{ TBuyList }

// This function taken from the Feekle Log Analyzer

function TBuyList.Price(const ts, coin: string):Integer;
{returns how much of a certian coin}
var
 x, y, z : integer;
 tmp     : string;
begin
   Result := 0;
   x := Pos(coin, ts);
   if x > 0 then begin
      for y := x - 2 downto 1 do
          if ts[y] = ' ' then break;

      for z := (y + 1) to (x - 2) do
          tmp := tmp + ts[z];

      Result := StrToInt(tmp);
   end;
end;


function TBuyList.IsLineType(const Line: string): boolean;
const
   PERSTR      = ' per ';
   FORTHESTR   = ' for the ';
   TELLSYOUSTR = ' tells you, ';
var
   ps : boolean;
   tmp : string;
   pt : integer;
   pp : integer;
begin
   ps := Pos(GETPRICE_STUB, Line) <> 0;

   if ps then begin
      BuyMode := True;
      Result := False;

      // Juni Sandfisher tells you, 'I'll give you 8 copper per Spider Legs.'
      pt := Pos(TELLSYOUSTR, Line);
      CurVendor := Copy(Line, 1, pt-1);
      pp := Pos(PERSTR, Line);

      if pp <> 0 then begin
         tmp := Copy(Line, pp + Length(PERSTR), Length(Line));
         CurItem := Copy(tmp, 1, Length(tmp)-2);
      end else begin
         pp := Pos(FORTHESTR, Line);
         tmp := Copy(Line, pp + Length(FORTHESTR), Length(Line));
         CurItem := Copy(tmp, 1, Length(tmp)-2);
      end;

      exit;
   end;

   Result := BuyMode;
end;


procedure TBuyList.ProcessKnownLine(const Line: string);
var
   yg     : boolean;
   Copper : integer;
   pp, gp, sp, cp : integer;
   s : string;
begin
   yg := Pos(BUYITEM_STUB, Line) <> 0;

   if yg then begin
      s := Line;

      pp := Price(s, 'platinum');
      gp := Price(s, 'gold');
      sp := Price(s, 'silver');
      cp := Price(s, 'copper');

      Copper := cp + 10 * sp + 100 * gp + 1000* pp;

      UpdateBuyItem(CurItem, CurDateTime, Copper);
   end;
end;


procedure TBuyList.UpdateBuyItem(const Item: string; LastBuy: TDateTime;
  Copper: Integer);
var
   i  : integer;
   bi : TBuyItem;
begin
   i := IndexOf(Item);

   if i = -1 then begin
      bi := TBuyItem.Create;
      bi.Item := Item;

      i := AddObject(Item, bi);
   end;

   bi := Objects[i] as TBuyItem;
   bi.NumBuy := bi.NumBuy  + 1;
   bi.LastBuy := LastBuy;
   bi.TotCopper := bi.TotCopper + Copper;
   bi.Vendor := CurVendor;
end;


end.