////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
//  FSM routines. FSM is Finite State Machine.                                //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20220221 - 1st release                                                     //
// 20220410 - TFsmEntity.Link,fsm_link()                                      //
// 20220412 - TFsmEntity.Modified,fsm_modified()                              //
// 20220427 - TFsmState.myColor -> TFsmParent.myColor                         //
// 20220621 - fsm_name_rule,fsm_valid_childtype                               //
// 20230515 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_fsm; // FSM routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes,
 _crw_alloc, _crw_rtc, _crw_str, _crw_bsencode, _crw_hl;

const ////////////////////// FSM entity type identifiers
 fsm_type_nil       = 0;  // Nil pointer, entity is not exist
 fsm_type_int       = 1;  // Parameter type Integer
 fsm_type_float     = 2;  // Parameter type Float
 fsm_type_string    = 3;  // Parameter type String
 fsm_type_parameter = 4;  // TFsmParameter, abstract
 fsm_type_manager   = 5;  // TFsmManager
 fsm_type_domain    = 6;  // TFsmDomain
 fsm_type_class     = 7;  // TFsmClass
 fsm_type_object    = 8;  // TFsmObject
 fsm_type_state     = 9;  // TFsmState
 fsm_type_action    = 10; // TFsmAction
 fsm_type_objectset = 11; // TFsmObjectSet
 fsm_type_function  = 12; // TFsmFunction
 fsm_type_parent    = 13; // TFsmParent, abstract
 fsm_type_entity    = 14; // TFsmEntity, abstract
 fsm_type_any       = 14; // Synonym of fsm_type_entity

type /////////////////////// Types of  TFsmEntity
 TFsmEntityTypeId   = fsm_type_nil..fsm_type_any;

const
 FsmParamTypes    = [fsm_type_int,fsm_type_float,fsm_type_string];
 FsmParentTypes   = [fsm_type_manager,fsm_type_domain,fsm_type_class,
                     fsm_type_object,fsm_type_state,fsm_type_action,
                     fsm_type_objectset,fsm_type_function];
 FsmAbstractTypes = [fsm_type_parameter,fsm_type_parent,fsm_type_entity];
 FsmValidTypes    = FsmParamTypes+FsmParentTypes;
 FsmAnyValidTypes = FsmValidTypes+FsmAbstractTypes;
 FsmAnyParamTypes = FsmParamTypes+[fsm_type_parameter];

const
 UsesFsmManagerCatalog : Boolean = true; // Faster  global search by path
 UsesFsmSafeListFind   : Boolean = true; // Faster local   search by name
 UsesFsmFastListFind   : Boolean = true; // Faster local   search by name

const
 FsmDefaultColor : LongString = '_3DFace';  // Default color of state
 FsmNilStateId   = '<NIL>';   // fsm_ctrl(obj,'state=<NIL>') to set NIL state

type
 TFsmEntity = class;
 TFsmParent = class;
 TFsmManager = class;
 TFsmDomain = class;
 TFsmClass  = class;
 TFsmObject = class;
 TFsmState  = class;
 TFsmAction = class;
 TFsmObjectSet = class;
 TFsmFunction = class;
 TFsmParameter  = class;
 TFsmParamInt = class;
 TFsmParamFloat = class;
 TFsmParamString = class;
 TFsmEntity = class(TMasterObject)
 private
  myName     : LongString;
  myTypeId   : Integer;
  myParent   : TFsmParent;
  myLinks    : THashList;
  myModified : Integer;
 private
  procedure UnifyName;
  procedure FreeAllChilds;
  function  GetName:LongString;
  function  GetTypeId:Integer;
  function  GetParent:TFsmParent;
 private
  function  GetPath:LongString;
  function  GetChildCount:Integer;
  function  GetParamCount:Integer;
  function  GetAdultCount:Integer;
  function  GetChildItems(i:Integer):TFsmEntity;
  function  GetParamItems(i:Integer):TFsmEntity;
  function  GetAdultItems(i:Integer):TFsmEntity;
  function  GetCount(aType:Integer):Integer;
  function  GetItems(aType,aIndex:Integer):TFsmEntity;
  function  GetParamInt:Integer;
  procedure SetParamInt(i:Integer);
  function  GetParamFloat:Double;
  procedure SetParamFloat(f:Double);
  function  GetParamString:LongString;
  procedure SetParamString(s:LongString);
  function  GetCookie:LongString;
  procedure SetCookie(s:LongString);
  function  GetBody:LongString;
  procedure SetBody(s:LongString);
  function  GetActualState:TFsmEntity;
  procedure SetActualState(aState:TFsmEntity);
  function  GetInitialState:TFsmEntity;
  procedure SetInitialState(aState:TFsmEntity);
  function  GetDeadState:TFsmEntity;
  procedure SetDeadState(aState:TFsmEntity);
  function  GetColor:LongString;
  procedure SetColor(s:LongString);
  function  GetDefaultColor:LongString;
  procedure SetDefaultColor(s:LongString);
  function  GetAssociated:Boolean;
  procedure SetAssociated(b:Boolean);
  function  GetDeclaration:LongString;
  function  GetIsOfClass:LongString;
  procedure SetIsOfClass(s:LongString);
  function  GetUnionList:LongString;
  procedure SetUnionList(s:LongString);
  function  GetUnionMode:Boolean;
  procedure SetUnionMode(b:Boolean);
  function  GetVisible:Boolean;
  procedure SetVisible(b:Boolean);
 private
  function  DoGetPath:LongString; virtual;
  function  DoGetFastList:THashList; virtual;
  function  DoGetChildList:TList; virtual;
  function  DoGetParamList:TList; virtual;
  function  DoGetAdultList:TList; virtual;
  function  DoGetChildCount:Integer; virtual;
  function  DoGetParamCount:Integer; virtual;
  function  DoGetAdultCount:Integer; virtual;
  function  DoGetChildItems(i:Integer):TFsmEntity; virtual;
  function  DoGetParamItems(i:Integer):TFsmEntity; virtual;
  function  DoGetAdultItems(i:Integer):TFsmEntity; virtual;
  function  DoGetCount(aType:Integer):Integer; virtual;
  function  DoGetItems(aType,aIndex:Integer):TFsmEntity; virtual;
  function  DoGetParamInt:Integer; virtual;
  procedure DoSetParamInt(i:Integer); virtual;
  function  DoGetParamFloat:Double; virtual;
  procedure DoSetParamFloat(f:Double); virtual;
  function  DoGetParamString:LongString; virtual;
  procedure DoSetParamString(s:LongString); virtual;
  function  DoGetCookie:LongString; virtual;
  procedure DoSetCookie(s:LongString); virtual;
  function  DoGetBody:LongString; virtual;
  procedure DoSetBody(s:LongString); virtual;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; virtual;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; virtual;
  function  DoGetActualState:TFsmEntity; virtual;
  procedure DoSetActualState(aState:TFsmEntity); virtual;
  function  DoGetInitialState:TFsmEntity; virtual;
  procedure DoSetInitialState(aState:TFsmEntity); virtual;
  function  DoGetDeadState:TFsmEntity; virtual;
  procedure DoSetDeadState(aState:TFsmEntity); virtual;
  function  DoGetColor:LongString; virtual;
  procedure DoSetColor(s:LongString); virtual;
  function  DoGetDefaultColor:LongString; virtual;
  procedure DoSetDefaultColor(s:LongString); virtual;
  function  DoGetAssociated:Boolean; virtual;
  procedure DoSetAssociated(b:Boolean); virtual;
  function  DoGetDeclaration:LongString; virtual;
  function  DoGetIsOfClass:LongString; virtual;
  procedure DoSetIsOfClass(s:LongString); virtual;
  function  DoGetUnionList:LongString; virtual;
  procedure DoSetUnionList(s:LongString); virtual;
  function  DoGetUnionMode:Boolean; virtual;
  procedure DoSetUnionMode(b:Boolean); virtual;
  function  DoGetVisible:Boolean; virtual;
  procedure DoSetVisible(b:Boolean); virtual;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Name        : LongString            read GetName;
  property  Path        : LongString            read GetPath;
  property  TypeId      : Integer               read GetTypeId;
  property  Parent      : TFsmParent            read GetParent;
  property  ChildCount  : Integer               read GetChildCount;
  property  ChildItems[i:Integer] : TFsmEntity  read GetChildItems;
  property  ParamCount  : Integer               read GetParamCount;
  property  ParamItems[i:Integer] : TFsmEntity  read GetParamItems;
  property  AdultCount  : Integer               read GetAdultCount;
  property  AdultItems[i:Integer] : TFsmEntity  read GetAdultItems;
  property  Declaration : LongString            read GetDeclaration;
 public
  function  ParentManager:TFsmManager;
  function  Link(const arg:LongString):Integer;
  function  Modified(delta:Integer):Integer;
  function  FindChild(aName:LongString):TFsmEntity;
  function  FindParam(aName:LongString):TFsmEntity;
  function  FindAdult(aName:LongString):TFsmEntity;
  property  Count[aType:Integer]:Integer read GetCount;
  property  Items[aType,aIndex:Integer]:TFsmEntity read GetItems;
 public
  property  ParamInt     : Integer    read GetParamInt     write SetParamInt;
  property  ParamFloat   : Double     read GetParamFloat   write SetParamFloat;
  property  ParamString  : LongString read GetParamString  write SetParamString;
  property  Cookie       : LongString read GetCookie       write SetCookie;
  property  Body         : LongString read GetBody         write SetBody;
  property  Color        : LongString read GetColor        write SetColor;
  property  DefaultColor : LongString read GetDefaultColor write SetDefaultColor;
  property  ActualState  : TFsmEntity read GetActualState  write SetActualState;
  property  InitialState : TFsmEntity read GetInitialState write SetInitialState;
  property  DeadState    : TFsmEntity read GetDeadState    write SetDeadState;
  property  Associated   : Boolean    read GetAssociated   write SetAssociated;
  property  IsOfClass    : LongString read GetIsOfClass    write SetIsOfClass;
  property  UnionList    : LongString read GetUnionList    write SetUnionList;
  property  UnionMode    : Boolean    read GetUnionMode    write SetUnionMode;
  property  Visible      : Boolean    read GetVisible      write SetVisible;
 public
  function  Control(arg:LongString):LongString;
  function  AddEntity(aType:Integer; aName:LongString):TFsmEntity;
  function  FindEntity(aType:Integer; aName:LongString):TFsmEntity;
 end;
 TFsmParent = class(TFsmEntity)
 private
  myFaster  : THashList;
  myChilds  : TList;
  myParams  : TList;
  myAdults  : TList;
  myCookie  : LongString;
  myBody    : LongString;
  myColor   : LongString;
  myVisible : Boolean;
 private
  procedure AppendChild(aChild:TFsmEntity);
  procedure RemoveChild(aChild:TFsmEntity);
 private
  procedure DoAppendChild(aChild:TFsmEntity); virtual;
  procedure DoRemoveChild(aChild:TFsmEntity); virtual;
  function  DoGetFastList:THashList; override;
  function  DoGetChildList:TList; override;
  function  DoGetParamList:TList; override;
  function  DoGetAdultList:TList; override;
  function  DoGetChildCount:Integer; override;
  function  DoGetParamCount:Integer; override;
  function  DoGetAdultCount:Integer; override;
  function  DoGetChildItems(i:Integer):TFsmEntity; override;
  function  DoGetParamItems(i:Integer):TFsmEntity; override;
  function  DoGetAdultItems(i:Integer):TFsmEntity; override;
  function  DoGetCookie:LongString; override;
  procedure DoSetCookie(s:LongString); override;
  function  DoGetBody:LongString; override;
  procedure DoSetBody(s:LongString); override;
  function  DoGetColor:LongString; override;
  procedure DoSetColor(s:LongString); override;
  function  DoGetVisible:Boolean; override;
  procedure DoSetVisible(b:Boolean); override;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; override;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
  destructor  Destroy; override;
 end;
 TFsmManager = class(TFsmParent)
 private
  myCatalog      : THashList;
  myDomains      : TList;
  myDefaultColor : LongString;
 private
  procedure CatalogAdd(aEntity:TFsmEntity);
  procedure CatalogRemove(aEntity:TFsmEntity);
  procedure DoAppendChild(aChild:TFsmEntity); override;
  procedure DoRemoveChild(aChild:TFsmEntity); override;
  function  DoGetCount(aType:Integer):Integer; override;
  function  DoGetItems(aType,aIndex:Integer):TFsmEntity; override;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoGetDefaultColor:LongString; override;
  procedure DoSetDefaultColor(s:LongString); override;
 public
  function    FindPath(aPath:LongString):TFsmEntity;
  function    ListCatalog:LongString;
 public
  constructor Create(aName:LongString='FsmManager');
  destructor  Destroy; override;
 end;
 TFsmDomain = class(TFsmParent)
 private
  myClasses : TList;
  myObjects : TList;
  myObjSets : TList;
 private
  function  DoGetPath:LongString; override;
  procedure DoAppendChild(aChild:TFsmEntity); override;
  procedure DoRemoveChild(aChild:TFsmEntity); override;
  function  DoGetCount(aType:Integer):Integer; override;
  function  DoGetItems(aType,aIndex:Integer):TFsmEntity; override;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmManager);
  destructor  Destroy; override;
 end;
 TFsmClass  = class(TFsmParent)
 private
  myStates          : TList;
  myFuncts          : TList;
  myDeadStateRef    : Integer;
  myActualStateRef  : Integer;
  myInitialStateRef : Integer;
  myAssociated      : Boolean;
 private
  function  DoGetPath:LongString; override;
  procedure DoAppendChild(aChild:TFsmEntity); override;
  procedure DoRemoveChild(aChild:TFsmEntity); override;
  function  DoGetCount(aType:Integer):Integer; override;
  function  DoGetItems(aType,aIndex:Integer):TFsmEntity; override;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoGetActualState:TFsmEntity; override;
  procedure DoSetActualState(aState:TFsmEntity); override;
  function  DoGetInitialState:TFsmEntity; override;
  procedure DoSetInitialState(aState:TFsmEntity); override;
  function  DoGetDeadState:TFsmEntity; override;
  procedure DoSetDeadState(aState:TFsmEntity); override;
  function  DoGetAssociated:Boolean; override;
  procedure DoSetAssociated(b:Boolean); override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmDomain);
  destructor  Destroy; override;
 end;
 TFsmObject = class(TFsmClass)
 private
  myIsOfClass : LongString;
 private
  function  DoGetDeclaration:LongString; override;
  function  DoGetIsOfClass:LongString; override;
  procedure DoSetIsOfClass(s:LongString); override;
 public
  constructor Create(aName:LongString; aParent:TFsmDomain);
  destructor  Destroy; override;
 end;
 TFsmState  = class(TFsmParent)
 private
  myActions : TList;
 private
  function  DoGetPath:LongString; override;
  procedure DoAppendChild(aChild:TFsmEntity); override;
  procedure DoRemoveChild(aChild:TFsmEntity); override;
  function  DoGetCount(aType:Integer):Integer; override;
  function  DoGetItems(aType,aIndex:Integer):TFsmEntity; override;
  function  DoAddEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoFindEntity(aType:Integer; aName:LongString):TFsmEntity; override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmClass);
  destructor  Destroy; override;
 end;
 TFsmAction = class(TFsmParent)
 private
  function  DoGetPath:LongString; override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmState);
 end;
 TFsmObjectSet = class(TFsmParent)
 private
  myIsOfClass : LongString;
  myUnionList : LongString;
  myUnionMode : Boolean;
 private
  function  DoGetPath:LongString; override;
  function  DoGetDeclaration:LongString; override;
  function  DoGetIsOfClass:LongString; override;
  procedure DoSetIsOfClass(s:LongString); override;
  function  DoGetUnionList:LongString; override;
  procedure DoSetUnionList(s:LongString); override;
  function  DoGetUnionMode:Boolean; override;
  procedure DoSetUnionMode(b:Boolean); override;
 public
  constructor Create(aName:LongString; aParent:TFsmDomain);
  destructor  Destroy; override;
 end;
 TFsmFunction = class(TFsmParent)
 private
  function  DoGetPath:LongString; override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmClass);
 end;
 TFsmParameter = class(TFsmEntity)
 private
  function  DoGetPath:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
 end;
 TFsmParamInt = class(TFsmParameter)
 private
  myParam : Integer;
 private
  function  DoGetParamInt:Integer; override;
  procedure DoSetParamInt(i:Integer); override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
 end;
 TFsmParamFloat = class(TFsmParameter)
 private
  myParam : Double;
 private
  function  DoGetParamFloat:Double; override;
  procedure DoSetParamFloat(f:Double); override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
 end;
 TFsmParamString = class(TFsmParameter)
 private
  myParam : LongString;
 private
  function  DoGetParamString:LongString; override;
  procedure DoSetParamString(s:LongString); override;
  function  DoGetDeclaration:LongString; override;
 public
  constructor Create(aName:LongString; aParent:TFsmParent);
  destructor  Destroy; override;
 end;

