sakurasuite/SakuraScriptFountain.pas

   1 {*******************************************************}
   2 {       TSakuraScriptFountain - TEditor Fountain Parser }
   3 {                                                       }
   4 {       Copyright (c) 2003 naruto/CANO-Lab              }
   5 {*******************************************************}
   6
   7 unit SakuraScriptFountain;
   8
   9 interface
  10
  11 uses
  12   SysUtils, Classes, heClasses, heFountain, heRaStrings, SsParser;
  13
  14 type
  15   TSakuraScriptFountainParser = class(TFountainParser)
  16   protected
  17     function GetTalkToken: char;
  18     procedure InitMethodTable; override;
  19     procedure TagProc;
  20     procedure MetaProc;
  21     procedure SymbolProc; override;
  22     function SsParser: TSsParser;
  23     function IsScope0ChangeTag(const Tag: String): boolean; virtual;
  24     function IsScope1ChangeTag(const Tag: String): boolean; virtual;
  25   public
  26     function NextToken: Char; override;
  27     function TokenToFountainColor: TFountainColor; override;
  28   end;
  29
  30   TSakuraScriptFountain = class(TFountain)
  31   private
  32     FScope0Color: TFountainColor;
  33     FScope1Color: TFountainColor;
  34     FTagColor: TFountainColor;
  35     FMetaWordColor: TFountainColor;
  36     FTagErrorColor: TFountainColor;
  37     FSynchronizedColor: TFountainColor;
  38     FSakuraScriptParser: TSsParser;
  39     FProcessSync: boolean;
  40     FChangeScopeByHU: boolean;
  41     FChangeScopeBy01: boolean;
  42     procedure SetMetaWordColor(const Value: TFountainColor);
  43     procedure SetScope0Color(const Value: TFountainColor);
  44     procedure SetScope1Color(const Value: TFountainColor);
  45     procedure SetTagColor(const Value: TFountainColor);
  46     procedure SetTagErrorColor(const Value: TFountainColor);
  47     procedure SetSynchronizedColor(const Value: TFountainColor);
  48     procedure SetSakuraScriptParser(const Value: TSsParser);
  49     procedure SetChangeScopeBy01(const Value: boolean);
  50     procedure SetChangeScopeByHU(const Value: boolean);
  51     procedure SetProcessSync(const Value: boolean);
  52     { Private \90é\8c¾ }
  53   protected
  54     { Protected \90é\8c¾ }
  55     procedure CreateFountainColors; override;
  56     function GetParserClass: TFountainParserClass; override;
  57   public
  58     constructor Create(AOwner: TComponent); override;
  59     destructor Destroy; override;
  60   published
  61     property Scope0Color: TFountainColor read FScope0Color write SetScope0Color;
  62     property Scope1Color: TFountainColor read FScope1Color write SetScope1Color;
  63     property TagColor: TFountainColor read FTagColor write SetTagColor;
  64     property TagErrorColor: TFountainColor read FTagErrorColor write SetTagErrorColor;
  65     property MetaWordColor: TFountainColor read FMetaWordColor write SetMetaWordColor;
  66     property SynchronizedColor: TFountainColor read FSynchronizedColor write SetSynchronizedColor;
  67     property SakuraScriptParser: TSsParser read FSakuraScriptParser write SetSakuraScriptParser;
  68     property ChangeScopeBy01: boolean read FChangeScopeBy01 write SetChangeScopeBy01 default true;
  69     property ChangeScopeByHU: boolean read FChangeScopeByHU write SetChangeScopeByHU default true;
  70     property ProcessSync: boolean read FProcessSync write SetProcessSync default true;
  71   published
  72     { Published \90é\8c¾ }
  73   end;
  74
  75 procedure Register;
  76
  77 implementation
  78
  79 const
  80   { \83g\81[\83N\83\93\82Ì\8eí\97Þ\82ð\95\\82·\92è\90\94(\97ñ\8b\93\8c^\82¾\82Æ\82±\82¤\82â\82Á\82Ä\91\9d\82â\82¹\82È\82¢\82©\82ç\82Ë) }
  81   toScope0   = char(50); //\83X\83R\81[\83v0\95¶\8e\9a\97ñ
  82   toScope1   = char(51); //\83X\83R\81[\83v1\95¶\8e\9a\97ñ
  83   toTag      = char(52); //\83^\83O
  84   toTagError = char(53); //\83^\83O\95\\8bL\83G\83\89\81[
  85   toMetaWord = char(54); //\83\81\83^\95¶\8e\9a\97ñ
  86   toSynchronized = char(55); //\83V\83\93\83N\83\8d\83i\83C\83Y\83h\83Z\83b\83V\83\87\83\93
  87
  88   InScope1 = $1;
  89   InSynchronized = $2;
  90
  91 { TSakuraScriptFountain }
  92
  93 constructor TSakuraScriptFountain.Create(AOwner: TComponent);
  94 begin
  95   inherited;
  96   FChangeScopeByHU := true;
  97   FChangeScopeBy01 := true;
  98   FProcessSync := true;
  99 end;
 100
 101 procedure TSakuraScriptFountain.CreateFountainColors;
 102 begin
 103   inherited;
 104   FScope0Color       := CreateFountainColor;
 105   FScope1Color       := CreateFountainColor;
 106   FTagColor          := CreateFountainColor;
 107   FTagErrorColor     := CreateFountainColor;
 108   FMetaWordColor     := CreateFountainColor;
 109   FSynchronizedColor := CreateFountainColor;
 110 end;
 111
 112 destructor TSakuraScriptFountain.Destroy;
 113 begin
 114   FScope0Color.Free;
 115   FScope1Color.Free;
 116   FTagColor.Free;
 117   FTagErrorColor.Free;
 118   FMetaWordColor.Free;
 119   FSynchronizedColor.Free;
 120   inherited;
 121 end;
 122
 123 function TSakuraScriptFountain.GetParserClass: TFountainParserClass;
 124 begin
 125   Result := TSakuraScriptFountainParser;
 126 end;
 127
 128 procedure TSakuraScriptFountain.SetChangeScopeBy01(const Value: boolean);
 129 begin
 130   FChangeScopeBy01 := Value;
 131 end;
 132
 133 procedure TSakuraScriptFountain.SetChangeScopeByHU(const Value: boolean);
 134 begin
 135   FChangeScopeByHU := Value;
 136 end;
 137
 138 procedure TSakuraScriptFountain.SetMetaWordColor(
 139   const Value: TFountainColor);
 140 begin
 141   FMetaWordColor.Assign(Value);
 142 end;
 143
 144 procedure TSakuraScriptFountain.SetProcessSync(const Value: boolean);
 145 begin
 146   FProcessSync := Value;
 147 end;
 148
 149 procedure TSakuraScriptFountain.SetSakuraScriptParser(
 150   const Value: TSsParser);
 151 begin
 152   FSakuraScriptParser := Value;
 153 end;
 154
 155 procedure TSakuraScriptFountain.SetScope0Color(
 156   const Value: TFountainColor);
 157 begin
 158   FScope0Color.Assign(Value);
 159 end;
 160
 161 procedure TSakuraScriptFountain.SetScope1Color(
 162   const Value: TFountainColor);
 163 begin
 164   FScope1Color.Assign(Value);
 165 end;
 166
 167 procedure TSakuraScriptFountain.SetSynchronizedColor(
 168   const Value: TFountainColor);
 169 begin
 170   FSynchronizedColor.Assign(Value);
 171 end;
 172
 173 procedure TSakuraScriptFountain.SetTagColor(const Value: TFountainColor);
 174 begin
 175   FTagColor.Assign(Value);
 176 end;
 177
 178 procedure TSakuraScriptFountain.SetTagErrorColor(
 179   const Value: TFountainColor);
 180 begin
 181   FTagErrorColor.Assign(Value);
 182 end;
 183
 184 { TSakuraScriptFountainParser }
 185
 186 function TSakuraScriptFountainParser.GetTalkToken: char;
 187 begin
 188   if (FElementIndex or InSynchronized) > 0 then
 189     Result := toSynchronized
 190   else if (FElementIndex or InScope1) > 0 then
 191     Result := toScope1
 192   else
 193     Result := toScope0;
 194 end;
 195
 196 procedure TSakuraScriptFountainParser.InitMethodTable;
 197 begin
 198   inherited;
 199   FMethodTable['\'] := TagProc;
 200   FMethodTable['%'] := MetaProc;
 201 end;
 202
 203
 204 function TSakuraScriptFountainParser.IsScope0ChangeTag(
 205   const Tag: String): boolean;
 206 begin
 207   Result := false;
 208   if (Self.FFountain as TSakuraScriptFountain).ChangeScopeBy01 then
 209     if Tag = '\0' then
 210       Result := true;
 211   if (Self.FFountain as TSakuraScriptFountain).ChangeScopeByHU then
 212     if Tag = '\h' then
 213       Result := true;
 214 end;
 215
 216 function TSakuraScriptFountainParser.IsScope1ChangeTag(
 217   const Tag: String): boolean;
 218 begin
 219   Result := false;
 220   if (Self.FFountain as TSakuraScriptFountain).ChangeScopeBy01 then
 221     if Tag = '\1' then
 222       Result := true;
 223   if (Self.FFountain as TSakuraScriptFountain).ChangeScopeByHU then
 224     if Tag = '\u' then
 225       Result := true;
 226 end;
 227
 228 procedure TSakuraScriptFountainParser.MetaProc;
 229 var i, Le: integer;
 230 begin
 231   Inc(FP);
 232   for i := 0 to SsParser.MetaPattern.Count-1 do
 233   begin
 234     Le := SsParser.MatchP(FP, PChar(SsParser.MetaPattern[i]));
 235     if Le > 0 then
 236     begin
 237       FToken := toMetaWord;
 238       Inc(FP, Le);
 239       Exit; // \82ß\82Å\82½\82\83\81\83^\95¶\8e\9a\82Æ\82µ\82Ä\89ð\90Í\8a®\97¹
 240     end else
 241   end;
 242   SymbolProc; // \92P\8f\83\82É\95¶\8e\9a\82Æ\82µ\82Ä\88µ\82¤
 243 end;
 244
 245 function TSakuraScriptFountainParser.NextToken: Char;
 246 begin
 247   // \82±\82Ì\83N\83\89\83X\82Ì\83L\83\82\81B
 248   // toInteger\82â\82çtoDBSymbol\82â\82ç\82Ì\83g\81[\83N\83\93\82Í\95s\97v\82Å\81A
 249   // \91ã\82í\82è\82É\82»\82Ì\83Z\83\8a\83t\82ª\82Ç\82¿\82ç\82Ì\83X\83R\81[\83v\82È\82Ì\82©\82ª\95K\97v\82È\82Ì\82Å\81A
 250   // \83g\81[\83N\83\93\82ð\8fã\8f\91\82«\82·\82é
 251   inherited NextToken;
 252   if FToken = toTag then
 253   begin
 254     if IsScope1ChangeTag(TokenString) then
 255       FElementIndex := FElementIndex or InScope1
 256     else if IsScope0ChangeTag(TokenString) then
 257       FElementIndex := FElementIndex and not InScope1
 258     else if (FFountain as TSakuraScriptFountain).ProcessSync and
 259       (TokenString = '\_s') then
 260       FElementIndex := FElementIndex xor InSynchronized;
 261   end else
 262   begin
 263     if FToken in [toSymbol..toFloat, toAnk, toDBSymbol..toKana, toHex] then
 264     begin
 265       if (FElementIndex and InSynchronized) > 0 then
 266         FToken := toSynchronized
 267       else if (FElementIndex and InScope1) > 0 then
 268         FToken := toScope1
 269       else
 270         FToken := toScope0;
 271     end;
 272   end;
 273   Result := FToken;
 274 end;
 275
 276 procedure TSakuraScriptFountainParser.SymbolProc;
 277 // '\'\82Æ'%'\88È\8aO\82Í\8d\8b\89õ\82É\93Ç\82Ý\94ò\82Î\82·\81B\97v\82ç\82È\82¢\81B
 278 // \83_\83u\83\8b\83o\83C\83g\95¶\8e\9a\82à\83V\83\93\83O\83\8b\83o\83C\83g\95¶\8e\9a\82à\95¹\82¹\82Ä\92P\82È\82é\83V\83\93\83{\83\8b\82Æ\82µ\82Ä\88µ\82¤\81B
 279 begin
 280   FToken := toSymbol;
 281   if not (FP^ in [#0, #9, #10, #13, '\', '%']) then
 282     if FP^ in LeadBytes then
 283       Inc(FP, 2)
 284     else
 285       Inc(FP);
 286 end;
 287
 288 function TSakuraScriptFountainParser.SsParser: TSsParser;
 289 begin
 290   Result := (FFountain as TSakuraScriptFountain).SakuraScriptParser;
 291   if Result = nil then raise Exception.Create('SakuraScriptParser property is nil');
 292 end;
 293
 294 procedure TSakuraScriptFountainParser.TagProc;
 295 var i, Le: integer;
 296     IsErr: boolean;
 297     Pat: String;
 298 begin
 299   Inc(FP);
 300   if (FP^ in [#0, #13, #10]) then
 301   begin
 302     FToken := toTagError;
 303     Exit;
 304   end else if (FP^ = '\') or (FP^ = '%') then // '\\', '\%'\8c`\8e®\82Ì\83G\83X\83P\81[\83v
 305   begin
 306     Inc(FP);
 307     SymbolProc;
 308   end else
 309   begin
 310     for i := 0 to SsParser.TagPattern.Count-1 do
 311     begin
 312       Pat := SsParser.TagPattern[i];
 313       if Length(Pat) < 2 then Continue;
 314       IsErr := Pat[1] = '!';
 315       Le := SsParser.MatchP(FP, @Pat[2]);
 316       if Le > 0 then
 317       begin
 318         Inc(FP, Le);
 319         if IsErr then
 320           FToken := toTagError
 321         else
 322           FToken := toTag;
 323         Exit; // \82ß\82Å\82½\82\83p\83^\81[\83\93\83}\83b\83`\90¬\8c÷\82Ì\8fê\8d\87
 324       end;
 325     end;
 326     // \88È\89º\82Í\83p\83^\81[\83\93\8eæ\93¾\8e¸\94s\82Ì\8fê\8d\87
 327     FToken := toTagError;
 328     if FP^ in LeadBytes then
 329       Inc(FP, 2)
 330     else
 331       Inc(FP);
 332   end;
 333 end;
 334
 335 function TSakuraScriptFountainParser.TokenToFountainColor: TFountainColor;
 336 begin
 337   with TSakuraScriptFountain(FFountain) do
 338     case FToken of
 339       toScope0:
 340         Result := FScope0Color;
 341       toScope1:
 342         Result := FScope1Color;
 343       toTag:
 344         Result := FTagColor;
 345       toTagError:
 346         Result := FTagErrorColor;
 347       toMetaWord:
 348         Result := FMetaWordColor;
 349       toSynchronized:
 350         Result := FSynchronizedColor;
 351     else
 352         Result := nil;
 353     end;
 354 end;
 355
 356 procedure Register;
 357 begin
 358   RegisterComponents('TEditor', [TSakuraScriptFountain]);
 359 end;
 360
 361 end.