src/flexui/fui_style.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, version 3 of the License ONLY.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 {.$DEFINE UI_STYLE_DEBUG_SEARCH}
  18 unit fui_style;
  19
  20 interface
  21
  22 uses
  23   SysUtils, Classes,
  24   fui_common, // for TGxRGBA
  25   xstreams, xparser, utils, hashtable;
  26
  27
  28 type
  29   TStyleSection = class;
  30
  31   TStyleValue = packed record
  32   public
  33     type TType = (Empty, Bool, Int, Color, Str);
  34
  35   public
  36     constructor Create (v: Boolean);
  37     constructor Create (v: Integer);
  38     constructor Create (ar, ag, ab: Integer; aa: Integer=255);
  39     constructor Create (const v: TGxRGBA);
  40     constructor Create (const v: AnsiString);
  41
  42     function isEmpty (): Boolean; inline;
  43
  44     function toString (): AnsiString;
  45     function asRGBA: TGxRGBA; inline;
  46     function asRGBADef (const def: TGxRGBA): TGxRGBA; inline;
  47     function asInt (const def: Integer=0): Integer; inline;
  48     function asBool (const def: Boolean=false): Boolean; inline;
  49     function asStr (const def: AnsiString=''): AnsiString; inline;
  50
  51   public
  52     vtype: TType;
  53     case TType of
  54       TType.Bool: (bval: Boolean);
  55       TType.Int: (ival: Integer);
  56       TType.Color: (r, g, b, a: Byte);
  57       TType.Str: (sval: Pointer); // AnsiString
  58   end;
  59
  60   THashStrStyleVal = specialize THashBase<AnsiString, TStyleValue, THashKeyStrAnsiCI>;
  61   THashStrSection = specialize THashBase<AnsiString, TStyleSection, THashKeyStrAnsiCI>;
  62
  63   TStyleSection = class
  64   private
  65     mParent: TStyleSection; // for inheritance
  66     mInherits: AnsiString;
  67     mHashName: AnsiString; // for this section
  68     mCtlName: AnsiString; // for this section
  69     mVals: THashStrStyleVal;
  70     mHashes: THashStrSection;
  71     mCtls: THashStrSection;
  72
  73   private
  74     function getTopLevel (): TStyleSection; inline;
  75     // "text-color#inactive@label"
  76     function getValue (const path: AnsiString): TStyleValue;
  77
  78   public
  79     constructor Create ();
  80     destructor Destroy (); override;
  81
  82     function get (name, hash, ctl: AnsiString): TStyleValue;
  83
  84   public
  85     property value[const path: AnsiString]: TStyleValue read getValue; default;
  86     property topLevel: TStyleSection read getTopLevel;
  87   end;
  88
  89   TUIStyle = class
  90   private
  91     mId: AnsiString; // style name ('default', for example)
  92     mMain: TStyleSection;
  93
  94   private
  95     procedure createMain ();
  96
  97     procedure parse (par: TTextParser);
  98
  99     function getValue (const path: AnsiString): TStyleValue; inline;
 100
 101   public
 102     constructor Create (const aid: AnsiString);
 103     constructor Create (st: TStream); // parse from stream
 104     constructor CreateFromFile (const fname: AnsiString);
 105     destructor Destroy (); override;
 106
 107     function get (name, hash, ctl: AnsiString): TStyleValue;
 108
 109   public
 110     property id: AnsiString read mId;
 111     property value[const path: AnsiString]: TStyleValue read getValue; default;
 112   end;
 113
 114
 115 procedure uiLoadStyles (const fname: AnsiString);
 116 procedure uiLoadStyles (st: TStream);
 117
 118 // will return "default" (or raise an exception if there is no "default")
 119 function uiFindStyle (const stname: AnsiString): TUIStyle;
 120
 121
 122 implementation
 123
 124 uses
 125   fui_wadread;
 126
 127
 128 var
 129   styles: array of TUIStyle;
 130
 131
 132 procedure FreeStyles();
 133 var
 134   stl: TUIStyle;
 135 begin
 136   for stl in styles do
 137     stl.Destroy();
 138   styles := nil;
 139 end;
 140
 141 {
 142 function createDefaultStyle (): TUIStyle;
 143 var
 144   st: TStream;
 145 begin
 146   result := nil;
 147   st := TStringStream.Create(defaultStyleStr);
 148   st.position := 0;
 149   try
 150     result := TUIStyle.Create(st);
 151   finally
 152     FreeAndNil(st);
 153   end;
 154 end;
 155 }
 156
 157
 158 function uiFindStyle (const stname: AnsiString): TUIStyle;
 159 var
 160   stl: TUIStyle;
 161 begin
 162   if (Length(stname) > 0) then
 163   begin
 164     for stl in styles do if (strEquCI1251(stl.mId, stname)) then begin result := stl; exit; end;
 165   end;
 166   for stl in styles do if (strEquCI1251(stl.mId, 'default')) then begin result := stl; exit; end;
 167   raise Exception.Create('FlexUI FATAL: no "default" style in stylesheet');
 168   {
 169   stl := createDefaultStyle();
 170   SetLength(styles, Length(styles)+1);
 171   styles[High(styles)] := stl;
 172   result := stl;
 173   }
 174 end;
 175
 176
 177 procedure uiLoadStyles (const fname: AnsiString);
 178 var
 179   st: TStream;
 180 begin
 181   st := fuiOpenFile(fname);
 182   if (st = nil) then raise Exception.Create('FlexUI file '''+fname+''' not found!');
 183   try
 184     uiLoadStyles(st);
 185   finally
 186     st.Free();
 187   end;
 188 end;
 189
 190
 191 procedure uiLoadStyles (st: TStream);
 192 var
 193   par: TTextParser;
 194   stl: TUIStyle = nil;
 195   f: Integer;
 196 begin
 197   if (st = nil) then raise Exception.Create('cannot load UI styles from nil stream');
 198   par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
 199   FreeStyles();
 200   try
 201     while (not par.isEOF) do
 202     begin
 203       stl := TUIStyle.Create('');
 204       stl.parse(par);
 205       //writeln('new style: <', stl.mId, '>');
 206       f := 0;
 207       while (f < Length(styles)) do
 208       begin
 209         if (strEquCI1251(styles[f].mId, stl.mId)) then
 210           break;
 211         f += 1;
 212       end;
 213       if (f < Length(styles)) then
 214       begin
 215         FreeAndNil(styles[f]);
 216       end
 217       else
 218       begin
 219         f := Length(styles);
 220         SetLength(styles, f+1);
 221       end;
 222       styles[f] := stl;
 223       stl := nil;
 224     end;
 225   finally
 226     stl.Free();
 227     par.Free();
 228   end;
 229   // we should have "default" style
 230   for f := 0 to High(styles) do if (strEquCI1251(styles[f].mId, 'default')) then exit;
 231   raise Exception.Create('FlexUI FATAL: no "default" style in stylesheet');
 232   {
 233   stl := createDefaultStyle();
 234   SetLength(styles, Length(styles)+1);
 235   styles[High(styles)] := stl;
 236   }
 237 end;
 238
 239
 240 // ////////////////////////////////////////////////////////////////////////// //
 241 procedure freeValueCB (var v: TStyleValue); begin
 242   if (v.vtype = v.TType.Str) then
 243   begin
 244     AnsiString(v.sval) := '';
 245   end;
 246   v.vtype := v.TType.Empty;
 247 end;
 248
 249 constructor TStyleValue.Create (v: Boolean); begin vtype := TType.Bool; bval := v; end;
 250 constructor TStyleValue.Create (v: Integer); begin vtype := TType.Int; ival := v; end;
 251 constructor TStyleValue.Create (const v: AnsiString); begin vtype := TType.Str; sval := Pointer(v); end;
 252
 253 constructor TStyleValue.Create (ar, ag, ab: Integer; aa: Integer=255);
 254 begin
 255   vtype := TType.Color;
 256   r := nmax(0, nmin(ar, 255));
 257   g := nmax(0, nmin(ag, 255));
 258   b := nmax(0, nmin(ab, 255));
 259   a := nmax(0, nmin(aa, 255));
 260 end;
 261
 262 constructor TStyleValue.Create (const v: TGxRGBA);
 263 begin
 264   vtype := TType.Color;
 265   r := v.r;
 266   g := v.g;
 267   b := v.b;
 268   a := v.a;
 269 end;
 270
 271 function TStyleValue.isEmpty (): Boolean; inline; begin result := (vtype = TType.Empty); end;
 272 function TStyleValue.asRGBA: TGxRGBA; inline; begin if (vtype = TType.Color) then result := TGxRGBA.Create(r, g, b, a) else result := TGxRGBA.Create(0, 0, 0, 0); end;
 273 function TStyleValue.asRGBADef (const def: TGxRGBA): TGxRGBA; inline; begin if (vtype = TType.Color) then result := TGxRGBA.Create(r, g, b, a) else result := def; end;
 274 function TStyleValue.asInt (const def: Integer=0): Integer; inline; begin if (vtype = TType.Int) then result := ival else if (vtype = TType.Bool) then begin if (bval) then result := 1 else result := 0; end else result := def; end;
 275 function TStyleValue.asBool (const def: Boolean=false): Boolean; inline; begin if (vtype = TType.Bool) then result := bval else if (vtype = TType.Int) then result := (ival <> 0) else result := def; end;
 276 function TStyleValue.asStr (const def: AnsiString=''): AnsiString; inline; begin if (vtype = TType.Str) then result := AnsiString(sval) else result := def; end;
 277
 278 function TStyleValue.toString (): AnsiString;
 279 begin
 280   case vtype of
 281     TType.Empty: result := '<empty>';
 282     TType.Bool: if bval then result := 'true' else result := 'false';
 283     TType.Int: result := formatstrf('%s', [ival]);
 284     TType.Color: if (a = 255) then result := formatstrf('rgb(%s,%s,%s)', [r, g, b]) else result := formatstrf('rgba(%s,%s,%s)', [r, g, b, a]);
 285     else result := '<invalid>';
 286   end;
 287 end;
 288
 289
 290 // ////////////////////////////////////////////////////////////////////////// //
 291 procedure freeSectionCB (var v: TStyleSection);
 292 begin
 293   FreeAndNil(v);
 294 end;
 295
 296
 297 function splitPath (const path: AnsiString; out name, hash, ctl: AnsiString): Boolean;
 298 var
 299   hashPos, atPos: Integer;
 300 begin
 301   result := false;
 302   name := '';
 303   hash := '';
 304   ctl := '';
 305   hashPos := pos('#', path);
 306   atPos := pos('@', path);
 307   // split
 308   if (atPos > 0) then
 309   begin
 310     // has ctl, and (possible) hash
 311     if (hashPos > 0) then
 312     begin
 313       // has ctl and hash
 314       if (atPos < hashPos) then
 315       begin
 316         // @ctl#hash
 317         if (atPos > 1) then name := Copy(path, 1, atPos-1);
 318         Inc(atPos); // skip "at"
 319         if (atPos < hashPos) then ctl := Copy(path, atPos, hashPos-atPos);
 320         Inc(hashPos); // skip hash
 321         if (hashPos <= Length(path)) then hash := Copy(path, hashPos, Length(path)-hashPos+1);
 322       end
 323       else
 324       begin
 325         // #hash@ctl
 326         if (hashPos > 1) then name := Copy(path, 1, hashPos-1);
 327         Inc(hashPos); // skip hash
 328         if (hashPos < atPos) then hash := Copy(path, hashPos, atPos-hashPos);
 329         Inc(atPos); // skip "at"
 330         if (atPos <= Length(path)) then ctl := Copy(path, atPos, Length(path)-atPos+1);
 331       end;
 332     end
 333     else
 334     begin
 335       // has only ctl
 336       if (atPos > 1) then name := Copy(path, 1, atPos-1);
 337       Inc(atPos); // skip "at"
 338       if (atPos <= Length(path)) then ctl := Copy(path, atPos, Length(path)-atPos+1);
 339     end;
 340   end
 341   else if (hashPos > 0) then
 342   begin
 343     // has hash
 344     if (hashPos > 1) then name := Copy(path, 1, hashPos-1);
 345     Inc(hashPos); // skip hash
 346     if (hashPos <= Length(path)) then hash := Copy(path, hashPos, Length(path)-hashPos+1);
 347   end
 348   else
 349   begin
 350     // only name
 351     name := path;
 352   end;
 353   result := true;
 354 end;
 355
 356
 357 // ////////////////////////////////////////////////////////////////////////// //
 358 constructor TStyleSection.Create ();
 359 begin
 360   mVals := THashStrStyleVal.Create(freeValueCB);
 361   mHashes := THashStrSection.Create(freeSectionCB);
 362   mCtls := THashStrSection.Create(freeSectionCB);
 363 end;
 364
 365
 366 destructor TStyleSection.Destroy ();
 367 begin
 368   mVals.Destroy();
 369   mHashes.Destroy();
 370   mCtls.Destroy();
 371   inherited;
 372 end;
 373
 374
 375 function TStyleSection.getTopLevel (): TStyleSection; inline;
 376 begin
 377   Result := Self;
 378   while Result.mParent <> nil do
 379     Result := Result.mParent;
 380 end;
 381
 382
 383 function TStyleSection.get (name, hash, ctl: AnsiString): TStyleValue;
 384 var
 385   tmp: AnsiString;
 386   sect, s1, so: TStyleSection;
 387   jumpsLeft: Integer = 32; // max inheritance level
 388   skipInherits: Boolean = false;
 389 begin
 390   result.vtype := result.TType.Empty;
 391   if (Length(name) = 0) then exit; // alas
 392   {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('***GET: <', name, '#', hash, '@', ctl, '>');{$ENDIF}
 393   // try control
 394   sect := self;
 395   if (Length(ctl) > 0) then
 396   begin
 397     if (not strEquCI1251(ctl, mCtlName)) then
 398     begin
 399       // has ctl section?
 400       if (not topLevel.mCtls.get(ctl, sect)) then sect := topLevel;
 401     end;
 402   end;
 403   // has hash?
 404   if (Length(hash) > 0) then
 405   begin
 406     if (not strEquCI1251(hash, sect.mHashName)) then
 407     begin
 408       if (sect.mHashes.get(hash, s1)) then sect := s1;
 409     end;
 410   end;
 411   // try name, go up with inheritance
 412   while (jumpsLeft > 0) do
 413   begin
 414     if (sect.mVals.get(name, result)) then
 415     begin
 416       if (not result.isEmpty) then exit; // i found her!
 417     end;
 418     // go up
 419     if (skipInherits) or (Length(sect.mInherits) = 0) then
 420     begin
 421       skipInherits := false;
 422       // for hash section: try parent section first
 423       if (Length(sect.mHashName) > 0) then
 424       begin
 425         {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash up');{$ENDIF}
 426         sect := sect.mParent;
 427         if (sect = nil) then break; // alas
 428         {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: trying <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
 429         if (sect.mVals.get(name, result)) then
 430         begin
 431           if (not result.isEmpty) then exit; // i found her!
 432         end;
 433         // move another parent up
 434         sect := sect.mParent;
 435         if (sect = nil) then break; // alas
 436         {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: jumped up twice to <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
 437       end
 438       else
 439       begin
 440         // one parent up
 441         {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: jump up');{$ENDIF}
 442         sect := sect.mParent;
 443         if (sect = nil) then break; // alas
 444       end;
 445       // here, we should have non-hash section
 446       assert(Length(sect.mHashName) = 0);
 447       // if we want hash, try to find it, otherwise do nothing
 448       if (Length(hash) > 0) then
 449       begin
 450         {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash down');{$ENDIF}
 451         if (sect.mHashes.get(hash, s1)) then
 452         begin
 453           sect := s1;
 454           {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('  found <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
 455         end;
 456       end;
 457     end
 458     else
 459     begin
 460       // inheritance
 461       Dec(jumpsLeft);
 462       if (jumpsLeft < 1) then break; // alas
 463       {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('inherits: <', sect.mInherits, '>');{$ENDIF}
 464       // parse inherit string
 465       if (not splitPath(sect.mInherits, tmp, hash, ctl)) then exit; // alas
 466       {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('inherits: <', hash, '>:<', ctl, '>');{$ENDIF}
 467       // find section
 468       if (Length(ctl) > 0) then
 469       begin
 470         // ctl
 471              if (strEquCI1251(ctl, '$main$')) then sect := topLevel
 472         else if (strEquCI1251(ctl, '$up$')) then begin if (Length(sect.mHashName) <> 0) then sect := sect.mParent.mParent else sect := sect.mParent; end
 473         else if (not topLevel.mCtls.get(ctl, sect)) then sect := topLevel;
 474         if (sect = nil) then break; // alas
 475         if (Length(hash) > 0) then
 476         begin
 477           if (sect.mHashes.get(hash, s1)) then sect := s1;
 478         end;
 479       end
 480       else
 481       begin
 482         // hash
 483         assert(Length(hash) > 0);
 484         // dummy loop, so i can use `break`
 485         repeat
 486           // get out of hash section
 487           if (Length(sect.mHashName) > 0) then
 488           begin
 489             {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('hash-jump-up: <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
 490             sect := sect.mParent;
 491             if (sect = nil) then break; // alas
 492             // check for hash section in parent; use parent if there is no such hash section
 493             {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
 494             so := sect;
 495             if (sect.mHashes.get(hash, s1)) then
 496             begin
 497               if (s1 <> sect) and (s1 <> so) then
 498               begin
 499                 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('  found in parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
 500                 sect := s1;
 501               end;
 502             end;
 503           end
 504           else
 505           begin
 506             // we're in parent, try to find hash section
 507             {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' checking: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
 508             if (sect.mHashes.get(hash, s1)) then
 509             begin
 510               {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('  found: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
 511               sect := s1;
 512             end
 513             else
 514             begin
 515               // reuse current parent, but don't follow inheritance for it
 516               skipInherits := true;
 517             end;
 518           end;
 519         until true;
 520         if (sect = nil) then break;
 521       end;
 522     end;
 523   end;
 524   // alas
 525   result.vtype := result.TType.Empty;
 526 end;
 527
 528
 529 // "text-color#inactive@label"
 530 function TStyleSection.getValue (const path: AnsiString): TStyleValue;
 531 var
 532   name, hash, ctl: AnsiString;
 533 begin
 534   result.vtype := result.TType.Empty;
 535   if (not splitPath(path, name, hash, ctl)) then exit; // alas
 536   //writeln('name:<', name, '>; hash:<', hash, '>; ctl:<', ctl, '>');
 537   result := get(name, hash, ctl);
 538 end;
 539
 540
 541 // ////////////////////////////////////////////////////////////////////////// //
 542 constructor TUIStyle.Create (const aid: AnsiString);
 543 begin
 544   mId := aid;
 545   createMain();
 546 end;
 547
 548
 549 constructor TUIStyle.Create (st: TStream); // parse from stream
 550 var
 551   par: TTextParser;
 552 begin
 553   mId := '';
 554   createMain();
 555   if (st = nil) then exit;
 556   par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
 557   try
 558     parse(par);
 559   finally
 560     par.Free();
 561   end;
 562 end;
 563
 564
 565 constructor TUIStyle.CreateFromFile (const fname: AnsiString);
 566 var
 567   st: TStream;
 568 begin
 569   st := openDiskFileRO(fname);
 570   try
 571     Create(st);
 572   finally
 573     st.Free();
 574   end;
 575 end;
 576
 577
 578 destructor TUIStyle.Destroy ();
 579 begin
 580   mId := '';
 581   mMain.Free();
 582   inherited;
 583 end;
 584
 585
 586 procedure TUIStyle.createMain ();
 587 begin
 588   mMain := TStyleSection.Create();
 589   mMain.mCtlName := '$main$';
 590 end;
 591
 592
 593 function TUIStyle.getValue (const path: AnsiString): TStyleValue; inline;
 594 begin
 595   result := mMain[path];
 596 end;
 597
 598 function TUIStyle.get (name, hash, ctl: AnsiString): TStyleValue;
 599 begin
 600   result := mMain.get(name, hash, ctl);
 601 end;
 602
 603
 604 procedure TUIStyle.parse (par: TTextParser);
 605   function getByte (): Byte;
 606   begin
 607     if (par.tokType <> par.TTInt) then par.expectInt();
 608     if (par.tokInt < 0) or (par.tokInt > 255) then par.error('invalid byte value');
 609     result := Byte(par.tokInt);
 610     par.skipToken();
 611   end;
 612
 613   procedure parseSection (sect: TStyleSection; ctlAllowed: Boolean; hashAllowed: Boolean);
 614   var
 615     s, inh: AnsiString;
 616     sc: TStyleSection = nil;
 617     v: TStyleValue;
 618
 619     procedure parseInherit ();
 620     begin
 621       inh := '';
 622       if (par.eatDelim('(')) then
 623       begin
 624         if (par.eatDelim(')')) then par.error('empty inheritance is not allowed');
 625         if (par.eatDelim('#')) then
 626         begin
 627           inh := '#';
 628           inh += par.expectId();
 629         end;
 630         if (par.eatDelim('@')) then
 631         begin
 632           inh += '#';
 633           inh += par.expectId();
 634         end;
 635         par.expectDelim(')');
 636       end;
 637     end;
 638
 639     function nib2c (n: Integer): Byte; inline;
 640     begin
 641            if (n < 0) then result := 0
 642       else if (n > 15) then result := 255
 643       else result := Byte(255*n div 15);
 644     end;
 645
 646   begin
 647     s := '';
 648     inh := '';
 649     par.expectDelim('{');
 650     while (not par.isDelim('}')) do
 651     begin
 652       while (par.eatDelim(';')) do begin end;
 653       // ctl
 654       if ctlAllowed and (par.eatDelim('@')) then
 655       begin
 656         s := par.expectId();
 657         parseInherit();
 658         par.eatDelim(':'); // optional
 659         if (not sect.mCtls.get(s, sc)) then
 660         begin
 661           // create new section
 662           sc := TStyleSection.Create();
 663           sc.mParent := sect;
 664           sc.mInherits := inh;
 665           sc.mHashName := '';
 666           sc.mCtlName := s;
 667           sect.mCtls.put(s, sc);
 668         end
 669         else
 670         begin
 671           assert(sc.mParent = sect);
 672           assert(sc.mHashName = '');
 673           assert(sc.mCtlName = s);
 674           if (Length(sc.mInherits) <> 0) and (Length(inh) <> 0) then par.error('double inheritance');
 675           sc.mInherits := inh;
 676         end;
 677         if (not par.eatDelim(';')) then parseSection(sc, false, true);
 678         continue;
 679       end;
 680       // hash
 681       if hashAllowed and (par.eatDelim('#')) then
 682       begin
 683         s := par.expectId();
 684         parseInherit();
 685         par.eatDelim(':'); // optional
 686         if (not sect.mHashes.get(s, sc)) then
 687         begin
 688           // create new section
 689           sc := TStyleSection.Create();
 690           sc.mParent := sect;
 691           sc.mInherits := inh;
 692           sc.mHashName := s;
 693           sc.mCtlName := '';
 694           sect.mHashes.put(s, sc);
 695         end
 696         else
 697         begin
 698           assert(sc.mParent = sect);
 699           assert(sc.mHashName = s);
 700           assert(sc.mCtlName = '');
 701           if (Length(sc.mInherits) <> 0) and (Length(inh) <> 0) then par.error('double inheritance');
 702           sc.mInherits := inh;
 703         end;
 704         if (not par.eatDelim(';')) then parseSection(sc, false, false);
 705         continue;
 706       end;
 707       // name
 708       s := par.expectId();
 709       par.expectDelim(':');
 710       if (par.eatId('rgb')) or (par.eatId('rgba')) then
 711       begin
 712         // color
 713         par.expectDelim('(');
 714         v.vtype := v.TType.Color;
 715         v.r := getByte(); par.eatDelim(','); // optional
 716         v.g := getByte(); par.eatDelim(','); // optional
 717         v.b := getByte(); par.eatDelim(','); // optional
 718         if (par.tokType = par.TTInt) then
 719         begin
 720           v.a := getByte(); par.eatDelim(','); // optional
 721         end
 722         else
 723         begin
 724           v.a := 255; // opaque
 725         end;
 726         par.expectDelim(')');
 727       end
 728       else if (par.isId) and (par.tokStr[1] = '#') then
 729       begin
 730         // html color
 731         assert((Length(par.tokStr) = 4) or (Length(par.tokStr) = 7));
 732         //writeln('<', par.tokStr, '>; {', par.curChar, '}');
 733         v.vtype := v.TType.Color;
 734         if (Length(par.tokStr) = 4) then
 735         begin
 736           // #rgb
 737           v.r := nib2c(digitInBase(par.tokStr[2], 16));
 738           v.g := nib2c(digitInBase(par.tokStr[3], 16));
 739           v.b := nib2c(digitInBase(par.tokStr[4], 16));
 740         end
 741         else
 742         begin
 743          // #rrggbb
 744           v.r := Byte(digitInBase(par.tokStr[2], 16)*16+digitInBase(par.tokStr[3], 16));
 745           v.g := Byte(digitInBase(par.tokStr[4], 16)*16+digitInBase(par.tokStr[5], 16));
 746           v.b := Byte(digitInBase(par.tokStr[6], 16)*16+digitInBase(par.tokStr[7], 16));
 747         end;
 748         v.a := 255;
 749         //writeln('  r=', v.r, '; g=', v.g, '; b=', v.b);
 750         par.skipToken();
 751       end
 752       else if (par.eatId('true')) or (par.eatId('yes')) then
 753       begin
 754         v.vtype := v.TType.Bool;
 755         v.bval := true;
 756       end
 757       else if (par.eatId('false')) or (par.eatId('no')) then
 758       begin
 759         v.vtype := v.TType.Bool;
 760         v.bval := false;
 761       end
 762       else if (par.isStr) then
 763       begin
 764         // string value
 765         v := TStyleValue.Create(par.tokStr);
 766         par.skipToken();
 767       end
 768       else if (par.eatId('inherit')) then
 769       begin
 770         v.vtype := v.TType.Empty;
 771       end
 772       else
 773       begin
 774         // should be int
 775         v.vtype := v.TType.Int;
 776         v.ival := par.expectInt();
 777       end;
 778       par.expectDelim(';');
 779       sect.mVals.put(s, v);
 780     end;
 781     par.expectDelim('}');
 782   end;
 783
 784 begin
 785   // style name
 786   if (not par.isIdOrStr) then
 787   begin
 788     if (Length(mId) = 0) then par.error('style name expected');
 789   end
 790   else
 791   begin
 792     mId := par.tokStr;
 793   end;
 794   if (Length(mId) = 0) then mId := 'default';
 795   par.skipToken();
 796   if (not par.eatDelim(';')) then parseSection(mMain, true, true);
 797 end;
 798
 799 finalization
 800   FreeStyles();
 801
 802 end.