unit rpLineControl;

interface

uses
  Dialogs,
  Controls,
  SysUtils,
  Graphics,
  SimpleLine,
  classes;

type
  // цвет
  PrpLineControl_Color_Rec =^TrpLineControl_Color_Rec;
  TrpLineControl_Color_Rec = record
    Color: TColor;
    Name: string;
  end;

  // ссылка на запись в репозитории
  PrpLineControl_LineRef_Rec =^TrpLineControl_LineRef_Rec;
  TrpLineControl_LineRef_Rec = record
    objSimpleLine: TSimpleLine;
    Color: TColor;
  end;

  // класс одного режима
  TrpLineControl_Mode = class
  public
    Filters: TStringList;
    TagName: string;
    TagIndex: integer;
    SetValue: integer;
    CurValue: integer;
    Enabled: Boolean;

    LineCount: integer;
    Lines: array of PrpLineControl_LineRef_Rec;

    constructor Create;
    procedure AddLineRef(obj: TSimpleLine); //FromRepository;
    destructor Destroy; override;
  end;

  // Главный класс TrpLineControl
  TrpLineControl = class
  private
    DefaultColor: TColor;
    CurrentColor: TColor;
    ColorCount: integer;
    Colors: array of PrpLineControl_Color_Rec;
    procedure ScanSimpleLines(ctrl: TWinControl);
  public
    ModeCount: integer;
    Modes: array of TrpLineControl_Mode;
    CurMode: TrpLineControl_Mode;

    constructor Create;
    procedure SetCurColor(ColorName: string);

    procedure AddColor(Name: string; Color: TColor);
    procedure AddMode(TagName: string; SetValue: integer);
    procedure AddFilter(s: string);

    procedure AddLineRefs;//FromRepository;
    destructor Destroy; override;
  end;




  procedure rpLineControlInit;
  procedure rpLineControlStart;
  procedure rpLineControlProcess;
  procedure rpLineControlDestroy;


implementation
uses
  main,
  RpVisualGlobal,
  TagStorage,
  globals,
  numbers;

var
  lnct: TrpLineControl;



////////////////////////////////////////////////////////////////////////////////
{ TrpLineControl_Mode }
////////////////////////////////////////////////////////////////////////////////

constructor TrpLineControl_Mode.Create;
begin
  Filters := TStringList.Create;
end;

destructor TrpLineControl_Mode.Destroy;
begin
  Filters.Free;
  inherited;
end;

procedure TrpLineControl_Mode.AddLineRef(obj: TSimpleLine);
var
  i: Integer;
begin
  for i:=0 to Filters.Count-1 do
    if CheckFilter(obj.Hint, Filters[i]) then begin
      SetLength(Lines, LineCount+1);
      new(Lines[LineCount]);
      Lines[LineCount].objSimpleLine := obj;
      Lines[LineCount].Color := TColor(Filters.Objects[i]);
      inc(LineCount);
    end;
end;



////////////////////////////////////////////////////////////////////////////////
{ TrpLineControl }
////////////////////////////////////////////////////////////////////////////////

procedure TrpLineControl.AddColor(Name: string; Color: TColor);
begin
  Name := uppercase(Name);

  if Name='DEFAULT' then begin
    lnct.DefaultColor := Color;
    exit;
  end;

  SetLength(Colors, ColorCount+1);
  new(Colors[ColorCount]);
  Colors[ColorCount].Color := Color;
  Colors[ColorCount].Name := Name;

  inc(ColorCount);
end;



procedure TrpLineControl.AddFilter(s: string);
begin
  if ModeCount=0 then exit;
  Modes[ModeCount-1].Filters.AddObject(s, pointer(CurrentColor));

end;



procedure TrpLineControl.AddMode(TagName: string; SetValue: integer);
begin
  SetLength(Modes, ModeCount+1);
  Modes[ModeCount] := TrpLineControl_Mode.Create;
  Modes[ModeCount].TagName := TagName;
  Modes[ModeCount].SetValue := SetValue;
  inc(ModeCount);
end;



constructor TrpLineControl.Create;
begin
  inherited;
  DefaultColor := $FFFFFF;
  CurrentColor := DefaultColor;
end;



destructor TrpLineControl.Destroy;
var
  i: integer;
begin
  for i:=0 to ColorCount-1 do
    dispose(Colors[i]);
  Colors:=nil;
  ColorCount:=0;

  for i:=0 to ModeCount-1 do
    Modes[i].Free;
  Modes:=nil;
  ModeCount:=0;

  inherited;
