{
    This file is part of Chentrah,
    Copyright (C) 2004-2008 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************}

{$include mo_globaldefs.h}

unit mo_menu;

interface
uses
  Sysutils, IniFiles, math, typinfo, mo_hub, chepersy, {mo_indexer,} mo_resources
//,threadcrashtest
  ;

procedure RegisterStandardMenuClasses;

procedure SetGlStatesFor2dRender;

const
  GuiDefaultColor: TVector4f = (0.85, 0.85{0.9}, 0.85{0.9}, 1);
  GuiDefaultRedColor: TVector4f = (1, 0.5, 0.3, 1);
  GuiDefaultGrayedColor: TVector4f = (0.5, 0.5, 0.5, 1);//(0.6, 0.4, 0.8, 1);
  GuiDefaultHighlight: TVector4f = (0.5, 1, 1, 1);
  GuiDefaultFontHeight = 18;
  GuiHeadlineFontHeight = 39;
  GuiDefaultTablePadding = 5;
  GuiDefaultCursorBlinkingrate = 1.0;
  GuiDefaultCheckBoxSize = 14;

  function SplitLinesTooLong(w: WideString; limit: integer; prefix: WideString): WideString;

type
  THAlign = (halign_center, halign_left, halign_right, halign_width);
  TVAlign = (valign_center, valign_top, valign_bottom, valign_height);
  TControlParameter = record
    Initial,
    Current: glFloat;
  end;
  TControlColor = record
    Initial,
    Current: TVector4f;
  end;
  TEventSubscriptionMethodType = (
    esmt_simple, //a method with no parameters
    esmt_string  //a method receiving single WideString
  );
  TEventSubscription = record
    Receiver: TManagedObject ;
    Method: AnsiString; //Duh. Methods are Pascal identifiers. There's no need to support Russian characters.
    MethodType: TEventSubscriptionMethodType;
    DefaultString: WideString;
  end;


  { TControl }
  CControl = class of TControl;
  TControl = class (TManagedObject)
  protected
    f_focus: boolean;
    procedure _SetFocus(b: boolean); virtual;
  public
    Upper, Lower: TControl; //neighbors in the chain
    id: WideString;

    constructor Create; virtual;

    procedure RegisterFields; override;
    procedure Cycle; virtual;
    procedure Render; virtual;

    procedure SubscribeEvent(var ES: TEventSubscription; Receiver: TManagedObject;  Method: AnsiString; PassString: WideString = ''; MustReceiveString: boolean = false);
    procedure UnSubscribeEvent(var ES: TEventSubscription);
    function PassEvent(var ES: TEventSubscription; w: WideString = ''): boolean;

 //Your control can intercept messages preventing them
 //  from reaching the bottom of the food chain.
 //  the base method just calls Lower.OnKey()
    function OnKey(Key: TKey): boolean; virtual;
    procedure OnResize; virtual;

 // var because if the target field is nil, the control needs to
 //  write itself in.
    procedure AddOnTop(var c: TControl);
    procedure AddBelow(var c: TControl);
    procedure AddAtBottom(var c: TControl);
    procedure RemoveFromChain;

    destructor Destroy; override;
    property Focus: boolean read f_focus write _SetFocus;
    procedure Scrape; override;
  published
    procedure Kill; virtual; //removes itself from chain and from the module.main menu if needed, then scrapes itself.
  end;
  
  // TModule takes care of calling the OnResize methods for all the controls,

  { TRectControl }
  //your generic rect. For the controls that *do* have a visual representation.
  TRectControl = class(TControl)
  public
    Parent: TRectControl;
      //if nil, aligns to the whole screen.
      //if TTable aligns to a specific cell.
      //else aligns to the parent as a whole

    ParentCellInd: integer;

    HAlign: THAlign;
    VAlign: TValign;
    xOff, yOff, x, y: glFloat;
    Width, Height: TControlParameter;
    Color: TControlColor;
    HighlightColor, NormalColor: TVector4f;
    Invisible, Disabled: boolean;
    HasBorder: boolean;
    constructor Create(_width, _height: float); virtual; overload;
    procedure ChangeSize(_width, _height: float);
    procedure RegisterFields; override;
    procedure OnResize; override;
    function RectShadeThickness: GLfloat; virtual;
    function RectLineThickness: GLfloat; virtual;
    procedure GetChildRect(CellInd: integer; var left, top, g_width, g_height: GLfloat); virtual;
    procedure Render; override;
  end;
  

  { TTable }
  TFloatArray = array of float;
  TBoolArray = array of boolean;
  TIntArray = array of integer;
  TArrayOfTRectControl = array of TRectControl;

  function ArrayOfConstToFloatArray(a: array of const; var f: TFloatArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean = false; DefaultValue: float = 0.0): boolean;
  function ArrayOfConstToIntArray(a: array of const; var i: TIntArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean = false; DefaultValue: integer = 0): boolean;
  function ArrayOfConstToBoolArray(a: array of const; var b: TBoolArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean = false; DefaultValue: boolean = false): boolean;
  function ArrayOfConstToTRectControlArray(a: array of const; var o: TArrayOfTRectControl; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean = false; DefaultValue: TRectControl = nil): boolean;

type
{  TTableCrR = record weight, maxpix: float; disabled: boolean end;
  TTableCeR = record obj: TRectControl; col, colspan, row, rowspan: integer end;
  TTableCrA = array of TTableCrR;
  TTableCeA = array of TTableCeR;
}
  TTable = class (TRectControl) //abstract class, do not use directly!
    { The idea behind this is an stretchable table, except the row/column
        structure is defined ibdependedly of the cells themselves.
      The cells are common GUI objects that are just strapped to
        the specific positions in this invisible table. In fact, there
        is nothing to prevent them from overlapping or even occupying
        the same cell.
      Both rows and columns could be collapsed, making their content invisible
    }
  protected
    f_xpadding, f_ypadding: float;
    f_ResizedOnce: boolean;
    f_ColumnMinPerc,
    f_ColumnMaxPix: TFloatArray;
    f_ColumnDisabled: TBoolArray;
    f_RowMinPerc,
    f_RowMaxPix: TFloatArray;
    f_RowDisabled: TBoolArray;
    f_Cell: TArrayOfTRectControl;
    f_CellColumn,
    f_CellColSpan,
    f_CellRow,
    f_CellRowSpan: TIntArray;
    procedure ResizeChildren; //calls OnResize for the children
    procedure BalanceWeights(Limit: float; var Size: TFloatArray; MinPerc, MaxPix: TFloatArray; b_Disabled: TBoolArray); virtual;

    //to be called in the ancestor's constructor (the sole purpose is to make the code more human-readable)
    //function RcChain(prev: TTableCrA; _Weight: float; _MaxPix: float = 1e5; _Disabled: boolean = false): TTableCrA;
    //function CellChain(prev: TTableCeA; _object: TRectControl; _CellColumn, _CellRow: integer; _CellColSpan: integer = 1; _CellRowSpan: integer = 1): TTableCeA;
  public
    ColWidth, RowHeight: TFloatArray;
{
    constructor Create( //do not use this shit
      //There are, in fact, three sets of parameters.

      //Cloumns:
      _ColumnMinPerc, //Dtermines the column width relative to the total sum of them.
      _ColumnMaxPix, //Limits how wide the column can stretch. Omittable (pass [] ).
      _ColumnDisabled,//omittable

      //Rows:
      _RowMinPerc,
      _RowMaxPix, //omittable
      _RowDisabled,  //omittable

      //Cells
      _Cell, //TRectControl object that will reside in these cell(s).
      _CellColumn,
      _CellColSpan, //NOT omittable
      _CellRow,
      _CellRowSpan //not omittable
        : array of const;

      _width, _height: float; _xpadding: float = GuiDefaultTablePadding; _ypadding: float = GuiDefaultTablePadding); overload;

    //This one is for more readable calls:
    constructor Create(C, R: TTableCrA; Ce: TTableCeA;  //this either! Blarg =:(
      _width, _height: float; _xpadding: float = GuiDefaultTablePadding; _ypadding: float = GuiDefaultTablePadding); overload;
}
    constructor Create(_width, _height: float; _xpadding: float = GuiDefaultTablePadding; _ypadding: float = GuiDefaultTablePadding); overload;

    function NewColumn(_Weight: float = 1; _MaxPix: float = 1e5; _Disabled: boolean = false): integer; //returns the column number
    function NewRow(_Weight: float = 1; _MaxPix: float = 1e5; _Disabled: boolean = false): integer; //returns row number
    function NewCell(_object: TRectControl; _CellColumn, _CellRow: integer; _CellColSpan: integer = 1; _CellRowSpan: integer = 1): integer;

    procedure Clear();
    procedure KillChildren();

    procedure RegisterFields; override;
    procedure Cycle; override;
    procedure Render; override;
    function OnKey(Key: TKey): boolean; override;
    procedure OnResize; override;
    procedure GetChildRect(CellInd: integer; var left, top,  g_width, g_height: GLfloat); override;
    function GetChildById(sid: WideString): TControl;
    property Cell: TArrayOfTRectControl read f_Cell;
  published
    procedure Kill; override;
  end;
  
{  TRect = class (TRectControl)
  public
    procedure RegisterFields; override;
    procedure Render; override;
  end;
}
  { TTextRect }

  TWideStringArray = array of WideString;

  TTextRect = class (TRectControl)
  protected
    f_fontheight,
    f_max_line_length: integer;
  public
    AllowMultiLine: boolean; //true by default
  protected
    f_line: TWideStringArray;
    fit: PStringFitRec;
    procedure Refit;
    procedure _SetLines(w: WideString); virtual;
    function _GetLines(): WideString;
    procedure _SetFontHeight(i: integer);
    function _GetCount(): integer;
    procedure OnResize; override;
    procedure _CalcRelativeRectCoord(var dx, dy: float); virtual; //the real text area alignment *inside* the rect object.
    function _GetActualWidth(): float; virtual;
  public
    constructor Create(_lines: WideString; _width, _height: float); virtual;
    property ActualWidth: float read _GetActualWidth;
    property Count: integer read _GetCount;
    property MaxLength: integer read f_max_line_length;
    property Text: WideString read _GetLines write _SetLines;
    property Line: TWideStringArray read f_line;
    property FontHeight: integer read f_fontheight write _SetFontHeight;
    procedure RegisterFields; override;
    procedure Render; override;
    destructor Destroy; override;
  end;

  { TTextEdit }

  TTextEdit = class (TTextRect)
  protected
    BlinkingRestartMoment: TDateTime; //setting it to Now() in fact restarts blinking from the beginning of the visible phase.
    procedure LimitCursor;
    procedure _SetFocus(b: boolean); override;
    procedure _SetLines(w: WideString); override;
    procedure JoinLines; virtual; //the line where the cursor is and the next one
    procedure SplitLine; virtual;  //at the cursor position
    procedure InsertChar(w: WideChar); virtual; //at the cursor position
    procedure DeleteChar; virtual; //at the cursor position
  public
    CurX, CurLastX, CurY: integer;
    BlinkingRate: single; //in seconds
    OnChangeEvent,
    OnEnterEvent: TEventSubscription;
    constructor Create(_lines: WideString; _width, _height: float); override;
    procedure RegisterFields; override;
    procedure Render; override;
    function OnKey(key: TKey): boolean; override;
    procedure Cycle; override;
    procedure AfterLoading; override;
    procedure MoveCursor(deltaX, deltaY: integer); virtual;
  end;

  
  { TButton }

  TButton = class(TRectControl) //abstract class. Do not use.
  protected
    class function TextPadding(hght, fnthght: float): float; virtual;
  public
    Text: TTextRect;
    PressingKey: TKey; //default is KEY_MOUSE_LEFT
   {On click, will try to find designated method on this
     object (method should have no parameters).
     If this works, OnClick is not called.}
    OnClickEvent: TEventSubscription;

    constructor Create(_caption: WideString; _width, _height: float;
      _ClickReceiver: TManagedObject = nil;
      _ClickReceiverMethod: AnsiString = '';
      _ClickReceiverParam: WideString = '';
      _PressingKey: TKey = KEY_MOUSE_LEFT); virtual;
    destructor Destroy; override;
    procedure RegisterFields; override;
    function OnKey(key: TKey): boolean; override;
    procedure OnResize; override;
    procedure Render; override;
    procedure OnClick; virtual;
    procedure SubscribeOnClick(Receiver: TManagedObject;  Method: AnsiString; PassString: WideString = ''; MustReceiveString: boolean = false);
  end;




  {  TCheckBox }
  TCheckBoxBox = class(TRectControl)
    procedure Render; override;
  end;
  TCheckBox = class(TTable)
  protected
    Box: TCheckBoxBox;
    Text: TTextRect;
    SwitchOnReceiver: TManagedObject;
    SwitchOnReceiverMethod: AnsiString;
    SwitchOffReceiver: TManagedObject;
    SwitchOffReceiverMethod: AnsiString;
    PressingKey: TKey;
    function PassClickToReceiver(): boolean; virtual;
  public
    Checked: boolean;
    constructor Create(_caption: WideString; _width, _height: float;
      _SwitchOnReceiver: TManagedObject = nil;
      _SwitchOnReceiverMethod: AnsiString = '';
      _SwitchOffReceiver: TManagedObject = nil;
      _SwitchOffReceiverMethod: AnsiString = '';
      _PressingKey: TKey = KEY_MOUSE_LEFT); virtual;
    destructor Destroy; override;
    procedure RegisterFields; override;
    function OnKey(key: TKey): boolean; override;
    procedure OnChange; virtual;
  end;



  { TRadioButtonPoint }

  TRadioButtonPoint = class(TRectControl)
  published
    property Selected: boolean read HasBorder write HasBorder;
    procedure Render; override;
  end;
  TRadioButtonPointArray = array of TRadioButtonPoint;
  TTextRectArray = array of TTextRect;

  { TRadioGroup}

  TRadioGroup = class(TTable)
  protected
    Caption: TTextRect;
    points: TRadioButtonPointArray;
    texts: TTextRectArray;
    PressingKey: TKey;
    Columns: integer;
  public
    SelectedItem: integer;