function NewFsmManager(aName:LongString='FsmManager'):TFsmManager;
function NewFsmDomain(aName:LongString; aParent:TFsmEntity):TFsmDomain;
function NewFsmClass(aName:LongString; aParent:TFsmEntity):TFsmClass;
function NewFsmObject(aName:LongString; aParent:TFsmEntity):TFsmObject;
function NewFsmState(aName:LongString; aParent:TFsmEntity):TFsmState;
function NewFsmAction(aName:LongString; aParent:TFsmEntity):TFsmAction;
function NewFsmObjectSet(aName:LongString; aParent:TFsmEntity):TFsmObjectSet;
function NewFsmFunction(aName:LongString; aParent:TFsmEntity):TFsmFunction;
function NewFsmParamInt(aName:LongString; aParent:TFsmEntity):TFsmParamInt;
function NewFsmParamFloat(aName:LongString; aParent:TFsmEntity):TFsmParamFloat;
function NewFsmParamString(aName:LongString; aParent:TFsmEntity):TFsmParamString;

procedure Kill(var TheObject:TFsmEntity); overload;
procedure Kill(var TheObject:TFsmManager); overload;
procedure Kill(var TheObject:TFsmDomain); overload;
procedure Kill(var TheObject:TFsmClass); overload;
procedure Kill(var TheObject:TFsmObject); overload;
procedure Kill(var TheObject:TFsmState); overload;
procedure Kill(var TheObject:TFsmAction); overload;
procedure Kill(var TheObject:TFsmObjectSet); overload;
procedure Kill(var TheObject:TFsmFunction); overload;
procedure Kill(var TheObject:TFsmParamInt); overload;
procedure Kill(var TheObject:TFsmParamFloat); overload;
procedure Kill(var TheObject:TFsmParamString); overload;

////////////////////////////////////////////////////////////////////////////////
// Easy FSM API
////////////////////////////////////////////////////////////////////////////////

function fsm_new:Integer;
function fsm_free(ref:Integer):Boolean;
function fsm_ref(ref:Integer):TFsmEntity;
function fsm_root(ref:Integer):Integer;
function fsm_type(ref:Integer):Integer;
function fsm_parent(ref:Integer):Integer;
function fsm_name(ref:Integer):LongString;
function fsm_path(ref:Integer):LongString;
function fsm_ctrl(ref:Integer; arg:LongString):LongString;
function fsm_count(ref,typ:Integer):Integer;
function fsm_items(ref,typ,i:Integer):Integer;
function fsm_get_iparam(ref:Integer):Integer;
function fsm_set_iparam(ref:Integer; data:Integer):Boolean;
function fsm_get_fparam(ref:Integer):Real;
function fsm_set_fparam(ref:Integer; data:Real):Boolean;
function fsm_get_sparam(ref:Integer):LongString;
function fsm_set_sparam(ref:Integer; data:LongString):Boolean;
function fsm_add(ref:Integer; typ:integer; key:LongString):Integer;
function fsm_find(ref:Integer; typ:integer; key:LongString):Integer;
function fsm_get_state(ref:Integer):Integer;
function fsm_set_state(ref:Integer; state:Integer):Integer; overload;
function fsm_set_state(ref:Integer; state:LongString):Integer; overload;
function fsm_link(ref:Integer; arg:LongString):Integer;
function fsm_modified(ref:Integer; delta:Integer):Integer;
function fsm_name_rule(typ:Integer):Integer;
function fsm_valid_childtype(typ,childtyp:Integer):Boolean;

////////////////////////////////////////////////////////////////////////////////
// FSM self test function
////////////////////////////////////////////////////////////////////////////////

function fsm_self_test:LongString;

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  ////////////////////// Properties Writable
  sid_State,
  sid_Initial_State,
  sid_Dead_State,
  sid_Cookie,
  sid_Body,
  sid_Color,
  sid_DefaultColor,
  sid_Associated,
  sid_is_of_class,
  sid_UnionList,
  sid_UnionMode,
  sid_Visible,
  ////////////////////// Properties ReadOnly
  sid_Name,
  sid_Path,
  sid_Type,
  sid_ClassName,
  sid_Catalog,
  sid_Declaration,
  ////////////////////// Properties End
  sid_Asterisk,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:LongString; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=@Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'State'               , sid_State);
 AddSid( 'initial_state'       , sid_initial_state);
 AddSid( 'dead_state'          , sid_dead_state);
 AddSid( 'Cookie'              , sid_Cookie);
 AddSid( 'Body'                , sid_Body);
 AddSid( 'Color'               , sid_Color);
 AddSid( 'DefaultColor'        , sid_DefaultColor);
 AddSid( 'Associated'          , sid_Associated);
 AddSid( 'is_of_class'         , sid_is_of_class);
 AddSid( 'UnionList'           , sid_UnionList);
 AddSid( 'UnionMode'           , sid_UnionMode);
 AddSid( 'Visible'             , sid_Visible);
 AddSid( 'Name'                , sid_Name);
 AddSid( 'Path'                , sid_Path);
 AddSid( 'Type'                , sid_Type);
 AddSid( 'ClassName'           , sid_ClassName);
 AddSid( 'Catalog'             , sid_Catalog);
 AddSid( 'Declaration'         , sid_Declaration);
 AddSid( '*'                   , sid_Asterisk);
end;

function Identify(const key:LongString):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

const
 sid_Control_Readable = [sid_State..sid_Declaration];
 sid_Control_Writable = [sid_State..sid_Visible];

///////////////////////////
// Internal helper routines
///////////////////////////

function SafeListCount(aList:TList):Integer;
begin
 if (aList<>nil)
 then Result:=aList.Count
 else Result:=0;
end;

function SafeListItems(aList:TList; aIndex:Integer):Pointer;
begin
 if (aList<>nil) and (aIndex>=0) and (aIndex<aList.Count)
 then Result:=aList.Items[aIndex]
 else Result:=nil;
end;

procedure SafeListAdd(aList:TList; aItem:Pointer);
begin
 if (aList<>nil) and (aItem<>nil)
 then aList.Add(aItem);
end;

procedure SafeListRemove(aList:TList; aItem:Pointer);
begin
 if (aList<>nil) and (aItem<>nil)
 then aList.Remove(aItem);
end;

function SafeListFind(aList:TList; const aName:LongString):TFsmEntity;
var i:Integer;
begin
 Result:=nil;
 if (aName='') then Exit;
 if (aList=nil) then Exit;
 for i:=0 to aList.Count-1 do
 if SameText(TFsmEntity(aList.Items[i]).Name,aName) then begin
  Result:=aList.Items[i];
  Break;
 end;
end;

////////////////////////////
// TFsmEntity implementation
////////////////////////////

constructor TFsmEntity.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create;
 myName:=SysUtils.Trim(aName);
 myTypeId:=fsm_type_entity;
 myParent:=aParent;
 myLinks:=nil;
 myModified:=0;
 UnifyName;
end;

destructor TFsmEntity.Destroy;
begin
 myName:='';
 myParent:=nil;
 Kill(myLinks);
 inherited Destroy;
end;

procedure TFsmEntity.AfterConstruction;
begin
 inherited AfterConstruction;
 Parent.AppendChild(Self);
end;

procedure TFsmEntity.BeforeDestruction;
begin
 FreeAllChilds;
 Parent.RemoveChild(Self);
 inherited BeforeDestruction;
end;

procedure TFsmEntity.UnifyName;
begin
 if (Self=nil) then Exit;
 if (Self is TFsmManager) then Exit;
 myName:=UpperCase(myName);
end;

