{
  Copyright 2002-2017 Michalis Kamburelis.

  This file is part of "Castle Game Engine".

  "Castle Game Engine" is free software; see the file COPYING.txt,
  included in this distribution, for details about the copyright.

  "Castle Game Engine" is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

  ----------------------------------------------------------------------------
}

{$ifdef read_interface}

  TAllowedChildren = (acAll, acClasses, acInterface);

  { VRML/X3D field holding a reference to a single node.
    It's defined in this unit, not in X3DFields, since it uses
    TX3DNode definition. NULL value of the field is indicated by
    Value field = nil.

    Note that we store AllowedChildren list, which is a list of
    classes allowed as a Value (also nil is always allowed).
    But this is used only to produce warnings for a user.
    You should never assert that Value actually is one the requested
    classes. We want to keep here even not allowed items,
    because we want operation "read from VRML file + write to VRML file"
    to be as non-destructible as possible. So if user wrote
    invalid class hierarchy, we will output this invalid class hierarchy. }
  TSFNode = class(TX3DSingleField)
  private
    FValue: TX3DNode;
    FParentNode: TX3DNode;
    AllowedChildren: TAllowedChildren;
    AllowedChildrenClasses: TX3DNodeClassesList;
    AllowedChildrenInterface: TGUID;
    FDefaultValue: TX3DNode;
    FDefaultValueExists: boolean;
    FWeakLink: boolean;
    procedure SetValue(AValue: TX3DNode);
    procedure SetDefaultValue(ADefaultValue: TX3DNode);
    procedure SetDefaultValueExists(AValue: boolean);
    procedure SetWeakLink(const AValue: boolean);
    procedure WarningIfUnusedWeakLink;
    procedure DestructionNotification(Node: TX3DNode);
  strict protected
    procedure SaveToStreamValue(Writer: TX3DWriter); override;
    function SaveToXmlValue: TSaveToXmlMethod; override;
  public
    { Construct a field allowing any children class.
      Suitable only for special cases. For example, in instantiated prototypes,
      we must initially just allow all children, otherwise valid prototypes
      with SFNode/MFNode would cause warnings when parsing. }
    constructor CreateUndefined(const AParentNode: TX3DFileItem;
      const AExposed: boolean; const AName: string); override;
    constructor Create(const AParentNode: TX3DNode;
      const AExposed: boolean; const AName: string;
      const AAllowedChildrenClasses: array of TX3DNodeClass;
      const AValue: TX3DNode = nil); overload;
    { Constructor that takes a list of allowed children classes.
      Note that we copy the contents of AAllowedChildrenClasses,
      not the reference. }
    constructor Create(const AParentNode: TX3DNode;
      const AExposed: boolean; const AName: string;
      const AAllowedChildrenClasses: TX3DNodeClassesList;
      const AValue: TX3DNode = nil); overload;
    { Constructor that allows as children any implementor of given interface. }
    constructor Create(const AParentNode: TX3DNode;
      const AExposed: boolean; const AName: string;
      const AnAllowedChildrenInterface: TGUID;
      const AValue: TX3DNode = nil); overload;
    destructor Destroy; override;

    { Default value of SFNode field.

      While X3D specification says for all SFNode fields that their
      default value is NULL, this is not necessarily true for PROTO
      SFNode fiels. So we have to take into account that any DefaultValue
      is possible.

      Note that this doesn't have to be @nil, but will be irrelevant
      if not DefaultValueExists. (Once I had an idea to automatically
      set DefaultValue to @nil when DefaultValueExists is set to @false,
      but this was uncomfortable (like "what to do when DefaultValue
      is assigned non-nil when DefaultValueExists is false?").)

      Freeing of this is automatically managed, just like the normal
      @link(Value) property. This means that you can simply set
      DefaultValue to @nil or some existing node, and eventual memory
      deallocation of previous DefaultValue node (if unused) will happen
      automatically. }
    property DefaultValue: TX3DNode
      read FDefaultValue write SetDefaultValue;
    property DefaultValueExists: boolean
      read FDefaultValueExists write SetDefaultValueExists default false;

    property Value: TX3DNode read FValue write SetValue;
    procedure ParseValue(Lexer: TX3DLexer; Reader: TX3DReader); override;
    procedure ParseXMLAttribute(const AttributeValue: string; Reader: TX3DReader); override;
    procedure ParseXMLElement(Element: TDOMElement; Reader: TX3DReader); override;

    function EqualsDefaultValue: boolean; override;
    function Equals(SecondValue: TX3DField): boolean; override;

    procedure Assign(Source: TPersistent); override;
    procedure AssignValue(Source: TX3DField); override;
    procedure AssignDefaultValueFromValue; override;

    { VRML node containing this field. May be @nil if unknown, in special
      cases.

      Note that this property is exactly the same as
      TX3DFieldOrEvent.ParentNode,
      contains always the same value. But this is declared as TX3DNode,
      so it's more comfortable. }
    property ParentNode: TX3DNode read FParentNode;

    class function X3DType: string; override;
    class function CreateEvent(const AParentNode: TX3DFileItem; const AName: string; const AInEvent: boolean): TX3DEvent; override;

    { Checks is the Child allowed as a value of this SFNode,
      and makes WritelnWarning if not.

      Check is allowed is done looking at AllowedChildrenAll
      and AllowedChildren properties.

      Child must not be @nil.

      WritelnWarning message will suggest that this Child is used as value
      of this node. In other words, you should only pass as Child
      a node that you want to assign as Value to this field,
      otherwise WritelnWarning message will be a little unsensible. }
    procedure WarningIfChildNotAllowed(Child: TX3DNode);

    function ChildAllowed(Child: TX3DNode): boolean;
    function CurrentChildAllowed: boolean;

    { Calls Func for our @link(Value), assuming it's set (non-nil).
      The main use for this is to simplify implementation of
      TX3DNode.DirectEnumerateActive overrides in TX3DNode descendants. }
    function Enumerate(Func: TEnumerateChildrenFunction): Pointer;

    procedure Send(const AValue: TX3DNode); overload;

    { Use weak links to deal with cycles in the X3D graph.

      Marking a field as a @italic(weak link) can only be done
      when the field value is empty, right when the field is created,
      in @link(TX3DNode.CreateNode) descendant.

      Being a @italic(weak link) means two things:

      @orderedList(
        @item(The nodes inside a weak link are not enumerated
          when traversing the X3D graph in @italic(any) way.
          This includes @link(TX3DNode.EnumerateNodes),
          @link(TX3DNode.Traverse) and all others.
          Nodes implementing @link(TX3DNode.DirectEnumerateActive)
          should also omit these fields.)

        @item(A weak link does not create a reference count
          preventing the node from being freed (or freeing
          it automatically when ref count drops to zero).
          Instead, weak links merely observe the nodes, and automatically
          set their value to @nil when the node gets freed.)
      )

      If effect, this avoids loops when enumerating (and avoids
      recursive loops in reference counts, which would cause memory leaks),
      but use this only when you know that the node
      must occur somewhere else in the X3D graph anyway (or it's OK to
      ignore it).
      For example, this is useful for
      @link(TGeneratedShadowMapNode.Light), as we know that the light
      must occur somewhere else in the graph anyway to be useful.
    }
    property WeakLink: boolean
      read FWeakLink write SetWeakLink default false;
  end;

  TSFNodeEventHelper = class helper for TSFNodeEvent
    procedure Send(const Value: TX3DNode; const Time: TX3DTime); overload;
    procedure Send(const Value: TX3DNode); overload;
  end;

{$endif read_interface}

{$ifdef read_implementation}

{ TSFNode --------------------------------------------------------------------- }

constructor TSFNode.CreateUndefined(const AParentNode: TX3DFileItem;
  const AExposed: boolean; const AName: string);
begin
  inherited;
  Value := nil;

  AllowedChildren := acAll;
  { AllowedChildrenClasses may remain nil in this case }

  FDefaultValue := nil;
  FDefaultValueExists := false;
end;

constructor TSFNode.Create(const AParentNode: TX3DNode;
  const AExposed: boolean; const AName: string;
  const AAllowedChildrenClasses: array of TX3DNodeClass;
  const AValue: TX3DNode);
begin
  inherited Create(AParentNode, AExposed, AName);

  { FParentNode is just a copy of inherited (TX3DFieldOrEvent) FParentNode,
    but casted to TX3DNode }
  FParentNode := AParentNode;

  AllowedChildren := acClasses;
  if AllowedChildrenClasses = nil then
    AllowedChildrenClasses := TX3DNodeClassesList.Create;
  AllowedChildrenClasses.AssignArray(AAllowedChildrenClasses);

  Value := AValue;
  AssignDefaultValueFromValue;
end;

constructor TSFNode.Create(const AParentNode: TX3DNode;
  const AExposed: boolean; const AName: string;
  const AAllowedChildrenClasses: TX3DNodeClassesList;
  const AValue: TX3DNode);
begin
  Create(AParentNode, AExposed, AName, [], AValue);

  Assert(AllowedChildren = acClasses);
  Assert(AllowedChildrenClasses <> nil);
  AllowedChildrenClasses.Assign(AAllowedChildrenClasses);
end;

constructor TSFNode.Create(const AParentNode: TX3DNode;
  const AExposed: boolean; const AName: string;
  const AnAllowedChildrenInterface: TGUID;
  const AValue: TX3DNode);
begin
  inherited Create(AParentNode, AExposed, AName);

  { FParentNode is just a copy of inherited (TX3DFieldOrEvent) FParentNode,
    but casted to TX3DNode }
  FParentNode := AParentNode;

  AllowedChildren := acInterface;
  AllowedChildrenInterface := AnAllowedChildrenInterface;

  Value := AValue;
  AssignDefaultValueFromValue;
end;

destructor TSFNode.Destroy;
begin
  { To delete Self from Value.FParentFields, and eventually free Value. }
  Value := nil;
  { To delete Self from DefaultValue.FParentFields, and eventually free DefaultValue. }
  DefaultValue := nil;
  FreeAndNil(AllowedChildrenClasses);
  inherited;
end;

function TSFNode.ChildAllowed(Child: TX3DNode): boolean;
begin
  case AllowedChildren of
    acAll      : Result := true;
    acClasses  : Result := (Child = nil) or (AllowedChildrenClasses.IndexOfAnyAncestor(Child) <> -1);
    acInterface: Result := (Child = nil) or Supports(Child, AllowedChildrenInterface);
    else raise EInternalError.Create('AllowedChildren?');
  end;
end;

function TSFNode.CurrentChildAllowed: boolean;
begin
  Result := ChildAllowed(Value);
end;

procedure TSFNode.WarningIfChildNotAllowed(Child: TX3DNode);

  procedure ChildNotAllowed;
  var
    S: string;
  begin
    S := Format('Node "%s" is not allowed in the field "%s"',
      [Child.X3DType, X3DName]);
    if ParentNode <> nil then
      S := S + Format(' of the node "%s"', [ParentNode.X3DType]);
    WritelnWarning('VRML/X3D', S);
  end;

begin
  if not ChildAllowed(Child) then
    ChildNotAllowed;
end;

procedure TSFNode.WarningIfUnusedWeakLink;
begin
  if WeakLink and
     (Value <> nil) and
     (Value.FVRML1Parents.Count = 0) and
     (Value.FParentFields.Count = 0) and
     (Value.KeepExisting = 0) then
  begin
    FValue.FreeIfUnused; // we know it will be freed now
    FValue := nil;
    { do a warning after freeing FValue, to avoid memory leaks in case OnWarning makes exception }
    WritelnWarning('VRML/X3D', Format('A node inside the field "%s" must be already used elsewhere (use USE clause, do not declare a new node here)',
      [NiceName]));
  end;
end;

procedure TSFNode.ParseValue(Lexer: TX3DLexer; Reader: TX3DReader);
begin
  if (Lexer.Token = vtKeyword) and (Lexer.TokenKeyword = vkNULL) then
  begin
    Value := nil;
    Lexer.NextToken;
  end else
  begin
    { This is one case when we can use NilIfUnresolvedUSE = @true }
    Value := ParseNode(Lexer, Reader as TX3DReaderNames, true);
    if Value <> nil then
    begin
      WarningIfChildNotAllowed(Value);
      WarningIfUnusedWeakLink;
    end;
  end;
end;

procedure TSFNode.ParseXMLAttribute(const AttributeValue: string; Reader: TX3DReader);
const
  SNull = 'NULL';
var
  UsedNodeFinished: boolean;
  V: TX3DNode;
begin
  { For SFNode and MFNode, X3D XML encoding has special handling:
    field value just indicates the node name, or NULL.
    (other values for SFNode / MFNode cannot be expressed inside
    the attribute). }

  V := (Reader as TX3DReaderNames).Nodes.Bound(AttributeValue, UsedNodeFinished);
  if (V <> nil) and (not UsedNodeFinished) then
  begin
    WritelnWarning('VRML/X3D', Format('Cycles in VRML/X3D graph: SFNode value inside node "%s" refers to the same name', [AttributeValue]));
    Value := nil;
    Exit;
  end;

  Value := V;
  if Value = nil then
  begin
    if AttributeValue <> SNull then
      WritelnWarning('VRML/X3D', Format('Invalid node name for SFNode field: "%s"', [AttributeValue]));
  end else
  begin
    WarningIfChildNotAllowed(Value);
    WarningIfUnusedWeakLink;
  end;
end;

procedure TSFNode.ParseXMLElement(Element: TDOMElement; Reader: TX3DReader);
var
  Child: TX3DNode;
  I: TXMLElementIterator;
  ContainerFieldDummy: string;
begin
  I := Element.ChildrenIterator;
  try
    if I.GetNext then
    begin
      Child := ParseXMLNode(I.Current,
        ContainerFieldDummy { ignore containerField }, Reader as TX3DReaderNames, true);
      if Child <> nil then
      begin
        Value := Child;
        WarningIfChildNotAllowed(Child);
      end;

      if I.GetNext then
        WritelnWarning('VRML/X3D', Format('X3D field "%s" is SFNode, but it contains more than one XML element (2nd element is "%s")',
          [X3DName, I.Current.TagName]));
    end;
  finally FreeAndNil(I) end;
end;

procedure TSFNode.SaveToStreamValue(Writer: TX3DWriter);
begin
  if Value = nil then
    { For XML encoding, note that the NULL value can only be saved
      as an XML attribute (not child element).
      Also, there's no way to specify containerField for NULL value
      --- and that's Ok, since NULL is the default value of all SFNode fields,
      so it's never actually written in normal cases. }
    Writer.Write('NULL') else
  begin
    { TX3DNode.SaveToStream normally starts from new line with an indent.
      In this case, we want it to start on the same line, so indent must
      be discarded. }
    if Writer.Encoding = xeClassic then
      Writer.DiscardNextIndent;

    Value.NodeSaveToStream(Writer, NameForVersion(Writer.Version));
  end;
end;

function TSFNode.SaveToXmlValue: TSaveToXmlMethod;
begin
  { NULL can only be encoded as an attribute in XML encoding }
  if Value = nil then
    Result := sxAttribute else
    Result := sxChildElement;
end;

function TSFNode.EqualsDefaultValue: boolean;
begin
  Result := DefaultValueExists and (Value = DefaultValue);
end;

function TSFNode.Equals(SecondValue: TX3DField): boolean;
begin
 Result := (inherited Equals(SecondValue)) and
   (SecondValue is TSFNode) and
   (TSFNode(SecondValue).Value = Value);
end;

procedure TSFNode.Assign(Source: TPersistent);
begin
  if Source is TSFNode then
  begin
    { Assign using Value property, so that FParentFields will get
      correctly updated. }
    Value              := TSFNode(Source).Value;
    DefaultValue       := TSFNode(Source).DefaultValue;
    DefaultValueExists := TSFNode(Source).DefaultValueExists;
    VRMLFieldAssignCommon(TX3DField(Source));
  end else
    inherited;
end;

procedure TSFNode.AssignValue(Source: TX3DField);
begin
  if Source is TSFNode then
  begin
    inherited;
    Value := TSFNode(Source).Value;
  end else
    AssignValueRaiseInvalidClass(Source);
end;

procedure TSFNode.AssignDefaultValueFromValue;
begin
  inherited;
  DefaultValue := Value;
  DefaultValueExists := true;
end;

procedure TSFNode.SetValue(AValue: TX3DNode);
begin
  if FValue <> AValue then
  begin
    if FValue <> nil then
    begin
      if WeakLink then
        FValue.RemoveDestructionNotification({$ifdef CASTLE_OBJFPC}@{$endif} DestructionNotification)
      else
        FValue.RemoveParentField(Self);
    end;

    FValue := AValue;

    if AValue <> nil then
    begin
      if WeakLink then
        FValue.AddDestructionNotification({$ifdef CASTLE_OBJFPC}@{$endif} DestructionNotification)
      else
        FValue.AddParentField(Self);
    end;
  end;
end;

procedure TSFNode.SetDefaultValue(ADefaultValue: TX3DNode);
begin
  if FDefaultValue <> ADefaultValue then
  begin
    if FDefaultValue <> nil then
    begin
      if WeakLink then
        FDefaultValue.RemoveDestructionNotification({$ifdef CASTLE_OBJFPC}@{$endif} DestructionNotification)
      else
        FDefaultValue.RemoveParentField(Self);
    end;

    FDefaultValue := ADefaultValue;

    if ADefaultValue <> nil then
    begin
      if WeakLink then
        FDefaultValue.AddDestructionNotification({$ifdef CASTLE_OBJFPC}@{$endif} DestructionNotification)
      else
        FDefaultValue.AddParentField(Self);
    end;
  end;
end;

procedure TSFNode.DestructionNotification(Node: TX3DNode);
begin
  if WeakLink then
  begin
    if FValue = Node then
      FValue := nil;
    if FDefaultValue = Node then
      FDefaultValue := nil;
  end;
end;

procedure TSFNode.SetDefaultValueExists(AValue: boolean);
begin
  FDefaultValueExists := AValue;
end;

class function TSFNode.X3DType: string;
begin
  Result := 'SFNode';
end;

function TSFNode.Enumerate(Func: TEnumerateChildrenFunction): Pointer;
begin
  { checking CurrentChildAllowed is not really necessary here,
    and costs time, because it may do a slow Supports() call }
  //if (Value <> nil) and CurrentChildAllowed and not WeakLink then

  if (Value <> nil) and not WeakLink then
    Result := Func(ParentNode, Value)
  else
    Result := nil;
end;

class function TSFNode.CreateEvent(const AParentNode: TX3DFileItem; const AName: string; const AInEvent: boolean): TX3DEvent;
begin
  Result := TSFNodeEvent.Create(AParentNode, AName, AInEvent);
end;

procedure TSFNode.Send(const AValue: TX3DNode);
var
  FieldValue: TSFNode;
begin
  { We construct using CreateUndefined constructor,to have AllowedChildren = acAll }
  { AExposed = false below, because not needed otherwise. }
  FieldValue := TSFNode.CreateUndefined(ParentNode, false, X3DName);
  try
    FieldValue.Value := AValue;
    Send(FieldValue);
  finally FreeAndNil(FieldValue) end;
end;

procedure TSFNode.SetWeakLink(const AValue: boolean);
begin
  if FWeakLink <> AValue then
  begin
    if Value <> nil then
      raise EInternalError.Create('TSFNode.WeakLink cannot change when some node is already assigned');
    FWeakLink := AValue;
  end;
end;

{ TSFNodeEventHelper --------------------------------------------------------- }

procedure TSFNodeEventHelper.Send(const Value: TX3DNode; const Time: TX3DTime);
var
  Field: TX3DField;
begin
  Field := CreateTemp;
  (Field as TSFNode).Value := Value;
  try
    Self.Send(Field, Time);
  finally FreeTemp(Field) end;
end;

procedure TSFNodeEventHelper.Send(const Value: TX3DNode);
begin
  if (ParentNode <> nil) and
     (TX3DNode(ParentNode).Scene <> nil) then
    Send(Value, TX3DNode(ParentNode).Scene.NextEventTime);
end;

{$endif read_implementation}