end;



procedure TrpLineControl.SetCurColor(ColorName: string);
var
  i: integer;
begin
  ColorName := uppercase(ColorName);
  for i:=0 to ColorCount-1 do
    if Colors[i].Name = ColorName then begin
      CurrentColor := Colors[i].Color;
      exit;
    end;

end;



procedure TrpLineControl.ScanSimpleLines(ctrl: TWinControl);
var
  i,j,k: integer;
  s: string;
begin
  with ctrl do begin
    for i:=0 to ComponentCount-1 do begin
      s:=Components[i].Name + ' ' + Components[i].ClassName + '#13#10';
      if Components[i] is TSimpleLine then
        for j:=0 to ModeCount-1 do
          Modes[j].AddLineRef( Components[i] as TSimpleLine );
    end;

    for i:=0 to ControlCount-1 do
      if Controls[i] is TWinControl then begin
        ScanSimpleLines(Controls[i] as TWinControl);
      end;
  end;

end;


procedure TrpLineControl.AddLineRefs;//FromRepository;
var
  i: Integer;
begin
  ScanSimpleLines(Form1);

end;


////////////////////////////////////////////////////////////////////////////////
// Инициализация
procedure rpLineControlInit;

  procedure _parse(s: string; var s1: string; var s2: string);
  var
    k: integer;
  begin
    delete(s,1,1);
    s := trim(s);
    k := pos('=', s);
    s1 := trim(copy(s, 1, k-1));
    s2 := trim(copy(s, k+1, length(s)-k));
  end;

var
  F: TextFile;
  k, i: integer;
  s,s1,s2: string;
begin
  rpLineControlDestroy;

  lnct := TrpLineControl.Create;

  if not FileExists(CurDir + 'rpvisual.lin') then Exit;

  AssignFile(F, CurDir + 'rpvisual.lin');
  try
    Reset(F);
    while not eof(F) do begin
      readln(F, s);
      s := trim(s);
      if length(s)=0 then continue;

      // коммент
      if s[1]='#' then continue;


      // определение цвета
      if s[1]='%' then begin
        _parse(s, s1, s2);
        lnct.AddColor( s1, HexDecI(s2) );
        continue;
      end;


      // установка цвета
      if s[1]=':' then begin
        delete(s,1,1);
        lnct.SetCurColor(trim(s));
        continue;
      end;


      // режим
      if s[1]='~' then begin
        _parse(s, s1, s2);
        val(s2, k, i);
        lnct.AddMode( s1, k );
        continue;
      end;


      // фильтр
      begin
        lnct.AddFilter(s);
        continue;
      end;

    end;
  except
  end;

  try
    CloseFile(F);
  except
  end;

  lnct.AddLineRefs;//FromRepository;

end;

////////////////////////////////////////////////////////////////////////////////
// Завершение работы
procedure rpLineControlDestroy;
begin
  if lnct = nil then exit;
  lnct.Free;
  lnct := nil;
end;

////////////////////////////////////////////////////////////////////////////////
// Инициализация индексов тегов
procedure rpLineControlStart;
var
  i: Integer;
begin
  if lnct = nil then exit;
  for i:=0 to lnct.ModeCount-1 do begin
    lnct.Modes[i].TagIndex := GetTagIndex(lnct.Modes[i].TagName);
    lnct.Modes[i].CurValue := -1;
  end;

end;

////////////////////////////////////////////////////////////////////////////////
// Обработка
procedure rpLineControlProcess;
var
  i,j,v: Integer;
  HasChanges: Boolean;
begin
  if not rvgLogIn then Exit;
  if lnct = nil then exit;

  HasChanges := False;
  for i:=0 to lnct.ModeCount-1 do
    with lnct.Modes[i] do begin
      v := GetTagValue(TagIndex);
      if v<>CurValue then begin
        CurValue := v;
        Enabled := SetValue = CurValue;
        HasChanges := true;
      end;
    end;

  if not HasChanges then Exit;

  for i:=0 to lnct.ModeCount-1 do
    if lnct.Modes[i].Enabled then begin
      for j:=0 to lnct.Modes[i].LineCount-1 do
        lnct.Modes[i].Lines[j].objSimpleLine.LineColor := lnct.Modes[i].Lines[j].Color;
    end else begin
      for j:=0 to lnct.Modes[i].LineCount-1 do
        lnct.Modes[i].Lines[j].objSimpleLine.LineColor := lnct.DefaultColor;
    end;

  form1.PageControl.Repaint;  

end;




end.