procedure TFsmEntity.FreeAllChilds;
var i:Integer;
begin
 for i:=ChildCount-1 downto 0 do ChildItems[i].Free;
end;

function TFsmEntity.GetName:LongString;
begin
 if (Self<>nil)
 then Result:=myName
 else Result:='';
end;

function TFsmEntity.GetTypeId:Integer;
begin
 if (Self<>nil)
 then Result:=myTypeId
 else Result:=0;
end;

function TFsmEntity.GetParent:TFsmParent;
begin
 if (Self<>nil)
 then Result:=myParent
 else Result:=nil;
end;

function TFsmEntity.GetPath:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetPath
 else Result:='';
end;

function TFsmEntity.DoGetPath:LongString;
begin
 Result:='';
end;

function TFsmEntity.DoGetFastList:THashList;
begin
 Result:=nil;
end;

function TFsmEntity.DoGetChildList:TList;
begin
 Result:=nil;
end;

function TFsmEntity.DoGetParamList:TList;
begin
 Result:=nil;
end;

function TFsmEntity.DoGetAdultList:TList;
begin
 Result:=nil;
end;

function TFsmEntity.GetChildCount:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetChildCount
 else Result:=0;
end;

function TFsmEntity.DoGetChildCount:Integer;
begin
 Result:=0;
end;

function TFsmEntity.GetChildItems(i:Integer):TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetChildItems(i)
 else Result:=nil;
end;

function TFsmEntity.DoGetChildItems(i:Integer):TFsmEntity;
begin
 Result:=nil;
end;

function TFsmEntity.GetParamCount:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetParamCount
 else Result:=0;
end;

function TFsmEntity.DoGetParamCount:Integer;
begin
 Result:=0;
end;

function TFsmEntity.GetParamItems(i:Integer):TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetParamItems(i)
 else Result:=nil;
end;

function TFsmEntity.DoGetParamItems(i:Integer):TFsmEntity;
begin
 Result:=nil;
end;

function TFsmEntity.GetAdultCount:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetAdultCount
 else Result:=0;
end;

function TFsmEntity.DoGetAdultCount:Integer;
begin
 Result:=0;
end;

function TFsmEntity.GetAdultItems(i:Integer):TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetAdultItems(i)
 else Result:=nil;
end;

function TFsmEntity.DoGetAdultItems(i:Integer):TFsmEntity;
begin
 Result:=nil;
end;

function TFsmEntity.GetCount(aType:Integer):Integer;
begin
 if (Self<>nil)
 then Result:=DoGetCount(aType)
 else Result:=0;
end;

function TFsmEntity.DoGetCount(aType:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 case aType of
  fsm_type_int       : Result:=ParamCount;
  fsm_type_float     : Result:=ParamCount;
  fsm_type_string    : Result:=ParamCount;
  fsm_type_parameter : Result:=ParamCount;
  fsm_type_parent    : Result:=AdultCount;
  fsm_type_entity    : Result:=ChildCount;
 end;
end;

function TFsmEntity.GetItems(aType,aIndex:Integer):TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetItems(aType,aIndex)
 else Result:=nil;
end;

function TFsmEntity.DoGetItems(aType,aIndex:Integer):TFsmEntity;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 case aType of
  fsm_type_int       : Result:=ParamItems[aIndex];
  fsm_type_float     : Result:=ParamItems[aIndex];
  fsm_type_string    : Result:=ParamItems[aIndex];
  fsm_type_parameter : Result:=ParamItems[aIndex];
  fsm_type_parent    : Result:=AdultItems[aIndex];
  fsm_type_entity    : Result:=ChildItems[aIndex];
 end;
end;

function TFsmEntity.GetParamInt:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetParamInt
 else Result:=0;
end;

function TFsmEntity.DoGetParamInt:Integer;
begin
 Result:=0;
end;

procedure TFsmEntity.SetParamInt(i:Integer);
begin
 if (Self<>nil) then DoSetParamInt(i);
end;

procedure TFsmEntity.DoSetParamInt(i:Integer);
begin
end;

function TFsmEntity.GetParamFloat:Double;
begin
 if (Self<>nil)
 then Result:=DoGetParamFloat
 else Result:=0;
end;

function TFsmEntity.DoGetParamFloat:Double;
begin
 Result:=0;
end;

procedure TFsmEntity.SetParamFloat(f:Double);
begin
 if (Self<>nil) then DoSetParamFloat(f);
end;

procedure TFsmEntity.DoSetParamFloat(f:Double);
begin
end;

function TFsmEntity.GetParamString:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetParamString
 else Result:='';
end;

function TFsmEntity.DoGetParamString:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetParamString(s:LongString);
begin
 if (Self<>nil) then DoSetParamString(s);
end;

procedure TFsmEntity.DoSetParamString(s:LongString);
begin
end;

function TFsmEntity.GetCookie:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetCookie
 else Result:='';
end;

function TFsmEntity.DoGetCookie:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetCookie(s:LongString);
begin
 if (Self<>nil) then DoSetCookie(s);
end;

procedure TFsmEntity.DoSetCookie(s:LongString);
begin
end;

function TFsmEntity.GetBody:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetBody
 else Result:='';
end;

function TFsmEntity.DoGetBody:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetBody(s:LongString);
begin
 if (Self<>nil) then DoSetBody(s);
end;

procedure TFsmEntity.DoSetBody(s:LongString);
begin
end;

function TFsmEntity.GetActualState:TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetActualState
 else Result:=nil;
end;

function TFsmEntity.DoGetActualState:TFsmEntity;
begin
 Result:=nil;
end;

procedure TFsmEntity.SetActualState(aState:TFsmEntity);
begin
 if (Self<>nil) then DoSetActualState(aState);
end;

procedure TFsmEntity.DoSetActualState(aState:TFsmEntity);
begin
end;

function TFsmEntity.GetInitialState:TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetInitialState
 else Result:=nil;
end;

function TFsmEntity.DoGetInitialState:TFsmEntity;
begin
 Result:=nil;
end;

procedure TFsmEntity.SetInitialState(aState:TFsmEntity);
begin
 if (Self<>nil) then DoSetInitialState(aState);
end;

procedure TFsmEntity.DoSetInitialState(aState:TFsmEntity);
begin
end;

function TFsmEntity.GetDeadState:TFsmEntity;
begin
 if (Self<>nil)
 then Result:=DoGetDeadState
 else Result:=nil;
end;

function TFsmEntity.DoGetDeadState:TFsmEntity;
begin
 Result:=nil;
end;

procedure TFsmEntity.SetDeadState(aState:TFsmEntity);
begin
 if (Self<>nil) then DoSetDeadState(aState);
end;

procedure TFsmEntity.DoSetDeadState(aState:TFsmEntity);
begin
end;

function TFsmEntity.GetColor:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetColor
 else Result:='';
end;

function TFsmEntity.DoGetColor:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetColor(s:LongString);
begin
 if (Self<>nil) then DoSetColor(s);
end;

procedure TFsmEntity.DoSetColor(s:LongString);
begin
end;

function TFsmEntity.GetDefaultColor:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetDefaultColor
 else Result:='';
end;

function TFsmEntity.DoGetDefaultColor:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetDefaultColor(s:LongString);
begin
 if (Self<>nil) then DoSetDefaultColor(s);
end;

procedure TFsmEntity.DoSetDefaultColor(s:LongString);
begin
end;

function TFsmEntity.GetAssociated:Boolean;
begin
 if (Self<>nil)
 then Result:=DoGetAssociated
 else Result:=false;
end;

function TFsmEntity.DoGetAssociated:Boolean;
begin
 Result:=false;
end;

procedure TFsmEntity.SetAssociated(b:Boolean);
begin
 if (Self<>nil) then DoSetAssociated(b);
end;

procedure TFsmEntity.DoSetAssociated(b:Boolean);
begin
end;

function TFsmEntity.GetDeclaration:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetDeclaration
 else Result:='';
end;

function TFsmEntity.DoGetDeclaration:LongString;
begin
 Result:='';
end;

function TFsmEntity.GetIsOfClass:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetIsOfClass
 else Result:='';
end;

function TFsmEntity.DoGetIsOfClass:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetIsOfClass(s:LongString);
begin
 if (Self<>nil) then DoSetIsOfClass(s);
end;

procedure TFsmEntity.DoSetIsOfClass(s:LongString);
begin
end;

function TFsmEntity.GetUnionList:LongString;
begin
 if (Self<>nil)
 then Result:=DoGetUnionList
 else Result:='';
end;

function TFsmEntity.DoGetUnionList:LongString;
begin
 Result:='';
end;

procedure TFsmEntity.SetUnionList(s:LongString);
begin
 if (Self<>nil) then DoSetUnionList(s);
end;

procedure TFsmEntity.DoSetUnionList(s:LongString);
begin
end;

function TFsmEntity.GetUnionMode:Boolean;
begin
 if (Self<>nil)
 then Result:=DoGetUnionMode
 else Result:=false;
end;

function TFsmEntity.DoGetUnionMode:Boolean;
begin
 Result:=false;
end;

procedure TFsmEntity.SetUnionMode(b:Boolean);
begin
 if (Self<>nil) then DoSetUnionMode(b);
end;

procedure TFsmEntity.DoSetUnionMode(b:Boolean);
begin
end;

function TFsmEntity.GetVisible:Boolean;
begin
 if (Self<>nil)
 then Result:=DoGetVisible
 else Result:=false;
end;

function TFsmEntity.DoGetVisible:Boolean;
begin
 Result:=false;
end;

procedure TFsmEntity.SetVisible(b:Boolean);
begin
 if (Self<>nil) then DoSetVisible(b);
end;

procedure TFsmEntity.DoSetVisible(b:Boolean);
begin
end;

function TFsmEntity.ParentManager:TFsmManager;
var E:TFsmEntity;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 E:=Self; while (E<>nil) and (E.TypeId<>fsm_type_manager) do E:=E.Parent;
 if (E is TFsmManager) then Result:=TFsmManager(E);
end;

function TFsmEntity.Link(const arg:LongString):Integer;
var sn,sv:LongString;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (arg='') then Exit;
 ExtractNameValuePair(arg,sn,sv,'=',0);
 if IsLexeme(sn,fsm_name_rule(fsm_type_int)) then begin
  if (sv<>'') then begin
   if (myLinks=nil) then begin
    myLinks:=NewHashList(false,HashList_DefaultHasher);
    myLinks.OwnsObjects:=False;
    myLinks.Master:=@myLinks;
   end;
   sv:=SysUtils.Trim(sv);
   myLinks.KeyedLinks[sn]:=StrToIntDef(sv,0);
  end;
  if (myLinks<>nil) then Result:=myLinks.KeyedLinks[sn];
 end;
end;

function TFsmEntity.Modified(delta:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (delta=0) then begin
  Result:=myModified;
  if (Result<>0)
  then myModified:=0;
  Exit;
 end;
 if (delta>0) then begin
  if not (Self is TFsmManager)
  then Parent.Modified(delta);
  inc(myModified,delta);
  Result:=myModified;
  Exit;
 end;
 Result:=myModified;
end;

function TFsmEntity.FindChild(aName:LongString):TFsmEntity;
var i:Integer;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aName='') then Exit;
 if UsesFsmFastListFind then begin
  Result:=TFsmEntity(DoGetFastList.KeyedObjects[aName]);
  if (Result<>nil) and not (TObject(Result) is TFsmEntity) then Result:=nil;
  Exit;
 end;
 if UsesFsmSafeListFind then begin
  Result:=SafeListFind(DoGetChildList,aName);
  Exit;
 end;
 for i:=0 to ChildCount-1 do
 if SameText(aName,ChildItems[i].Name) then begin
  Result:=ChildItems[i];
  Break;
 end;
end;

function TFsmEntity.FindParam(aName:LongString):TFsmEntity;
var i:Integer;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aName='') then Exit;
 if UsesFsmFastListFind then begin
  Result:=TFsmEntity(DoGetFastList.KeyedObjects[aName]);
  if (Result<>nil) and not (Result is TFsmParameter) then Result:=nil;
  Exit;
 end;
 if UsesFsmSafeListFind then begin
  Result:=SafeListFind(DoGetParamList,aName);
  Exit;
 end;
 for i:=0 to ParamCount-1 do
 if SameText(aName,ParamItems[i].Name) then begin
  Result:=ParamItems[i];
  Break;
 end;
end;

