{
  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}
  { Base node type for all font style nodes. }
  TAbstractFontStyleNode = class(TAbstractNode)
  public
    procedure CreateNode; override;

    {$I auto_generated_node_helpers/x3dnodes_x3dfontstylenode.inc}
  end;

  { Font family that can be specified by a TFontStyleNode. }
  TX3DFontFamily = (ffSerif, ffSans, ffTypeWriter);

  { Font justification that can be specified by a TFontStyleNode. }
  TX3DFontJustify = (fjFirst, fjBegin, fjMiddle, fjEnd);

  { Defines the size, family, style and other properties used for @link(TTextNode). }
  TFontStyleNode = class(TAbstractFontStyleNode)
  strict private
    JustifyWarningUppercaseDone, JustifyWarningObsoleteDone,
      JustifyWarningNotSupportedDone: boolean;
    function GetBlending: boolean;
    procedure SetBlending(const Value: boolean);
    function StringToJustify(const S: string;
      const DefaultValue: TX3DFontJustify): TX3DFontJustify;
    function GetFamily: TX3DFontFamily;
    procedure SetFamily(const Value: TX3DFontFamily);
    function GetBold: boolean;
    procedure SetBold(const Value: boolean);
    function GetItalic: boolean;
    procedure SetItalic(const Value: boolean);
    function GetJustify: TX3DFontJustify;
    procedure SetJustify(const Value: TX3DFontJustify);
    function GetJustifyMinor: TX3DFontJustify;
    procedure SetJustifyMinor(const Value: TX3DFontJustify);
  private
    function Font: TTextureFontData;
  public
    const
      DefaultSize = 1.0;
      DefaultSpacing = 1.0;
      DefaultFamily = ffSerif;
      DefaultBold = false;
      DefaultItalic = false;
      DefaultJustify = fjBegin;
      DefaultJustifyMinor = fjFirst;
      DefaultBlending = true;

    procedure CreateNode; override;
    class function ClassX3DType: string; override;
    class function URNMatching(const URN: string): boolean; override;

    strict private FFdFamily: TMFString;
    public property FdFamily: TMFString read FFdFamily;
    property Family: TX3DFontFamily read GetFamily write SetFamily;

    strict private FFdHorizontal: TSFBool;
    public property FdHorizontal: TSFBool read FFdHorizontal;

    strict private FFdJustify: TMFString;
    public property FdJustify: TMFString read FFdJustify;
    property Justify: TX3DFontJustify read GetJustify write SetJustify;
    property JustifyMinor: TX3DFontJustify read GetJustifyMinor write SetJustifyMinor;

    strict private FFdLanguage: TSFString;
    public property FdLanguage: TSFString read FFdLanguage;

    strict private FFdLeftToRight: TSFBool;
    public property FdLeftToRight: TSFBool read FFdLeftToRight;

    strict private FFdSize: TSFFloat;
    public property FdSize: TSFFloat read FFdSize;

    strict private FFdSpacing: TSFFloat;
    public property FdSpacing: TSFFloat read FFdSpacing;

    strict private FFdStyle: TSFString;
    public property FdStyle: TSFString read FFdStyle;
    property Bold: boolean read GetBold write SetBold;
    property Italic: boolean read GetItalic write SetItalic;

    strict private FFdTopToBottom: TSFBool;
    public property FdTopToBottom: TSFBool read FFdTopToBottom;

    strict private FFdBlending: TSFBool;
    public property FdBlending: TSFBool read FFdBlending;
    property Blending: boolean read GetBlending write SetBlending;

    class function ForVRMLVersion(const Version: TX3DVersion): boolean;
      override;

    type
      TFontEvent = procedure (const FontStyle: TFontStyleNode; var Font: TTextureFontData) of object;

    { Adjust the font used for a given FontStyle node.
      Assign here a callback which can modify a font.
      You can look at any font style properties to decide how to adjust
      the font, like @link(Bold), @link(Italic), @link(Family).

      You can always decide to leave the given "Font" instance
      at the default value, or to modify it.

      The font instance set here is a TTextureFontData instance.
      You can load it from a TTF file by @link(TTextureFontData.Create),
      or you can assign here a TTextureFontData instance defined
      by a unit generated by texture-font-to-pascal.
      See http://castle-engine.sourceforge.net/tutorial_text.php
      about using texture-font-to-pascal.
      In the first case, remember that it is your resposibility
      to free this font later, but only after all possible Text nodes
      using this font are destroyed. }
    class var OnFont: TFontEvent;

    {$I auto_generated_node_helpers/x3dnodes_fontstyle.inc}
  end;
  TFontStyleNode_2 = TFontStyleNode deprecated 'use TFontStyleNode';

  TPixelTextureNode = class;

  { Multiline text, visualized as a set of flat and textured polygons. }
  TTextNode = class(TAbstractGeometryNode)
  strict private
    FFontTextureNode: TPixelTextureNode;
    function Font: TTextureFontData;
    function GetFontStyle: TFontStyleNode;
    procedure SetFontStyle(const Value: TFontStyleNode);
  public
    procedure CreateNode; override;
    destructor Destroy; override;
    class function ClassX3DType: string; override;
    class function URNMatching(const URN: string): boolean; override;

    strict private FFdFontStyle: TSFNode;
    public property FdFontStyle: TSFNode read FFdFontStyle;

    strict private FFdLength: TMFFloat;
    public property FdLength: TMFFloat read FFdLength;

    strict private FFdMaxExtent: TSFFloat;
    public property FdMaxExtent: TSFFloat read FFdMaxExtent;

    strict private FFdString: TMFString;
    public property FdString: TMFString read FFdString;

    { Event out } { }
    strict private FEventLineBounds: TMFVec2fEvent;
    public property EventLineBounds: TMFVec2fEvent read FEventLineBounds;

    { Event out } { }
    strict private FEventOrigin: TSFVec3fEvent;
    public property EventOrigin: TSFVec3fEvent read FEventOrigin;

    { Event out } { }
    strict private FEventTextBounds: TSFVec2fEvent;
    public property EventTextBounds: TSFVec2fEvent read FEventTextBounds;

    strict private FFdSolid: TSFBool;
    public property FdSolid: TSFBool read FFdSolid;

    strict private FFdTexCoord: TSFNode;
    public property FdTexCoord: TSFNode read FFdTexCoord;
    function TexCoordField: TSFNode; override;

    function Proxy(var State: TX3DGraphTraverseState;
      const OverTriangulate: boolean): TAbstractGeometryNode; override;
    function ProxyUsesOverTriangulate: boolean; override;
    function LocalBoundingBox(State: TX3DGraphTraverseState;
      ProxyGeometry: TAbstractGeometryNode; ProxyState: TX3DGraphTraverseState): TBox3D; override;

    { The font rendering style. Returns @nil if not assigned,
      or if the underlying X3D field has invalid node type assigned. }
    property FontStyle: TFontStyleNode read GetFontStyle write SetFontStyle;

    function SolidField: TSFBool; override;
    function FontTextureNode: TAbstractTexture2DNode; override;

    { Force recalculating the shape when font changed.
      For now, we don't detect font changes (when TFontStyleNode.OnFont
      returns something different) outselves. }
    procedure FontChanged;

    {$I auto_generated_node_helpers/x3dnodes_text.inc}
  end;