//    constructor Create(_caption: WideString; _Items: TWideStringArray; _columns: integer; _width, _height: float;  _PressingKey: TKey = KEY_MOUSE_LEFT); virtual;
    destructor Destroy; override;
    procedure RegisterFields; override;
    function OnKey(key: TKey): boolean; override;
    procedure Render; override;
    procedure OnChange; virtual;
  end;

  { TBackground }

  TBackground = class (TControl) //just renders the current mother module background
  public
    procedure Render; override;
  end;

  { TModuleMainMenu }

  CModuleMainMenu = class of TModuleMainMenu;
  TModuleMainMenu = class (TTable)
  public
    Constructor Create; override;
  published
    function OnKey(key:TKey): boolean; override;
    procedure ExitProgram();
    procedure RestartProgram;
    procedure RestartModule;
    procedure GoToModuleSelectionMenu();
    procedure InvokeSessionMenu();
    procedure InvokeSettingsMenu();
  end;

  THasToHaveTabletMenu = class (TTable)
  published
    Constructor Create; override;
    procedure ExitProgram();
    procedure RestartProgram();
    procedure GoToModuleSelectionMenu();
    procedure Cycle(); override;
  end;

  TSettingsMenu = class(TTable)
  public
    Mode: WideString;
    constructor Create; override;
  published
    procedure Reset(what: widestring);
    procedure Act(action: widestring); virtual;
    procedure SwitchSession(sess: widestring); virtual;
    procedure EraseSession(stub: WideString);
    procedure Form(what: widestring); virtual;
    procedure Back; virtual;
    function OnKey(key: TKey): boolean; override;
    procedure RegisterFields; override;
    procedure AfterLoading; override;
    procedure SaveSession;
    procedure RollbackSession;
  end;

  TThreadsStopIndicator = class(TTable)
  public
    Constructor Create;
    procedure Cycle(); override;
  end;


implementation

  uses mo_module;

  procedure RegisterStandardMenuClasses;
  begin
    RegClass(TTable);
    RegClass(TButton);
    RegClass(TCheckBox);
    RegClass(TTextEdit);
    RegClass(TBackground);
    RegClass(THasToHaveTabletMenu);
    RegClass(TSettingsMenu);
  end;

  function TRectControl.RectShadeThickness: GLfloat;
  begin
    Result:= 4.5;
  end;

  function TRectControl.RectLineThickness: GLfloat;
  begin
    Result:= 2.5;
  end;

  procedure TRectControl.GetChildRect(CellInd: integer; var  left, top, g_width,  g_height: GLfloat);
  begin
    left:= x;
    top:= y;
    g_width:= Self.Width.Current;
    g_height:= Self.Height.Current;
  end;

  procedure TRectControl.Render;
    procedure RenderRect(bev: GLfloat);
    begin
      glBegin(GL_LINE_LOOP);
        glVertex2f(x + bev, y - bev);
        glVertex2f(x + Width.Current - bev, y - bev);
        glVertex2f(x + Width.Current + bev, y + bev);
        glVertex2f(x + Width.Current + bev, y + Height.Current - bev);
        glVertex2f(x + Width.Current - bev, y + Height.Current + bev);
        glVertex2f(x + bev, y + Height.Current + bev);
        glVertex2f(x - bev, y + Height.Current - bev);
        glVertex2f(x - bev, y + bev);
      glEnd();
    end;
  begin
    inherited;
    glDisable(GL_TEXTURE_2D);
    glEnable(GL_LINE_SMOOTH);
    glEnable(GL_BLEND);
    glDisable(GL_ALPHA_TEST);
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
    if HasBorder then begin
      glLineWidth(RectShadeThickness());
      glColor4f(0, 0, 0, Color.Current[3]);
      RenderRect(2);
      glLineWidth(RectLineThickness());
      glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
      RenderRect(2);
    end;
  end;


 procedure SetGlStatesFor2dRender;
 begin
   glDisable(GL_TEXTURE_2D);
   glEnable(GL_ALPHA_TEST);
   glEnable(GL_BLEND);
   glAlphaFunc(GL_GREATER, 0);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
   glDisable(GL_CULL_FACE);
   glDisable(GL_DEPTH_TEST);
   glViewport(0, 0, MotherState^.DisplayWidth, MotherState^.DisplayHeight);
   glMatrixMode(GL_PROJECTION);
   glLoadIdentity();
   glMatrixMode(GL_MODELVIEW);
   glLoadIdentity();
   //origin in the upper left corner!!
   glOrtho(0, MotherState^.DisplayWidth, MotherState^.DisplayHeight, 0, 0 ,1);
 end;


  constructor TControl.Create;
  begin
    inherited Create;
  end;

  procedure TControl.Cycle;
  begin
  end;

  procedure TControl.Render;
  begin
  end;

  procedure TControl.Kill;
  begin
    RemoveFromChain;
    if Self = Module.MainMenu then pointer(Module.MainMenu):= nil;
    Scrape;
  end;

  procedure TControl.SubscribeEvent(var ES: TEventSubscription;
    Receiver: TManagedObject; Method: AnsiString; PassString: WideString; MustReceiveString: boolean
    );
  begin
    ES.Receiver:= Receiver;
    ES.Method:= Method;
    if (PassString <> '') or MustREceiveString then ES.MethodType:= esmt_string else ES.MethodType:= esmt_simple;
