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}
21 interface
23 uses
29 type
33 public
36 public
52 public
65 private
74 private
76 // "text-color#inactive@label"
79 public
85 public
91 private
95 private
102 public
110 public
119 // will return "default" (or raise an exception if there is no "default")
123 implementation
125 uses
126 fui_wadread;
129 var
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 }
151 var
153 begin
155 begin
160 {
161 stl := createDefaultStyle();
162 SetLength(styles, Length(styles)+1);
163 styles[High(styles)] := stl;
164 result := stl;
165 }
170 var
172 begin
175 try
177 finally
184 var
188 begin
190 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
192 try
194 begin
197 //writeln('new style: <', stl.mId, '>');
199 while (f < Length(styles)) do begin if (strEquCI1251(styles[f].mId, stl.mId)) then break; Inc(f); end;
201 begin
203 end
204 else
205 begin
212 finally
216 // we should have "default" style
219 {
220 stl := createDefaultStyle();
221 SetLength(styles, Length(styles)+1);
222 styles[High(styles)] := stl;
223 }
227 // ////////////////////////////////////////////////////////////////////////// //
230 begin
238 constructor TStyleValue.Create (const v: AnsiString); begin vtype := TType.Str; sval := Pointer(v); end;
241 begin
250 begin
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;
266 begin
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]);
277 // ////////////////////////////////////////////////////////////////////////// //
282 var
284 begin
291 // split
293 begin
294 // has ctl, and (possible) hash
296 begin
297 // has ctl and hash
299 begin
300 // @ctl#hash
306 end
307 else
308 begin
309 // #hash@ctl
316 end
317 else
318 begin
319 // has only ctl
324 end
326 begin
327 // has hash
331 end
332 else
333 begin
334 // only name
341 // ////////////////////////////////////////////////////////////////////////// //
343 begin
355 begin
368 begin
375 var
380 begin
384 // try control
387 begin
389 begin
390 // has ctl section?
394 // has hash?
396 begin
398 begin
402 // try name, go up with inheritance
404 begin
406 begin
409 // go up
411 begin
413 // for hash section: try parent section first
415 begin
416 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash up');{$ENDIF}
419 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' hash up: trying <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
421 begin
424 // move another parent up
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}
436 // here, we should have non-hash section
438 // if we want hash, try to find it, otherwise do nothing
440 begin
441 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' search for <#', hash, '@', ctl, '> at <#', sect.mHashName, '@', sect.mCtlName, '>: hash down');{$ENDIF}
443 begin
445 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
448 end
449 else
450 begin
451 // inheritance
455 // parse inherit string
458 // find section
460 begin
461 // ctl
463 else if (strEquCI1251(ctl, '$up$')) then begin if (Length(sect.mHashName) <> 0) then sect := sect.mParent.mParent else sect := sect.mParent; end
467 begin
470 end
471 else
472 begin
473 // hash
475 // dummy loop, so i can use `break`
476 repeat
477 // get out of hash section
479 begin
480 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln('hash-jump-up: <#', sect.mHashName, '@', sect.mCtlName, '>');{$ENDIF}
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}
487 begin
489 begin
490 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found in parent: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
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}
500 begin
501 {$IFDEF UI_STYLE_DEBUG_SEARCH}writeln(' found: <#', sect.mHashName, '@', sect.mCtlName, '> for <#', hash, '>');{$ENDIF}
503 end
504 else
505 begin
506 // reuse current parent, but don't follow inheritance for it
515 // alas
520 // "text-color#inactive@label"
522 var
524 begin
527 //writeln('name:<', name, '>; hash:<', hash, '>; ctl:<', ctl, '>');
532 // ////////////////////////////////////////////////////////////////////////// //
534 begin
541 var
543 begin
547 par := TFileTextParser.Create(st, false, [par.TOption.SignedNumbers, par.TOption.DollarIsId, par.TOption.DashIsId, par.TOption.HtmlColors]);
548 try
550 finally
557 var
559 begin
561 try
563 finally
570 begin
577 begin
584 begin
589 begin
596 begin
604 var
610 begin
613 begin
616 begin
621 begin
630 begin
636 begin
641 begin
643 // ctl
645 begin
650 begin
651 // create new section
658 end
659 else
660 begin
668 continue;
670 // hash
672 begin
677 begin
678 // create new section
685 end
686 else
687 begin
695 continue;
697 // name
701 begin
702 // color
709 begin
711 end
712 else
713 begin
717 end
719 begin
720 // html color
722 //writeln('<', par.tokStr, '>; {', par.curChar, '}');
725 begin
726 // #rgb
730 end
731 else
732 begin
733 // #rrggbb
739 //writeln(' r=', v.r, '; g=', v.g, '; b=', v.b);
741 end
743 begin
746 end
748 begin
751 end
753 begin
754 // string value
757 end
759 begin
761 end
762 else
763 begin
764 // should be int
774 begin
775 // style name
777 begin
779 end
780 else
781 begin