function TFsmEntity.FindAdult(aName:LongString):TFsmEntity;
var i:Integer;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aName='') then Exit;
 if UsesFsmFastListFind then begin
  Result:=TFsmEntity(DoGetFastList.KeyedObjects[aName]);
  if (Result<>nil) and not (Result is TFsmParent) then Result:=nil;
  Exit;
 end;
 if UsesFsmSafeListFind then begin
  Result:=SafeListFind(DoGetAdultList,aName);
  Exit;
 end;
 for i:=0 to AdultCount-1 do
 if SameText(aName,AdultItems[i].Name) then begin
  Result:=AdultItems[i];
  Break;
 end;
end;

function TFsmEntity.Control(arg:LongString):LongString;
var i,pe,iv,si:Integer; sn,sv:LongString; Ent:TFsmEntity;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (arg='') then Exit;
 try
  pe:=ExtractNameValuePair(arg,sn,sv,'=',0);
  case Identify(sn) of
   sid_State: begin
    if (pe>0) then begin
     sv:=SysUtils.Trim(sv);
     if SameText(sv,FsmNilStateId) then begin
      ActualState:=nil;
     end else begin
      ent:=FindEntity(fsm_type_state,sv);
      if (ent is TFsmState) then ActualState:=ent;
     end;
    end;
    Result:=ActualState.Name;
   end;
   sid_initial_state: begin
    if (pe>0) then begin
     sv:=SysUtils.Trim(sv);
     if SameText(sv,FsmNilStateId) then begin
      InitialState:=nil;
     end else begin
      ent:=FindEntity(fsm_type_state,sv);
      if (ent is TFsmState) then InitialState:=ent;
     end;
    end;
    Result:=InitialState.Name;
   end;
   sid_dead_state: begin
    if (pe>0) then begin
     sv:=SysUtils.Trim(sv);
     if SameText(sv,FsmNilStateId) then begin
      DeadState:=nil;
     end else begin
      ent:=FindEntity(fsm_type_state,sv);
      if (ent is TFsmState) then DeadState:=ent;
     end;
    end;
    Result:=DeadState.Name;
   end;
   sid_Name: begin
    if (pe>0) and IsLexeme(sv,fsm_name_rule(fsm_type_manager)) then
    if (Self is TFsmManager) then begin
     myName:=UpperCase(sv);
    end;
    Result:=Name;
   end;
   sid_Path: begin
    Result:=Path;
   end;
   sid_Type: begin
    Result:=ClassName;
    Delete(Result,1,1);
   end;
   sid_ClassName: begin
    Result:=ClassName;
   end;
   sid_Catalog: begin
    Result:=ParentManager.ListCatalog;
   end;
   sid_Cookie: begin
    if (pe>0) then Cookie:=sv;
    Result:=Cookie;
   end;
   sid_Body: begin
    if (pe>0) then Body:=sv;
    Result:=Body;
   end;
   sid_Color: begin
    if (pe>0) then Color:=sv;
    Result:=Color;
   end;
   sid_DefaultColor: begin
    if (pe>0) then DefaultColor:=sv;
    Result:=DefaultColor;
   end;
   sid_Associated: begin
    if (pe>0) and Str2Int(sv,iv) then Associated:=(iv<>0);
    Result:=IntToStr(Ord(Associated));
   end;
   sid_Declaration: begin
    Result:=Declaration;
   end;
   sid_is_of_class: begin
    if (pe>0) then IsOfClass:=sv;
    Result:=IsOfClass;
   end;
   sid_UnionList: begin
    if (pe>0) then UnionList:=sv;
    Result:=UnionList;
   end;
   sid_UnionMode: begin
    if (pe>0) and Str2Int(sv,iv) then UnionMode:=(iv<>0);
    Result:=IntToStr(Ord(UnionMode));
   end;
   sid_Visible: begin
    if (pe>0) and Str2Int(sv,iv) then Visible:=(iv<>0);
    Result:=IntToStr(Ord(Visible));
   end;
   sid_Asterisk: begin
    if (Dictionary<>nil) then
    for i:=0 to Dictionary.Count-1 do begin
     si:=Dictionary.Links[i];
     if (si<=Ord(sid_Unknown)) then continue;
     if (si>=Ord(sid_Asterisk)) then continue;
     if not (TStringIdentifier(si) in sid_Control_Readable) then continue;
     if (pe>0) and not (TStringIdentifier(si) in sid_Control_Writable) then continue;
     Result:=Result+Dictionary.Keys[i]+EOL;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Control');
 end;
end;

function TFsmEntity.AddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aName='') then Exit;
 if (aType in FsmValidTypes) then
 try
  Result:=DoFindEntity(aType,aName);
  if (Result=nil) then Result:=DoAddEntity(aType,aName);
  if (Result.TypeId<>aType) then Result:=nil;
 except
  on E:Exception do BugReport(E,Self,'AddEntity');
 end;
end;

function TFsmEntity.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
end;

function TFsmEntity.FindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aName='') then Exit;
 if (aType in FsmAnyValidTypes) then
 try
  Result:=DoFindEntity(aType,aName);
  if (Result.TypeId<>aType) and (aType in FsmValidTypes) then Result:=nil;
 except
  on E:Exception do BugReport(E,Self,'FindEntity');
 end;
end;

function TFsmEntity.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
end;

procedure Kill(var TheObject:TFsmEntity); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

////////////////////////////
// TFsmParent implementation
////////////////////////////

constructor TFsmParent.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_parent;
 myFaster:=NewHashList(false,HashList_DefaultHasher);
 myFaster.OwnsObjects:=False;
 myFaster.Master:=@myFaster;
 myChilds:=TList.Create;
 myParams:=TList.Create;
 myAdults:=TList.Create;
 myCookie:='';
 myBody:='';
 myColor:=ParentManager.DefaultColor;
 myVisible:=true;
end;

destructor TFsmParent.Destroy;
begin
 myBody:='';
 myColor:='';
 myCookie:='';
 Kill(myFaster);
 Kill(myChilds);
 Kill(myParams);
 Kill(myAdults);
 inherited Destroy;
end;

procedure TFsmParent.AppendChild(aChild:TFsmEntity);
begin
 if Assigned(Self) then DoAppendChild(aChild);
end;

procedure TFsmParent.DoAppendChild(aChild:TFsmEntity);
begin
 if (aChild=nil) then Exit;
 SafeListAdd(myChilds,aChild);
 if (aChild is TFsmParent) then SafeListAdd(myAdults,aChild) else
 if (aChild is TFsmParameter) then SafeListAdd(myParams,aChild);
 myFaster.KeyedObjects[aChild.Name]:=aChild;
 ParentManager.CatalogAdd(aChild);
end;

procedure TFsmParent.RemoveChild(aChild:TFsmEntity);
begin
 if Assigned(Self) then DoRemoveChild(aChild);
end;

procedure TFsmParent.DoRemoveChild(aChild:TFsmEntity);
begin
 if (aChild=nil) then Exit;
 SafeListRemove(myChilds,aChild);
 if (aChild is TFsmParent) then SafeListRemove(myAdults,aChild) else
 if (aChild is TFsmParameter) then SafeListRemove(myParams,aChild);
 ParentManager.CatalogRemove(aChild);
 myFaster.Delete(aChild.Name);
end;

function TFsmParent.DoGetFastList:THashList;
begin
 Result:=myFaster;
end;

function TFsmParent.DoGetChildList:TList;
begin
 Result:=myChilds;
end;

function TFsmParent.DoGetParamList:TList;
begin
 Result:=myParams;
end;

function TFsmParent.DoGetAdultList:TList;
begin
 Result:=myAdults;
end;

function TFsmParent.DoGetChildCount:Integer;
begin
 Result:=SafeListCount(myChilds);
end;

function TFsmParent.DoGetChildItems(i:Integer):TFsmEntity;
begin
 Result:=SafeListItems(myChilds,i);
end;

function TFsmParent.DoGetParamCount:Integer;
begin
 Result:=SafeListCount(myParams);
end;

function TFsmParent.DoGetParamItems(i:Integer):TFsmEntity;
begin
 Result:=SafeListItems(myParams,i);
end;

function TFsmParent.DoGetAdultCount:Integer;
begin
 Result:=SafeListCount(myAdults);
end;

function TFsmParent.DoGetAdultItems(i:Integer):TFsmEntity;
begin
 Result:=SafeListItems(myAdults,i);
end;

function TFsmParent.DoGetCookie:LongString;
begin
 Result:=myCookie;
end;

procedure TFsmParent.DoSetCookie(s:LongString);
begin
 myCookie:=s;
end;

function TFsmParent.DoGetBody:LongString;
begin
 Result:=myBody;
end;

procedure TFsmParent.DoSetBody(s:LongString);
begin
 myBody:=s;
end;

function TFsmParent.DoGetColor:LongString;
begin
 Result:=myColor;
end;

procedure TFsmParent.DoSetColor(s:LongString);
begin
 myColor:=SysUtils.Trim(s);
end;

function TFsmParent.DoGetVisible:Boolean;
begin
 Result:=myVisible;
end;

procedure TFsmParent.DoSetVisible(b:Boolean);
begin
 myVisible:=b;
end;

function TFsmParent.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=NewFsmParamInt(aName,Self);
   fsm_type_float     : Result:=NewFsmParamFloat(aName,Self);
   fsm_type_string    : Result:=NewFsmParamString(aName,Self);
  end;
 end;
end;

function TFsmParent.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=FindParam(aName);
   fsm_type_float     : Result:=FindParam(aName);
   fsm_type_string    : Result:=FindParam(aName);
   fsm_type_parameter : Result:=FindParam(aName);
   fsm_type_parent    : Result:=FindAdult(aName);
   fsm_type_entity    : Result:=FindChild(aName);
  end;
 end else begin
  if (TypeId<>fsm_type_manager)
  then Result:=ParentManager.DoFindEntity(aType,aName);
 end;
end;

/////////////////////////////
// TFsmManager implementation
/////////////////////////////

constructor TFsmManager.Create(aName:LongString='FsmManager');
begin
 inherited Create(aName,nil);
 myTypeId:=fsm_type_manager;
 myDomains:=TList.Create;
 myCatalog:=NewHashList(false,HashList_DefaultHasher);
 myCatalog.OwnsObjects:=false;
 myCatalog.Master:=@myCatalog;
 myDefaultColor:=SysUtils.Trim(FsmDefaultColor);
end;

destructor TFsmManager.Destroy;
begin
 Kill(myCatalog);
 Kill(myDomains);
 myDefaultColor:='';
 inherited Destroy;
end;

procedure TFsmManager.DoAppendChild(aChild:TFsmEntity);
begin
 inherited DoAppendChild(aChild);
 if (aChild is TFsmDomain) then SafeListAdd(myDomains,aChild);
end;

procedure TFsmManager.DoRemoveChild(aChild:TFsmEntity);
begin
 inherited DoRemoveChild(aChild);
 if (aChild is TFsmDomain) then SafeListRemove(myDomains,aChild);
end;

procedure TFsmManager.CatalogAdd(aEntity:TFsmEntity);
var aPath:LongString;
begin
 if (Self=nil) then Exit;
 if (aEntity=nil) then Exit;
 if (myCatalog=nil) then Exit;
 aPath:=aEntity.Path; if (aPath='') then Exit;
 myCatalog.KeyedObjects[aPath]:=aEntity;
end;

procedure TFsmManager.CatalogRemove(aEntity:TFsmEntity);
var aPath:LongString;
begin
 if (Self=nil) then Exit;
 if (aEntity=nil) then Exit;
 if (myCatalog=nil) then Exit;
 aPath:=aEntity.Path; if (aPath='') then Exit;
 myCatalog.Delete(aPath);
end;

function TFsmManager.FindPath(aPath:LongString):TFsmEntity;
var obj:TObject;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 if (aPath='') then Exit;
 if (myCatalog=nil) then Exit;
 obj:=myCatalog.KeyedObjects[aPath];
 if (obj is TFsmEntity) then Result:=TFsmEntity(obj);
end;

function TFsmManager.ListCatalog:LongString;
var List:TStringList; i:Integer;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (myCatalog=nil) then Exit;
 try
  List:=TStringList.Create;
  List.Sorted:=true;
  try
   for i:=0 to myCatalog.Count-1 do List.Add(UpperCase(myCatalog.Keys[i]));
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,Self,'ListCatalog');
 end;