{$endif read_interface}

{$ifdef read_implementation}
procedure TAbstractFontStyleNode.CreateNode;
begin
  inherited;

  DefaultContainerField := 'fontStyle';
end;

procedure TFontStyleNode.CreateNode;
begin
  inherited;

  FFdFamily := TMFString.Create(Self, false, 'family', ['SERIF']);
   FdFamily.ChangesAlways := [chFontStyle];
  AddField(FFdFamily);

  FFdHorizontal := TSFBool.Create(Self, false, 'horizontal', true);
   FdHorizontal.ChangesAlways := [chFontStyle];
  AddField(FFdHorizontal);

  FFdJustify := TMFString.Create(Self, false, 'justify', ['BEGIN']);
   FdJustify.ChangesAlways := [chFontStyle];
  AddField(FFdJustify);
  { X3D specification comment: ["BEGIN","END","FIRST","MIDDLE",""] }

  FFdLanguage := TSFString.Create(Self, false, 'language', '');
   FdLanguage.ChangesAlways := [chFontStyle];
  AddField(FFdLanguage);

  FFdLeftToRight := TSFBool.Create(Self, false, 'leftToRight', true);
   FdLeftToRight.ChangesAlways := [chFontStyle];
  AddField(FFdLeftToRight);

  FFdSize := TSFFloat.Create(Self, false, 'size', DefaultSize);
   FdSize.ChangesAlways := [chFontStyle];
  AddField(FFdSize);
  { X3D specification comment: (0,Inf) }

  FFdSpacing := TSFFloat.Create(Self, false, 'spacing', DefaultSpacing);
   FdSpacing.ChangesAlways := [chFontStyle];
  AddField(FFdSpacing);
  { X3D specification comment: [0,Inf) }

  FFdStyle := TSFString.Create(Self, false, 'style', 'PLAIN');
   FdStyle.ChangesAlways := [chFontStyle];
  AddField(FFdStyle);
  { X3D specification comment: ["PLAIN"|"BOLD"|"ITALIC"|"BOLDITALIC"|""] }

  FFdTopToBottom := TSFBool.Create(Self, false, 'topToBottom', true);
   FdTopToBottom.ChangesAlways := [chFontStyle];
  AddField(FFdTopToBottom);

  FFdBlending := TSFBool.Create(Self, false, 'blending', DefaultBlending);
   FdBlending.ChangesAlways := [chFontStyle];
  AddField(FFdBlending);
