PascalType.FontScanner.pas

unit PascalType.FontScanner;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//  Version: MPL 1.1 or LGPL 2.1 with linking exception                       //
//                                                                            //
//  The contents of this file are subject to the Mozilla Public License       //
//  Version 1.1 (the "License"); you may not use this file except in          //
//  compliance with the License. You may obtain a copy of the License at      //
//  http://www.mozilla.org/MPL/                                               //
//                                                                            //
//  Software distributed under the License is distributed on an "AS IS"       //
//  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the   //
//  License for the specific language governing rights and limitations under  //
//  the License.                                                              //
//                                                                            //
//  Alternatively, the contents of this file may be used under the terms of   //
//  the Free Pascal modified version of the GNU Lesser General Public         //
//  License Version 2.1 (the "FPC modified LGPL License"), in which case the  //
//  provisions of this license are applicable instead of those above.         //
//  Please see the file LICENSE.txt for additional information concerning     //
//  this license.                                                             //
//                                                                            //
//  The code is part of the PascalType Project                                //
//                                                                            //
//  The initial developer of this code is Christian-W. Budde                  //
//                                                                            //
//  Portions created by Christian-W. Budde are Copyright (C) 2010-2017        //
//  by Christian-W. Budde. All Rights Reserved.                               //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

interface

{$I PT_Compiler.inc}

uses
  Windows, Classes, SysUtils,
  PascalType.Types,
  PascalType.Classes,
  PascalType.Unicode,
  PascalType.FontFace,
  PascalType.FontFace.SFNT,
  PascalType.Tables,
  PascalType.Tables.TrueType.Directory;

//------------------------------------------------------------------------------
//
//              TPascalTypeFontFaceScan
//
//------------------------------------------------------------------------------
// Basic font reader used to extract basic properties from a font file
//------------------------------------------------------------------------------
type
  TPascalTypeFontFaceScan = class(TCustomPascalTypeFontFace)
  private
    FTableTypes: TTableTypes;
  protected
    function LoadTableFromStream(Stream: TStream; const TableEntry: TDirectoryTableEntry): TCustomPascalTypeNamedTable; override;
    procedure Loaded; override;
  public
    constructor Create(const ATableTypes: TTableTypes = nil); reintroduce;

    function GetGlyphByCodePoint(ACodePoint: TPascalTypeCodePoint): Integer; override;
    procedure SaveToStream(Stream: TStream); override;
    function CreateLayoutEngine: TObject; override;
  end;


//------------------------------------------------------------------------------
//
//              TFontNameScanner
//
//------------------------------------------------------------------------------
// File system font scanner.
//------------------------------------------------------------------------------
type
  TFontScannedEvent = procedure(Sender: TObject; const FileName: string;
    Font: TCustomPascalTypeFontFacePersistent) of object;

  TFontNameScanner = class(TThread)
  private
    FTableTypes: TTableTypes;
    FPath: string;
    FOnFontName  : TFontScannedEvent;
    FCurrentFile : string;
    FFontFaceScan : TPascalTypeFontFaceScan;
    procedure FontScanned;
  protected
    procedure Execute; override;
  public
    constructor Create(const APath: string = '*.ttf;*.otf'; const ATableTypes: TTableTypes = nil);
    property OnFontScanned: TFontScannedEvent read FOnFontName write FOnFontName;
  end;


implementation

uses
  IOUtils,
  Generics.Collections,
  PascalType.ResourceStrings,
  PascalType.Platform.Windows;

//------------------------------------------------------------------------------
//
//              TFontNameScanner
//
//------------------------------------------------------------------------------
constructor TFontNameScanner.Create(const APath: string; const ATableTypes: TTableTypes);
var
  FolderFont: string;
begin
  inherited Create(True);

  FolderFont := GetFontDirectory;
  FPath := TPath.Combine(FolderFont, APath);
  FTableTypes := ATableTypes;
end;

procedure TFontNameScanner.Execute;
var
  Folder: string;
  Mask: string;
  Masks: TArray<string>;
  Filename: string;
begin
  if (not Assigned(FOnFontName)) then
    exit;

  Folder := TPath.GetDirectoryName(FPath);
  if (not TDirectory.Exists(Folder)) then
    exit;

  Mask := TPath.GetFileName(FPath);
  Masks := Mask.Split([';']);

  for Mask in Masks do
    for Filename in TDirectory.GetFiles(Folder, Mask) do
    begin
      if (Terminated) then
        break;

      FFontFaceScan := TPascalTypeFontFaceScan.Create(FTableTypes);
      try

        try

          // load font from file
          FFontFaceScan.LoadFromFile(Filename);

          FCurrentFile := Filename;

          Synchronize(FontScanned);

        except
          on E: EPascalTypeError do
            continue;
        else
          continue;
        end;

      finally
        FreeAndNil(FFontFaceScan);
      end;
    end;
end;

procedure TFontNameScanner.FontScanned;
begin
  if Assigned(FOnFontName) then
  begin
    UniqueString(FCurrentFile);
    FOnFontName(Self, FCurrentFile, FFontFaceScan);
  end;
end;

//------------------------------------------------------------------------------
//
//              TPascalTypeFontFaceScan
//
//------------------------------------------------------------------------------
constructor TPascalTypeFontFaceScan.Create(const ATableTypes: TTableTypes);
begin
  inherited Create;
  FTableTypes := ATableTypes;
  TArray.Sort<TTableType>(FTableTypes);
end;

function TPascalTypeFontFaceScan.CreateLayoutEngine: TObject;
begin
  Result := nil;
end;

function TPascalTypeFontFaceScan.GetGlyphByCodePoint(ACodePoint: TPascalTypeCodePoint): Integer;
begin
  Result := GlyphNotDef;
end;

procedure TPascalTypeFontFaceScan.Loaded;
begin
  // Verify that required tables are present
  if (HeaderTable = nil) then
    raise EPascalTypeError.Create(RCStrNoHeaderTable);

  if (NameTable = nil) then
    raise EPascalTypeError.Create(RCStrNoNameTable);
end;

function TPascalTypeFontFaceScan.LoadTableFromStream(Stream: TStream; const TableEntry: TDirectoryTableEntry): TCustomPascalTypeNamedTable;
begin
  // We only need to load a very few tables
  case TableEntry.TableType.AsCardinal of
    // Required table types
    ttName,
    ttHead:
      Result := inherited;

  else
    var Index: integer;
    if (FTableTypes <> nil) and (TArray.BinarySearch<TTableType>(FTableTypes, TableEntry.TableType, Index)) then
      Result := inherited
    else
      Result := nil;
  end;
end;

procedure TPascalTypeFontFaceScan.SaveToStream(Stream: TStream);
begin
  raise EPascalTypeNotImplemented.Create(RCStrNotImplemented);
end;



end.