end;

function TFsmManager.DoGetCount(aType:Integer):Integer;
begin
 Result:=0;
 case aType of
  fsm_type_int       : Result:=ParamCount;
  fsm_type_float     : Result:=ParamCount;
  fsm_type_string    : Result:=ParamCount;
  fsm_type_parameter : Result:=ParamCount;
  fsm_type_domain    : Result:=SafeListCount(myDomains);
  fsm_type_parent    : Result:=AdultCount;
  fsm_type_entity    : Result:=ChildCount;
 end;
end;

function TFsmManager.DoGetItems(aType,aIndex:Integer):TFsmEntity;
begin
 Result:=nil;
 case aType of
  fsm_type_int       : Result:=ParamItems[aIndex];
  fsm_type_float     : Result:=ParamItems[aIndex];
  fsm_type_string    : Result:=ParamItems[aIndex];
  fsm_type_parameter : Result:=ParamItems[aIndex];
  fsm_type_domain    : Result:=SafeListItems(myDomains,aIndex);
  fsm_type_parent    : Result:=AdultItems[aIndex];
  fsm_type_entity    : Result:=ChildItems[aIndex];
 end;
end;

 // DOMAIN::OBJECT/STATE/ACTION#PARAM
function ParsePathName(aPath:LongString; out dom,obj,sta,act,par:LongString):Boolean;
var i,n,nc:Integer; c:Char;
begin
 Result:=false;
 dom:=''; obj:=''; sta:=''; act:=''; par:='';
 if (aPath='') then Exit;
 nc:=0; n:=1;
 for i:=1 to Length(aPath) do begin
  c:=aPath[i];
  case c of
   '#' : begin
    par:=Copy(aPath,i+1,Length(aPath)-i);
    Break;
   end;
   ':' : begin
    inc(nc);
    if (nc>2) then Exit;
    case n of
     1: if (nc=2) then inc(n);
     2: obj:=obj+c;
     3: sta:=sta+c;
     4: act:=act+c;
     else Exit;
    end;
   end;
   '/' : begin
    if (n<2) then Exit;
    if (n>3) then Exit;
    inc(n);
   end;
   'a'..'z','A'..'Z','_','0'..'9': begin
    case n of
     1: dom:=dom+c;
     2: obj:=obj+c;
     3: sta:=sta+c;
     4: act:=act+c;
     else Exit;
    end;
   end;
   '&','.','-': begin
    case n of
     2: obj:=obj+c;
     3: sta:=sta+c;
     4: act:=act+c;
     else Exit;
    end;
   end;
   else Exit;
  end;
  if (c<>':') then nc:=0;
 end;
 if (dom='') and (obj='') and (sta='') and (act='') and (par='') then Exit;
 if (dom<>'') then if (dom[1] in ['0'..'9']) then Exit;
 if (obj<>'') then if (obj[1] in ['0'..'9']) then Exit;
 if (sta<>'') then if (sta[1] in ['0'..'9']) then Exit;
 if (act<>'') then if (act[1] in ['0'..'9']) then Exit;
 if (par<>'') then if (par[1] in ['0'..'9']) then Exit;
 if (act<>'') and (sta='') then Exit;
 if (sta<>'') and (obj='') then Exit;
 if (obj<>'') and (dom='') then Exit;
 Result:=true;
end;

function TFsmManager.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
var dom,obj,sta,act,par:LongString; E:TFsmEntity;
 procedure SubAdd(var E:TFsmEntity; aType:Integer; const aName:LongString; const WantedTypes:TByteSet);
 begin
  if (E<>nil) then
  if (aType in WantedTypes)
  then E:=E.AddEntity(aType,aName)
  else E:=E.FindEntity(fsm_type_entity,aName);
  if not (E.TypeId in WantedTypes) then E:=nil;
 end;
begin
 Result:=nil;
 if (aType in FsmValidTypes) then
 try
  if IsLexeme(aName,fsm_name_rule(aType)) and fsm_valid_childtype(myTypeId,aType) then begin
   case aType of
    fsm_type_int       : Result:=NewFsmParamInt(aName,Self);
    fsm_type_float     : Result:=NewFsmParamFloat(aName,Self);
    fsm_type_string    : Result:=NewFsmParamString(aName,Self);
    fsm_type_domain    : Result:=NewFsmDomain(aName,Self);
   end;
  end else begin
   if not ParsePathName(aName,dom,obj,sta,act,par) then Exit;
   E:=Self;
   if (dom<>'') then begin
    SubAdd(E,aType,dom,[fsm_type_domain]);
    if (E=nil) then Exit;
   end;
   if (obj<>'') then begin
    SubAdd(E,aType,obj,[fsm_type_class,fsm_type_object,fsm_type_objectset]);
    if (E=nil) then Exit;
   end;
   if (sta<>'') then begin
    SubAdd(E,aType,sta,[fsm_type_state,fsm_type_function]);
    if (E=nil) then Exit;
   end;
   if (act<>'') then begin
    SubAdd(E,aType,act,[fsm_type_action]);
    if (E=nil) then Exit;
   end;
   if (par<>'') then begin
    SubAdd(E,aType,par,FsmParamTypes);
    if (E=nil) then Exit;
   end;
   if (E<>nil) and (E<>Self) then begin
    if (aType in FsmValidTypes) and (E.TypeId=aType) then Result:=E;
   end;
  end;
  if (Result.TypeId<>aType) then Result:=nil;
 except
  on E:Exception do BugReport(E,Self,'DoAddEntity');
 end;
end;

function TFsmManager.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
var dom,obj,sta,act,par:LongString; E:TFsmEntity;
 procedure SubFind(var E:TFsmEntity; const aName:LongString; const WantedTypes:TByteSet);
 begin
  if (E<>nil) then
  E:=E.FindChild(aName);
  if not (E.TypeId in WantedTypes) then E:=nil;
 end;
begin
 Result:=nil;
 if (aType in FsmAnyValidTypes) then
 try
  if IsLexeme(aName,fsm_name_rule(aType)) and fsm_valid_childtype(myTypeId,aType) then begin
   case aType of
    fsm_type_int       : Result:=FindParam(aName);
    fsm_type_float     : Result:=FindParam(aName);
    fsm_type_string    : Result:=FindParam(aName);
    fsm_type_parameter : Result:=FindParam(aName);
    fsm_type_domain    : Result:=FindAdult(aName);
    fsm_type_parent    : Result:=FindAdult(aName);
    fsm_type_entity    : Result:=FindChild(aName);
   end;
  end else begin
   if UsesFsmManagerCatalog then begin
    E:=FindPath(aName);
    if (E<>nil) then begin
     if (aType in FsmValidTypes) and (E.TypeId=aType) then Result:=E else
     if (aType in FsmAbstractTypes) and (E.TypeId in FsmValidTypes) then Result:=E;
    end;
    Exit;
   end else E:=nil;
   if (E=nil) then begin
    if not ParsePathName(aName,dom,obj,sta,act,par) then Exit;
    E:=Self;
    if (dom<>'') then begin
     SubFind(E,dom,[fsm_type_domain]);
     if (E=nil) then Exit;
    end;
    if (obj<>'') then begin
     SubFind(E,obj,[fsm_type_class,fsm_type_object,fsm_type_objectset]);
     if (E=nil) then Exit;
    end;
    if (sta<>'') then begin
     SubFind(E,sta,[fsm_type_state,fsm_type_function]);
     if (E=nil) then Exit;
    end;
    if (act<>'') then begin
     SubFind(E,act,[fsm_type_action]);
     if (E=nil) then Exit;
    end;
    if (par<>'') then begin
     SubFind(E,par,FsmParamTypes);
     if (E=nil) then Exit;
    end;
    if (E<>nil) then begin
     if (aType in FsmValidTypes) and (E.TypeId=aType) then Result:=E;
     if (aType in FsmAbstractTypes) and (E.TypeId in FsmValidTypes) then Result:=E;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoFindEntity');
 end;
end;

function TFsmManager.DoGetDefaultColor:LongString;
begin
 Result:=myDefaultColor;
end;

procedure TFsmManager.DoSetDefaultColor(s:LongString);
begin
 myDefaultColor:=SysUtils.Trim(s);
end;

function NewFsmManager(aName:LongString='FsmManager'):TFsmManager;
begin
 Result:=nil;
 try
  Result:=TFsmManager.Create(aName);
 except
  on E:Exception do BugReport(E,nil,'NewFsmManager');
 end;
end;

procedure Kill(var TheObject:TFsmManager); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////
// TFsmDomain implementation
////////////////////////////

constructor TFsmDomain.Create(aName:LongString; aParent:TFsmManager);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_domain;
 myClasses:=TList.Create;
 myObjects:=TList.Create;
 myObjSets:=TList.Create;
end;

destructor TFsmDomain.Destroy;
begin
 Kill(myObjSets);
 Kill(myObjects);
 Kill(myClasses);
 inherited Destroy;
end;

procedure TFsmDomain.DoAppendChild(aChild:TFsmEntity);
begin
 inherited DoAppendChild(aChild);
 if (aChild is TFsmObjectSet) then SafeListAdd(myObjSets,aChild) else
 if (aChild is TFsmObject) then SafeListAdd(myObjects,aChild) else
 if (aChild is TFsmClass)  then SafeListAdd(myClasses,aChild);
end;

procedure TFsmDomain.DoRemoveChild(aChild:TFsmEntity);
begin
 inherited DoRemoveChild(aChild);
 if (aChild is TFsmObjectSet) then SafeListRemove(myObjSets,aChild) else
 if (aChild is TFsmObject) then SafeListRemove(myObjects,aChild) else
 if (aChild is TFsmClass)  then SafeListRemove(myClasses,aChild);
end;

function TFsmDomain.DoGetPath:LongString;
begin
 Result:=Name;
end;

function TFsmDomain.DoGetCount(aType:Integer):Integer;
begin
 Result:=0;
 case aType of
  fsm_type_int       : Result:=ParamCount;
  fsm_type_float     : Result:=ParamCount;
  fsm_type_string    : Result:=ParamCount;
  fsm_type_parameter : Result:=ParamCount;
  fsm_type_class     : Result:=SafeListCount(myClasses);
  fsm_type_object    : Result:=SafeListCount(myObjects);
  fsm_type_objectset : Result:=SafeListCount(myObjSets);
  fsm_type_parent    : Result:=AdultCount;
  fsm_type_entity    : Result:=ChildCount;
 end;
end;

function TFsmDomain.DoGetItems(aType,aIndex:Integer):TFsmEntity;
begin
 Result:=nil;
 case aType of
  fsm_type_int       : Result:=ParamItems[aIndex];
  fsm_type_float     : Result:=ParamItems[aIndex];
  fsm_type_string    : Result:=ParamItems[aIndex];
  fsm_type_parameter : Result:=ParamItems[aIndex];
  fsm_type_class     : Result:=SafeListItems(myClasses,aIndex);
  fsm_type_object    : Result:=SafeListItems(myObjects,aIndex);
  fsm_type_objectset : Result:=SafeListItems(myObjSets,aIndex);
  fsm_type_parent    : Result:=AdultItems[aIndex];
  fsm_type_entity    : Result:=ChildItems[aIndex];
 end;
end;

function TFsmDomain.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=NewFsmParamInt(aName,Self);
   fsm_type_float     : Result:=NewFsmParamFloat(aName,Self);
   fsm_type_string    : Result:=NewFsmParamString(aName,Self);
   fsm_type_class     : Result:=NewFsmClass(aName,Self);
   fsm_type_object    : Result:=NewFsmObject(aName,Self);
   fsm_type_objectset : Result:=NewFsmObjectSet(aName,Self);
  end;
 end;
end;

function TFsmDomain.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=FindParam(aName);
   fsm_type_float     : Result:=FindParam(aName);
   fsm_type_string    : Result:=FindParam(aName);
   fsm_type_parameter : Result:=FindParam(aName);
   fsm_type_class     : Result:=FindAdult(aName);
   fsm_type_object    : Result:=FindAdult(aName);
   fsm_type_objectset : Result:=FindAdult(aName);
   fsm_type_parent    : Result:=FindAdult(aName);
   fsm_type_entity    : Result:=FindChild(aName);
  end;
 end else begin
  if (TypeId<>fsm_type_manager)
  then Result:=ParentManager.DoFindEntity(aType,aName);
 end;