end;

class function TFontStyleNode.ClassX3DType: string;
begin
  Result := 'FontStyle';
end;

class function TFontStyleNode.URNMatching(const URN: string): boolean;
begin
  Result := (inherited URNMatching(URN)) or
    (URN = URNVRML97Nodes + ClassX3DType) or
    (URN = URNX3DNodes + ClassX3DType);
end;

class function TFontStyleNode.ForVRMLVersion(const Version: TX3DVersion): boolean;
begin
  Result := Version.Major >= 2;
end;

function TFontStyleNode.GetFamily: TX3DFontFamily;
var
  I: Integer;
begin
  for I := 0 to FdFamily.Items.Count - 1 do
    if FdFamily.Items[I] = 'SERIF' then
      Exit(ffSerif)
    else
    if FdFamily.Items[I] = 'SANS' then
      Exit(ffSans)
    else
    if FdFamily.Items[I] = 'TYPEWRITER' then
      Exit(ffTypeWriter)
    else
      WritelnWarning('VRML/X3D', 'Font family "' + FdFamily.Items[I] + '" not supported');

  { If no supported values on FdFamily.Items then fall back to serif }
  Result := ffSerif;
end;

procedure TFontStyleNode.SetFamily(const Value: TX3DFontFamily);
const
  FontFamilyNames: array [TX3DFontFamily] of string =
  ('SERIF', 'SANS', 'TYPEWRITER');
begin
  FdFamily.Send(FontFamilyNames[Value]);
end;

const
  StyleBold = 'BOLD';
  StyleBoldItalic = 'BOLDITALIC';
  StyleItalic = 'ITALIC';
  StylePlain = 'PLAIN';
  StyleString: array[boolean { bold ? }, boolean { italic ? }] of string =
  ( (StylePlain, StyleItalic),
    (StyleBold, StyleBoldItalic) );

function TFontStyleNode.GetBold: boolean;
var
  S: string;
begin
  S := FdStyle.Value;
  Result :=
    (S = StyleBold) or
    (S = StyleBoldItalic);

  { This is the end of calculating Result.
    But we would like to make a warning in case of invalid FdStyle
    value, so we do check below. }

  if not Result then
  begin
    if not (
      (S = StyleItalic) or
      (S = StylePlain) or
      (S = '')) then
      WritelnWarning('VRML/X3D', 'Font style "' + S + '" not supported');
  end;
end;

procedure TFontStyleNode.SetBold(const Value: boolean);
begin
  FdStyle.Send(StyleString[Value, Italic]);
end;

function TFontStyleNode.GetItalic: boolean;
var
  S: string;
begin
  S := FdStyle.Value;
  Result :=
    (S = StyleItalic) or
    (S = StyleBoldItalic);

  { This is the end of calculating Result.
    But we would like to make a warning in case of invalid FdStyle
    value, so we do check below. }

  if not Result then
  begin
    if not (
      (S = StyleBold) or
      (S = StylePlain) or
      (S = '')) then
      WritelnWarning('VRML/X3D', 'Font style "' + S + '" not supported');
  end;
end;

procedure TFontStyleNode.SetItalic(const Value: boolean);
begin
  FdStyle.Send(StyleString[Bold, Value]);
end;

function TFontStyleNode.StringToJustify(const S: string;
  const DefaultValue: TX3DFontJustify): TX3DFontJustify;
const
  SJustifyObsolete = 'Font justify "%s" should not be used in VRML >= 2.0, use "%s" instead';
var
  J: string;