//addlog(' - %0.SubscribeEvent(,%1,%2,%3,%4) -- %5',[string(self.ClassName), string(Receiver.ClassName), Method,PassString,MustReceiveString,(PassString <> '') or MustREceiveString]);
    ES.DefaultString:= PassString;
  end;

  procedure TControl.UnSubscribeEvent(var ES: TEventSubscription);
  begin
    ES.Receiver:= nil;
  end;

  function TControl.PassEvent(var ES: TEventSubscription; w: WideString): boolean;
  type tmethod_with_str_par = procedure(slf: TObject; par: Widestring);
  var
    method: procedure(slf: TObject);
    //method_with_str_par: procedure(slf: TObject; par: ansistring) //Fuck. It compiles, works, but code completion is shoot >:( absolute method; //har har, two variables accupying the same address Ain't I clever?
    //a hack: calling orbitrary class method by its string name.
    //watch the parameter list! (shall either be none or one ansistring,
    //with ClickReceiverParam either nil or a non-empty string accordingly!)
  begin
    if not Assigned(ES.Receiver) then Exit(No);
    if w = '' then w:= ES.DefaultString;
    Result:= Yes;
    if ES.Receiver.Scraped then Die(RuEn( //the joys of garbage collector ;)
      'Крах класса %0: подписчик события является уничтоженным объектом (%1)'#13'  метод %2, параметр: "%3"',
      'Class %0 crash: the event subscriber is an already destroyed object (%1)'#13'  method %2; parameter "%3"'),
        [string(self.ClassName), string(ES.Receiver.Classname), ES.Method, w]);
    pointer(method):= ES.Receiver.MethodAddress(ES.Method);
    if not Assigned(pointer(method)) then begin
      AddLog(RuEn(
        'Класс %0: не удалось передать событие, подписчик (%1) не имеет метода "%2" '#13'  параметр: "%3"',
        'Class %0: failed to pass event, the subscriber (%1) doesn''t have a method "%2" '#13'  parameter "%3"'),
          [string(self.ClassName), string(ES.Receiver.Classname), ES.Method, w]);
      Exit(No);
    end;
    try
      if ES.MethodType = esmt_simple then method(ES.Receiver)
      else begin
        //pointer(method_with_str_par):= pointer(method); //ES.Receiver.MethodAddress(ClickReceiverMethod);
        //method_with_str_par(ES.Receiver, w);
        tmethod_with_str_par(method)(ES.Receiver, w);
      end;
//if ES.MethodType = esmt_simple
//then AddLog('+  %0 -> %1.%2',[string(self.ClassName), string(ES.Receiver.Classname), ES.Method])
//else AddLog('+  %0 -> %1.%2(%3)',[string(self.ClassName), string(ES.Receiver.Classname), ES.Method, w])
    except
      Die(RuEn(
        'Крах класса %0 при вызове подписчика события, %1.%2(%3)',
        'Class %0 crashed at calling the event subscriber %1.%2(%3)'),
        [string(self.ClassName), string(ES.Receiver.Classname), ES.Method, w])
    end;
  end;

  function TControl.OnKey(key: TKey): boolean;
  begin
    if Scraped then Exit(false);
    if Assigned(Lower) then Result:= Lower.OnKey(key);
    Result:= true;
  end;
  

  procedure TControl.OnResize;
  begin
  end;


  procedure TControl.RegisterFields;
  begin
    RegType(typeinfo(TControlParameter), Sizeof(TControlParameter), ['Initial', 'Current', typeinfo(glFloat)]);
    RegType(typeinfo(TControlColor), Sizeof(TControlColor), ['Initial', 'Current', typeinfo(TVector4f)]);
    RegType(typeinfo(TEventSubscriptionMethodType));
    RegType(typeinfo(TEventSubscription), Sizeof(TEventSubscription), [
      'Receiver', typeinfo(TManagedObject),
      'Method', typeinfo(AnsiString),
      'MethodType', typeinfo(TEventSubscriptionMethodType),
      'DefaultString', typeinfo( WideString)
    ]);
    inherited;
    ListFields([
      'Focus', @f_focus, TypeInfo(boolean),
      'Upper', @Upper,
      'Lower', @Lower, TypeInfo(TControl),
      'id', @id, TypeInfo(wideString)
    ]);
  end;

  procedure TControl.AddOnTop(var c: TControl);
  begin
    RemoveFromChain;
    if Assigned(c) then begin
      Upper:= c.Upper;
      Lower:= c;
      c.Upper:= Self;
    end;
    c:= Self;
  end;

  procedure TControl.AddBelow(var c: TControl);
  begin
    RemoveFromChain;
    if Assigned(c) then begin
      if (Assigned(c.Lower)) then begin
        Lower:= c.Lower;
        Lower.Upper:= Self;
      end;
      c.Lower:= Self;
    end
    else
      c:= Self;
  end;

  procedure TControl.AddAtBottom(var c: TControl);
  var
    v: TControl;
  begin
    RemoveFromChain;
    if Assigned(c) then begin
      v:= c;
      while Assigned(v.Lower) do v:= V.Lower;
      v.Lower:= Self;
      Upper:= v;
    end
    else
      c:= Self;
  end;

  procedure TControl.RemoveFromChain;
  begin
    if Module.Control = Self
      then Module.Control:= Lower;
    if Module.MainMenu = Self
      then Module.MainMenu:= nil;
    // connect the adjacent links of the chain together
    if Assigned(Upper) then Upper.Lower:= Lower;
    if Assigned(Lower) then Lower.Upper:= Upper;
    Upper:= nil;
    Lower:= nil;
  end;

  procedure TControl.Scrape;
  begin
    RemoveFromChain;
    inherited;
  end;

  destructor TControl.Destroy;
  begin
    RemoveFromChain;
    inherited;
  end;




{ TRectControl }

constructor TRectControl.Create(_width, _height: float);
begin
  inherited Create;
  Width.Initial:= _width;
  Height.Initial:= _height;
end;

procedure TRectControl.ChangeSize(_width, _height: float);
begin
  Width.Initial:= _width;
  Height.Initial:= _height;
  OnResize;
end;

procedure TRectControl.RegisterFields;
begin
  RegType(typeinfo(THAlign));
  RegType(typeinfo(TVAlign));
  RegType(typeinfo(TVector4f), typeinfo(GLfloat), [0, 3]);
  inherited;
  ListFields([
    'parent', @Parent, typeinfo(TRectControl),
    'parent cell index', @ParentCellInd, typeinfo(integer),
    'halign', @HAlign, typeinfo(THAlign),
    'valign', @VAlign, typeinfo(TValign),
    'xOff', @xOff,
    'yOff', @yOff,
    'x', @x,
    'y', @y, typeinfo(float),
    'width', @Width,
    'height', @Height,  typeinfo(TControlParameter),
    'Color', @Color, Typeinfo(TControlColor),
    'HighlightColor', @HighlightColor,
    'NormalColor', @NormalColor, typeinfo(TVector4f),
    'Invisible', @Invisible, 'Disabled', @disabled, 'HasBorder', @HasBorder, typeinfo(boolean)
  ]);
end;

procedure TRectControl.OnResize;
var
  pleft, ptop, pwidth, pheight, o_xOff, o_yOff: glFloat;
begin
  inherited; // the parent sits att the bottom of the food chain,
  //  also they are rendered bottom to top, so parent is rendered first
  //  (remember, there's no such thing as a depth buffer).
  if Assigned(parent)
  then Parent.GetChildRect(ParentCellInd, pleft, ptop, pwidth, pheight)
  else begin
    pleft:=0;
    ptop:=0;
    pwidth:= MotherState^.DisplayWidth;
    pheight:= MotherState^.DisplayHeight;
  end;
  o_xOff:= min(Self.xOff, pwidth / 4);
  o_yOff:= min(Self.yOff, pheight / 4);
  Width.Current:= min(Width.Initial, pwidth - (2*xOff));
  case HAlign of
    halign_left: x:= pleft + o_xOff;
    halign_right: x:= pleft + pwidth - Width.Current - o_xOff;
    halign_center: x:= pleft + (pwidth - Width.Current) / 2;
    halign_width: begin
      Width.Current:= pwidth - 2*o_xOff;
      x:= pleft + o_xOff;
    end;
  end;
  Height.Current:= min(Height.Initial, pheight - o_yOff *2);
  case VAlign of
    valign_top: y:= ptop + o_yOff;
    valign_bottom: y:= ptop + pheight - Height.Current - o_yOff;
    valign_center: y:= ptop + (pheight - Height.Current) / 2;
    valign_height: begin
      Height.Current:= pheight - 2*o_xOff;
      y:= ptop + o_yOff;
    end;
  end;
//  addlog('%0.OnResize: %1 x %2 (%3 x %4)', [string(Self.ClassName), Width.Current,Height.Current, x, y]);
  //inherited;
end;


{
  constructor TTable.Create(
      _ColumnMinPerc,
      _ColumnMaxPix,
      _ColumnDisabled,
      _RowMinPerc,
      _RowMaxPix,
      _RowDisabled,
      _Cell,
      _CellColumn,
      _CellColSpan,
      _CellRow,
      _CellRowSpan: array of const;
      _width, _height, _xpadding, _ypadding: float);
    var
      i: integer;
      ErrorMessage: WideString;
    procedure ReportFuckUp();
    begin
      Die(MI_ERROR_PROGRAMMER_NO_BAKA, [
        PervertedFormat(RuEn(
          'Недопустимые параметры при вызове %0.Create():'#10#13'  %1',
          'Invalid parameters passed to %0.Create():'#10#13'  %1'),
          [string(Self.ClassName), ErrorMessage])
         ])
    end;
  begin
    inherited Create(_width, _height);

    f_xpadding:= _xpadding;
    f_ypadding:= _ypadding;

    if not ArrayOfConstToFloatArray(_ColumnMinPerc, f_ColumnMinPerc, -1, '_ColumnMinPerc', ErrorMessage) then ReportFuckUp;
    if not ArrayOfConstToFloatArray(_ColumnMaxPix, f_ColumnMaxPix, length(_ColumnMinPerc), '_ColumnMaxPix', ErrorMessage, Yes, 1e5) then ReportFuckUp;
    if not ArrayOfConstToBoolArray(_ColumnDisabled, f_ColumnDisabled, length(_ColumnMinPerc), '_ColumnDisabled', ErrorMessage, Yes, No) then ReportFuckUp;

    if not ArrayOfConstToFloatArray(_RowMinPerc, f_RowMinPerc, -1, '_RowMinPerc', ErrorMessage) then ReportFuckUp;
    if not ArrayOfConstToFloatArray(_RowMaxPix, f_RowMaxPix, length(_RowMinPerc), '_RowMaxPix', ErrorMessage, Yes, 1e5) then ReportFuckUp;
    if not ArrayOfConstToBoolArray(_RowDisabled, f_RowDisabled, length(_RowMinPerc), '_RowDisabled', ErrorMessage, Yes, No) then ReportFuckUp;

    if not ArrayOfConstToTRectControlArray(_Cell, f_Cell, -1, '_Cell', ErrorMessage) then ReportFuckUp;

    if not ArrayOfConstToIntArray(_CellColumn, f_CellColumn, length(f_Cell), '_CellColumn', ErrorMessage) then ReportFuckUp;
    if not ArrayOfConstToIntArray(_CellRow, f_CellRow, length(f_Cell), '_CellRow', ErrorMessage) then ReportFuckUp;

    if not ArrayOfConstToIntArray(_CellColSpan, f_CellColSpan, length(f_Cell), '_CellColSpan', ErrorMessage, Yes, 1) then ReportFuckUp;
    if not ArrayOfConstToIntArray(_CellRowSpan, f_CellRowSpan, length(f_Cell), '_CellRowSpan', ErrorMessage, Yes, 1) then ReportFuckUp;

    SetLength(ColWidth, length(f_ColumnMinPerc));
    SetLengtH(RowHeight, length(f_RowMinPerc));
    for i:=0 to high(f_Cell) do
      with f_Cell[i] do begin
        ParentCellInd:= i;
        Parent:= Self;
      end;
    OnResize;
  end;
}


  function TTable.NewColumn(_Weight: float; _MaxPix: float = 1e5; _Disabled: boolean = false): integer;
  var j: integer;
  begin
    j:= Length(f_ColumnMinPerc);
    SetLength(f_ColumnMinPerc, j + 1);
    SetLength(f_ColumnMaxPix, j + 1);
    SetLength(f_ColumnDisabled, j + 1);
    SetLength(ColWidth, j + 1);
    f_ColumnMinPerc[j]:= _Weight;
    f_ColumnMaxPix[j]:= _MaxPix;
    f_ColumnDisabled[j]:= _Disabled;
    Result:= j;
  end;

  function TTable.NewRow(_Weight: float; _MaxPix: float = 1e5; _Disabled: boolean = false): integer;
  var j: integer;
  begin
    j:= Length(f_RowMinPerc);
    SetLength(f_RowMinPerc, j + 1);
    SetLength(f_RowMaxPix, j + 1);
    SetLength(f_RowDisabled, j + 1);
    SetLengtH(RowHeight, j + 1);
    f_RowMinPerc[j]:= _Weight;
    f_RowMaxPix[j]:= _MaxPix;
    f_RowDisabled[j]:= _Disabled;
    Result:= j;
  end;

  function TTable.NewCell(_object: TRectControl; _CellColumn, _CellRow: integer; _CellColSpan: integer = 1; _CellRowSpan: integer = 1): integer;
  var j: integer;
  begin
    j:= Length(f_Cell);
    SetLength(f_Cell, j + 1);
    SetLength(f_CellColumn, j + 1);
    SetLength(f_CellRow, j + 1);
    SetLength(f_CellColSpan, j + 1);
    SetLength(f_CellRowSpan,j + 1);
    f_Cell[j]:= _object;
    f_CellColumn[j]:= _CellColumn;
    f_CellRow[j]:= _CellRow;
    f_CellColSpan[j]:= _CellColSpan;
    f_CellRowSpan[j]:= _CellRowSpan;
    _object.ParentCellInd:= j;
    _object.Parent:= Self;
    Result:= j;
  end;

 {
  function TTable.RcChain(prev: TTableCrA; _Weight: float; _MaxPix: float; _Disabled: boolean): TTableCrA;
  var j: integer;
  begin
    result:= prev;
    j:= Length(result);
    SetLength(result, j + 1 );
    with result[j] do begin
      weight:= _Weight;
      maxpix:= _MaxPix;
      disabled:= _Disabled;
    end;
  end;

  function TTable.CellChain(prev: TTableCeA; _object: TRectControl; _CellColumn, _CellRow: integer; _CellColSpan: integer; _CellRowSpan: integer): TTableCeA;
  var j: integer;
  begin
    result:= prev;
    j:= Length(result);
    SetLength(result, j + 1 );
    with result[j] do begin
      obj:= _object;
      col:= _CellColumn;
      row:= _CellRow;
      colspan:= _CellColSpan;
      rowspan:= _CellRowSpan;
    end;
  end;

}

  constructor TTable.Create(//C, R: TTableCrA; Ce: TTableCeA;
    _width, _height: float; _xpadding: float; _ypadding: float);
  var i,j: integer;
  begin
    inherited Create(_width, _height);

    f_xpadding:= _xpadding;
    f_ypadding:= _ypadding;

{
    j:= Length(C);
    SetLength(f_ColumnMinPerc, j);
    SetLength(f_ColumnMaxPix, j);
    SetLength(f_ColumnDisabled, j);
    for i:=0 to j - 1 do
      with C[i] do begin
        f_ColumnMinPerc[i]:= weight;
        f_ColumnMaxPix[i]:= maxpix;
        f_ColumnDisabled[i]:= disabled;
      end;

    j:= Length(R);
    SetLength(f_RowMinPerc, j);
    SetLength(f_RowMaxPix, j);
    SetLength(f_RowDisabled, j);
    for i:=0 to j - 1 do
      with R[i] do begin
        f_RowMinPerc[i]:= weight;
        f_RowMaxPix[i]:= maxpix;
        f_RowDisabled[i]:= disabled;
      end;

    j:= Length(Ce);
    SetLength(f_Cell, j);
    SetLength(f_CellColumn, j);
    SetLength(f_CellRow, j);
    SetLength(f_CellColSpan, j);
    SetLength(f_CellRowSpan,j);
    for i:=0 to j - 1 do
      with Ce[i] do begin
        f_Cell[i]:= obj;
        f_CellColumn[i]:= col;
        f_CellRow[i]:= row;
        f_CellColSpan[i]:= colspan;
        f_CellRowSpan[i]:= rowspan;
      end;

    SetLength(ColWidth, length(f_ColumnMinPerc));
    SetLengtH(RowHeight, length(f_RowMinPerc));
    for i:=0 to high(f_Cell) do
      with f_Cell[i] do begin
        ParentCellInd:= i;
        Parent:= Self;
      end;
}
    //OnResize; must be called by the ancestor?
  end;


  procedure TTable.Clear();
  begin
    SetLength(f_ColumnMinPerc, 0);
    SetLength(f_ColumnMaxPix, 0);
    SetLength(f_ColumnDisabled, 0);
    SetLength(f_RowMinPerc, 0);
    SetLength(f_RowMaxPix, 0);
    SetLength(f_RowDisabled, 0);
    SetLength(f_Cell, 0);
    SetLength(f_CellColumn, 0);
    SetLength(f_CellRow, 0);
    SetLength(f_CellColSpan, 0);
    SetLength(f_CellRowSpan, 0);
    SetLength(ColWidth, 0);
    SetLengtH(RowHeight, 0);
    f_ResizedOnce:= No;
  end;

  procedure TTable.KillChildren();
  var i: integer;
  begin
    for i:=0 to High(f_Cell) do f_Cell[i].Scrape;
    SetLength(f_Cell, 0);
  end;


  procedure TTable.RegisterFields;
  begin
    RegType(typeinfo(TArrayOfTRectControl), typeInfo(TRectControl));
    RegType(typeinfo(glFloatArray), typeinfo(glFloat));
    RegType(typeinfo(TBoolArray), typeinfo(boolean));
    RegType(typeinfo(TFloatArray), typeinfo(float));
    RegType(typeinfo(TIntArray), typeinfo(integer));

    inherited;
    ListFields([
      'f_xpadding', @f_xpadding,
      'f_ypadding', @f_ypadding, typeinfo(float),
      'f_ResizedOnce', @f_ResizedOnce, typeinfo(boolean),
      'f_ColumnMinPerc', @f_ColumnMinPerc,
      'f_ColumnMaxPix', @f_ColumnMaxPix, typeinfo(TFloatArray),
      'f_ColumnDisabled', @f_ColumnDisabled, typeinfo(TBoolArray),
      'f_RowMinPerc', @f_RowMinPerc,
      'f_RowMaxPix', @f_RowMaxPix, typeinfo(TFloatArray),
      'f_RowDisabled', @f_RowDisabled, typeinfo(TBoolArray),
      'f_Cell', @f_Cell, typeinfo(TArrayOfTRectControl),
      'f_CellColumn', @f_CellColumn,
      'f_CellColSpan', @f_CellColSpan,
      'f_CellRow', @f_CellRow,
      'f_CellRowSpan', @f_CellRowSpan, typeinfo(TIntArray),
      'ColWidth', @ColWidth, 'RowHeight' , @RowHeight, typeinfo(glFloatArray)
    ]);
  end;

  procedure TTable.Cycle;
  var i: integer;
  begin
    if not f_ResizedOnce then OnResize;
    inherited;
    for i:= 0 to high(f_cell) do
      if Assigned(f_cell[i]) then f_cell[i].Cycle;
  end;

  procedure TTable.Render;
  var i: integer;
  begin
    if not f_ResizedOnce or not Assigned(f_Cell) then exit; //NOT visible until it has at least one column and one row and one cell
    inherited;
    for i:= 0 to high(f_cell) do
      if Assigned(f_cell[i])
         and not (f_RowDisabled[f_CellRow[i]] or f_ColumnDisabled[f_CellColumn[i]])
           then f_cell[i].Render;
  end;
  
  procedure TTable.OnResize;
  var
    i, j: integer;
    distribsize,
    percentsum: float;
    maxed: array of boolean;
    allmaxed: boolean;
  begin
    inherited;
    if not Assigned(ColWidth) or not Assigned(RowHeight) then exit; //Balancing would divide by zero if there are no columns or no rows
    f_ResizedOnce:= Yes;
    BalanceWeights(Width.Current, ColWidth, f_ColumnMinPerc, f_ColumnMaxPix, f_ColumnDisabled);
    BalanceWeights(Height.Current, RowHeight, f_RowMinPerc, f_RowMaxPix, f_RowDisabled);
    ResizeChildren;
  end;

  procedure TTable.ResizeChildren;
  var i: integer;
  begin
    for i:= 0 to high(f_cell) do
      if Assigned(f_cell[i])
        and not (f_RowDisabled[f_CellRow[i]] or f_ColumnDisabled[f_CellColumn[i]]) //don't resize invisible items
          then f_cell[i].OnResize
  end;

  procedure TTable.BalanceWeights(Limit: float; var Size: TFloatArray; MinPerc,
    MaxPix: TFloatArray; b_Disabled: TBoolArray);
  var
    i, j: integer;
    allmaxed, thismaxed: boolean;
    distrib, delta, factor, newfac, addition: float;
  begin
    for i:=0 to high(Size) do Size[i]:=0.0;
    factor:= 0.0;
    for i:=0 to high(Size) do if not b_Disabled[i] then factor+= MinPerc[i];
    if factor < floaterror then Exit; //avoid the floating point overflow. It's incorrectly reported as an Ctrl+Break exception (!??)
    factor:= 1.0 / factor;
    delta:= Limit;
    repeat
      allmaxed:= Yes;
      distrib:= delta;
      newfac:= 0.0;
      for i:=0 to high(Size) do begin
        if b_Disabled[i] then continue;
        addition:= MinPerc[i] * factor * delta;
        if Size[i] + addition > MaxPix[i]
        then
          addition:= MaxPix[i] - Size[i]
        else begin
          allmaxed:= No;
          newfac+= MinPerc[i];
        end;
        distrib -= addition;
        Size[i]+= addition;
      end;
      delta:= distrib;
      if newfac < floaterror then Exit; // end it right there.
      factor:= 1.0 / newfac;
    until allmaxed or (delta < floaterror);
  end;


  procedure TTable.GetChildRect(CellInd: integer; var left, top, g_width, g_height: GLfloat);
  var
    i, n: integer;
    v: float;
  begin
    if CellInd < 0 then inherited GetChildRect(CellInd, top, left, g_width, g_height)
    else begin
      left:= x;
      n:= f_CellColumn[CellInd];
      for i:= 0 to n - 1 do
        if not f_ColumnDisabled[i]
          then left+= ColWidth[i];
      g_width:= ColWidth[n];
      for i:= n + 1 to n + f_CellColspan[CellInd] - 1 do
        if not f_ColumnDisabled[i]
          then g_width+= ColWidth[i];
      v:= min(f_xpadding, g_width / 10);
      left+= v;
      g_width -= 2*v;

      top:= y;
      n:= f_cellRow[CellInd];
      for i:= 0 to n - 1 do
        if not f_RowDisabled[i]
          then top+= RowHeight[i];
      g_height:= RowHeight[n];
      for i:= n + 1 to n + f_CellRowSpan[CellInd] - 1 do
        if not f_RowDisabled[i]
          then g_height+= RowHeight[i];
      v:= min(f_ypadding, g_height / 10);
      top+= v;
      g_height -= 2*v;
    end;
  end;

  function TTable.GetChildById(sid: WideString): TControl;
  var i: integer = 0;
  begin
    while (i < Length(f_Cell)) and Assigned(f_Cell[i]) do begin
      if f_Cell[i].id = sid then Exit(f_Cell[i]);
      inc(i);
    end;
    Result:= nil;
  end;


  function TTable.OnKey(Key: TKey): boolean;
  var k: integer;
  begin
    inherited;
    for k:=0 to integer(high(f_cell)) do begin
      if k > high(f_cell) then exit; //обрабатываемое событие может очистить очередь, выдернув половичок у себя из под ног
      if Assigned(pointer(f_cell[k]))
        and not F_cell[k].Disabled
        and not (f_RowDisabled[f_CellRow[k]])
        and not (f_ColumnDisabled[f_CellColumn[k]])
          then if not f_cell[k].OnKey(Key) then Exit(false);
      if Self.Scraped then Exit(false);
    end;
    Result:= true;
  end;

  procedure TTable.Kill;
  begin
    KillChildren;
    inherited;
  end;

{ TRect }

(*  procedure TRect.RegisterFields;
  begin
    inherited;
  end;

  procedure TRect.Render;
  procedure RenderRect(bev: GLfloat);
  begin
    glBegin(GL_LINE_LOOP);
      glVertex2f(x + bev, y - bev);
      glVertex2f(x + Width.Current - bev, y - bev);
      glVertex2f(x + Width.Current + bev, y + bev);
      glVertex2f(x + Width.Current + bev, y + Height.Current - bev);
      glVertex2f(x + Width.Current - bev, y + Height.Current + bev);
      glVertex2f(x + bev, y + Height.Current + bev);
      glVertex2f(x - bev, y + Height.Current - bev);
      glVertex2f(x - bev, y + bev);
    glEnd();
  end;
  begin
    inherited;
    glDisable(GL_TEXTURE_2D);
    glEnable(GL_LINE_SMOOTH);
    glEnable(GL_BLEND);
    glDisable(GL_ALPHA_TEST);
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
    glLineWidth(RectShadeThickness());
    glColor4f(0, 0, 0, Color.Current[3]);
    RenderRect(2);
    glLineWidth(RectLineThickness());
    glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
    RenderRect(2);
  end;
  *)

{ TTextRect }

procedure TTextRect.Refit;
var
  i: integer;
begin
  //if length(f_line) = 0 then Exit;
  f_max_line_length:= 1;
  for i:=0 to length(f_line) - 1 do
    f_max_line_length:= max(f_max_line_length,  length(f_line[i]));
  if not Assigned(fit) then New(fit);
  cgeffFitStringIntoRectangle(FontHeight, MaxLength, Count,  round(Width.Current), round(Height.Current), fit);
  AfterEfCheck;
//addlog('  actualwidth %0, actualheight %1', [fit^.actualwidth, fit^.actualheight]);
end;

procedure TTextRect._SetLines(w: WideString);
var
  a, b: integer;
  o: boolean;
begin
  f_max_line_length:= 1;
  SetLength(f_line, 0);
  f_max_line_length:= 1;
  if w = '' then begin
    SetLength(f_line, 1);
  end else begin
    b:= 0;
    a:= 1;
    repeat
      repeat inc(b) until (b = length(w)) or (w[b] = #13);
      if AllowMultiLine or (length(f_line) = 0) then SetLength(f_line, length(f_line) + 1);
      f_line[high(f_line)]+= copy(w, a, b - a + 1);
      f_max_line_length:= max(b - a + 1, f_max_line_length);
      a:= b + 1;
    until a > length(w);
    for a:=0 to high(f_line) do begin
      o:= false;
      for b:= 1 to length(f_line[a]) do
        if (ord(f_line[a][b]) < ord(' ')) then begin
          if ord(f_line[a][b]) = 9 then f_line[a][b]:= ' ' else f_line[a][b]:= #1;
          o:= true;
        end;
      if o then f_line[a]:= WideReplace(f_line[a], #1, '');
    end;
  end;
  Refit;
end;

function TTextRect._GetLines(): WideString;
var i: integer;
begin
  if length(f_line) = 0 then Exit('');
  Result:= f_line[0];
  for i:=1 to length(f_line) - 1 do Result+= #13 + f_line[i];
end;

procedure TTextRect._SetFontHeight(i: integer);
begin
  f_FontHeight:= i;
  Refit;
end;

function TTextRect._GetCount(): integer;
begin
  Result:= length(f_line);
end;

procedure TTextRect.OnResize;
begin
  inherited;
  Refit;
end;

function TTextRect._GetActualWidth(): float;
begin
  if not Assigned(fit) then Refit;
  result:= fit^.ActualWidth;
end;

procedure TTextRect._CalcRelativeRectCoord(var dx, dy: float);
begin
  case Halign of
     halign_left: dx:=0;
     halign_right: dx:= (Width.Current - fit^.ActualWidth);
  else
    dx:= (Width.Current - fit^.ActualWidth) / 2;
  end;
  case Valign of
    valign_top: dy:= 0;
    valign_bottom: dy:= (Height.Current - fit^.ActualHeight);
  else
    dy:= (Height.Current - fit^.ActualHeight) / 2;
  end;
end;

constructor TTextRect.Create(_lines: WideString;  _width, _height: float);
begin
  inherited Create(_width, _height);
  f_fontheight:= GuiDefaultFontHeight;
  NormalColor:= GuiDEfaultColor;
  HighlightColor:= GuiDEfaultHighlight;
  Color.Initial:= NormalColor;
  Color.Current:= NormalColor;
  AllowMultiLine:= True;
  Text:= _lines;
end;

procedure TTextRect.RegisterFields;
begin
  RegType(typeinfo(TWideStringArray), typeinfo(WideString));
  inherited;
  ListFields([
    'FontHeight', @f_fontHeight,
    'MaxLength', @f_max_line_length, typeinfo(integer),
    'AllowMultiLine', @AllowMultiLine, typeinfo(boolean),
    'Line', @f_line, typeinfo(TWideStringArray),
    'fit', @fit, '*pointer']);
end;

procedure TTextRect.Render;
var
  i: integer;
  h: GLfloat;
  dx, dy: float;
begin
  inherited;
  if not Assigned(fit) then Refit;
  cgeffSetRenderState(false);
  AfterEfCheck;
  if Count < 1 then Exit;
  glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
  h:= (1.0*fit^.ActualHeight) / Count;
//addlog('%0',[h]);
  _CalcRelativeRectCoord(dx, dy);
  for i:= 0 to Count - 1 do begin
    cgeffRenderString(fit, x + dx,
       y + dy + h * i,
       PWideChar(f_line[i]));
    AfterEfCheck;
  end;
end;

destructor TTextRect.Destroy;
begin
  if Assigned(fit) then Dispose(fit);
  inherited;
end;

{ TButton }

class function TButton.TextPadding(hght, fnthght: float): float;
begin
  if hght > 20.0
    then Result:= 5.0
    else Result:= hght / 4.0;
end;


constructor TButton.Create(_caption: WideString; _width, _height: float;
   _ClickReceiver: TManagedObject; _ClickReceiverMethod: AnsiString; _ClickReceiverParam: WideString; _PressingKey: TKey);
begin
  inherited Create(_width, _height);
  HasBorder:= true;
  Text:= TTextRect.Create(_caption, _width, _height);
  Text.Parent:= Self;
  Text.xOff:= TextPadding(_height, Text.FontHeight);
  Text.yOff:= TextPadding(_height, Text.Fontheight);
  NormalColor:= GuiDEfaultColor;
  HighlightColor:= GuiDEfaultHighlight;
  PressingKey:= _PressingKey;
  SubscribeEvent(OnClickEvent, _ClickReceiver, _ClickReceiverMethod, _ClickReceiverParam);
  OnResize;
end;

destructor TButton.Destroy;
begin
  Text.Free;
  inherited;
end;

procedure TButton.RegisterFields;
begin
  RegClass(TTextRect);
  RegType(typeinfo(TKey));
  inherited;
  ListFields([
    'Text', @Text, typeinfo(TTextRect),
    'PressingKey', @PressingKey, typeinfo(TKey),
    'OnClickEvent', @OnClickEvent, typeinfo(OnClickEvent)
  ]);
end;

function TButton.OnKey(key: TKey): boolean;
var
  selected: boolean;
begin
  with Module do
    selected:= (mousex > x) and (mousex < x + width.Current)
           and (mousey > y) and (mousey < y + height.Current);
  if key = KEY_NULL then begin
    if selected then begin
      Color.Current:= HighlightColor;
      Text.Color.Current:= Color.Current;
    end
    else begin
      Color.Current:= NormalColor;
      Text.Color.Current:= Color.Current;
    end
  end;
  if (key = PressingKey) and Module.KeyDown[key] and selected
  then begin
    if not PassEvent(OnClickEvent) then OnClick;
    Result:= false;
  end
  else
    Result:= inherited;
end;

procedure TButton.OnClick; begin end;

procedure TButton.SubscribeOnClick(Receiver: TManagedObject;
  Method: AnsiString; PassString: WideString; MustReceiveString: boolean);
begin
  SubscribeEvent(OnClickEvent, Receiver,  Method, PassString, MustReceiveString);
end;

procedure TButton.OnResize;
begin
  inherited;
  OnKey(KEY_NULL);
  Text.OnResize;
//addlog('button resize: "%0" x%1 y%2 w%3 h%4',[Text.Text, x, y, width.current, height.current]);
end;

procedure TButton.Render;
begin
  inherited;
  Text.Render;
end;

{ TTextEdit }

procedure TTextEdit.LimitCursor;
begin
  CurLastX:= min(max(0, CurLastX), f_max_line_length);
  CurX:= min(max(0, CurX), CurLastX);
  CurY:= min(max(0, CurY), length(f_line) - 1);
  if length(f_line) > 0 then CurX:= min (CurX, length(f_line[CurY]));
end;

procedure TTextEdit._SetFocus(b: boolean);
begin
  inherited;
  MotherState^.TextInput:= b;
end;

procedure TTextEdit._SetLines(w: WideString);
begin
  inherited _SetLines(w);
  LimitCursor;
end;

procedure TTextEdit.JoinLines;
var
  i: integer;
begin
  if not Assigned(f_line) or (CurY >= length(f_line) - 1) then Exit;
  f_line[CurY]+= f_line[CurY + 1];
  for i:= CurY + 1 to length(f_line) - 2 do f_line[i]:= f_line[i + 1];
  SetLength(f_line, length(f_line) - 1);
end;

procedure TTextEdit.SplitLine;
var j: integer;
begin
  if length(f_line) = 0 then SetLength(f_line, 1);
  SetLength(f_line, length(f_line) + 1);
  for j:= length(f_line) - 1 downto CurY + 2 do f_line[j]:= f_line[j - 1];
  f_line[CurY + 1] := Copy(f_line[CurY], CurX + 1, length(f_line[CurY]) - CurX);
  f_line[CurY]:= Copy(f_line[CurY], 1, CurX);
  inc(CurY);
  CurX:=0;
  CurlastX:=0;
end;

procedure TTextEdit.InsertChar(w: WideChar);
begin
  if length(f_line) = 0 then SetLength(f_line, 1);
  if not Module.InsertMode or (CurX >= length(f_line[CurY]))
    then f_line[CurY]:= Copy(f_line[CurY], 1, CurX) + w + Copy(f_line[CurY], CurX + 1, length(f_line[CurY]) - CurX)
    else f_line[CurY][CurX + 1]:= w;
  inc(CurX);
  CurLastX:= CurX;
end;

procedure TTextEdit.DeleteChar;
begin
  f_line[CurY]:= Copy(f_line[CurY], 1, CurX) + Copy(f_line[CurY], CurX + 2, length(f_line[CurY]) - CurX - 1);
end;

procedure TControl._SetFocus(b: boolean);
var
  c: TControl;
begin
  if b then begin
    c:= Module.Control;
    while Assigned(c) do begin
      if c <> Self then c.Focus:= False;
      c:= c.Lower;
    end;
  end;
  f_focus:= b;
end;

constructor TTextEdit.Create(_lines: WideString; _width, _height: float);

begin
  inherited Create(_lines, _width, _height);
  BlinkingRate:= GuiDefaultCursorBlinkingRate; //cycles per second
end;

procedure TTextEdit.RegisterFields;
begin
  //RegType(typeinfo(TDateTime));//fix the bug in Chepersy to allow registering types like this one!
  inherited;
  ListFields([
    //a skipped field, skipped, so that the cursor is always blinking after loading
    '-BlinkingRestartMoment', @BlinkingRestartMoment, typeinfo(double),//typeinfo(TDateTime),
    'CurX', @CurX, 'CurLastX', @CurLastX, 'CurY', @CurY, typeinfo(integer),
    'BlinkingRate', @BlinkingRate, typeinfo(single),
    'OnChangeEvent', @OnChangeEvent,  'OnEnterEvent', @OnEnterEvent, typeinfo(TEventSubscription)
]);
end;

procedure TTextEdit.Render;
var
  cx, cy, h, w, d: GLfloat;
  dx, dy: float;
  j: integer;
const k = 0.35;
begin
  inherited;
  if Focus and (sin((BlinkingRestartMoment - Now()) * SecondsPerDay * 2 * 3.14 * BlinkingRate) > 0)
  then begin
    if f_max_line_length > 0
      then cx:= (Fit^.ActualWidth / f_max_line_length) * CurX
      else cx:= 0;
    _CalcRelativeRectCoord(dx, dy);
    cx+= x + dx;
    h:= fit^.ActualHeight / max (1, Count);
    w:= fit^.ActualWidth / f_max_line_length;
    cy:= y + dy + (h * (CurY));
    d:= RectShadeThickness() / 2;
    //draw the cursor
    glDisable(GL_TEXTURE_2D);
    glEnable(GL_LINE_SMOOTH);
    glEnable(GL_BLEND);
    glDisable(GL_ALPHA_TEST);
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
    if not Module.InsertMode or ((length(f_line) = 0) or (CurX >= length(f_line[CurY]))) then begin
      //draw the vertical line cursor
      for j:=0 to 1 do begin
        if j=0 then begin
          glLineWidth(max(1.2,min(w *0.35, RectShadeThickness())));
          glColor4f(0, 0, 0, Color.Current[3]);
        end
        else begin
          glLineWidth(max(0.8,min(w * 0.25, RectLineThickness())));
          glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
        end;
        glBegin(GL_LINES);
          glVertex2f(cx + w * k, cy - d);
          glVertex2f(cx + w * k, cy + h +d );
        glEnd();
      end;
    end
    else begin
      // draw the rectangle cursor
      for j:=0 to 1 do begin
        if j=0 then begin
          glLineWidth(max(1.2,min(w *0.35, RectShadeThickness())));
          glColor4f(0, 0, 0, Color.Current[3]);
        end
        else begin
          glLineWidth(max(0.8,min(w * 0.25, RectLineThickness())));
          glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
        end;
        glBegin(GL_LINE_LOOP);
          glVertex2f(cx + w * k, cy - d);
          glVertex2f(cx + w * k, cy + h +d );
          glVertex2f(cx + w * (k + 1), cy + h +d );
          glVertex2f(cx + w * (k + 1), cy - d );
        glEnd();
      end;
    end;
//addlog('%0 %1 %2', [cx, cy, cy2]);
  end;
end;

function TTextEdit.OnKey(key: TKey): boolean;
var
  selected: boolean;
  changed: boolean = No;
  i, j: integer;
  w: WideChar;
  cwx, cwy, rx, ry: float;
begin
  with Module do
    selected:= (mousex > x) and (mousex < x + width.Current)
           and (mousey > y) and (mousey < y + height.Current);
  if key = KEY_NULL then begin
    if selected or Focus then begin
      Color.Current:= HighlightColor;
    end
    else begin
      Color.Current:= NormalColor;
    end
  end;
  if (key = KEY_MOUSE_LEFT) and (Module.KeyDown[key]) then begin
    if selected <> Focus then Focus:= selected;
  end;
//addlog(' %0  %1', [IntToHex(ord(key), 2),GetEnumName(typeinfo(tkey), ord(key))]);
  if not Assigned(fit) then Refit;
  if Focus then begin
    if Key = KEY_NULL then begin
        if selected then ;// ДОДЕЛАТЬ! Switch mouse pointer to a vertical line
      for i:=1 to length(module.TextInput) do begin
        w:= Module.TextInput[i];
        if w >= ' ' then begin
          InsertChar(w);
          changed:= Yes;
        end;
      end;
      if Module.TextInput <> '' then begin
        Refit;
        BlinkingRestartMoment:= Now + 1/SecondsPerDay;
      end;
      Module.TextInput:= '';
    end
    else BlinkingRestartMoment:= Now + 1/SecondsPerDay;
    if Module.KeyDown[key] then begin
      case key of
        KEY_MOUSE_LEFT: begin //put the cursor at the appropriate position
          //
          _CalcRelativeRectCoord(rx, ry);
          cwx:= fit^.ActualWidth / f_max_line_length;
          cwy:= fit^.ActualHeight / max(1, Count);
          CurX:= round((Module.MouseX - x - rx) / cwx);
          CurY:= round((Module.MouseY - y - ry - cwy/2) / cwy);
          CurLastX:= CurX;
          LimitCursor;
        end;
        KEY_LEFT: begin
          if (CurX = 0) and (CurY > 0) then begin
            dec(CurY);
            CurX:= length(f_line[CurY]);
            CurLastX:= CurX;
          end
          else MoveCursor(-1, 0);
        end;
        KEY_RIGHT: begin
          if (CurY < length(f_line) - 1) and (CurX = length(f_line[CurY])) then begin
            inc(CurY);
            CurX:= 0;
            CurLastX:= 0;
          end
          else MoveCursor(1, 0);
        end;
        KEY_UP: MoveCursor(0, -1);
        KEY_DOWN: MoveCursor(0, 1);
        KEY_BACKSPACE: begin
          if CurX = 0 then begin
            if CurY > 0 then begin
              CurX:= length(f_line[CurY - 1]);
              CurLastX:= CurX;
              Dec(CurY);
              JoinLines;
              changed:= Yes;
            end;
          end
          else begin
            dec(CurX);
            DeleteChar;
            changed:= Yes;
          end;
          CurLastX:=CurX;
          Refit;
        end;
        KEY_DELETE: begin
          if length(f_line) > 0 then begin
            if CurX < length(f_line[CurY])
              then DeleteChar
              else JoinLines;
            CurLastX:=CurX;
            changed:= Yes;
            Refit;
          end;
        end;
        KEY_INSERT: begin
          Module.InsertMode:= not Module.InsertMode;
        end;
        KEY_HOME: begin
          CurX:=0;
          CurLastX:=0;
        end;
        KEY_END: begin
          if length(f_line) = 0 then CurX:=0
                                else CurX:= length(f_line[CurY]);
          CurLastX:=CurX;
          LimitCursor;
        end;
        KEY_PGUP: begin
          CurY:=0;
          LimitCursor;
        end;
        KEY_PGDN: begin
          CurY:=Count - 1;
          LimitCursor;
        end;
        KEY_ENTER, KEY_KP_ENTER:
          if AllowMultiLine then begin
            SplitLine;
            changed:= Yes;
            Refit;
          end else begin
            PassEvent(OnEnterEvent);
          end;
      else
        //ignore it
      end;
      if changed then PassEvent(OnChangeEvent);
    end;
  end;
  if not selected then inherited; //hog all messages when the mouse is over us
end;

procedure TTextEdit.Cycle;
var
  i,j : integer;
  w: WideChar;
begin
  inherited Cycle;
end;

procedure TTextEdit.AfterLoading;
begin
  inherited;
  if f_focus then MotherState^.TextInput:= true;
end;

procedure TTextEdit.MoveCursor(deltaX, deltaY: integer);
begin
  CurX+= deltaX;
  if deltaX <> 0 then CurLastX:=CurX;
  CurY+= deltaY;
  LimitCursor;
  CurX:= min(CurLastX, length(f_line[CurY]));
end;

{ TBackground }



procedure TBackground.Render;
begin
  _cgeDrawBackground;
  AfterEfCheck;
  inherited Render;
end;

{  TSettingsMenu  }
  constructor TSettingsMenu.Create;
  begin
    inherited Create(300, 300, 10, 20);
    Reset('settings');
    Self.AddOnTop(Module.Control);
  end;

  procedure TSettingsMenu.AfterLoading;
  begin
    Self.Scrape;
  end;

  procedure TSettingsMenu.Reset(what: widestring);
  begin
    KillChildren;
    Clear;
//addlog(' -- Reset(%0)',[what]);
    Form(what);

    PlaySound('button.wav');
    NewCell(
      TButton.Create(RuEn('<< Назад','<< Back'), 300, 40, Self, 'back')
      , 0, NewRow(20), Length(f_ColumnMaxPix));
    Mode:= what;
  end;

  procedure TSettingsMenu.Form(what: widestring);
  var w, h, num_columns, i, cn, c, r, YourArbitraryButtonNum: integer;
    text, text2: ttextrect;
    button: TButton;
    sl: TArrayOfAnsiString;
    edit: TTextEdit;
    ws: WideString;
  begin
//addlog(' -- Form(%0)',[what]);
    w:= 300;
    h:= 40;
    if what = 'session' then begin
      ChangeSize(900,600);
      NewColumn(600);
      NewColumn(300);
      text:= TTextRect.Create(RuEn('Сессия','Session') + ' (' + Module.SessionId + ')' ,w,h);
        text.FontHeight:= GuiHeadlineFontHeight;
        NewCell(text, 0, NewRow(30), 2);

      NewCell(
        TButton.Create(RuEn('Сохранить','Save') + ' (' + HotKeyStringDescription(gv_QuickSaveHotKey) + ')',w,h, Self, 'SaveSession')
        , 1, NewRow(20));

      sl:= Module.GetSessionsList();
      if Length(sl) < 2 then begin
        button:= TButton.Create(RuEn('Нельзя переключить, есть только одна.','Cannot switch, there''s only one.'), w, h, Self, 'Act', 'buzz');
        button.NormalColor:= GuiDefaultGrayedColor;
        button.HighlightColor:= GuiDefaultGrayedColor;
      end else begin
        button:= TButton.Create(RuEn('Переключить...','Switch...'), w, h, Self, 'Reset', 'session_switch');
      end;
      NewCell(button, 1, NewRow(20));

      NewCell(
        TButton.Create(RuEn('Начать новую с нуля...','Begin new one from scratch...'), w, h, Self, 'Reset', 'session_new')
        , 1, NewRow(20));
      NewCell(
        TButton.Create(RuEn('Форкнуть текущую...','Fork the current one...'), w, h, Self, 'Reset', 'session_fork')
        , 1, NewRow(20));
      if Module.SessionId = 'default' then begin
        button:= TButton.Create(RuEn('Нельзя удалить сессию по умолчанию.','Cannot erase the default session.'), w, h, Self, 'Act', 'buzz');
        button.NormalColor:= GuiDefaultGrayedColor;
        button.HighlightColor:= GuiDefaultGrayedColor;
      end else begin
        button:= TButton.Create(RuEn('Стереть текущую...','Erase the current one...'), w, h, Self, 'Reset', 'session_erase');
        button.NormalColor:= GuiDefaultRedColor;
      end;
      NewCell(button, 1, NewRow(20));

      NewCell(
        TButton.Create(RuEn('Откатить','Roll back') + ' (' + HotKeyStringDescription(gv_QuickLoadHotKey) + ')',w,h, Self, 'RollbackSession')
        , 1, NewRow(20));


//      NewRow(60);
      text2:= TTextRect.Create(SplitLinesTooLong(MsgRaw(MI_SESSION_EXPLAIN),60,''),600,400);
        //text2.Halign:= halign_left;
        text2.Valign:= valign_top;
        NewCell(text2, 0, 1, 1, Length(f_RowMaxPix) - 1);
    end
    else if (what = 'session_new') or (what = 'session_fork') then begin
      ChangeSize(600,350);
      NewColumn(600);
      if what = 'session_new'
        then ws:= RuEn('Cессия: Начать новую','Session: Begin a new one')
        else ws:= RuEn('Сессия: Форкнуть текущую','Session: Fork the current one');

        text:= TTextRect.Create(ws,600,h);
        text.FontHeight:= GuiHeadlineFontHeight;
        NewCell(text, 0, NewRow(30));

      text:=  TTextRect.Create(RuEn('Введите ID новой сессии:','Enter the new session ID:'), w, h);
        //text.Halign:= halign_left;
        text.Valign:= valign_top;
        NewCell(text, 0, NewRow(20));

      if what = 'session_fork' then ws:= Module.SessionId else ws:= '';
      edit:= TTextEdit.Create(ws, w, h);
        edit.AllowMultiLine:= No;
        edit.HasBorder:= Yes;
        edit.Focus:= Yes;
        edit.id:= 'NewSessionIdEdit';
        edit.SubscribeEvent(edit.OnChangeEvent, Self, 'Act', 'text-edit-change');
        edit.SubscribeEvent(edit.OnEnterEvent, Self, 'Act', 'text-edit-confirm');
        NewCell(edit, 0, NewRow(20));

      text2:= TTextRect.Create('',600,h*2);
        //text2.Halign:= halign_left;
        text2.Valign:= valign_top;
        text2.id:= 'NewSessionIdDetails';
        NewCell(text2, 0, NewRow(40));
      if what = 'session_fork' then Self.Act('text-edit-change');
    end
    else if what = 'session_switch' then begin
      sl:= Module.GetSessionsList(); //not optimized at all, but fool-proof. Don't store the list, re-read the folder contents each time we try anything
      cn:= 1 + ((length(sl) - 1) div 10);
      ChangeSize(300 * cn, 200 + min(10, length(sl)) * 40);
      for c:= 1 to cn do NewColumn(300);

      text:= TTextRect.Create(RuEn('Cессия: Переключить','Session: Switch'),600,h);
        text.FontHeight:= GuiHeadlineFontHeight;
        NewCell(text, 0, NewRow(30), cn, 1);

      for i:= 1 to min(10, length(sl)) do NewRow(20);
      for i:=0 to High(sl) do begin
        c:= i div 10;
        r:= 1 + (i mod 10);
        if Module.SessionId = sl[i] then begin
          button:= TButton.Create(sl[i], w, h, Self, 'Act', 'buzz');
          button.NormalColor:= GuiDefaultRedColor;
          button.HighlightColor:= GuiDefaultRedColor;
        end else begin
          button:= TButton.Create(sl[i], w, h, Self, 'SwitchSession', sl[i]);
        end;
        NewCell(button, c, r);
      end;
      NewRow(20);
    end
    else if what = 'session_erase' then begin
      ChangeSize(600,600);
      cn:= 10;
      for c:= 1 to cn do NewColumn(600 / cn);

      text:= TTextRect.Create(RuEn('Cтереть текущую сессию?','Erase the current session?'),600,h);
        text.FontHeight:= GuiHeadlineFontHeight;
        text.Color.Current:= GuiDEfaultRedColor;
        NewCell(text, 0, NewRow(30), cn, 1);

      YourArbitraryButtonNum:= Random(cn) + 1;

      text:= TTextRect.Create(RuEn(
        'Текущая сессия «' + Module.SessionId + '»'#10#13'будет необратимо стёрта. Всё, нажитое непосильным трудом,'#10#13'окажется безвозвратно утрачено!'#10#13#10#13'Чтобы удалить сессию, нажмите кнопку №' + IntToStr(YourArbitraryButtonNum)
       ,'The current session "' + Module.SessionId + '"'#10#13'will be irrecoverably erased. Every fruit of your'#10#13'hard labor will be irrevocably lost!'#10#13#10#13'To continue with session removal, press button number ' + IntToStr(YourArbitraryButtonNum)
       ),600,h*5);
        text.Color.Current:= GuiDEfaultRedColor ;
        NewCell(text, 0, NewRow(60), cn, 1);

      r:= NewRow(30);

      for i:= 0 to cn - 1 do begin
        if (i + 1) = YourArbitraryButtonNum then begin
          button:= TButton.Create(IntToStr(i + 1), h, h, Self, 'EraseSession', '');
        end else begin
          button:= TButton.Create(IntToStr(i + 1), h, h, Self, 'Act', 'back');
        end;
        button.NormalColor:= GuiDefaultRedColor;
        button.HighlightColor:= GuiDefaultRedColor;
        NewCell(button, i, r);
      end;
      NewRow(40);
    end
    else begin
      what:= 'settings';
      w:= 300;
      h:= 40;
      ChangeSize(300,350);
      NewColumn(1);
      text:= TTextRect.Create(RuEn('Настройки','Setup'),w,h);
        text.FontHeight:= GuiHeadlineFontHeight;
        NewCell(text, 0, NewRow(30));
{
      NewCell(
        TButton.Create(RuEn('Сессия...','Session...'), w, h, Self, 'Reset', 'session')
        , 0, NewRow(20));
}
      NewCell(
        TButton.Create(RuEn('Изображение...','Visual...'), w, h, Self, 'Reset', 'video')
        , 0, NewRow(20));
      NewCell(
        TButton.Create(RuEn('Звук...','Audio...'), w, h, Self, 'Reset', 'audio')
        , 0, NewRow(20));
      NewCell(
        TButton.Create(RuEn('Графический планшет...','Pen tablet...'), w, h, Self, 'Reset', 'tablet')
        , 0, NewRow(20));
{      NewCell(
        TButton.Create(RuEn('XBox360 совместимый геймпад...','XBox360 compatible controller...'), w, h, Self, 'Reset', 'controller')
        , 0, NewRow(20));
}
    end;
  end;

  procedure TSettingsMenu.Act(action: widestring);
  var c: TControl;
      e: TTextEdit;
      r: TTextREct;
      w: WideString;
      sl: array of AnsiString;
      invalid: WideString = '';
      i: integer;
  begin
    if action = 'back' then Back;
    if action = 'buzz' then PlaySound('gui-disabled.wav');


     if (action = 'text-edit-change') or (action = 'text-edit-confirm') then begin
       e:= GetChildById('NewSessionIdEdit') as TTextEdit;
       r:= GetChildById('NewSessionIdDetails') as TTextRect;
       w:= e.Text;
       sl:= Module.GetSessionsList;
       if Trim(w) <> w then begin
         e.Text:= Trim(w);
         w:= e.Text;
       end;
       if w = ''
         then invalid:= RuEn('Введите идентификатор сессии','Enter the session id')
         else
           for i:=0 to high(sl) do
             if sl[i] = w then begin
               invalid:=RuEn('Такая сессия уже есть.','Such session already exists.');
               break
             end;
         if invalid = '' then
           for i:=1 to length(w) do
             if not (((w[i] >= 'a') and(w[i] <= 'z')) or ((w[i] >= '0') and (w[i] <= '9')) or (w[i] = '_')) then begin
               invalid:= RuEn(
                'Допустимы только строчные латинские буквы,'#13' цифры и символ подчёркивания _',
                'The only allowed symbols are lowercase basic Latin,'#13'numbers and the underline character _!');
               break;
             end;
       if Length(w) > 200 then invalid:= RuEn('Слишком длинно.','Too long.');
     end;
     if action = 'text-edit-change' then begin
       if invalid = '' then begin
         e.Color.Current:= GuiDEfaultColor ;
         r.Color.Current:= GuiDEfaultColor ;
         e.HighlightColor:= GuiDefaultHighlight;
         invalid:= RuEn('Нажмите Enter чтобы создать сессию','Press Enter to create session');
       end else begin
         e.Color.Current:= GuiDEfaultRedColor ;
         e.HighlightColor:= GuiDEfaultRedColor;
         r.Color.Current:= GuiDEfaultRedColor ;
       end;
       r.Text:= invalid;
     end;
     if  action = 'text-edit-confirm' then begin
       if invalid <> '' then exit;
       if Mode = 'session_new' then Module.SwitchSession(w);
       if Mode = 'session_fork' then begin
          Module.ForkSession(w);
          Mode:= '';
          Back; //commit suicide
       end;
     end;
  end;

  procedure TSettingsMenu.Back;
  begin
    if (Mode = 'session_new') or (Mode = 'session_fork') or (Mode = 'session_switch') or (Mode = 'session_erase') then begin
      Reset('session');
      exit;
    end;
addlog('*** mode=%0',[Mode]);
    if (Mode <> 'settings') and (Mode <> 'session') then begin
      Reset('settings');
      exit;
    end;
    KillChildren;
    RemoveFromChain;
    Scrape;
    Module.InvokeMenu(TModuleMainMenu);
  end;

  function TSettingsMenu.OnKey(key: TKey): boolean;
  begin
    if (key = KEY_ESCAPE) and Module.KeyDown[key] then begin //FYI this piggy gets called both on press AND release.
      Result:= false;
      Back;
    end
    else Result:= inherited OnKey(key);
  end;

  procedure TSettingsMenu.RegisterFields;
  begin
    inherited;
    ListFields([
      'Mode', @Mode, typeinfo(WideString)
    ]);
  end;

  procedure TSettingsMenu.EraseSession(stub: WideString);
  begin
    Module.EraseCurrentSession; //calls Module.SwitchSession('default') , which causes session re-load.
  end;

  procedure TSettingsMenu.SwitchSession(sess: WideString);
  var
    sl: TArrayOfAnsiString;
    i: integer;
    found: boolean;
  begin
    sl:= Module.GetSessionsList(); //not optimized at all, but fool-proof. Don't store the list, re-read the folder contents each time we try anything
    found:= No;
    for i:= 0 to Length(sl) - 1 do
      if sl[i] = sess then begin
        found:= Yes;
        break;
      end;
    if not found then begin
      AddLog(RuEn('Ошибка! Нет такой сессии, "%0"!','Error! There''s no session "%0"!'), [sess]);
      Reset(Mode);
      Exit;
    end;
    AddLog(RuEn('Переключение на сессию "%0".','Switching to session "%0".'),[sess]);
    Module.SwitchSession(sess);
  end;

  procedure TSettingsMenu.RollbackSession;
  begin
    PlaySound('click.wav');
    Module.RollbackSession; //execution continues happily after this point, the real action happens afther the end of the current frame.
  end;

  procedure TSettingsMenu.SaveSession;
  begin
    PlaySound('click.wav');
    Module.SaveSession;
  end;


{ TModuleMainMenu ------------------------------------------------------------------------------------------------------------------------------------------------------ }

constructor TModuleMainMenu.Create;
const
  bw = 300;
  bh = 40;
var
  cind: integer;
  text: ttextrect;
begin
  inherited Create(300, 300, 10, 20);

  cind:= NewColumn(1.0);

  // TButton.Create(RuEn('Упасть','Crash'), bw, bh, Self, 'CommitSuicideByAV'),0,1),

//  NewCell(TCheckBox.Create('Раз', bw, bh), cind, NewRow(20));

text:= TTextRect.Create(MotherState^.ModuleNameW,bw,bh);
  text.FontHeight:= GuiHeadlineFontHeight;
  NewCell(text, 0, NewRow(20), 2);
  NewCell(
    TButton.Create(RuEn('Сессия...','Session...'), bw, bh, Self, 'InvokeSessionMenu')
    , cind, NewRow(20));
  NewCell(
    TBUtton.Create(RuEn('Настройки...','Setup...'),bw,bh, Self, 'InvokeSettingsMenu')
    , cind, NewRow(20));
  NewCell(
     TButton.Create(RuEn('Выбрать другой модуль','Choose another module'),bw,bh, Self, 'GoToModuleSelectionMenu')
    , cind, NewRow(20, 1e5, not MotherState^.DeveloperMode));
  NewCell(
    TButton.Create(RuEn('Перезапустить программу','Restart the program'),bw,bh, Self, 'RestartProgram')
    , cind, NewRow(20, 1e5, not MotherState^.DebugMode));
  NewCell(
    TButton.Create(RuEn('Выйти из программы','Exit the program'),bw,bh, Self, 'Exitprogram')
    , cind, NewRow(20));
  NewCell(
    TButton.Create(RuEn('<< Продолжить','<< Continue'),bw,bh,Self, 'Kill')
    , cind, NewRow(20));

(*  inherited Create(
    [1.0],
    [],
    [],
    [20.0,  20.0,  20.0, 20.0,  20.0,  20.0, 20.0],
    [],
    [No, No, not MotherState^.DeveloperMode,
      not (MotherState^.DeveloperMode or MotherState^.DebugMode), No, not MotherState^.DebugMode, No],
    [TButton.Create(RuEn('Продолжить','Continue'),bw,bh,Self, 'Kill'),
     TButton.Create(RuEn('Упасть','Crash'), bw, bh, Self, 'CommitSuicideByAV'),
     TButton.Create(RuEn('Выбрать другой модуль','Choose another module'),bw,bh, Self, 'GoToModuleSelectionMenu'),
     TButton.Create(RuEn('Сохранить сессию','Save the session now'),bw,bh, Self, 'RestartModule'),
     TButton.Create(RuEn('Откатить сессию','Roll back the session'),bw,bh, Self, 'RollbackSession'),
     TButton.Create(RuEn('Перезапустить программу','Restart the program'),bw,bh, Self, 'RestartProgram'),
     TButton.Create(RuEn('Выйти из программы','Exit the program'),bw,bh, Self, 'Exitprogram')
    ],
    [0, 0, 0, 0, 0, 0, 0],
    [1, 1, 1, 1, 1, 1, 1],
    [0, 1, 2, 3, 4, 5, 6],
    [1, 1, 1, 1, 1, 1, 1],
    300, 300, 10, 20);    *)

{      _RowMinPerc,
      _RowMaxPix,
      _RowDisabled,
      _RowMinPerc,
      _RowMaxPix,
      _RowDisabled,
      _Cell,
      _CellRow,
      _CellColSpan,
      _CellRow,
      _CellRowSpan: array of const; }
  OnResize;
  Self.AddOnTop(Module.Control);
end;

function TModuleMainMenu.OnKey(key: TKey): boolean;
begin
  if (key = KEY_ESCAPE) and Module.KeyDown[key] then begin
    Result:= false;
    Kill;
  end
  else Result:= inherited OnKey(key);
end;

procedure TModuleMainMenu.InvokeSettingsMenu();
begin
  Module.InvokeMenu(TSettingsMenu);
end;

procedure TModuleMainMenu.InvokeSessionMenu();
begin
  Module.InvokeMenu(TSettingsMenu);
  (Module.MainMenu as TSettingsMenu).Reset('session'); //it was too deep inside that option so I decided to move it up.
end;

procedure TModuleMainMenu.ExitProgram();
begin
  _RequestExit;
  AfterEfCheck;
end;

procedure TModuleMainMenu.RestartProgram;
begin
  PlaySound('click.wav');
  MotherState^.RestartRequested:= Yes;
end;

procedure TModuleMainMenu.RestartModule;
begin
  PlaySound('click.wav');
  MotherState^.ModuleState:= ms_Unloading;
  MotherState^.BlackoutStart:= Now();
end;

procedure TModuleMainMenu.GoToModuleSelectionMenu();
begin
  PlaySound('click.wav');
  MotherState^.ModuleRequestToChooseModule:= Yes;
end;

//var ttt: TCrashTestThread;
//procedure TModuleMainMenu.CommitSuicideByAV;
//begin
 // ttt:= TCrashTestThread.Create(false);
{  Try
    byte(nil^):=0;
  except
    Die(RuEn('Исключение успешно поймано в DLL модуля.','The exception was successfully caught in the module DLL.'));
  end;
}
//end;

  function VarRecTypeName(Vt: integer): WideString;
  begin
    Case Vt of
      vtInteger:    Result:= RuEn('целый','integer');
      vtBoolean:    Result:= RuEn('булев','boolean');
      vtChar:       Result:= 'ansichar';
      vtWideChar:   Result:= 'widechar';
      vtExtended:   Result:= 'extended';
      vtAnsiString: Result:= RuEn('ansi строка','ansi string');
      vtWideString: Result:= RuEn('wide строка','wide string');
      vtPWideChar:  Result:= 'pwidechar';
      vtPChar:      Result:= 'pansichar';
      vtObject:     Result:= RuEn('экземпляр класса','class instance');
      vtClass:      Result:= RuEn('метакласс','metaclass');
      vtPointer:    Result:= RuEn('указатель','pointer');
      vtCurrency:   Result:= 'currency';
      vtVariant:    Result:= RuEn('вариант','variant');

      vtInt64:      Result:= 'int64';
      vtQword:      Result:= 'qword';
    else
      Result:= RuEn('<неизвестный тип VarRec ','<unknown VarRec type ') + IntToHex(vt, 2) + 'h>';
    end;
  end;

  function ArrayOfConstBasicChecks(a: array of const; _type: integer; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean): boolean;
  var j: integer;
  begin
    if (Length(a) = 0) and not AllowEmpty then begin
      ErrorMessage:= RuEn('пустой ','empty ') + ArrayName;
      Exit(No);
    end;
    if (ControlLen >=0) and (Length(a) <> ControlLen) and not ((Length(a) = 0) and AllowEmpty) then begin
      ErrorMessage:= PervertedFormat(RuEn('длина %0 равна %1, ожидалась %2','%0 has length %1, expected %2'),[ArrayName, Length(a), ControlLen]);
      Exit(No);
    end;
    for j:=0 to high(a) do begin
      if a[j].Vtype <> _type then begin
        ErrorMessage:= PervertedFormat(RuEn('неверный тип %0[%1](%2): ожидался %3','wrong type of %0[%1](%2): expected %3'), [ArrayName, j, VarRecTypeName(a[j].VType), VarRecTypeName(_type)]);
        Exit(No);
      end;
    end;
    Result:=Yes;
  end;

  function ArrayOfConstToFloatArray(a: array of const; var f: TFloatArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean; DefaultValue: float): boolean;
  var j: integer;
  begin
    if not ArrayOfConstBasicChecks(a, vtExtended, ControlLen, ArrayName, ErrorMessage, AllowEmpty) then Exit(No);
    Result:= Yes;
    if (length(a) = 0) and AllowEmpty then begin
      SetLength(f , ControlLen);
      For j:=0 to ControlLen - 1 do f[j]:= Defaultvalue;
    end
    else begin
      SetLength(f , Length(a));
      For j:=0 to high(a) do f[j]:= a[j].VExtended^;
    end;
  end;

  function ArrayOfConstToIntArray(a: array of const; var i: TIntArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean; DefaultValue: integer): boolean;
  var j: integer;
  begin
    if not ArrayOfConstBasicChecks(a, vtInteger, ControlLen, ArrayName, ErrorMessage, AllowEmpty) then Exit(No);
    Result:= Yes;
    if (length(a) = 0) and AllowEmpty then begin
      SetLength(i , ControlLen);
      For j:=0 to ControlLen - 1 do i[j]:= Defaultvalue;
    end
    else begin
      SetLength(i , Length(a));
      For j:=0 to high(a) do i[j]:= a[j].VInteger;
    end;
  end;

  function ArrayOfConstToBoolArray(a: array of const; var b: TBoolArray; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean; DefaultValue: boolean): boolean;
  var j: integer;
  begin
    if not ArrayOfConstBasicChecks(a, vtBoolean, ControlLen, ArrayName, ErrorMessage, AllowEmpty) then Exit(No);
    Result:= Yes;
    if (length(a) = 0) and AllowEmpty then begin
      SetLength(b , ControlLen);
      For j:=0 to ControlLen - 1 do b[j]:= Defaultvalue;
    end
    else begin
      SetLength(b , Length(a));
      For j:=0 to high(a) do b[j]:= a[j].VBoolean;
    end;
  end;

  function ArrayOfConstToTRectControlArray(a: array of const; var o: TArrayOfTRectControl; ControlLen: integer; ArrayName: WideString; var ErrorMessage: WideString; AllowEmpty: boolean; DefaultValue: TRectControl): boolean;
  var j: integer;
  begin
    if not ArrayOfConstBasicChecks(a, vtObject, ControlLen, ArrayName, ErrorMessage, AllowEmpty) then Exit(No);
    Result:= Yes;
    if (length(a) = 0) and AllowEmpty then begin
      SetLength(o , ControlLen);
      For j:=0 to ControlLen - 1 do o[j]:= Defaultvalue;
    end
    else begin
      SetLength(o , Length(a));
      For j:=0 to high(a) do begin
        TObject(o[j]):= a[j].VObject;
//if not Assigned(o[j]) then AddLog('!nil in %0',[j]) else AddLog('!%0 in %1',[string(o[j].Classname), j]);
        if not (o[j] is TRectControl) then begin
          ErrorMessage:= PervertedFormat(RuEn('%0[%1](%2) - не потомок TRectControl','%0[%1](%2) is not a TRectControl descentant'), [ArrayName, j, string(o[j].ClassName)]);
          Exit(No);
        end;
      end;
    end;
  end;


{ TCheckBox }

function TCheckBox.PassClickToReceiver(): boolean;
var
  method: procedure(slf: TObject);  //A hack ^_^;
  receiver: TManagedObject;
  method_name: ansistring;
  function ename: WideString;
  begin
    if Checked then result:= RuEn('активации','on')
               else result:= RuEn('деактивации','off');
  end;
begin
  if Checked then begin
    receiver:= SwitchOnReceiver;
    method_name:= SwitchOnReceiverMethod;
  end
  else begin
    receiver:= SwitchOffReceiver;
    method_name:= SwitchOffReceiverMethod;
  end;
  if not Assigned(receiver) then Exit(No);
  Result:= Yes;
  if receiver.Scraped then Die(RuEn( //the joys of garbage collector ;)
    'Крах чекбокса %0: получатель сигнала %2 принадлежит удалённому объекту (%1)',
    'Checkbox %0 crash: the "%2" signal receiver is a scraped object (%1)'),
    [string(self.ClassName), string(receiver.Classname), ename()]);
  pointer(method):= receiver.MethodAddress(method_name);
  if not Assigned(@method) then begin
    AddLog(RuEn(
      'Чекбокс %0: нажатие не удалось: получатель сигнала %3 (%1) не имеет метода "%2"',
      'Checkbox %0: click failed, the "%3" signal receiver (%1) doesn''t have a method "%2"'),
        [string(self.ClassName), string(receiver.Classname), method_name, ename()]);
    Exit;//(No);
  end;
  try
    method(receiver);
  except
    Die(RuEn(
      'Крах чекбокса %0 при вызове обработчика сигнала %3, %1.%2()',
      'Checkbox %0 crashed at calling the "%3" signal receiver %1.%2()'),
      [string(self.ClassName), string(receiver.Classname), method_name, ename()])
  end;
end;

constructor TCheckBox.Create(_caption: WideString; _width, _height: float;
  _SwitchOnReceiver: TManagedObject; _SwitchOnReceiverMethod: AnsiString;
  _SwitchOffReceiver: TManagedObject; _SwitchOffReceiverMethod: AnsiString;
  _PressingKey: TKey);
begin
  SwitchOnReceiver:= _SwitchOnReceiver;
  SwitchOnReceiverMethod:= _SwitchOnReceiverMethod;
  SwitchOffReceiver:= _SwitchOffReceiver;
  SwitchOffReceiverMethod:= _SwitchOffReceiverMethod;
  PressingKey:= _PressingKey;

  Box:= TCheckBoxBox.Create(GuiDefaultCheckBoxSize, GuiDefaultCheckBoxSize);
  Box.Parent:= Self;
  Box.HasBorder:= true;
  Text:= TTextRect.Create(_caption, _width, _height);
  Text.Parent:= Self;
  Text.Halign:= halign_left;

  inherited Create(_width, _height);
  NewRow(1.0);
  NewColumn(1.0, 2*GuiDefaultTablePadding + GuiDefaultCheckBoxSize);
  NewColumn(1.0);
  NewCell(Box, 0, 0);
  NewCell(Text, 1, 0);

  NormalColor:= GuiDEfaultColor;
  HighlightColor:= GuiDEfaultHighlight;
  Text.Color.Current:= NormalColor;
  Box.Color.Current:= NormalColor;
  OnResize;
end;

destructor TCheckBox.Destroy;
begin
  Text.Free;
  Box.Free;
  inherited Destroy;
end;

procedure TCheckBox.RegisterFields;
begin
  RegClass(TCheckBoxBox);
  inherited RegisterFields;
  ListFields(
   ['box', @Box, typeinfo(TCheckBoxBox),
    'text', @Text, typeinfo(TTextRect),
    'SwitchOnReceiver', @SwitchOnReceiver, typeinfo(TManagedObject),
    'SwitchOnReceiverMethod', @SwitchOnReceiverMethod, typeinfo(AnsiString),
    'SwitchOffReceiver', @SwitchOffReceiver, typeinfo(TManagedObject),
    'SwitchOffReceiverMethod', @SwitchOffReceiverMethod, typeinfo(AnsiString),
    'PressingKey', @PressingKey, typeinfo(TKey),
    'Checked', @Checked, typeinfo(boolean)
   ]);
end;

function TCheckBox.OnKey(key: TKey): boolean;
var
  selected: boolean;
begin
  with Module do
    selected:= (mousex > x) and (mousex < x + width.Current)
           and (mousey > y) and (mousey < y + height.Current);
  if key = KEY_NULL then begin
    if selected then begin
      Color.Current:= HighlightColor;
      Box.Color.Current:= Color.Current;
      Text.Color.Current:= Color.Current;
    end
    else begin
      Color.Current:= NormalColor;
      Box.Color.Current:= Color.Current;
      Text.Color.Current:= Color.Current;
    end
  end;
  if (key = PressingKey) and Module.KeyDown[key] and selected
  then begin
    Result:= false;
    Checked:= not Checked;
    if not PassClickToReceiver
      then OnChange;
  end
  else
    Result:= inherited;
end;

procedure TCheckBoxBox.Render;
  procedure RenderMark(bev: float);
  begin
    glBegin(GL_LINE_STRIP);
      glVertex2f(x + bev, y + bev);
      glVertex2f(x + Width.Current/2, y + Height.Current - bev);
      glVertex2f(x + Width.Current - bev, y + bev);
      glVertex2f(x + Width.Current + bev, y - bev*0.6);
      glVertex2f(x + Width.Current + 2*bev, y - bev);
    glEnd();
  end;
  procedure RenderSquare(bev: float);
  begin
    glBegin(GL_LINE_LOOP);
      glVertex2f(x + bev, y + bev);
      glVertex2f(x + Width.Current, y + bev);
      glVertex2f(x + Width.Current, y + Height.Current - bev);
      glVertex2f(x + bev, y + Height.Current - bev);
    glEnd();
  end;
begin
  //inherited;
  glDisable(GL_TEXTURE_2D);
  glEnable(GL_LINE_SMOOTH);
  glEnable(GL_BLEND);
  glDisable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glLineWidth(RectShadeThickness());
  glColor4f(0, 0, 0, Color.Current[3]);
  RenderSquare(1);
  glLineWidth(RectLineThickness());
  glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
  RenderSquare(1);
  if (Parent as TCheckBox).Checked then begin
    glLineWidth(RectShadeThickness());
    glColor4f(0, 0, 0, Color.Current[3]);
    RenderMark(4);
    glLineWidth(RectLineThickness());
    glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
    RenderMark(4);
  end;

end;



procedure TCheckBox.OnChange;
begin
//do nothing
end;

{ TRadioButtonPoint }

procedure TRadioButtonPoint.Render;
const
  PointRadius = 2;
  numSubs = 10;
  procedure RenderCircle(r: float);
  var i: integer;
  begin
    glBegin(GL_LINE_LOOP);
      for i:=0 to numSubs - 1 do
        glVertex2f(x + Width.Current / 2  + r * sin(2 * Pi * i / numSubs),
                   y + Height.Current / 2 + r * cos(2 * Pi * i / numSubs));
    glEnd();
  end;
begin
  //inherited;
  glDisable(GL_TEXTURE_2D);
  glEnable(GL_LINE_SMOOTH);
  glEnable(GL_BLEND);
  glDisable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glLineWidth(RectShadeThickness());
  glColor4f(0, 0, 0, Color.Current[3]);
  RenderCircle(min(Width.Current, Height.Current) - 1);
  if Selected then RenderCircle(PointRadius);
  glLineWidth(RectLineThickness());
  glColor4f(Color.Current[0]*MotherState^.FadeIn, Color.Current[1]*MotherState^.FadeIn, Color.Current[2]*MotherState^.FadeIn, Color.Current[3]);
  RenderCircle(min(Width.Current, Height.Current) - 1);
  if Selected then RenderCircle(PointRadius);
end;

{ TRadioGroup }


destructor TRadioGroup.Destroy;
var i: integer;
begin
  Caption.Free;
  for i:= 0 to high(points) do points[i].Free;
  for i:= 0 to high(texts) do texts[i].Free;
  inherited Destroy;
end;

procedure TRadioGroup.RegisterFields;
begin
  RegClass(TRadioButtonPoint);
  RegType(typeinfo(TRadioButtonPointArray), typeinfo(TRadioButtonPoint));
  RegType(typeinfo(TTextRectArray), typeinfo(TTextRect));
  inherited RegisterFields;
  ListFields([
    'Caption', @Caption, typeinfo(TTextRect),
    'points', @points, typeinfo(TRadioButtonPointArray),
    'texts', @texts, typeinfo(TTextRectArray),
    'PressingKey', @PressingKey, typeinfo(TKey),
    'Columns', @Columns, typeinfo(integer)
  ]);
end;

function TRadioGroup.OnKey(key: TKey): boolean;
begin
  Result:= inherited OnKey(key);
end;

procedure TRadioGroup.Render;
begin
  inherited Render;
end;

procedure TRadioGroup.OnChange;
begin
  //do nothing
end;

constructor THasToHaveTabletMenu.Create;
const
  bw = 500;
  bh = 60;
  ll = 50;
var
  Headline,Explanation,Summary: TTextRect;
  s: WideString;
begin

  inherited Create(bw, 380, 10, 20);
  NewColumn();

  Headline:= TTextRect.Create(RuEn('Коснитесь пером планшета','Touch your graphical tablet with its pen'),bw,bh);
  HeadLine.FontHeight:= GuiHeadlineFontHeight;
  NewCell(Headline, 0, NewRow(20));

  Explanation:= TTextRect.Create(SplitLinesTooLong(RuEn(
    'Модуль «' + PWideCharToWideString(MotherState^.ModuleNameW) + '» требует обязательного наличия графического планшета.',
    'Module “' + PWideCharToWideString(MotherState^.ModuleNameW) + '” requires that you have a graphical pen tablet.'),ll,'  '),bw,65);
  Explanation.Halign:= halign_left;
  Explanation.Valign:= valign_top;
  NewCell(Explanation, 0, NewRow(25));

  s:= RuEn('Планшет: ' ,'Pen tablet: ');
  if Assigned(MotherState^.PenTabletName)
    then begin
      s+= PWideCharToWideString(MotherState^.PenTabletName);
      if MotherState^.PenTabletPressureResolution > 0 then s+= PervertedFormat(RuEn(
        #13'(%0 степеней чувствительности к нажатию)',
        #13'(pressure sensivity range %0)'), [MotherState^.PenTabletPressureResolution]);
    end
    else
      s+= RuEn('отсутствует','none present');

  if Assigned(MotherState^.PenTabletAbsenceReason) then s+= ' (' + PWideCharToWideString(MotherState^.PenTabletAbsenceReason) + ')';
  Summary:= TTextRect.Create(SplitLinesTooLong(s,ll,'  '), bw, bh*2);
  if not MotherState^.PenTabletPresent then Summary.Color.Current:= GuiDefaultRedColor;
  Summary.Parent:=Self;
  Summary.Halign:= halign_left;
  Summary.Valign:= valign_top;
  NewCell(Summary, 0, NewRow(50));


  NewCell(TButton.Create(RuEn('Перезапустить чтобы определить заново','Restart to detect anew'),300,40, Self, 'Restartprogram'), 0, NewRow(20));
  NewCell(TButton.Create(RuEn('Выбрать другой модуль','Choose another module'),300,40, Self, 'GoToModuleSelectionMenu'),
    0, NewRow(20, 1e5, not (MotherState^.DeveloperMode or MotherState^.DebugMode)));
  NewCell(TButton.Create(RuEn('Выйти из программы','Exit the program'),300,40, Self, 'Exitprogram'), 0, NewRow(20));


  OnResize;
  Self.AddOnTop(Module.Control);
end;

procedure THasToHaveTabletMenu.RestartProgram();
begin
  PlaySound('click.wav');
  MotherState^.RestartRequested:= Yes;
  AfterEfCheck;
end;

procedure THasToHaveTabletMenu.ExitProgram();
begin
  PlaySound('click.wav');
  _RequestExit;
  AfterEfCheck;
end;

procedure THasToHaveTabletMenu.GoToModuleSelectionMenu();
begin
  PlaySound('click.wav');
  MotherState^.ModuleRequestToChooseModule:= Yes;
end;

procedure THasToHaveTabletMenu.Cycle;
begin
  inherited;
  if MotherState^.PenActivityDetected then begin
     RemoveFromChain;
     Scrape;
     Module.MainMenu:= nil;
  end;
end;


constructor TThreadsStopIndicator.Create;
var t, t2: TTextrect;
begin
  inherited Create(600, 300, 10, 20);
  NewColumn();
  t:= TTextRect.Create(RuEn('Ожидание завершения фоновых задач...','Waiting for background tasks to stop...'),600,60);
  t.FontHeight:= GuiHeadlineFontHeight;
  NewCell(t, 0, NewRow(20));

  t2:= TTextRect.Create('', 300, 40);
  t2.id:= 'ind';
  NewCell(t2, 0, NewRow(20));


  Self.Lower:= TBackground.Create();
end;

procedure TThreadsStopIndicator.Cycle;
var
  T: TTextrect;
  seconds: integer;
begin
  T:= Self.GetChildById('ind') as TTextRect;
  seconds:= trunc((MotherState^.WaitingForModuleThreadsToTerminateTimeoutMoment - Now()) /SecondsPerDay);
  T.text:= IntToStr(seconds);
end;

function SplitLinesTooLong(w: WideString; limit: integer; prefix: WideString): WideString;
var
  i: integer;
  lstart: integer = 1;
  lend: integer = 0;
  L: integer;
begin
  Result:= '';
  for i:=1 to Length(w) do begin
    if w[i] <= ' ' then lend:= i;
    if (((i - lstart) > limit) and (lend > 0)) or (i = Length(w)) or (w[i] = #13) then begin
      if lstart > 1 then Result+= #10#13 + prefix;
      if (i < Length(w)) and (lend > 0) then L:= lend - lstart else L:= Length(w) - lstart + 1;
      Result+= copy(w, lstart, L);
      lstart:= lend + 1;
      lend:=0;
    end;
  end;
end;


end.
  