end;

function TFsmDomain.DoGetDeclaration:LongString;
begin
 Result:='!domain: '+Name;
end;

function NewFsmDomain(aName:LongString; aParent:TFsmEntity):TFsmDomain;
begin
 Result:=nil;
 if (aParent is TFsmManager) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_domain)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmDomain.Create(aName,aParent as TFsmManager);
 except
  on E:Exception do BugReport(E,nil,'NewFsmDomain');
 end;
end;

procedure Kill(var TheObject:TFsmDomain); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

///////////////////////////
// TFsmClass implementation
///////////////////////////

constructor TFsmClass.Create(aName:LongString; aParent:TFsmDomain);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_class;
 myStates:=TList.Create;
 myFuncts:=TList.Create;
 myInitialStateRef:=0;
 myActualStateRef:=0;
 myDeadStateRef:=0;
 myAssociated:=false;
end;

destructor TFsmClass.Destroy;
begin
 Kill(myFuncts);
 Kill(myStates);
 inherited Destroy;
end;

procedure TFsmClass.DoAppendChild(aChild:TFsmEntity);
begin
 inherited DoAppendChild(aChild);
 if (aChild is TFsmFunction) then SafeListAdd(myFuncts,aChild) else
 if (aChild is TFsmState) then begin
  SafeListAdd(myStates,aChild);
  if (SafeListCount(myStates)=1) then begin
   InitialState:=aChild;
   ActualState:=aChild;
  end;
 end;
end;

procedure TFsmClass.DoRemoveChild(aChild:TFsmEntity);
begin
 if (aChild is TFsmFunction) then SafeListAdd(myFuncts,aChild) else
 if (aChild is TFsmState) then begin
  SafeListRemove(myStates,aChild);
  if (DeadState=aChild) then DeadState:=nil;
  if (ActualState=aChild) then ActualState:=nil;
  if (InitialState=aChild) then InitialState:=nil;
 end;
 inherited DoRemoveChild(aChild);
end;

function TFsmClass.DoGetPath:LongString;
begin
 Result:=Parent.Path+'::'+Name;
end;

function TFsmClass.DoGetCount(aType:Integer):Integer;
begin
 Result:=0;
 case aType of
  fsm_type_int       : Result:=ParamCount;
  fsm_type_float     : Result:=ParamCount;
  fsm_type_string    : Result:=ParamCount;
  fsm_type_parameter : Result:=ParamCount;
  fsm_type_state     : Result:=SafeListCount(myStates);
  fsm_type_function  : Result:=SafeListCount(myFuncts);
  fsm_type_parent    : Result:=AdultCount;
  fsm_type_entity    : Result:=ChildCount;
 end;
end;

function TFsmClass.DoGetItems(aType,aIndex:Integer):TFsmEntity;
begin
 Result:=nil;
 case aType of
  fsm_type_int       : Result:=ParamItems[aIndex];
  fsm_type_float     : Result:=ParamItems[aIndex];
  fsm_type_string    : Result:=ParamItems[aIndex];
  fsm_type_parameter : Result:=ParamItems[aIndex];
  fsm_type_state     : Result:=SafeListItems(myStates,aIndex);
  fsm_type_function  : Result:=SafeListItems(myFuncts,aIndex);
  fsm_type_parent    : Result:=AdultItems[aIndex];
  fsm_type_entity    : Result:=ChildItems[aIndex];
 end;
end;

function TFsmClass.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=NewFsmParamInt(aName,Self);
   fsm_type_float     : Result:=NewFsmParamFloat(aName,Self);
   fsm_type_string    : Result:=NewFsmParamString(aName,Self);
   fsm_type_state     : Result:=NewFsmState(aName,Self);
   fsm_type_function  : Result:=NewFsmFunction(aName,Self);
  end;
 end;
end;

function TFsmClass.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=FindParam(aName);
   fsm_type_float     : Result:=FindParam(aName);
   fsm_type_string    : Result:=FindParam(aName);
   fsm_type_parameter : Result:=FindParam(aName);
   fsm_type_state     : Result:=FindAdult(aName);
   fsm_type_function  : Result:=FindAdult(aName);
   fsm_type_parent    : Result:=FindAdult(aName);
   fsm_type_entity    : Result:=FindChild(aName);
  end;
 end else begin
  if (TypeId<>fsm_type_manager)
  then Result:=ParentManager.DoFindEntity(aType,aName);
 end;
end;

function TFsmClass.DoGetActualState:TFsmEntity;
var obj:TObject;
begin
 Result:=nil;
 obj:=ObjectRegistry[myActualStateRef];
 if (obj is TFsmState) then Result:=TFsmState(obj);
end;

procedure TFsmClass.DoSetActualState(aState:TFsmEntity);
begin
 if (aState<>nil) then begin
  if (aState is TFsmState) and (aState.Parent=Self)
  then myActualStateRef:=aState.Ref;
 end else myActualStateRef:=0;
end;

function TFsmClass.DoGetInitialState:TFsmEntity;
var obj:TObject;
begin
 Result:=nil;
 obj:=ObjectRegistry[myInitialStateRef];
 if (obj is TFsmState) then Result:=TFsmState(obj);
end;

procedure TFsmClass.DoSetInitialState(aState:TFsmEntity);
begin
 if (aState<>nil) then begin
  if (aState is TFsmState) and (aState.Parent=Self)
  then myInitialStateRef:=aState.Ref;
 end else myInitialStateRef:=0;
end;

function TFsmClass.DoGetDeadState:TFsmEntity;
var obj:TObject;
begin
 Result:=nil;
 obj:=ObjectRegistry[myDeadStateRef];
 if (obj is TFsmState) then Result:=TFsmState(obj);
end;

procedure TFsmClass.DoSetDeadState(aState:TFsmEntity);
begin
 if (aState<>nil) then begin
  if (aState is TFsmState) and (aState.Parent=Self)
  then myDeadStateRef:=aState.Ref;
 end else myDeadStateRef:=0;
end;

function TFsmClass.DoGetAssociated:Boolean;
begin
 Result:=myAssociated;
end;

procedure TFsmClass.DoSetAssociated(b:Boolean);
begin
 myAssociated:=b;
end;

function TFsmClass.DoGetDeclaration:LongString;
begin
 Result:='class: '+Name;
 if Associated then Result:=Result+' /associated';
end;

function NewFsmClass(aName:LongString; aParent:TFsmEntity):TFsmClass;
begin
 Result:=nil;
 if (aParent is TFsmDomain) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_class)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmClass.Create(aName,aParent as TFsmDomain);
 except
  on E:Exception do BugReport(E,nil,'NewFsmClass');
 end;
end;

procedure Kill(var TheObject:TFsmClass); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////
// TFsmObject implementation
////////////////////////////

constructor TFsmObject.Create(aName:LongString; aParent:TFsmDomain);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_object;
 myIsOfClass:='';
end;

destructor TFsmObject.Destroy;
begin
 myIsOfClass:='';
 inherited Destroy;
end;

function TFsmObject.DoGetDeclaration:LongString;
begin
 Result:='object: '+Name;
 if (IsOfClass<>'') then Result:=Result+' is_of_class '+IsOfClass;
 if Associated then Result:=Result+' /associated';
end;

function TFsmObject.DoGetIsOfClass:LongString;
begin
 Result:=myIsOfClass;
end;

procedure TFsmObject.DoSetIsOfClass(s:LongString);
begin
 myIsOfClass:=SysUtils.Trim(UpperCase(s));
end;

function NewFsmObject(aName:LongString; aParent:TFsmEntity):TFsmObject;
begin
 Result:=nil;
 if (aParent is TFsmDomain) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_object)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmObject.Create(aName,aParent as TFsmDomain);
 except
  on E:Exception do BugReport(E,nil,'NewFsmObject');
 end;
end;

procedure Kill(var TheObject:TFsmObject); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

///////////////////////////
// TFsmState implementation
///////////////////////////

constructor TFsmState.Create(aName:LongString; aParent:TFsmClass);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_state;
 myActions:=TList.Create;
end;

destructor TFsmState.Destroy;
begin
 Kill(myActions);
 inherited Destroy;
end;

procedure TFsmState.DoAppendChild(aChild:TFsmEntity);
begin
 inherited DoAppendChild(aChild);
 if (aChild is TFsmAction) then SafeListAdd(myActions,aChild);
end;

procedure TFsmState.DoRemoveChild(aChild:TFsmEntity);
begin
 if (aChild is TFsmAction) then SafeListRemove(myActions,aChild);
 inherited DoRemoveChild(aChild);
end;

function TFsmState.DoGetPath:LongString;
begin
 Result:=Parent.Path+'/'+Name;
end;

function TFsmState.DoGetCount(aType:Integer):Integer;
begin
 Result:=0;
 case aType of
  fsm_type_int       : Result:=ParamCount;
  fsm_type_float     : Result:=ParamCount;
  fsm_type_string    : Result:=ParamCount;
  fsm_type_parameter : Result:=ParamCount;
  fsm_type_action    : Result:=SafeListCount(myActions);
  fsm_type_parent    : Result:=AdultCount;
  fsm_type_entity    : Result:=ChildCount;
 end;
end;

function TFsmState.DoGetItems(aType,aIndex:Integer):TFsmEntity;
begin
 Result:=nil;
 case aType of
  fsm_type_int       : Result:=ParamItems[aIndex];
  fsm_type_float     : Result:=ParamItems[aIndex];
  fsm_type_string    : Result:=ParamItems[aIndex];
  fsm_type_parameter : Result:=ParamItems[aIndex];
  fsm_type_action    : Result:=SafeListItems(myActions,aIndex);
  fsm_type_parent    : Result:=AdultItems[aIndex];
  fsm_type_entity    : Result:=ChildItems[aIndex];
 end;
end;

function TFsmState.DoAddEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=NewFsmParamInt(aName,Self);
   fsm_type_float     : Result:=NewFsmParamFloat(aName,Self);
   fsm_type_string    : Result:=NewFsmParamString(aName,Self);
   fsm_type_action    : Result:=NewFsmAction(aName,Self);
  end;
 end;
end;

function TFsmState.DoFindEntity(aType:Integer; aName:LongString):TFsmEntity;
begin
 Result:=nil;
 if IsLexeme(aName,fsm_name_rule(aType)) then begin
  case aType of
   fsm_type_int       : Result:=FindParam(aName);
   fsm_type_float     : Result:=FindParam(aName);
   fsm_type_string    : Result:=FindParam(aName);
   fsm_type_parameter : Result:=FindParam(aName);
   fsm_type_action    : Result:=FindAdult(aName);
   fsm_type_parent    : Result:=FindAdult(aName);
   fsm_type_entity    : Result:=FindChild(aName);
  end;
 end else begin
  if (TypeId<>fsm_type_manager)
  then Result:=ParentManager.DoFindEntity(aType,aName);
 end;
end;

function TFsmState.DoGetDeclaration:LongString;
begin
 Result:='state: '+Name;
 if (Self=Parent.InitialState) then Result:=Result+' /initial_state';
 if (Self=Parent.DeadState) then Result:=Result+' /dead_state';
 if (Color<>'') then Result:=Result+' !color: '+Color;
end;

function NewFsmState(aName:LongString; aParent:TFsmEntity):TFsmState;
begin
 Result:=nil;
 if (aParent is TFsmClass) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_state)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmState.Create(aName,aParent as TFsmClass);
 except
  on E:Exception do BugReport(E,nil,'NewFsmState');
 end;
end;

procedure Kill(var TheObject:TFsmState); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////
// TFsmAction implementation
////////////////////////////

constructor TFsmAction.Create(aName:LongString; aParent:TFsmState);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_action;
end;

function TFsmAction.DoGetPath:LongString;
begin
 Result:=Parent.Path+'/'+Name;
end;

function TFsmAction.DoGetDeclaration:LongString;
var i:Integer;
begin
 Result:='action: '+Name;
 if (ParamCount>0) then begin
  Result:=Result+'(';
  for i:=0 to ParamCount-1 do begin
   if (i>0) then Result:=Result+',';
   Result:=Result+ParamItems[i].Declaration;
  end;
  Result:=Result+')';
 end;
 Result:=Result+' !visible: '+IntToStr(Ord(Visible));
end;

