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