begin
  { Some X3D models use lowercase names, like [http://instant-reality.com/]
    test models. }
  J := UpperCase(S);
  if (J <> S) and not JustifyWarningUppercaseDone then
  begin
    WritelnWarning('VRML/X3D', Format('Font justify value "%s" should be specified in uppercase',
      [S]));
    JustifyWarningUppercaseDone := true;
  end;

  if J = ''       then Result := DefaultValue else
  if J = 'BEGIN'  then Result := fjBegin else
  if J = 'FIRST'  then Result := fjFirst else
  if J = 'MIDDLE' then Result := fjMiddle else
  if J = 'END'    then Result := fjEnd else

  { Some X3D models use old justify names, like cic.nist.gov X3D demos. }
  if J = 'LEFT' then
  begin
    if not JustifyWarningObsoleteDone then
    begin
      WritelnWarning('VRML/X3D', Format(SJustifyObsolete, ['LEFT', 'BEGIN']));
      JustifyWarningObsoleteDone := true;
    end;
    Result := fjBegin;
  end else
  if J = 'CENTER' then
  begin
    if not JustifyWarningObsoleteDone then
    begin
      WritelnWarning('VRML/X3D', Format(SJustifyObsolete, ['CENTER', 'MIDDLE']));
      JustifyWarningObsoleteDone := true;
    end;
    Result := fjMiddle;
  end else
  if J = 'RIGHT' then
  begin
    if not JustifyWarningObsoleteDone then
    begin
      WritelnWarning('VRML/X3D', Format(SJustifyObsolete, ['RIGHT', 'END']));
      JustifyWarningObsoleteDone := true;
    end;
    Result := fjEnd;
  end else

  begin
    Result := DefaultValue;
    if not JustifyWarningNotSupportedDone then
    begin
      WritelnWarning('VRML/X3D', 'Font justify "' + S + '" not supported');
      JustifyWarningNotSupportedDone := true;
    end;
  end;
end;

const
  JustifyToString: array[TX3DFontJustify] of string =
  ('FIRST', 'BEGIN', 'MIDDLE', 'END');

function TFontStyleNode.GetJustify: TX3DFontJustify;
begin
  if FdJustify.Items.Count > 0 then
    Result := StringToJustify(FdJustify.Items[0], DefaultJustify)
  else
    Result := DefaultJustify;
end;

function TFontStyleNode.GetJustifyMinor: TX3DFontJustify;
begin
  if FdJustify.Items.Count > 1 then
    Result := StringToJustify(FdJustify.Items[1], DefaultJustifyMinor)
  else
    Result := DefaultJustifyMinor;
end;

procedure TFontStyleNode.SetJustify(const Value: TX3DFontJustify);
begin
  FdJustify.Send([JustifyToString[Value], JustifyToString[JustifyMinor]]);
end;

procedure TFontStyleNode.SetJustifyMinor(const Value: TX3DFontJustify);
begin
  FdJustify.Send([JustifyToString[Justify], JustifyToString[Value]]);
end;

function TFontStyleNode.GetBlending: boolean;
begin
  Result := FdBlending.Value;
end;

procedure TFontStyleNode.SetBlending(const Value: boolean);
begin
  FdBlending.Send(Value);
end;

procedure TTextNode.CreateNode;
begin
  inherited;

  FFdFontStyle := TSFNode.Create(Self, true, 'fontStyle', [TAbstractFontStyleNode]);
   FdFontStyle.ChangesAlways := [chGeometry];
  AddField(FFdFontStyle);

  FFdLength := TMFFloat.Create(Self, true, 'length', []);
   FdLength.ChangesAlways := [chGeometry];
  AddField(FFdLength);
  { X3D specification comment: [0,Inf) }

  FFdMaxExtent := TSFFloat.Create(Self, true, 'maxExtent', 0.0);
   FdMaxExtent.ChangesAlways := [chGeometry];
  AddField(FFdMaxExtent);
  { X3D specification comment: [0,Inf) }

  FFdString := TMFString.Create(Self, true, 'string', []);
   FdString.ChangesAlways := [chGeometry];
  AddField(FFdString);

  FEventLineBounds := TMFVec2fEvent.Create(Self, 'lineBounds', false);
  AddEvent(FEventLineBounds);

  FEventOrigin := TSFVec3fEvent.Create(Self, 'origin', false);
  AddEvent(FEventOrigin);

  FEventTextBounds := TSFVec2fEvent.Create(Self, 'textBounds', false);
  AddEvent(FEventTextBounds);

  FFdSolid := TSFBool.Create(Self, false, 'solid', false);
   FdSolid.ChangesAlways := [chGeometry];
  AddField(FFdSolid);

  FFdTexCoord := TSFNode.Create(Self, true, 'texCoord', [TTextureCoordinateGeneratorNode, TProjectedTextureCoordinateNode, TMultiTextureCoordinateNode]);
   FdTexCoord.ChangesAlways := [chGeometry];
  AddField(FFdTexCoord);
end;

destructor TTextNode.Destroy;
begin
  { actually FreeAndNil would also be OK, as this is never
    a child of another node. But for safety... }
  FreeIfUnusedAndNil(FFontTextureNode);
  inherited;
end;

procedure TTextNode.FontChanged;
begin
  FreeIfUnusedAndNil(FFontTextureNode);
end;

class function TTextNode.ClassX3DType: string;
begin
  Result := 'Text';
end;

class function TTextNode.URNMatching(const URN: string): boolean;
begin
  Result := (inherited URNMatching(URN)) or
    (URN = URNVRML97Nodes + ClassX3DType) or
    (URN = URNX3DNodes + ClassX3DType);
end;

function TTextNode.TexCoordField: TSFNode;
begin
  Result := FdTexCoord;
end;

function TTextNode.GetFontStyle: TFontStyleNode;
begin
  if (FdFontStyle.Value <> nil) and
     (FdFontStyle.Value is TFontStyleNode) then
    Result := TFontStyleNode(FdFontStyle.Value) else
    Result := nil;
end;

procedure TTextNode.SetFontStyle(const Value: TFontStyleNode);
begin
  FdFontStyle.Send(Value);
end;

function TTextNode.SolidField: TSFBool;
begin
  Result := FdSolid;
end;

{ Create a simple mesh (filling OutCoords, OutTexCoords fields
  to initialize X3D node like QuadSet) that represents input Text node.
  The interface is suitable for both VRML 2.0 / X3D Text node,
  as well as VRML 1.0 AsciiText node. }
procedure TextProxy(const OriginalNode: TX3DNode;
  const Size, Spacing: Single;
  const Justify, JustifyMinor: TX3DFontJustify;
  const Strings: TCastleStringList;
  const Font: TTextureFontData;
  const Solid: boolean;
  const EventLineBounds: TMFVec2fEvent;
  const EventOrigin: TSFVec3fEvent;
  const EventTextBounds: TSFVec2fEvent;
  const OutCoord: TMFVec3f; const OutTexCoord, OutExtraTexCoord: TMFVec2f);
var
  TextWidths: TSingleList;

  { StringPos* calculate position to start the given line of text.
    They ignore the Size parameter. }

  function StringPosX(I: Integer): Single;
  begin
    case Justify of
      fjBegin, fjFirst :
                Result := 0;
      fjMiddle: Result := - TextWidths.Items[I] / 2;
      fjEnd   : Result := - TextWidths.Items[I];
      else raise EInternalError.Create('StringPosX: Invalid font Justify value');
    end;
  end;

  function StringPosY(I: Integer): Single;
  begin
    case JustifyMinor of
      fjFirst : Result := - I;
      fjBegin : Result := - (I + 1);
      fjMiddle: Result := Strings.Count / 2 - (I + 1);
      fjEnd   : Result := Strings.Count     - (I + 1);
      else raise EInternalError.Create('StringPosY: Invalid font JustifyMinor value');
    end;
    Result := Result * (Font.RowHeight * Spacing);
  end;

var
  YScale, XScale, MaxTextWidth: Single;
  ExtraTexOrigin: TVector2;

  procedure SendEvents;
  var
    Origin: TVector3;
    LineBounds: TMFVec2f;
    FinalRowHeight: Single;
    I: Integer;
  begin
    if (EventOrigin <> nil) and
       (OriginalNode.Scene <> nil) then
    begin
      { This is all simple, since we ignore topToBottom, leftToRight.
        Also, we don't honour the rule that the upper line of the text
        is exactly on Y = 0 (instead, our *row* (which is slightly higher
        than the upper text line) is on Y = 0, this is documented
        on [http://castle-engine.sourceforge.net/x3d_implementation_status.php]
        by failed NIST test about it.

        So the lacks of current Text rendering implementation
        make this somewhat simple :) }

      FinalRowHeight := Font.RowHeight * Spacing * YScale;

      { calculate and send Origin }
      Origin := TVector3.Zero;
      case Justify of
        fjBegin, fjFirst :
                  Origin[0] := 0;
        fjMiddle: Origin[0] := -MaxTextWidth * XScale / 2;
        fjEnd   : Origin[0] := -MaxTextWidth * XScale    ;
        else raise EInternalError.Create('SendEvents: Invalid font justify value');
      end;
      case JustifyMinor of
        fjFirst : Origin[1] := -FinalRowHeight;
        fjBegin : Origin[1] := 0;
        fjMiddle: Origin[1] := -FinalRowHeight * Strings.Count / 2;
        fjEnd   : Origin[1] := -FinalRowHeight * Strings.Count;
        else raise EInternalError.Create('SendEvents: Invalid font justify value');
      end;
      EventOrigin.Send(Origin, OriginalNode.Scene.NextEventTime);

      if EventLineBounds.SendNeeded then
      begin
        LineBounds := TMFVec2f.CreateUndefined(OriginalNode, false, EventLineBounds.X3DName);
        try
          LineBounds.Items.Count := TextWidths.Count;

          case Justify of
            fjBegin, fjFirst:
              for I := 0 to TextWidths.Count - 1 do
                LineBounds.Items.List^[I] := Vector2(
                  TextWidths[I] * XScale, FinalRowHeight);
            fjMiddle:
              for I := 0 to TextWidths.Count - 1 do
                LineBounds.Items.List^[I] := Vector2(
                  (MaxTextWidth + TextWidths[I]) * XScale / 2, FinalRowHeight);
            fjEnd   :
              for I := 0 to TextWidths.Count - 1 do
                LineBounds.Items.List^[I] := Vector2(
                  MaxTextWidth * XScale, FinalRowHeight);
            else raise EInternalError.Create('Invalid font justify value');
          end;

          EventLineBounds.Send(LineBounds, OriginalNode.Scene.NextEventTime);
        finally FreeAndNil(LineBounds) end;
      end;

      EventTextBounds.Send(Vector2(
        MaxTextWidth * XScale, FinalRowHeight * Strings.Count), OriginalNode.Scene.NextEventTime);
    end;
  end;

  { Print the string, by adding rectangles to current QuadSet.
    This is somewhat analogous to printing straight in 2D done
    by TCastleFont.Print and TGLImageCore.Draw. }
  procedure Print(X, Y: Single; const S: string; const XScale, YScale: Single);

    function ConvertCoordToExtraTex(const CoordIndex: Integer; const Coord: Single): Single;
    begin
      Result := MapRange(Coord,
        ExtraTexOrigin[CoordIndex],
        ExtraTexOrigin[CoordIndex] + Font.RowHeight * Spacing * YScale,
        0, 1);
    end;

  var
    C: TUnicodeChar;
    TextPtr: PChar;
    CharLen: Integer;
    G: TTextureFontData.TGlyph;
    CoordX0, CoordX1, CoordY0, CoordY1,
      TexX0, TexX1, TexY0, TexY1,
      ExtraTexX0, ExtraTexX1, ExtraTexY0, ExtraTexY1: Single;
  begin
    TextPtr := PChar(S);
    C := UTF8CharacterToUnicode(TextPtr, CharLen);
    while (C > 0) and (CharLen > 0) do
    begin
      Inc(TextPtr, CharLen);

      G := Font.Glyph(C);
      if G <> nil then
      begin
        if (G.Width <> 0) and (G.Height <> 0) then
        begin
          { Use a small margin around every glyph to allow bilinear
            filtering to smoothly go from opaque to fully transparent
            at glyph border. This prevents glyph border from ending suddenly,
            it looks much better in the case of blending.

            This cooperates with TTextureFontData.Create (used by
            texture-font-to-pascal) that makes sure that each letter is
            surrounded with a padding that allows such border,
            see GlyphPadding in castletexturefontdata.pas. }
          {$define EXTRA_GLYPH_SPACE}

          CoordX0 := X - G.X {$ifdef EXTRA_GLYPH_SPACE} - 0.5 {$endif};
          CoordY0 := Y - G.Y {$ifdef EXTRA_GLYPH_SPACE} - 0.5 {$endif};
          CoordX1 := CoordX0 + G.Width  {$ifdef EXTRA_GLYPH_SPACE} + 1 {$endif};
          CoordY1 := CoordY0 + G.Height {$ifdef EXTRA_GLYPH_SPACE} + 1 {$endif};

          CoordX0 := CoordX0 * XScale;
          CoordX1 := CoordX1 * XScale;
          CoordY0 := CoordY0 * YScale;
          CoordY1 := CoordY1 * YScale;

          OutCoord.Items.Add(Vector3(CoordX0, CoordY0, 0));
          OutCoord.Items.Add(Vector3(CoordX1, CoordY0, 0));
          OutCoord.Items.Add(Vector3(CoordX1, CoordY1, 0));
          OutCoord.Items.Add(Vector3(CoordX0, CoordY1, 0));

          TexX0 := (G.ImageX {$ifdef EXTRA_GLYPH_SPACE} - 0.5 {$endif}) / Font.Image.Width;
          TexY0 := (G.ImageY {$ifdef EXTRA_GLYPH_SPACE} - 0.5 {$endif}) / Font.Image.Height;
          TexX1 := (G.ImageX + G.Width  {$ifdef EXTRA_GLYPH_SPACE} + 1 {$endif}) / Font.Image.Width;
          TexY1 := (G.ImageY + G.Height {$ifdef EXTRA_GLYPH_SPACE} + 1 {$endif}) / Font.Image.Height;

          OutTexCoord.Items.Add(Vector2(TexX0, TexY0));
          OutTexCoord.Items.Add(Vector2(TexX1, TexY0));
          OutTexCoord.Items.Add(Vector2(TexX1, TexY1));
          OutTexCoord.Items.Add(Vector2(TexX0, TexY1));

          { if we want extra texture coordinates, generate them knowing
            ExtraTexOrigin and current Coord* values. This is enough,
            see the specification:

              The texture origin is at the origin of the first string,
              as determined by the justification. The texture is scaled
              equally in both S and T dimensions, with the font height
              representing 1 unit. S increases to the right, and T increases up. }

          if OutExtraTexCoord <> nil then
          begin
            ExtraTexX0 := ConvertCoordToExtraTex(0, CoordX0);
            ExtraTexY0 := ConvertCoordToExtraTex(1, CoordY0);
            ExtraTexX1 := ConvertCoordToExtraTex(0, CoordX1);
            ExtraTexY1 := ConvertCoordToExtraTex(1, CoordY1);

            OutExtraTexCoord.Items.Add(Vector2(ExtraTexX0, ExtraTexY0));
            OutExtraTexCoord.Items.Add(Vector2(ExtraTexX1, ExtraTexY0));
            OutExtraTexCoord.Items.Add(Vector2(ExtraTexX1, ExtraTexY1));
            OutExtraTexCoord.Items.Add(Vector2(ExtraTexX0, ExtraTexY1));
          end;
        end;
        X := X + G.AdvanceX;
        Y := Y + G.AdvanceY;
      end;

      C := UTF8CharacterToUnicode(TextPtr, CharLen);
    end;
  end;

var
  I: Integer;
begin
  YScale := Size / Font.RowHeight;
  { TODO: Use maxEntent, length for VRML 2.0. Use width for VRML 1.0. }
  XScale := YScale;

  TextWidths := TSingleList.Create;
  try
    TextWidths.Count := Strings.Count;
    MaxTextWidth := 0;
    for I := 0 to TextWidths.Count - 1 do
    begin
      TextWidths.List^[I] := Font.TextWidth(Strings[I]);
      MaxVar(MaxTextWidth, TextWidths.List^[I]);
    end;

    if Strings.Count <> 0 then
    begin
      ExtraTexOrigin := Vector2(StringPosX(0) * XScale, StringPosY(0) * YScale);
      for I := 0 to Strings.Count - 1 do
        Print(StringPosX(I), StringPosY(I), Strings[I], XScale, YScale);
    end;

    { These events should be generated only when
      the default values of length and maxExtent are used.
      For now, we ignore length and maxExtent, so these events are
      simply always generated. }
    SendEvents;
  finally FreeAndNil(TextWidths) end;
end;

function TTextNode.Proxy(var State: TX3DGraphTraverseState;
  const OverTriangulate: boolean): TAbstractGeometryNode;
var
  Size, Spacing: Single;
  Justify, JustifyMinor: TX3DFontJustify;
  FaceSet: TQuadSetNode;
  CoordNode: TCoordinateNode;
  MultiTexCoordNode: TMultiTextureCoordinateNode;
  TexCoordNode, ExtraTexCoordNode: TTextureCoordinateNode;
  I: Integer;
  ExtraTexCoordField: TMFVec2f;
begin
  if FontStyle = nil then
  begin
    Size := TFontStyleNode.DefaultSize;
    Spacing := TFontStyleNode.DefaultSpacing;
    Justify := TFontStyleNode.DefaultJustify;
    JustifyMinor := TFontStyleNode.DefaultJustifyMinor;
  end else
  begin
    Size := FontStyle.FdSize.Value;
    Spacing := FontStyle.FdSpacing.Value;
    Justify := FontStyle.Justify;
    JustifyMinor := FontStyle.JustifyMinor;
  end;

  FaceSet := TQuadSetNode.Create(X3DName, BaseUrl);
  try
    FaceSet.Solid := Solid;

    CoordNode := TCoordinateNode.Create('', BaseUrl);
    FaceSet.Coord := CoordNode;

    MultiTexCoordNode := TMultiTextureCoordinateNode.Create('', BaseUrl);
    FaceSet.TexCoord := MultiTexCoordNode;

    TexCoordNode := TTextureCoordinateNode.Create('', BaseUrl);
    MultiTexCoordNode.FdTexCoord.Add(TexCoordNode);

    if (FdTexCoord.Value <> nil) and FdTexCoord.CurrentChildAllowed then
    begin
      { If you specify explicit Text.texCoord value, we assume you want
        to use it for Appearance.texture, instead of automatic texture
        coordinates that would be placed inside ExtraTexCoordNode.
        So we don't use ExtraTexCoordNode then.

        Note: don't worry about CastleInternalShadowMaps processing here.
        CastleInternalShadowMaps processing happens on the resulting geometry node,
        it *does not* modify source FdTexCoord field. So shadow maps
        will work on both textured and untextured text,
        because CastleInternalShadowMaps processing will actually cut off ExtraTexCoordNode
        in case they are unused (because text is not textured),
        before adding ProjectedTextureCoordinate. }
      ExtraTexCoordNode := nil;
      if FdTexCoord.Value is TMultiTextureCoordinateNode then
      begin
        for I := 0 to TMultiTextureCoordinateNode(FdTexCoord.Value).FdTexCoord.Count - 1 do
          MultiTexCoordNode.FdTexCoord.Add(
            TMultiTextureCoordinateNode(FdTexCoord.Value).FdTexCoord.Items[I]);
      end else
        MultiTexCoordNode.FdTexCoord.Add(FdTexCoord.Value);
    end else
    begin
      ExtraTexCoordNode := TTextureCoordinateNode.Create('', BaseUrl);
      MultiTexCoordNode.FdTexCoord.Add(ExtraTexCoordNode);
    end;
    if ExtraTexCoordNode <> nil then
      ExtraTexCoordField := ExtraTexCoordNode.FdPoint else
      ExtraTexCoordField := nil;

    TextProxy(Self, Size, Spacing, Justify, JustifyMinor, FdString.Items, Font,
      Solid, EventLineBounds, EventOrigin, EventTextBounds,
      CoordNode.FdPoint, TexCoordNode.FdPoint, ExtraTexCoordField);

    Result := FaceSet;
  except FreeAndNil(FaceSet); raise end;
end;

function TTextNode.ProxyUsesOverTriangulate: boolean;
begin
  Result := false;
end;

function TFontStyleNode.Font: TTextureFontData;
{$ifdef CASTLE_EMBED_ALL_3D_FONT_VARIATIONS}
begin
  case Family of
    ffSerif:
      if Bold and Italic then
        Result := TextureFont_DejaVuSerifBoldItalic_20 else
      if Bold then
        Result := TextureFont_DejaVuSerifBold_20 else
      if Italic then
        Result := TextureFont_DejaVuSerifItalic_20 else
        Result := TextureFont_DejaVuSerif_20;
    ffSans:
      if Bold and Italic then
        Result := TextureFont_DejaVuSansBoldOblique_20 else
      if Bold then
        Result := TextureFont_DejaVuSansBold_20 else
      if Italic then
        Result := TextureFont_DejaVuSansOblique_20 else
        Result := TextureFont_DejaVuSans_20;
    ffTypeWriter:
      if Bold and Italic then
        Result := TextureFont_DejaVuSansMonoBoldOblique_20 else
      if Bold then
        Result := TextureFont_DejaVuSansMonoBold_20 else
      if Italic then
        Result := TextureFont_DejaVuSansMonoOblique_20 else
        Result := TextureFont_DejaVuSansMono_20;
    else raise EInternalError.Create('GetFont:Family?');
  end;
{$else}
begin
  Result := TextureFont_DejaVuSans_20;
{$endif}
  if Assigned(OnFont) then
    OnFont(Self, Result);
end;

function TTextNode.Font: TTextureFontData;
var
  TemporaryFontStyle: TFontStyleNode;
begin
  if FontStyle <> nil then
    Result := FontStyle.Font
  else
  begin
    TemporaryFontStyle := TFontStyleNode.Create('', BaseUrl);
    try
      { get font for a default FontStyle node }
      Result := TemporaryFontStyle.Font;
    finally FreeAndNil(TemporaryFontStyle) end;
  end;
end;

function CreateFontTextureNode(const Font: TTextureFontData;
  const Blending: boolean): TPixelTextureNode;
begin
  Result := TPixelTextureNode.Create;
  { although repeat=TRUE seems counter-intuitive, in fact:
    - We *can* use it, since CastleTextureFontData surrounds each glyph from
      the right and top with GlyphPadding, so we will not accidentally pick
      other glyph by slightly going outside the texture area.
    - We *want* to use it actually, for EXTRA_GLYPH_SPACE. This way glyphs
      on the very left and bottom border of the font texture will also
      have a transparent pixel row to the left / bottom. }
  Result.RepeatS := true;
  Result.RepeatT := true;
  { convert grayscale image with TreatAsAlpha to TGrayscaleAlphaImage }
  Result.FdImage.Value := Font.Image.ToGrayscaleAlphaImage;
  if Blending then
    Result.AlphaChannelField := acBlending
  else
    Result.AlphaChannelField := acTest;
end;

function TTextNode.FontTextureNode: TAbstractTexture2DNode;
var
  Blending: boolean;
begin
  { For now, we assume that font value never changes,
    and so FFontTextureNode is neved changed once it's initially
    created. This is correct for normal X3D usage, since FontStyle
    fields, like family and style, are initializeOnly.

    In the future, if we want to handle FontStyle field changes,
    then chFontStyle should provoke recreating proxy (just like
    chGeometry does now) and it should provoke recreating FontTextureNode. }
  if FFontTextureNode = nil then
  begin
    if FontStyle <> nil then
      Blending := FontStyle.Blending
    else
      Blending := TFontStyleNode.DefaultBlending;
    FFontTextureNode := CreateFontTextureNode(Font, Blending);
  end;
  Result := FFontTextureNode;
end;

procedure RegisterTextNodes;
begin
  NodesManager.RegisterNodeClasses([
    TFontStyleNode,
    TTextNode
  ]);
end;

{$endif read_implementation}