function NewFsmAction(aName:LongString; aParent:TFsmEntity):TFsmAction;
begin
 Result:=nil;
 if (aParent is TFsmState) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_action)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmAction.Create(aName,aParent as TFsmState);
 except
  on E:Exception do BugReport(E,nil,'NewFsmAction');
 end;
end;

procedure Kill(var TheObject:TFsmAction); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

///////////////////////////////
// TFsmObjectSet implementation
///////////////////////////////

constructor TFsmObjectSet.Create(aName:LongString; aParent:TFsmDomain);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_objectset;
 myIsOfClass:='VOID';
 myUnionMode:=false;
 myUnionList:='';
end;

destructor TFsmObjectSet.Destroy;
begin
 myUnionList:='';
 myIsOfClass:='';
 inherited Destroy;
end;

function TFsmObjectSet.DoGetIsOfClass:LongString;
begin
 Result:=myIsOfClass;
end;

procedure TFsmObjectSet.DoSetIsOfClass(s:LongString);
begin
 myIsOfClass:=SysUtils.Trim(UpperCase(s));
end;

function TFsmObjectSet.DoGetUnionList:LongString;
begin
 Result:=myUnionList;
end;

procedure TFsmObjectSet.DoSetUnionList(s:LongString);
begin
 myUnionList:=SysUtils.Trim(UpperCase(s));
end;

function TFsmObjectSet.DoGetUnionMode:Boolean;
begin
 Result:=myUnionMode;
end;

procedure TFsmObjectSet.DoSetUnionMode(b:Boolean);
begin
 myUnionMode:=b;
end;

function TFsmObjectSet.DoGetPath:LongString;
begin
 Result:=Parent.Path+'::'+Name;
end;

function NewFsmObjectSet(aName:LongString; aParent:TFsmEntity):TFsmObjectSet;
begin
 Result:=nil;
 if (aParent is TFsmDomain) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_objectset)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmObjectSet.Create(aName,aParent as TFsmDomain);
 except
  on E:Exception do BugReport(E,nil,'NewFsmObjectSet');
 end;
end;

function TFsmObjectSet.DoGetDeclaration:LongString;
begin
 Result:='objectset: '+Name;
 if UnionMode then Result:=Result+' union';
 if (UnionList<>'') then Result:=Result+' {'+UnionList+'}';
 if (IsOfClass<>'') then Result:=Result+' is_of_class '+IsOfClass;
end;

procedure Kill(var TheObject:TFsmObjectSet); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

//////////////////////////////
// TFsmFunction implementation
//////////////////////////////

constructor TFsmFunction.Create(aName:LongString; aParent:TFsmClass);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_function;
end;

function TFsmFunction.DoGetPath:LongString;
begin
 Result:=Parent.Path+'/'+Name;
end;

function NewFsmFunction(aName:LongString; aParent:TFsmEntity):TFsmFunction;
begin
 Result:=nil;
 if (aParent is TFsmClass) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_function)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmFunction.Create(aName,aParent as TFsmClass);
 except
  on E:Exception do BugReport(E,nil,'NewFsmFunction');
 end;
end;

function TFsmFunction.DoGetDeclaration:LongString;
var i:Integer;
begin
 Result:='function: '+Name;
 if (ParamCount>0) then begin
  Result:=Result+'(';
  for i:=0 to ParamCount-1 do begin
   if (i>0) then Result:=Result+',';
   Result:=Result+ParamItems[i].Declaration;
  end;
  Result:=Result+')';
 end;
end;

procedure Kill(var TheObject:TFsmFunction); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

///////////////////////////////
// TFsmParameter implementation
///////////////////////////////

constructor TFsmParameter.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_parameter;
end;

function TFsmParameter.DoGetPath:LongString;
begin
 Result:=Parent.Path+'#'+Name;
end;

///////////////////////////////
// TFsmParamInt implementation
///////////////////////////////

constructor TFsmParamInt.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_int;
 myParam:=0;
end;

function TFsmParamInt.DoGetParamInt:Integer;
begin
 Result:=myParam;
end;

procedure TFsmParamInt.DoSetParamInt(i:Integer);
begin
 myParam:=i;
end;

function TFsmParamInt.DoGetDeclaration:LongString;
begin
 Result:=Format('int %s = %d',[Name,myParam]);
end;

function NewFsmParamInt(aName:LongString; aParent:TFsmEntity):TFsmParamInt;
begin
 Result:=nil;
 if (aParent is TFsmParent) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_int)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmParamInt.Create(aName,aParent as TFsmParent);
 except
  on E:Exception do BugReport(E,nil,'NewFsmParamInt');
 end;
end;

procedure Kill(var TheObject:TFsmParamInt); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

////////////////////////////////
// TFsmParamFloat implementation
////////////////////////////////

constructor TFsmParamFloat.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_float;
 myParam:=0;
end;

function TFsmParamFloat.DoGetParamFloat:Double;
begin
 Result:=myParam;
end;

procedure TFsmParamFloat.DoSetParamFloat(f:Double);
begin
 myParam:=f;
end;

function TFsmParamFloat.DoGetDeclaration:LongString;
begin
 Result:=Format('float %s = %g',[Name,myParam]);
end;

function NewFsmParamFloat(aName:LongString; aParent:TFsmEntity):TFsmParamFloat;
begin
 Result:=nil;
 if (aParent is TFsmParent) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_float)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmParamFloat.Create(aName,aParent as TFsmParent);
 except
  on E:Exception do BugReport(E,nil,'NewFsmParamFloat');
 end;
end;

procedure Kill(var TheObject:TFsmParamFloat); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

/////////////////////////////////
// TFsmParamString implementation
/////////////////////////////////

constructor TFsmParamString.Create(aName:LongString; aParent:TFsmParent);
begin
 inherited Create(aName,aParent);
 myTypeId:=fsm_type_string;
 myParam:='';
end;

destructor TFsmParamString.Destroy;
begin
 myParam:='';
 inherited Destroy;
end;

function TFsmParamString.DoGetParamString:LongString;
begin
 Result:=myParam;
end;

procedure TFsmParamString.DoSetParamString(s:LongString);
begin
 myParam:=s;
end;

function TFsmParamString.DoGetDeclaration:LongString;
begin
 Result:=Format('string %s = "%s"',[Name,backslash_encode(myParam,[],[QuoteMark])]);
end;

function NewFsmParamString(aName:LongString; aParent:TFsmEntity):TFsmParamString;
begin
 Result:=nil;
 if (aParent is TFsmParent) then
 if IsLexeme(aName,fsm_name_rule(fsm_type_string)) then
 if (aParent.FindChild(aName)=nil) then
 try
  Result:=TFsmParamString.Create(aName,aParent as TFsmParent);
 except
  on E:Exception do BugReport(E,nil,'NewFsmParamString');
 end;
end;

procedure Kill(var TheObject:TFsmParamString); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

//////////////////////////////
// Easy FSM API implementation
//////////////////////////////

function fsm_new:Integer;
begin
 Result:=0;
 try
  Result:=NewFsmManager.Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_new');
 end;
end;

function fsm_free(ref:Integer):Boolean;
var fsm:TFsmEntity;
begin
 Result:=false;
 try
  fsm:=fsm_ref(ref);
  if (fsm is TFsmManager) then begin
   Result:=true;
   Kill(fsm);
  end;
 except
  on E:Exception do BugReport(E,nil,'fsm_free');
 end;
end;

function fsm_ref(ref:Integer):TFsmEntity;
var obj:TObject;
begin
 Result:=nil;
 if (ref=0) then Exit;
 obj:=ObjectRegistry[ref];
 if (obj is TFsmEntity) then Result:=TFsmEntity(obj);
end;

function fsm_root(ref:Integer):Integer;
var obj:TObject;
begin
 Result:=0;
 try
  if (ref=0) then Exit;
  obj:=ObjectRegistry[ref];
  if (obj is TFsmEntity) then Result:=TFsmEntity(obj).ParentManager.Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_root');
 end;
end;

function fsm_type(ref:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).TypeId;
 except
  on E:Exception do BugReport(E,nil,'fsm_type');
 end;
end;

function fsm_parent(ref:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).Parent.Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_parent');
 end;
end;

function fsm_name(ref:Integer):LongString;
begin
 Result:='';
 try
  Result:=fsm_ref(ref).Name;
 except
  on E:Exception do BugReport(E,nil,'fsm_name');
 end;
end;

function fsm_path(ref:Integer):LongString;
begin
 Result:='';
 try
  Result:=fsm_ref(ref).Path;
 except
  on E:Exception do BugReport(E,nil,'fsm_path');
 end;
end;

function fsm_count(ref,typ:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).Count[typ];
 except
  on E:Exception do BugReport(E,nil,'fsm_count');
 end;
end;

function fsm_items(ref,typ,i:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).Items[typ,i].ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_items');
 end;
end;

function fsm_get_iparam(ref:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).ParamInt;
 except
  on E:Exception do BugReport(E,nil,'fsm_get_iparam');
 end;
end;

function fsm_set_iparam(ref:Integer; data:Integer):Boolean;
var obj:TFsmEntity;
begin
 Result:=false;
 try
  obj:=fsm_ref(ref);
  if (obj.TypeId=fsm_type_int) then begin
   obj.ParamInt:=data;
   Result:=true;
  end;
 except
  on E:Exception do BugReport(E,nil,'fsm_set_iparam');
 end;
end;

function fsm_get_fparam(ref:Integer):Real;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).ParamFloat;
 except
  on E:Exception do BugReport(E,nil,'fsm_get_fparam');
 end;
end;

function fsm_set_fparam(ref:Integer; data:Real):Boolean;
var obj:TFsmEntity;
begin
 Result:=false;
 try
  obj:=fsm_ref(ref);
  if (obj.TypeId=fsm_type_float) then begin
   obj.ParamFloat:=data;
   Result:=true;
  end;
 except
  on E:Exception do BugReport(E,nil,'fsm_set_fparam');
 end;
end;

function fsm_get_sparam(ref:Integer):LongString;
begin
 Result:='';
 try
  Result:=fsm_ref(ref).ParamString;
 except
  on E:Exception do BugReport(E,nil,'fsm_get_sparam');
 end;
end;

function fsm_set_sparam(ref:Integer; data:LongString):Boolean;
var obj:TFsmEntity;
begin
 Result:=false;
 try
  obj:=fsm_ref(ref);
  if (obj.TypeId=fsm_type_string) then begin
   obj.ParamString:=data;
   Result:=true;
  end;
 except
  on E:Exception do BugReport(E,nil,'fsm_set_sparam');
 end;
end;

function fsm_ctrl(ref:Integer; arg:LongString):LongString;
begin
 Result:='';
 try
  Result:=fsm_ref(ref).Control(arg);
 except
  on E:Exception do BugReport(E,nil,'fsm_ctrl');
 end;
end;

function fsm_add(ref:Integer; typ:integer; key:LongString):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).AddEntity(typ,key).Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_add');
 end;
end;

function fsm_find(ref:Integer; typ:integer; key:LongString):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).FindEntity(typ,key).Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_find');
 end;
end;

function fsm_get_state(ref:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).ActualState.Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_get_state');
 end;
end;

function fsm_set_state(ref:Integer; state:Integer):Integer; overload;
var ent:TFsmEntity;
begin
 Result:=0;
 try
  ent:=fsm_ref(state);
  if (ent is TFsmState) then fsm_ref(ref).ActualState:=ent;
  Result:=fsm_ref(ref).ActualState.Ref;
 except
  on E:Exception do BugReport(E,nil,'fsm_set_state');
 end;
end;

function fsm_set_state(ref:Integer; state:LongString):Integer; overload;
begin
 Result:=fsm_set_state(ref,fsm_find(ref,fsm_type_state,state));
end;

function fsm_link(ref:Integer; arg:LongString):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).Link(arg);
 except
  on E:Exception do BugReport(E,nil,'fsm_link');
 end;
end;

function fsm_modified(ref:Integer; delta:Integer):Integer;
begin
 Result:=0;
 try
  Result:=fsm_ref(ref).Modified(delta);
 except
  on E:Exception do BugReport(E,nil,'fsm_modified');
 end;
end;

