{ TSsPlayTime Component - Estimates SakuraScript playing time }
{ }
{ Copyright (c) 2001-2003 naruto/CANO-Lab }
+{ (c) 2001-2005 WinBottle Project }
{*************************************************************}
unit SsPlayTime;
TSsPlayTimeException = class(Exception);
TSsPlayTimeInitException = class(TSsPlayTimeException);
+ TSsPlayTimeSpecialChar = class(TCollectionItem)
+ private
+ FWait: integer;
+ FChar: String;
+ procedure SetChar(const Value: String);
+ procedure SetWait(const Value: integer);
+ protected
+ function GetDisplayName: String; override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ function DisplayChar: String;
+ published
+ property Char: String read FChar write SetChar;
+ property Wait: integer read FWait write SetWait;
+ end;
+
+ TSsPlayTimeSpecialChars = class(TCollection)
+ end;
+
TSsPlayTimeParams = class(TComponent)
private
FCostWait: integer;
FCostHiResWait: integer;
FCostSurface: integer;
FCostQuickChar: integer;
- FCostWhiteSpace: integer;
- FCostDBWhiteSpace: integer;
FProfileName: String;
+ FSpecialChars: TSsPlayTimeSpecialChars;
procedure SetCostChar(const Value: integer);
procedure SetCostConst(const Value: integer);
procedure SetCostDBChar(const Value: integer);
procedure SetCostSurface(const Value: integer);
procedure SetCostQuickChar(const Value: integer);
procedure SetProfileName(const Value: String);
+ procedure SetSpecialChars(const Value: TSsPlayTimeSpecialChars);
public
constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property ProfileName: String read FProfileName write SetProfileName;
property CostSurface: integer read FCostSurface write SetCostSurface default 5;
property CostChar: integer read FCostChar write SetCostChar default 50;
property CostDBChar: integer read FCostDBChar write SetCostDBChar default 50;
- property CostWhiteSpace: integer read FCostWhiteSpace write FCostWhiteSpace default 10;
- property CostDBWhiteSpace: integer read FCostDBWhiteSpace write FCostDBWhiteSpace default 10;
property CostQuickChar: integer read FCostQuickChar write SetCostQuickChar default 0;
+ property SpecialChars: TSsPlayTimeSpecialChars read FSpecialChars write SetSpecialChars;
end;
TSsPlayTimeCount = record
Surface: integer;
Char: integer;
DBChar: integer;
- WhiteSpace: integer;
- DBWhiteSpace : integer;
QuickChar: integer;
+ Specials: integer;
end;
TSsPlayTime = class(TComponent)
protected
procedure CountElements;
procedure CountCharacterType(const Str: String; out SB, DB,
- SBS, DBS: integer);
+ SPNum, SPWait: integer);
public
function PlayTime(const Script: String): integer;
property Counts: TSsPlayTimeCount read FCounts;
FCostSurface := Src.FCostSurface;
FCostChar := Src.FCostChar;
FCostDBChar := Src.FCostDBChar;
- FCostWhiteSpace := Src.FCostWhiteSpace;
- FCostDBWhiteSpace := Src.FCostDBWhiteSpace;
FCostQuickChar := Src.FCostQuickChar;
FProfileName := Src.FProfileName;
+ FSpecialChars.Assign(Src.SpecialChars);
end;
end;
FCostSurface := 5;
FCostChar := 50;
FCostDBChar := 50;
- FCostWhiteSpace := 10;
- FCostDBWhiteSpace := 10;
FCostQuickChar := 0;
+ FSpecialChars := TSsPlayTimeSpecialChars.Create(TSsPlayTimeSpecialChar);
+end;
+
+destructor TSsPlayTimeParams.Destroy;
+begin
+ FSpecialChars.Free;
+ inherited;
end;
procedure TSsPlayTimeParams.SetCostChar(const Value: integer);
FProfileName := Value;
end;
+procedure TSsPlayTimeParams.SetSpecialChars(
+ const Value: TSsPlayTimeSpecialChars);
+begin
+ FSpecialChars.Assign(Value);
+end;
+
{ TSsPlayTime }
procedure TSsPlayTime.CountCharacterType(const Str: String; out SB,
- DB, SBS, DBS: integer);
+ DB, SPNum, SPWait: integer);
var
- i: integer;
- InLeadByte: boolean;
+ i, j, lnStr: integer;
+ InLeadByte, Flag: boolean;
+ AChar: TSsPlayTimeSpecialChar;
begin
SB := 0;
DB := 0;
- SBS := 0;
- DBS := 0;
+ SPNum := 0;
+ SPWait := 0;
InLeadByte := false;
- for i := 1 to Length(Str) do
+ lnStr := Length(Str);
+ for i := 1 to lnStr do
begin
if InLeadByte then
begin
Inc(DB);
InLeadByte := false;
end
- else if Str[i] in LeadBytes then
+ else
begin
- InLeadByte := true;
- if Str[i] + Str[i+1] = CDBWhiteSpace then
+ Flag := false;
+ for j := 0 to PlayTimeParams.SpecialChars.Count-1 do
begin
- Inc(DBS);
- Dec(DB);
+ AChar := PlayTimeParams.SpecialChars.Items[j] as TSsPlayTimeSpecialChar;
+ if (Length(AChar.Char) = 2) and (lnStr-i > 0) then
+ begin
+ if Str[i] + Str[i+1] = AChar.Char then
+ begin
+ Inc(SPWait, AChar.Wait);
+ Inc(SPNum);
+ Dec(DB);
+ Flag := true;
+ InLeadByte := true;
+ Break;
+ end;
+ end else
+ begin
+ if Str[i] = AChar.Char then
+ begin
+ Inc(SPWait, AChar.Wait);
+ Inc(SPNum);
+ Flag := true;
+ Break;
+ end;
+ end;
end;
- end
- else if Str[i] = ' ' then
- Inc(SBS)
- else
- Inc(SB);
+ if not Flag then
+ begin
+ if Str[i] in LeadBytes then
+ InLeadByte := true
+ else
+ Inc(SB);
+ end;
+ end;
end;
end;
procedure TSsPlayTime.CountElements;
var
- i, SB, DB, SBS, DBS: integer;
+ i, SB, DB, SPNum, SPWait: integer;
Mark: String;
InQuick: boolean;
begin
begin
if InQuick then
begin
- CountCharacterType(Mark, SB, DB, SBS, DBS);
- Inc(FCounts.QuickChar, SB + DB + SBS + DBS);
+ CountCharacterType(Mark, SB, DB, SPNum, SPWait);
+ Inc(FCounts.QuickChar, SB + DB + SPNum);
end else
begin
- CountCharacterType(Mark, SB, DB, SBS, DBS);
+ CountCharacterType(Mark, SB, DB, SPNum, SPWait);
Inc(FCounts.Char, SB);
Inc(FCounts.DBChar, DB);
- Inc(FCounts.WhiteSpace, SBS);
- Inc(FCounts.DBWhiteSpace, DBS);
+ Inc(FCounts.Specials, SPWait);
end;
end;
// Ignore all tag errors
raise TSsPlayTimeInitException.Create('SsParser is not set');
if FPlayTimeParams = nil then
raise TSsPlayTimeInitException.Create('PlayTimeParams is not set');
- try
- SsParser.InputString := Script;
- CountElements;
- with PlayTimeParams do
- Result := CostConst + CostWait * FCounts.Wait + CostSurface * FCounts.Surface +
- CostHiResWait * FCounts.HiResWait + CostChar * FCounts.Char +
- CostDBChar * FCounts.DBChar +
- CostWhiteSpace * FCounts.WhiteSpace + CostDBWhiteSpace * FCounts.DBWhiteSpace +
- CostQuickChar * FCounts.QuickChar;
- except
- Result := 0;
- raise;
- end;
+ SsParser.InputString := Script;
+ CountElements;
+ with PlayTimeParams do
+ Result := CostConst + CostWait * FCounts.Wait + CostSurface * FCounts.Surface +
+ CostHiResWait * FCounts.HiResWait + CostChar * FCounts.Char +
+ CostDBChar * FCounts.DBChar + FCounts.Specials +
+ CostQuickChar * FCounts.QuickChar;
end;
procedure TSsPlayTime.SetPlayTimeParams(const Value: TSsPlayTimeParams);
FSsParser := Value;
end;
+{ TSsPlayTimeSpecialChar }
+
+procedure TSsPlayTimeSpecialChar.Assign(Source: TPersistent);
+begin
+ if not(Source is TSsPlayTimeSpecialChar) then
+ inherited
+ else
+ begin
+ Self.FChar := (Source as TSsPlayTimeSpecialChar).FChar;
+ Self.FWait := (Source as TSsPlayTimeSpecialChar).FWait;
+ end;
+end;
+
+function TSsPlayTimeSpecialChar.DisplayChar: String;
+begin
+ if FChar = ' ' then
+ Result := '(SP)'
+ else if FChar = CDBWhiteSpace then
+ Result := '(DB SP)'
+ else
+ Result := FChar;
+end;
+
+function TSsPlayTimeSpecialChar.GetDisplayName: String;
+begin
+ Result := Format('"%s" = %d', [DisplayChar, FWait]);
+end;
+
+procedure TSsPlayTimeSpecialChar.SetChar(const Value: String);
+begin
+ if Value = '' then
+ FChar := Value
+ else
+ begin
+ if (Value[1] in LeadBytes) then
+ begin
+ if Length(Value) = 2 then
+ FChar := Value;
+ end else if Length(Value) = 1 then
+ FChar := Value;
+ end;
+end;
+
+procedure TSsPlayTimeSpecialChar.SetWait(const Value: integer);
+begin
+ FWait := Value;
+end;
+
end.
\ No newline at end of file
OSDN Git Service