function fsm_name_rule(typ:Integer):Integer;
begin
 Result:=-1;
 case typ of
  fsm_type_int       : Result:=lex_Name;
  fsm_type_float     : Result:=lex_Name;
  fsm_type_string    : Result:=lex_Name;
  fsm_type_parameter : Result:=lex_Name;
  fsm_type_manager   : Result:=lex_Name;
  fsm_type_domain    : Result:=lex_Name;
  fsm_type_class     : Result:=lex_Name;
  fsm_type_object    : Result:=lex_FsmName;
  fsm_type_state     : Result:=lex_FsmName;
  fsm_type_action    : Result:=lex_FsmName;
  fsm_type_objectset : Result:=lex_Name;
  fsm_type_function  : Result:=lex_Name;
  fsm_type_parent    : Result:=lex_FsmName;
  fsm_type_entity    : Result:=lex_FsmName;
 end;
end;

function fsm_valid_childtype(typ,childtyp:Integer):Boolean;
begin
 Result:=false;
 case typ of
  fsm_type_manager   : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes+[fsm_type_domain]));
  fsm_type_domain    : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes+[fsm_type_class,fsm_type_object,fsm_type_objectset,fsm_type_function]));
  fsm_type_class     : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes+[fsm_type_state]));
  fsm_type_object    : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes+[fsm_type_state]));
  fsm_type_state     : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes+[fsm_type_action]));
  fsm_type_action    : Result:=(childtyp in (FsmAnyParamTypes+[fsm_type_entity]));
  fsm_type_objectset : Result:=(childtyp in (FsmAnyParamTypes+[fsm_type_entity]));
  fsm_type_function  : Result:=(childtyp in (FsmAnyParamTypes+[fsm_type_entity]));
  fsm_type_parent    : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes));
  fsm_type_entity    : Result:=(childtyp in (FsmAnyParamTypes+FsmAbstractTypes));
 end;
end;

/////////////////////////
// FSM self test function
/////////////////////////

function fsm_self_test:LongString;
var Lines:TStringList; i,n,nobj,fsm,dom,obj,sta,act,par:Integer; t0,dt:QWord;
begin
 Result:='';
 try
  fsm:=0;
  nobj:=ObjectRegistry.Count;
  Lines:=TStringList.Create;
  try
   Lines.Add('FSM_SELF_TEST:');
   fsm:=fsm_new;
   Lines.Add(Format('FSM    %d, %d, %s',[fsm,fsm_type(fsm),fsm_ctrl(fsm,'name')]));
   //
   fsm_add(fsm,fsm_type_string,'dns');
   dom:=fsm_add(fsm,fsm_type_domain,'test');
   fsm_add(dom,fsm_type_string,'source');
   Lines.Add(Format('DOMAIN %d, %d, %s, %s',[dom,fsm_type(dom),fsm_name(dom),fsm_path(dom)]));
   obj:=fsm_add(fsm,fsm_type_object,'TEST::LOGGER');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   sta:=fsm_add(fsm,fsm_type_state,'TEST::LOGGER/READY');
   Lines.Add(Format('STATE  %d, %d, %s, %s',[sta,fsm_type(sta),fsm_name(sta),fsm_path(sta)]));
   act:=fsm_add(fsm,fsm_type_action,'TEST::LOGGER/READY/START');
   Lines.Add(Format('ACTION  %d, %d, %s, %s',[act,fsm_type(act),fsm_name(act),fsm_path(act)]));
   act:=fsm_add(fsm,fsm_type_action,'TEST::LOGGER/READY/STOP');
   Lines.Add(Format('ACTION  %d, %d, %s, %s',[act,fsm_type(act),fsm_name(act),fsm_path(act)]));
   sta:=fsm_add(fsm,fsm_type_state,'TEST::LOGGER/ERROR');
   Lines.Add(Format('STATE  %d, %d, %s, %s',[sta,fsm_type(sta),fsm_name(sta),fsm_path(sta)]));
   Lines.Add(Format('STATE %s',[fsm_name(fsm_get_state(obj))]));
   Lines.Add(Format('STATE %s',[fsm_name(fsm_set_state(obj,fsm_find(obj,fsm_type_state,'ERROR')))]));
   Lines.Add(Format('STATE %s',[fsm_name(fsm_get_state(obj))]));
   Lines.Add(fsm_ctrl(obj,'state')+' '+fsm_ctrl(obj,'state=ready')+' '+fsm_ctrl(obj,'state=error'));
   for i:=1 to 10 do fsm_add(obj,fsm_type_state,Format('STATE_%.2d',[i]));
   for i:=0 to fsm_count(obj,fsm_type_entity)-1 do begin
    Lines.Add(' '+fsm_name(fsm_items(obj,fsm_type_entity,i)));
   end;
   for i:=0 to fsm_count(obj,fsm_type_state)-1 do begin
    Lines.Add('  '+fsm_name(fsm_items(obj,fsm_type_state,i)));
   end;
   fsm_ctrl(obj,'dead_state=ERROR');
   Lines.Add('initial '+fsm_ctrl(obj,'initial_state')+' actual '+fsm_ctrl(obj,'state')+' dead '+fsm_ctrl(obj,'dead_state'));
   Lines.Add('defcolor '+fsm_ctrl(fsm,'DefaultColor')+' color '+fsm_ctrl(sta,'color')+' new '+fsm_ctrl(sta,'color=Red'));
   par:=fsm_add(obj,fsm_type_int,'RUN_NUMBER'); fsm_set_iparam(par,123);
   Lines.Add(Format('%s = %d',[fsm_name(par),fsm_get_iparam(par)]));
   par:=fsm_add(obj,fsm_type_float,'VOLTAGE'); fsm_set_fparam(par,1.23);
   Lines.Add(Format('%s = %g',[fsm_name(par),fsm_get_fparam(par)]));
   par:=fsm_add(obj,fsm_type_string,'RUN_TYPE'); fsm_set_sparam(par,'PHYSICS');
   Lines.Add(Format('%s = %s',[fsm_name(par),fsm_get_sparam(par)]));
   par:=fsm_add(act,fsm_type_int,'NUMBER'); fsm_set_iparam(par,321);
   par:=fsm_add(act,fsm_type_float,'WEIGHT'); fsm_set_fparam(par,3.1);
   par:=fsm_add(act,fsm_type_string,'USER'); fsm_set_sparam(par,'FRODO');
   fsm_ctrl(obj,'Associated=1');
   fsm_ctrl(obj,'initial_state=error');
   fsm_ctrl(obj,'is_of_class=test');
   Lines.Add(fsm_ctrl(dom,'Declaration'));
   Lines.Add(fsm_ctrl(obj,'Declaration'));
   Lines.Add(fsm_ctrl(sta,'Declaration'));
   Lines.Add(fsm_ctrl(act,'Declaration'));
   Lines.Add(fsm_ctrl(par,'Declaration'));
   Lines.Add(fsm_path(fsm_find(fsm,fsm_type_any,'TEST::LOGGER#VOLTAGE')));
   //
   UsesFsmManagerCatalog:=false;
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_find(fsm,fsm_type_any,'TEST::LOGGER/STATE_10');
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_find '+fsm_path(fsm_find(fsm,fsm_type_any,'TEST::LOGGER/STATE_10'))+Format('  %1.3f mks',[1e3*dt/n]));
   //
   UsesFsmManagerCatalog:=true;
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_find(fsm,fsm_type_any,'TEST::LOGGER/STATE_10');
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_find '+fsm_path(fsm_find(fsm,fsm_type_any,'TEST::LOGGER/STATE_10'))+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_find(obj,fsm_type_any,'STATE_10');
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_find '+fsm_path(fsm_find(obj,fsm_type_any,'STATE_10'))+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_set_state(obj,sta);
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_set_state '+fsm_path(fsm_set_state(obj,sta))+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_get_state(obj);
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_get_state '+fsm_path(fsm_get_state(obj))+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_ctrl(obj,'state');
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_ctrl(state) '+fsm_ctrl(obj,'state')+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    fsm_ref(obj);
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('fsm_ref(obj) '+fsm_path(obj)+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    ObjectRegistry[obj];
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('ObjectRegistr(obj) '+fsm_path(obj)+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    ObjectRegistry.Lock;ObjectRegistry.UnLock;
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('Lock/Unlock(obj) '+fsm_path(obj)+Format('  %1.3f mks',[1e3*dt/n]));
   //
   t0:=GetTickCount64; n:=0; dt:=0;
   while (dt<200) do begin
    dt:=GetTickCount64-t0;
    inc(n);
   end;
   Lines.Add('Empty cycle (GetTickCount64) '+Format('  %1.3f mks',[1e3*dt/n]));
   //
   Lines.Add('fsm_find name '+fsm_path(fsm_find(obj,fsm_type_any,'STATE_10')));
   Lines.Add('fsm_find path '+fsm_path(fsm_find(obj,fsm_type_any,'TEST::LOGGER/STATE_01')));
   //
   Lines.Add('Catalog:');
   Lines.Add(SysUtils.Trim(fsm_ctrl(obj,'Catalog')));
   //
   Lines.Add('Readable:');
   Lines.Add(SysUtils.Trim(fsm_ctrl(obj,'*')));
   //
   Lines.Add('Writable:');
   Lines.Add(SysUtils.Trim(fsm_ctrl(obj,'*=')));
   //
   dom:=fsm_add(fsm,fsm_type_domain,'DEMO');
   Lines.Add(Format('DOMAIN %d, %d, %s, %s',[dom,fsm_type(dom),fsm_name(dom),fsm_path(dom)]));
   obj:=fsm_add(dom,fsm_type_object,'LOGGER');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   sta:=fsm_add(obj,fsm_type_state,'READY');
   Lines.Add(Format('STATE  %d, %d, %s, %s',[sta,fsm_type(sta),fsm_name(sta),fsm_path(sta)]));
   act:=fsm_add(sta,fsm_type_action,'START');
   Lines.Add(Format('ACTION  %d, %d, %s, %s',[act,fsm_type(act),fsm_name(act),fsm_path(act)]));
   //
   dom:=fsm_find(fsm,fsm_type_domain,'DEMO');
   Lines.Add(Format('DOMAIN %d, %d, %s, %s',[dom,fsm_type(dom),fsm_name(dom),fsm_path(dom)]));
   obj:=fsm_find(dom,fsm_type_object,'LOGGER');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   sta:=fsm_find(obj,fsm_type_state,'READY');
   Lines.Add(Format('STATE  %d, %d, %s, %s',[sta,fsm_type(sta),fsm_name(sta),fsm_path(sta)]));
   act:=fsm_find(sta,fsm_type_action,'START');
   Lines.Add(Format('ACTION  %d, %d, %s, %s',[act,fsm_type(act),fsm_name(act),fsm_path(act)]));
   //
   dom:=fsm_find(fsm,fsm_type_domain,'DEMO');
   Lines.Add(Format('DOMAIN %d, %d, %s, %s',[dom,fsm_type(dom),fsm_name(dom),fsm_path(dom)]));
   obj:=fsm_find(fsm,fsm_type_object,'DEMO::LOGGER');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   sta:=fsm_find(fsm,fsm_type_state,'DEMO::LOGGER/READY');
   Lines.Add(Format('STATE  %d, %d, %s, %s',[sta,fsm_type(sta),fsm_name(sta),fsm_path(sta)]));
   act:=fsm_find(fsm,fsm_type_action,'DEMO::LOGGER/READY/START');
   Lines.Add(Format('ACTION  %d, %d, %s, %s',[act,fsm_type(act),fsm_name(act),fsm_path(act)]));
   //
   obj:=fsm_add(fsm,fsm_type_object,'DEMO::AUTO::AUTO&PILOT');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   obj:=fsm_find(fsm,fsm_type_object,'DEMO::AUTO::AUTO&PILOT');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   obj:=fsm_find(dom,fsm_type_object,'AUTO::AUTO&PILOT');
   Lines.Add(Format('OBJECT %d, %d, %s, %s',[obj,fsm_type(obj),fsm_name(obj),fsm_path(obj)]));
   //
   Result:=Lines.Text;
  finally
   Lines.Free;
   fsm_free(fsm);
  end;
  Result:=Result+EOL+Format('ObjectLeak=%d',[ObjectRegistry.Count-nobj]);
 except
  on E:Exception do BugReport(E,nil,'fsm_self_test');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_fsm;
begin
 InitDictionary;
end;

procedure Free_crw_fsm;
begin
 FreeDictionary;
end;

initialization

 Init_crw_fsm;

finalization

 Free_crw_fsm;

end.

//////////////
// END OF FILE
//////////////

